;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.151
;;; Reason:
;;;  Server Telnet's rubout handler wasn't echoing or including the :untyi'd character in its
;;;  input.  E.g., the "(" typed to a debugger prompt that causes it to type Eval: 
;;; Written 7-Dec-87 17:50:02 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.150, 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.NETWORK.IP-TCP.SERVER; TERMCAP.LISP#45 at 7-Dec-87 19:09:25
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TERMCAP  "


(defmethod (simple-ascii-stream-terminal :rubout-handler) (options function &rest args)
  (declare (arglist rubout-handler-options function &rest args))
  (if (and (eq global:rubout-handler self) (not (cdr (assoc :nonrecursive options :test #'eq))))
      (let ((tv:rubout-handler-options (append options tv:rubout-handler-options)))
	(apply function args))
    (let ((tv:rubout-handler-options options))
      (setq buffer nil status :initial-entry)
      (catch 'return-from-rubout-handler
	(let ((tv:prompt-starting-x cursor-x)
	      (tv:prompt-starting-y cursor-y)
	      (tv:rubout-handler-starting-x cursor-x)
	      (tv:rubout-handler-starting-y cursor-y)
	      (tv:rubout-handler self)
	      (tv:rubout-handler-inside self)
	      (tv:rubout-handler-re-echo-flag nil)
	      (tv:rubout-handler-activation-character nil))
	  (loop
	    (setq tv:rubout-handler-re-echo-flag nil)
	    (catch 'tv:rubout-handler			;throw here when rubbing out
	      (global:condition-case (error)
		  (return
		    (multiple-value-prog1 (apply function args)
					  (send self :force-output)))
		(sys:parse-error
		  (send self :fresh-line)
		  (princ ">>ERROR: " self)
		  (send error :report self)
		  (send self :fresh-line)
		  (setq tv:rubout-handler-re-echo-flag t)
		  (loop (send self :tyi)))))			;if error, force user to rub out
	    ;;maybe return when user rubs all the way back
	    (when (null peek-chars)
	      (let ((full-rubout-option (assoc :full-rubout tv:rubout-handler-options :test #'eq)))
		(when full-rubout-option
		  ;;***Get rid of prompt.  Ideally, something like:
		  ;;(send self :clear-between-cursorposes prompt-starting-x prompt-starting-y cursor-x cursor-y)
		  ;;(send self :set-cursorpos prompt-starting-x prompt-starting-y)
		  (dotimes (i (- cursor-x tv:prompt-starting-x))
		    (send self :tyo #\Overstrike)
		    (send self :tyo #\Space)
		    (send self :tyo #\Overstrike))
		  (return (values nil (cadr full-rubout-option))))))))))))


))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; TERMCAP.LISP#45 at 7-Dec-87 19:09:29
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TERMCAP  "


(defmethod (simple-ascii-stream-terminal :any-tyi) (&optional ignore)
  (char-int-if-any
    (cond ((not tv:rubout-handler)
	   (let ((c (if peek-chars
			(pop peek-chars)
		      (send self :subtyi))))
	     (if (eq c *telnet-quote-character*)
		 (send self :subtyi)
	       c)))
	  ('else
	   (when (member status '(:restored :initial-entry) :test #'eq)
	     (setq status nil)
	     (send self :do-rubout-handler-prompting nil)
	     (when echo-p
	       (dolist (ch (reverse peek-chars))
		 (send self :tyo ch))))
	   (do ((ch) (quote)
		(rubout? nil)
		(activation-handler (assoc :activation tv:rubout-handler-options :test #'eq)))
	       (peek-chars
		 (car (push (pop peek-chars) buffer)))
	     (setq ch (send self :subtyi))
	     (cond ((null ch)
		    (return nil))
		   ((and (not quote) (eq ch *telnet-quote-character*))
		    (setq quote t))
		   ((and (not quote) (eq ch #\Rubout))
		    (when buffer
		      (let ((x (pop buffer)))
			(dotimes (i (send self :tyo-print-length x))
			  (send self :tyo #\Overstrike)
			  (send self :tyo #\Space)
			  (send self :tyo #\Overstrike)))
		      (and (null buffer)
			   (assoc :full-rubout tv:rubout-handler-options :test #'eq)
			   (throw 'tv:rubout-handler t))
		      (setq rubout? t)))
		   ((and (not quote) (eq ch #\Control-U))
		    (when buffer
		      (format self "<RUBOUT-ALL>~%")
		      (setq tv:prompt-starting-x 0)
		      (send self :force-output)
		      (setq buffer nil)
		      (setq peek-chars nil)
		      (throw 'tv:rubout-handler t)))
		   ((and (not quote) (eq ch #\Form))
		    (send self :clear-screen)
		    (send self :redisplay ch))
		   ((and (not quote) (eq ch #\Control-R))
		    (send self :fresh-line)
		    (send self :redisplay ch))
		   (t
		    (push ch buffer)
		    (cond ((and activation-handler
				(apply (cadr activation-handler) (char-int-if-any ch) (cddr activation-handler)))
			   (setq ch `(:activation ,(char-int-if-any ch) 1))
			   (setq tv:rubout-handler-activation-character ch))
			  (echo-p
			   (send self :tyo ch)))
		    (when rubout?
		      (setq peek-chars (reverse buffer))
		      (throw 'tv:rubout-handler t))
		    (setq tv:rubout-handler-activation-character nil)
		    (return ch)))
	     )))))

))