;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.142
;;; Reason:
;;;  Our User Telnet is nice: If you type Meta-<x>, it sends the ASCII
;;;  character for <x> with the #o200 bit set.  Our Telnet Server now
;;;  understands this.
;;; Written 4-Dec-87 17:24:53 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; TERMCAP.LISP#39 at 4-Dec-87 17:25:18
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TERMCAP  "


(defun translate-char (c)
  (let ((meta-bit nil))
    (unless (zerop (logand c #o200))
      (setq meta-bit t)
      (setq c (logand c #o177)))
    (setq c (or (cadr (assoc c *special-ascii-lispm-translations* :test #'eq)) c))
    (when (< c #o40)
      (setq c (set-char-bit (logior c #o100) :control t)))
    (when meta-bit
      (setq c (set-char-bit (global:char-flipcase c) :meta t)))
    c))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; TERMCAP.LISP#39 at 4-Dec-87 17:25:20
#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 :subtyi) ()
  (if need-force-output (send global:self :force-output))
  (do ((c) (action) (option))
      ((not (setq c (send input :tyi)))
       nil)
    (cond ((= c (get 'iac 'telnet-sym))
	   (setq flush-next-lf nil)
	   (setq c (send input :tyi))
	   (case (setq action (cadr (assoc c *telsyms* :test #'eq)))
	     (nil)
	     (iac
	      (return #\Meta-Rubout))
	     (do
	      (setq c (send input :tyi))
	      (setq option (cadr (assoc c *telopts* :test #'eq)))
	       (push (list action option) telnet-commands-received)
	       (case option
		 (telopt_echo
		  (unless (send self :echo-p)
		    (send self :set-echo-p t)
		    (send-iac output 'will option)))
		 (telopt_sga)
		 (telopt_logout
		  (return nil))
		 (t
		  (send-iac output 'wont option))))
	     (dont
	      (setq c (send input :tyi))
	      (setq option (cadr (assoc c *telopts* :test #'eq)))
	      (push (list action option) telnet-commands-received)
	      (case option
		(telopt_echo
		 (when (send self :echo-p)
		   (send self :set-echo-p nil)
		   (send-iac output 'wont option)))
		(telopt_sga
		 (send-iac output 'wont option))))
	     (will
	      (setq c (send input :tyi))
	      (setq option (cadr (assoc c *telopts* :test #'eq)))
	      (push (list action option) telnet-commands-received)
	      (case option
		(telopt_sga
		 (send-iac output 'do option))
		(t
		 (send-iac output 'dont option))))
	     (wont
	      (setq c (send input :tyi))
	      (setq option (cadr (assoc c *telopts* :test #'eq)))
	      (push (list action option) telnet-commands-received)
	      (case option
		(telopt_sga
		 (send-iac output 'dont option))))
	     (sb
	      (do ()
		  ((= (send input :tyi) (get 'se 'telnet-sym))))
	      (push action telnet-commands-received))
	     (t
	      (push action telnet-commands-received))))
	  ((= c #\Altmode)
	   (return (set-char-bit (send global:self :subtyi) :meta t)))
	  ((= c (glass-tty-ascii-code #\Control-\\))
	   (setq c (send global:self :subtyi))
	   (return (set-char-bit (make-char (global:char-flipcase (char-code c))
					    (char-bits c))
				 :super t)))
	  ((= (setq c (translate-char c)) #\Return)
	   (setq flush-next-lf t)
	   (return #\Return))
	  ((and (= c #\Line) flush-next-lf)
	   (setq flush-next-lf nil))
	  ('else
	   (setq flush-next-lf nil)
	   (return c)))))


))