;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.143
;;; Reason:
;;;  Our Telnet Server now has a Quote character: control-v.  This will allow you
;;;  to pass any of the special interrupt characters (control-b, control-g,
;;;  control-t, and now, control-v) to the lisp listener.
;;; Written 4-Dec-87 17:29:30 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.141, 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; TELNET.LISP#90 at 4-Dec-87 17:29:44
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TELNET  "


(defvar *telnet-quote-character* (glass-tty-ascii-code #\Control-V))

))

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


(defun telnet-server-input (user-process buffer remote-stream)
  (do (c int quote)
      ((null (setq c (send remote-stream :tyi))))
    (cond ((= c (get 'iac 'telnet-sym))
	   (let* ((c1 (send remote-stream :tyi))
		  (action (cadr (assoc c1 *telsyms* :test #'eq))))
	     (cond ((eq action 'ip)
		    (send user-process :interrupt 'telnet-user:abortion-interrupt))
		   (t
		    (simple-io-buffer-put buffer c)
		    (simple-io-buffer-put buffer c1)))))
	  ((and (not quote) (= c *telnet-quote-character*))
	   (setq quote t))
	  ((and (not quote) (setq int (assoc c *telnet-interrupt-characters* :test #'eq)))
	   (cond ((third int)
		  (send user-process :interrupt 
			(second int)
			(funcall (third int) user-process)))
		 (t
		  (send user-process :interrupt (second int)))))
	  ((simple-io-buffer-full-p buffer)
	   ;; GOOD QUESTION. LETS JUST THROW AWAY CHARACTERS, OTHERWISE
	   ;; WE WILL MISS ANY #\CONTROL-G'S COMING DOWN.
	   (send remote-stream :tyo (glass-tty-ascii-code #\Control-g)))
	  (t
	   (setq quote nil)
	   (simple-io-buffer-put buffer c)))))

))