;;; -*- Mode:Lisp; Readtable:COMMON-LISP; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.159
;;; Reason:
;;;  (:method tv:stream-mixin :rubout-handler) calls (sheet-clear-between-cursorposes).
;;;  It should call the :clear-between-cursorposes method (the default one supplied
;;;  by tv:stream-mixin simply calls the function -- but streams can override it).
;;; Written 11-Dec-87 10:48:00 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.158, Experimental Local-File 73.3, Experimental FILE-Server 22.1, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.0, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, microcode 1754, SDU Boot Tape 3.12, SDU ROM 8.



; From modified file DJ: L.WINDOW; STREAM.LISP#152 at 11-Dec-87 10:51:53
#8R TV#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TV")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: WINDOW; STREAM  "

(defmethod (stream-mixin :rubout-handler) (options function &rest args)
  (declare (arglist rubout-handler-options function &rest args))
  (if (and (eq rubout-handler self) (not (cdr (assq :nonrecursive options))))
      (let ((rubout-handler-options (append options rubout-handler-options)))
	(apply function args))
    (let ((rubout-handler-options options))
      (if ( (rhb-fill-pointer) (rhb-scan-pointer))
	  (setf (rhb-fill-pointer) 0)
	(copy-array-portion rubout-handler-buffer (rhb-scan-pointer) (rhb-fill-pointer)
			    rubout-handler-buffer 0 (array-length rubout-handler-buffer))
	(if (numberp (rhb-typein-pointer))
	    (decf (rhb-typein-pointer) (rhb-scan-pointer)))
	(decf (rhb-fill-pointer) (rhb-scan-pointer)))
      (setf (rhb-scan-pointer) 0 (rhb-status) :initial-entry)
      (catch 'return-from-rubout-handler
	(let (prompt-starting-x prompt-starting-y
	      rubout-handler-starting-x rubout-handler-starting-y
	      (rubout-handler self)
	      (rubout-handler-inside self)
	      (rubout-handler-re-echo-flag nil)
	      (rubout-handler-activation-character nil))
	  (multiple-value (prompt-starting-x prompt-starting-y) (send self :read-cursorpos))
	  (setq rubout-handler-starting-x prompt-starting-x
		rubout-handler-starting-y prompt-starting-y)
	  (do-forever
	    (setq rubout-handler-re-echo-flag nil)
	    (catch 'rubout-handler			;Throw here when rubbing out
	      (condition-case (error)
		  (return
		   (multiple-value-prog1
		     (apply function args)		;Call READ or whatever.
		     (setf (rhb-fill-pointer) (rhb-scan-pointer))
		     (and (rhb-typein-pointer)
			  (> (rhb-typein-pointer) (rhb-fill-pointer))
			  (setf (rhb-typein-pointer) (rhb-fill-pointer)))))
		(sys:parse-error
		 (send self :fresh-line)
		 (princ ">>ERROR: " self)
		 (send error :report self)
		 (send self :fresh-line)
		 (setq rubout-handler-re-echo-flag t)
		 (do-forever (send self :tyi)))))	;If error, force user to rub out
	    ;;Maybe return when user rubs all the way back
	    (and (zerop (rhb-fill-pointer))
		 (let ((full-rubout-option (assq :full-rubout rubout-handler-options)))
		   (when full-rubout-option
		     ;; Get rid of the prompt, if any.
		     (send self :clear-between-cursorposes
				prompt-starting-x prompt-starting-y
				(- cursor-x left-margin-size) (- cursor-y top-margin-size))
		     (send self :set-cursorpos prompt-starting-x prompt-starting-y)
		     (return (values nil (cadr full-rubout-option))))))))))))

))