;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.137
;;; Reason:
;;;  Telnet window assumes non-overprint mode and handles received ASCII backspaces
;;;  by backing up a character.
;;; Written 3-Dec-87 14:46:23 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.136, 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; SUPDUP.LISP#300 at 3-Dec-87 14:46:40
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "


(defmethod (basic-telnet :connect) (&optional path (net-window 3) &aux conn)
  (multiple-value-bind (host protocol contact contact-p)
      (parse-path path "TELNET" 23. :internet)
    (setq conn (send self :new-connection host protocol contact contact-p net-window)))
  (unless (errorp conn)
    (setq overprint nil)
    (telnet-send-option nvt-do nvt-echo)
    (setq echo-flag t)			;Assume success...
    (telnet-send-option nvt-do nvt-suppress-go-ahead)
    )
  conn)

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#300 at 3-Dec-87 14:46:43
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "


(defmethod (basic-telnet :buffered-tyo) (ch)
  (telnet-buffered-tyo ch))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#300 at 3-Dec-87 14:46:44
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "


(defun telnet-buffered-tyo (ch &aux ch1)
  (declare (:self-flavor basic-telnet))
  (COND ((= CH NVT-IAC)
	 (SEND SELF ':HANDLE-IAC))		;Perform new telnet negotiations.
	(( CH #o200))				;Ignore otelnet negotiations
	((AND (= CH 7) (NOT (AND SIMULATE-IMLAC-FLAG BINARY-OUTPUT-FLAG)))
	 (SEND SELF ':REMOTE-BEEP))		;^G rings the bell.
	((AND (= CH #o15)
	      (IF (= (SETQ CH1 (NVT-NETI)) #o12)	;CR LF is NVT newline "character"
		  NIL				;Output normally
		  ;; A CR not followed by a LF.  Move the "carriage" to the start of the
		  ;; current line.  Then if the next character is anything other than a NUL,
		  ;; assume the other end if not obeying protocol and output it too.
		  (SEND SELF ':FORCE-OUTPUT)
		  (MULTIPLE-VALUE-BIND (IGNORE Y) (SEND SELF ':READ-CURSORPOS)
		    (SEND SELF ':SET-CURSORPOS 0 Y))
		  (= (SETQ CH CH1) 0))))	;If NUL, skip any output
	((AND (= CH #o177) SIMULATE-IMLAC-FLAG)	;Escape character
	 (SEND SELF ':HANDLE-IMLAC-ESCAPE))
	((= ch #o10)				;Back Space
	 (send self :force-output)
	 (send self :backward-char))
	(T
	 (AND (memq ch '(#o11 #o12 #o14 #o15))	;Convert formatting controls
	      (NOT (AND SIMULATE-IMLAC-FLAG BINARY-OUTPUT-FLAG))
	      (SETQ CH (+ CH 200)))		;to Lisp machine char set.
	 (DO () ((ARRAY-PUSH OUTPUT-BUFFER CH))
	   (SEND SELF ':FORCE-OUTPUT)))))

;;; New telnet protocol IAC handler

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#300 at 3-Dec-87 15:11:35
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "

(DEFMETHOD (BASIC-TELNET :HANDLE-IAC) (&AUX COMMAND OPTION)
  (SETQ COMMAND (NVT-NETI))
  (AND ( COMMAND NVT-WILL) ( COMMAND NVT-DONT)
       (SETQ OPTION (NVT-NETI)))
  (SELECT COMMAND
    (NVT-WILL
     (SELECT OPTION
       (NVT-SUPPRESS-GO-AHEAD)		;ignore things we requested
       (NVT-ECHO
	(telnet-echo t))
       (NVT-TRANSMIT-BINARY
	(SETQ BINARY-OUTPUT-FLAG T)
	(TELNET-SEND-OPTION NVT-DO OPTION))
       (NVT-SUPDUP-OUTPUT
	(TELNET-START-SUPDUP-OUTPUT))
       (nvt-logout
	(telnet-send-option nvt-do option))
       (OTHERWISE
	(TELNET-SEND-OPTION NVT-DONT OPTION))))
    (NVT-DO
     (select option
       ((NVT-SUPPRESS-GO-AHEAD NVT-TIMING-MARK NVT-TRANSMIT-BINARY)
	(TELNET-SEND-OPTION NVT-WILL OPTION))
       (T (TELNET-SEND-OPTION NVT-WONT OPTION))))
    (NVT-DONT
     (TELNET-SEND-OPTION NVT-WONT OPTION))
    (NVT-WONT
     (select option
       (NVT-ECHO
	(telnet-echo nil))
       (NVT-TRANSMIT-BINARY
	(SETQ BINARY-OUTPUT-FLAG NIL)
	(TELNET-SEND-OPTION NVT-DONT OPTION))))
    (NVT-SUBNEGOTIATION-BEGIN
     (TELNET-HANDLE-SUBNEGOTIATION))))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#300 at 3-Dec-87 15:19:28
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "

(DEFMETHOD (BASIC-TELNET :NET-OUTPUT) (CH)
  (LOCK-OUTPUT
    (COND ((LDB-TEST #o1701 CH)
	   (SEND STREAM ':TYO NVT-IAC)
	   (SETQ CH (LDB #o0010 CH))))
    (SEND STREAM ':TYO CH)
    (COND ((= CH 15)
	   (SEND STREAM ':TYO #o12))		;CR is two chars
	  ((= CH NVT-IAC)
	   (SEND STREAM ':TYO #o377)))))	;IAC's must be quoted

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#300 at 3-Dec-87 15:20:17
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "

(DEFMETHOD (BASIC-TELNET :AFTER :DISCONNECT) ()
  (SETQ ECHO-FLAG NIL SUPDUP-OUTPUT-FLAG NIL BINARY-OUTPUT-FLAG NIL)
  (SEND SELF ':SET-LABEL (FORMAT NIL "~A -- not connected" TV:NAME)))

))