;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.153
;;; Reason:
;;;  User and Server telnet now agree on Lispm Keyboard conventions:
;;;   - Super key causes Control-\ prefix (compatible with 3.0 TCP)
;;;   - Meta key causes Escape prefix (compatible with 3.0 TCP)
;;;   - Break, Help, Abort, and Resume keys sent through intact
;;;   - Clear-Input --> Control-U
;;;   - Quote --> Control-V
;;;   - BS, TAB, Line, Form, Rubout --> obvious ASCII translations
;;; Written 8-Dec-87 12:28:51 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.151, 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#46 at 8-Dec-87 12:28:52
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TERMCAP  "

(defun translate-char (c)
  (setq c (or (cadr (assoc c *special-ascii-lispm-translations* :test #'eq)) c))
  (unless (characterp c)
    (when (< c #o40)
      (setq c (set-char-bit (logior c #o100) :control t))))
  (int-char c))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#305 at 8-Dec-87 12:29:03
#8R SUPDUP#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "

(DEFVAR TELNET-SUPDUP-KEYS (MAKE-ARRAY #o200 :TYPE 'ART-16B))
(FILLARRAY TELNET-SUPDUP-KEYS
	   #o'(0 100101 100370 100364		;null break clear call
	       0 37 37 177 10 11 12		;esc back-next help rubout bs tab lf
	       13 14 15 21 0			;vt form return quote hold-output
	       100365 100363 0 100366		;stop-output abort resume status
	       0 0 0 0 0 0 0 0 0 0		;end ...
	       100101 0))			;network

(FILLARRAY TELNET-KEYS
	   #o'(0 #/break 25 0			;null break clear-input call
	       0 0 #/help 177 10 11 12		;esc back-next help rubout bs tab lf
	       13 14 15 26 0			;vt form return quote hold-output
	       0 #/abort #/resume 0		;stop-output abort resume status
	       0 0 0 0 0 0 0 0 0 0		;end ...
	       0 0))				;network

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#305 at 8-Dec-87 12:29:09
#8R SUPDUP#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "

(DEFMETHOD (BASIC-TELNET :NET-OUTPUT-TRANSLATED) (CH)
  (COND ((CONSP CH)
	 (SELECTQ (FIRST CH)
	   (:MOUSE-BUTTON (IF SUPDUP-OUTPUT-FLAG
			      (MOUSE-OUT (FOURTH CH) (FIFTH CH) (SECOND CH))))))
	(T
	 (LET ((CHAR (LDB %%KBD-CHAR CH)))
	   (unless ECHO-FLAG
	     ;; Echo the character.
	     (IF (LDB-TEST %%KBD-CONTROL CH)
		 (SEND SELF :TYO #/))
	     (SEND SELF :TYO CHAR))
	   (COND ((AND SUPDUP-OUTPUT-FLAG
		       (= CHAR #/END))
		  (SEND SELF :NET-OUTPUT #o30)	;control X
		  (SEND SELF :NET-OUTPUT #o23))	;control S
		 (T
		  (AND (> CHAR #o200)
		       (SETQ CHAR (AREF (if supdup-output-flag
					    telnet-supdup-keys
					  TELNET-KEYS)
					(- CHAR #o200))))
		  (when (plusp char)
		    (AND (LDB-TEST %%KBD-CONTROL CH) (SETQ CHAR (LDB (byte 5 0) CH)))	;controlify
		    (AND (LDB-TEST %%KBD-super CH) (send self :net-output #o34))	;control-\
		    (AND (LDB-TEST %%KBD-meta CH) (send self :net-output #o33))	;escape
		    (SEND SELF :NET-OUTPUT CHAR))))))))

))