;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.163
;;; Reason:
;;;  Various cleanups in Telnet Server.  All the hooks are there for a SUPDUP server.
;;;  Better **MORE** processing.  More functions shadowed in TELNET-USER: to keep
;;;  windows from being created on host.
;;; Written 19-Dec-87 14:29:02 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.162, Experimental Local-File 73.3, Experimental FILE-Server 22.1, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.3, 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#81 at 19-Dec-87 14:42:46
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TERMCAP  "

(defstruct (termcap
	     (:conc-name termcap.)
	     (:print-function (lambda (termcap stream ignore)
				(sys:printing-random-object
				  (termcap stream :type :no-pointer)
				  (format stream "of ~A"
					  (termcap.name termcap))))))
  name
  nicknames
  documentation
  add-blank-line
  (back-space #o10)
  clear-to-end-of-display
  clear-to-end-of-line
  clear-to-beginning-of-line
  clear-screen
  cursor-motion
  (number-of-columns 256)
  (number-of-lines 1000000)
  (carriage-return '(#o15 0))
  change-scrolling-region
  cursor-horizontal-motion
  cursor-vertical-motion
  delete-character
  delete-line
  enter-delete-mode
  down-one-line
  end-delete-mode
  enter-insert-mode
  end-insert-mode
  (form-feed #o14)
  hardcopy-p
  home-cursor
  insert-character
  initialization-string
  cursor-right
  (line-feed #o12)
  (tab-stops 8)
  (tab #o11)
  cursor-up
  visible-bell
  (audible-bell #o7)
  (linewrap-indicator #\!)
  auto-new-line
  cursor-down
  cursor-left
  (cursor-motion-characters 0)
  clear-character
  multiple-character-insert
  multiple-character-delete
  multiple-line-insert
  multiple-line-delete
  fresh-line-and-clear
  (clear-screen-homes-cursor t)
  (selective-erase t)
  extended-keyboard
  overprint
  line-insert-delete
  character-insert-delete
  (new-line '(#o15 #o12))
  )

(define-termcap default "the default terminal capabilities"
  )

(define-termcap h19 "Now manufactured by Zenith Data Systems. For Zenith-Mode functions"
  :nicknames '(h-19 z29 z-29 heath zenith)
  :add-blank-line '(*esc* "L")
  :clear-to-end-of-display '(*esc* "J")
  :clear-to-end-of-line '(*esc* "K")
  :clear-to-beginning-of-line '(*esc* "l")
  :clear-screen '(*esc* "E")
  :cursor-motion '(*esc* "Y" (+ y 32) (+ x 32))
  :cursor-motion-characters 4
  :number-of-columns 80
  :number-of-lines 24 
  :delete-character '(*esc* "N")
  :delete-line '(*esc* "M")
  :enter-insert-mode '(*esc* "@")
  :end-insert-mode '(*esc* "O")
  :home-cursor '(*esc* "H")
  :cursor-up '(*esc* "A")
  :cursor-down '(*esc* "B")
  :cursor-right '(*esc* "C")
  :cursor-left '(*esc* "D")
  :tab nil
  :auto-new-line t
  )

(define-termcap vt-100 "Another commonly used terminal"
  :nicknames '(vt100)
  :clear-to-end-of-display '(*esc* "[J")
  :clear-to-end-of-line '(*esc* "[K")
  :clear-screen '(*esc* "[;H" *esc* "[2J")
  :cursor-motion '(*esc* "[" y ";" x "H")
  :cursor-motion-characters 6
  :number-of-columns 80
  :number-of-lines 24 
  :home-cursor '(*esc* "[H")
  )

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; TERMCAP.LISP#81 at 19-Dec-87 15:05: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 :after :init) (&rest ignored)
  (or termcap (send self :termcap term))
  (setq tv:superior nil)			;We are a screen
  (setq tv:line-height 1)
  (setq tv:char-width 1)
  (setq tv:width (termcap.number-of-columns termcap))
  (setq tv:height (termcap.number-of-lines termcap))
  (send self :set-more-p t))

(defmethod (simple-ascii-stream-terminal :no-inferior-windows-p) ()
  t)

(defmethod (simple-ascii-stream-terminal :notice) (event &rest args)
  (declare (ignore args))
  (case event
    ((:input :output)		;Deexposed window needs some attention
     t)
    (:input-wait		;Hanging up waiting for input.
     (setf (tv:sheet-more-flag self) 0)
     (cond ((null tv:more-vpos))		;Unless MORE inhibited entirely
	   ((< (* (- tv:height tv:cursor-y) 4)	;More than 3/4 way down window?
	       tv:height)
	    ;; Wrap around and more just before the current line
	    (setq tv:more-vpos (- tv:cursor-y tv:line-height)))
	   (t ;; More at bottom 
	    (setq tv:more-vpos (- tv:height tv:line-height))))
     t)
    (:error			;Error in process using this window as its *TERMINAL-IO*.
     t)
    (otherwise nil)))

(defmethod (simple-ascii-stream-terminal :any-tyi) (&optional ignore &aux idx c)
  (char-int-if-any
    (cond (untyi-char
	   (prog1 untyi-char
		  (setq untyi-char nil)))
	  ((> (tv:rhb-fill-pointer) (setq idx (tv:rhb-scan-pointer)))
	   ;;untyi'd characters...
	   (incf (tv:rhb-scan-pointer))
	   (aref tv:rubout-handler-buffer idx))
	  ((not (eq tv:rubout-handler self))
	   ;;rubout handling not in effect...
	   (when need-force-output
	     (send self :force-output))
	   (unless (send input :listen)
	     (send self :notice :input-wait))
	   (setq c (send input :tyi))
	   (cond ((null c) nil)
		 ((eq c #\Control-U)
		  #\Clear-Input)
		 ((eq c #\Control-R)
		  #\Delete)
		 (t
		  c)))
	  (t
	   ;;Rubout handler (will call us for new characters)
	   (funcall (or tv:stream-rubout-handler 'tv:default-rubout-handler))))))

(defmethod (simple-ascii-stream-terminal :tyi) (&optional ignore)
  (loop
    (let ((c (send self :any-tyi)))
      (when (or (null c) (numberp c))
	(return c)))))

(defmethod (simple-ascii-stream-terminal :terpri) (&aux fresh-line)
  (with-lock (output-lock)
    (setq tv:cursor-x 0)
    (incf tv:cursor-y tv:line-height)
    (cond ((= tv:cursor-y tv:height)
	   (send self :home-cursor)
	   (send self :clear-rest-of-line))
	  ((setq fresh-line (termcap.fresh-line-and-clear termcap))
	   (send self :output-control-sequence fresh-line))
	  (t
	   (send self :output-control-sequence (termcap.new-line termcap))
	   (send self :clear-rest-of-line)))
    (when (eql tv:cursor-y tv:more-vpos)
      (setf (tv:sheet-more-flag self) 1))))

(defmethod (simple-ascii-stream-terminal :more-exception) ()
  (when (plusp (tv:sheet-more-flag self))
    (setf (tv:sheet-more-flag self) 0)
    (let ((more-vpos tv:more-vpos))
      (unwind-protect
	  (progn (princ "**MORE**" output)
		 (send self :clear-rest-of-line)
		 (force-output self)
		 (send self :clear-input)
		 (send self :any-tyi))
	(setq tv:more-vpos more-vpos)
	(send self :output-control-sequence (termcap.carriage-return termcap))
	(send self :clear-rest-of-line)))))

(defmethod (simple-ascii-stream-terminal :clear-rest-of-line) (&aux clear)
  (when (setq clear (termcap.clear-to-end-of-line termcap))
    (send self :output-control-sequence clear)))

(defmethod (simple-ascii-stream-terminal :clear-window) (&aux clear)
  (cond ((setq clear (termcap.clear-screen termcap))
	 (send self :output-control-sequence clear)
	 (cond ((termcap.clear-screen-homes-cursor termcap)
		(setq tv:cursor-x 0)
		(setq tv:cursor-y 0))
	       (t
		(send self :home-cursor))))
	(t
	 (send self :fresh-line)))
  t)

(defmethod (simple-ascii-stream-terminal :set-cursorpos) (x y &optional (type :pixel))
  (ecase type
    (:pixel
     (let ((cursor-motion (termcap.cursor-motion termcap)))
       (cond (cursor-motion			;Terminal can move cursor
	      (dolist (item cursor-motion)
		(send self :output-control-sequence
		      (eval-cursorpos-item (pixels-to-chars x) (pixels-to-lines y) item)))
	      (setq tv:cursor-x x)
	      (setq tv:cursor-y y))
	     ((= tv:cursor-y y)			;Same line
	      (if (> x tv:cursor-x)
		  (dotimes (i (pixels-to-chars (- x tv:cursor-x)))
		    ;;***Probably destructive....
		    (send self :tyo #\Space))
		(dotimes (i (pixels-to-chars (- tv:cursor-x x)))
		  (send self :tyo #\Backspace))))
	     (t					;Different line.  Sorry....
	      ))))
    (:character
     (send self :set-cursorpos (chars-to-pixels x) (lines-to-pixels y)))))

(defun eval-multiple-item (n item)
  (cond ((eq item 'n)
	 n)
	((and (symbolp item) (boundp item))
	 (symbol-value item))
	((atom item)
	 item)
	('else
	 (apply (car item) (mapcar #'(lambda (z) (eval-multiple-item n z)) (cdr item))))))

(defmethod (simple-ascii-stream-terminal :insert-string) (string &optional (start 0) end (type-too t) &aux insert count)
  (when (null end)
    (setq end (string-length string)))
  (setq count (- end start))
  (multiple-value-bind (x y)
      (send self :read-cursorpos)
    (cond ((setq insert (termcap.multiple-character-insert termcap))
	   (dolist (elt insert)
	     (send self :output-control-sequence (eval-multiple-item count elt))))
	  ((setq insert (termcap.enter-insert-mode termcap))
	   (send self :output-control-sequence insert)
	   (send self :string-out string start end)
	   (send self :output-control-sequence (termcap.end-insert-mode termcap)))
	  ((setq insert (termcap.insert-character termcap))
	   (dotimes (i count)
	     (send self :output-control-sequence insert))
	   (send self :set-cursorpos x y)
	   (send self :string-out string start end))
	  (t					;Sorry...
	   ))
    (unless type-too
      (send self :set-cursorpos x y))))

(defmethod (simple-ascii-stream-terminal :delete-string) (string &optional (start 0) end &aux delete count)
  (when (null end)
    (setq end (string-length string)))
  (setq count (- end start))
  (cond ((setq delete (termcap.multiple-character-delete termcap))
	 (dolist (elt delete)
	   (send self :output-control-sequence (eval-multiple-item count elt))))
	((setq delete (termcap.delete-character termcap))
	 (dotimes (i count)
	   (send self :output-control-sequence delete)))
	((setq delete (termcap.enter-delete-mode termcap))
	 ;;I don't known how to use this...
	 )
	(t					;Sorry....
	 )))

(defmethod (simple-ascii-stream-terminal :clear-between-cursorposes) (x1 y1 x2 y2)
  (normal-clear-between-cursorposes x1 y1 x2 y2))

(defun normal-clear-between-cursorposes (x1 y1 x2 y2)
  (declare (:self-flavor simple-ascii-stream-terminal))
  (cond ((null (termcap.cursor-motion termcap))
	 ;;No cursor motion
	 (cond ((= y1 y2)			;clear in same line
		(erase-chars (pixels-to-chars (- x2 x1))))
	       ((= y2 tv:cursor-y)		;multiple lines, but end on current line
		(erase-chars (pixels-to-chars x2)))
	       (t				;sorry... 
		)))
	((= y1 y2)				;Erase within line
	 (let ((delete (pixels-to-chars (- x2 x1))))
	   (cond ((= tv:cursor-x x1)
		  (dotimes (i delete)
		    (send self :tyo #\Space))
		  (send self :set-cursorpos x1 y1))
		 ((or (/= tv:cursor-x x2)
		      (< (+ (* 2 (termcap.cursor-motion-characters termcap)) delete)
			 (* 3 delete)))
		  (send self :set-cursorpos x1 y1)
		  (dotimes (i delete)
		    (send self :tyo #\Space))
		  (send self :set-cursorpos x1 y1))
		 (t
		  (erase-chars delete)))))
	(t
	 (let ((clear-to-bol (termcap.clear-to-beginning-of-line termcap))
	       (clear-to-eol (termcap.clear-to-end-of-line termcap)))
	   (cond (clear-to-bol
		  (send self :set-cursorpos x2 y2)
		  (send self :output-control-sequence clear-to-bol))
		 (t
		  (send self :set-cursorpos 0 y2)
		  (dotimes (i (pixels-to-chars x2))
		    (send self :tyo #\Space))))
	   (dotimes (i (- (pixels-to-lines (+ y2 (if (> y2 y1) 0 tv:height)))
			  (pixels-to-lines y1)
			  1))
	     (send self :set-cursorpos 0 (mod (+ y1 (* (1+ i) tv:line-height)) tv:height))
	     (send self :output-control-sequence clear-to-eol))
	   (send self :set-cursorpos x1 y1)
	   (send self :output-control-sequence clear-to-eol)))))


))


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

(defconstant %tdbs  #o211 "Back space")
(defconstant %tdlf  #o212 "Line Feed")
(defconstant %tdcr  #o213 "Carriage Return")
(defconstant %tdors #o214 "Output reset")
(defconstant %tdqot #o215 "Quote following character")
(defconstant %tdbel #o221 "Create audible tone")
(defconstant %tdbow #o227 "Black on White mode")
(defconstant %tdrst #o230 "Reset")
(defconstant %tdgrf #o231 "Graphics")

(define-termcap supdup "Supdup"
  :add-blank-line '(%tdilp 1)
  :clear-character %tddlf
  :clear-to-end-of-display %tdeof
  :clear-to-end-of-line %tdeol
  :clear-screen %tdclr
  :cursor-right %tdfs
  :cursor-motion '(%tdmv0 y x)
  :delete-character '(%tddcp 1)
  :delete-line '(%tddlp 1)
  :insert-character '(%tdicp 1)
  :multiple-character-insert '(%tdicp n)
  :multiple-character-delete '(%tddcp n)
  :multiple-line-insert '(%tdilp n)
  :multiple-line-delete '(%tddlp n)
  :fresh-line-and-clear %tdcrl
  :back-space %tdbs
  :carriage-return %tdcr
  :line-feed %tdlf
  :new-line '(%tdcr %tdlf)
  :audible-bell %tdbel
  :tab nil
  )

(defun start-supdup-output (type)
  (declare (:self-flavor simple-ascii-stream-terminal))
  (let ((nwords (dpb (get-18-bits input) (byte 18. 0) -1))
	(ttyopt-left 0)
	(ttyopt-right 0)
	(ttyrol 0))
    (when (or (< nwords -16.) (> nwords 0))
      (return-from start-supdup-output nil))
    (get-18-bits input)
    (when (not (zerop nwords))
      (get-18-bits input)
      (unless (= (get-18-bits input) 7)
	(return-from start-supdup-output nil))
      (incf nwords))
    (send self :termcap type)
    (setq termcap (copy-termcap termcap))
    (when (not (zerop nwords))
      (setq ttyopt-left (get-18-bits input))
      (setf (termcap.selective-erase termcap) (not (zerop (logand ttyopt-left #o40000))))
      (setf (termcap.overprint termcap) (not (zerop (logand ttyopt-left #o1000))))
      (setf (termcap.extended-keyboard termcap) (not (zerop (logand ttyopt-left #o10))))
      (setf (termcap.line-insert-delete termcap) (not (zerop (logand ttyopt-left #o2))))
      (setf (termcap.character-insert-delete termcap) (not (zerop (logand ttyopt-left #o1))))
      (send self :set-more-p (not (zerop (logand ttyopt-left #o200))))
      (setq ttyopt-right (get-18-bits input))
      (incf nwords))
    (when (not (zerop nwords))
      (get-18-bits input)
      (setq tv:height (get-18-bits input))	;height in lines
      (setf (termcap.number-of-lines termcap) tv:height)
      (incf nwords))
    (when (not (zerop nwords))
      (get-18-bits input)
      (setq tv:width (get-18-bits input))	;width in characters
      (setf (termcap.number-of-columns termcap) tv:width)
      (incf nwords))
    (when (not (zerop nwords))
      ;;scroll glitch
      (get-18-bits input)
      (setq ttyrol (get-18-bits input))
      (incf nwords))
    (when (not (zerop nwords))
      ;;TTYSMT
      (let ((x (get-18-bits input)))
	(setq tv:line-height (ldb (byte 8 10) x))
	(setq tv:height (* tv:height tv:line-height))
	(setq tv:char-width (ldb (byte 4 6) x))
	(setq tv:width (* tv:width tv:char-width)))
      (get-18-bits input)
      (incf nwords))
    (do ()
	((zerop nwords))
      (get-18-bits input)
      (get-18-bits input)
      (incf nwords))
    ))

))

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

(define-termcap supdup-output "Telnet Supdup Output"
  :add-blank-line '(supdup-sb 2 %tdilp 1 supdup-se)
  :clear-character '(supdup-sb 1 %tddlf supdup-se)
  :clear-to-end-of-display '(supdup-sb 1 %tdeof supdup-se)
  :clear-to-end-of-line '(supdup-sb 1 %tdeol supdup-se)
  :clear-screen '(supdup-sb 1 %tdclr supdup-se)
  :cursor-right '(supdup-sb 1 %tdfs supdup-se)
  :cursor-motion '(supdup-sb 3 %tdmv0 y x supdup-se)
  :delete-character '(supdup-sb 2 %tddcp 1 supdup-se)
  :delete-line '(supdup-sb 2 %tddlp 1 supdup-se)
  :insert-character '(supdup-sb 2 %tdicp 1 supdup-se)
  :multiple-character-insert '(supdup-sb 2 %tdicp n supdup-se)
  :multiple-character-delete '(supdup-sb 2 %tddcp n supdup-se)
  :multiple-line-insert '(supdup-sb 2 %tdilp n supdup-se)
  :multiple-line-delete '(supdup-sb 2 %tddlp n supdup-se)
  :fresh-line-and-clear '(supdup-sb 1 %tdcrl supdup-se)
  :cursor-motion-characters 12
  )

(defmethod (telnet-server :notice) (event &rest args)
  (declare (ignore args))
  (case event
    ((:input :output)		;Deexposed window needs some attention
     t)
    (:input-wait		;Hanging up waiting for input.
     (setf (tv:sheet-more-flag self) 0)
     (cond ((null tv:more-vpos))		;Unless MORE inhibited entirely
	   ((< (* (- tv:height tv:cursor-y) 4)	;More than 3/4 way down window?
	       tv:height)
	    ;; Wrap around and more just before the current line
	    (setq tv:more-vpos (- tv:cursor-y tv:line-height)))
	   (t ;; More at bottom 
	    (setq tv:more-vpos (- tv:height tv:line-height))))
     (unless (find-option telnet-options-received 'telopt_sga '(do))
       ;;Unless remote side said Do Suppress Go-aheads, send a Go-ahead
       (send-iac 'ga))
     t)
    (:error			;Error in process using this window as its *TERMINAL-IO*.
     t)
    (otherwise nil)))

(defmethod (telnet-server :subtyi) ()
  (if need-force-output (send self :force-output))
  (flet ((getc (tcp stream)
	   (unless (send tcp :listen)
	     (send stream :notice :input-wait))
	   (send tcp :tyi)))
    (do ((c) (quote)
	 (extended (termcap.extended-keyboard termcap)))
	((not (setq c (or untyi-char (getc input self))))
	 nil)
      (cond (untyi-char
	     (return (prog1 untyi-char (setq untyi-char nil))))
	    ((= c iac)
	     (multiple-value-bind (done value)
		 (receive-iac)
	       (when done
		 (return value))))
	    ((and (not quote) (= c *telnet-ascii-quote-character*))
	     (setq quote t))
	    ((and (not extended) (not quote) (= c (glass-tty-ascii-code #\Altmode)))
	     (setq c (send self :subtyi))
	     (return (set-char-bit (make-char (if (plusp (char-bits c)) c (global:char-flipcase (char-code c)))
					      (char-bits c))
				   :meta t)))
	    ((and (not quote) (= c (glass-tty-ascii-code #\Control-\\)))
	     (cond (extended
		    (let ((bits (send input :tyi)))
		      (when (= bits #o034)
			(return c))
		      (setq c (send input :tyi))
		      (return (make-char (global:char-flipcase c) (logand bits #o77)))))
		   (t
		    (setq c (send self :subtyi))
		    (return (set-char-bit (make-char (if (plusp (char-bits c)) c (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)
	     (when quote
	       (setq untyi-char c)
	       (setq c *telnet-quote-character*))
	     (return c))))))

(defmethod (telnet-server :any-tyi) (&optional ignore)
  (let ((extended (termcap.extended-keyboard termcap))
	idx c quote)
    (char-int-if-any
      (loop
	(cond (untyi-char
	       (return (prog1 untyi-char
			      (setq untyi-char nil))))
	      ((> (tv:rhb-fill-pointer) (setq idx (tv:rhb-scan-pointer)))
	       (incf (tv:rhb-scan-pointer))
	       (setq c (aref tv:rubout-handler-buffer idx))
	       (cond ((and (not quote) (= c *telnet-quote-character*))
		      (setq quote t))
		     (extended
		      (return c))
		     (t
		      (return c))))
	      ((not (eq tv:rubout-handler self))
	       (setq c (send self :subtyi))
	       (cond ((null c)
		      (return nil))
		     ((and (not quote) (= c *telnet-quote-character*))
		      (setq quote t))
		     (extended
		      (return c))
		     (quote
		      (return c))
		     ((eq c #\Control-U)
		      (return #\Clear-Input))
		     ((eq c #\Control-R)
		      (return #\Delete))
		     (t
		      (return c))))
	      (t
	       (return (funcall (or tv:stream-rubout-handler 'tv:default-rubout-handler)))))))))

(defmethod (telnet-server :clear-between-cursorposes) (x1 y1 x2 y2)
  (if (eq term :supdup-output)
      (supdup-clear-between-cursorposes x1 y1 x2 y2)
    (normal-clear-between-cursorposes x1 y1 x2 y2)))

(defun handle-subnegotiation ()
  (declare (:self-flavor telnet-server))
  (let* ((c (send input :tyi))
	 (option (cadr (assoc c *telopts* :test #'eq))))
    (case option
      (telopt_supdup-output
       (when (= (send input :tyi) 1)
	 (start-supdup-output :supdup-output))))
    ;;Here to skip to end of subnegotiation
    (do ((iac-seen nil))
	((and iac-seen (= (send input :tyi) se)))
      (setq iac-seen (= (send input :tyi) iac)))))
))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; TELNET-UTILITIES.LISP#9 at 19-Dec-87 16:51:02
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TELNET-UTILITIES  "

(defun telnet-user:help ()
  (format t "~&You are logged into a Lisp Machine Telnet Server.

Interrupt Keys:
    Control-G        Abort Interrupt
    Control-T        Status Interrupt
    Control-S        Stop Output
    Control-Q        Resume Output
    Control-Z        Break Interrupt

Quote character:
    Control-V <x>    <x>
")
  (cond ((eq 'tv:alternate-rubout-handler (global:symeval-in-instance *terminal-io* 'tv:stream-rubout-handler))
	 (format t "
Your terminal is smart enough to use the full Lisp Machine Rubout handler
for editing input.
"))
	(t
	 (format t "
Your terminal is smart enough only to provide minimal rubout handling.

Keys to Edit Input:
    Rubout           Delete one character
    Meta-Rubout      Delete one word
    Control-U        Delete all input
    Control-L        Clear screen and refresh input
    Control-R        Fresh Line and refresh input
")))
  (cond ((telnet:termcap.extended-keyboard (global:symeval-in-instance *terminal-io* 'telnet:termcap))
	 (format t "
Your terminal can send Control, Meta, Super, and Hyper bits with its characters.
"))
	(t
	 (format t "
Ascii Keys for the rubout handler:
    Control-U        Delete all input (Clear-Input)
    Control-L        Clear screen and refresh input (Clear-Screen)

Prefix keys to modify characters:
    Escape <x>       Meta-<x>
    Control-\\ <x>    Super-<x>
")))
  (format t "
Useful programs in the TELNET-USER package:
    (logout)         Close the Telnet connection
    (help)           Print this message
")
  )

))


; From modified file DJ: L.NETWORK.IP-TCP.SERVER; TELNET.LISP#105 at 21-Dec-87 11:57:58
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TELNET  "

(defun telnet-server-function (remote-stream)
  (let* ((safe-input-stream (make-eof-throwing-stream remote-stream))
	 (si:user-id nil)
	 (telnet-user:*term* nil)
	 (cvars '(telnet-user:*term* si:user-id)))
    (global:using-resource (terminal telnet-server remote-stream safe-input-stream)
      (catch 'eof
	(send terminal :send-if-handles :send-initial-telnet-frobs)
	(format terminal "~%Welcome to ~A Server Telnet.~%" (send si:local-host :name))
	(send terminal :force-output)
	(telnet-user-login terminal)
	(send terminal :initialize-terminal)
	(global:print-herald terminal)
	(format terminal "~%Type (help) for keyboard help~%~%")
	(send terminal :force-output)
	(subprocess :closure-variables cvars
		    (loop
		      (send terminal :force-output)
		      (sys:process-sleep *telnet-asynchronous-force-output-period*)))
	(multiple-value-bind (buffer-stream buffer)
	    (make-simple-io-buffer-stream)
	  (send terminal :set-input-stream buffer-stream)
	  (send terminal :set-more-p t)
	  (send sys:current-process :set-priority 1)
	  (catch 'telnet-server-logout
	    (telnet-server-input (subprocess :closure-variables cvars
					     (global:progw (append *telnet-user-process-bindings* si:*break-bindings*)
					       (catch 'telnet-server-logout
						 (si:lisp-top-level1 terminal))
					       (send (network-server-process *server*)
						     :interrupt #'telnet-user:logout)))
				 buffer
				 remote-stream
				 terminal)))))))

))

; From modified file DJ: L.NETWORK; PACKAGES.LISP#25 at 21-Dec-87 12:08:26
#10R USER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "USER")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; PACKAGES  "

(defpackage telnet-user
  ;;Like USER, but has a few functions shadowed...
  (:shadow "LOGOUT" "ED" "FED" "INSPECT" "KERMIT" "PEEK" "SUPDUP" "TELNET" "ZMAIL")
  (:use "GLOBAL"))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; TELNET-UTILITIES.LISP#10 at 21-Dec-87 12:08:44
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TELNET-UTILITIES  "

(defun telnet-user:ed (&rest ignored)
  (no-window-calls))

(defun telnet-user:fed (&rest ignored)
  (no-window-calls))

(defun telnet-user:inspect (&rest ignored)
  (no-window-calls))

(defun telnet-user:kermit (&rest ignored)
  (no-window-calls))

(defun telnet-user:peek (&rest ignored)
  (no-window-calls))

(defun telnet-user:supdup (&rest ignored)
  (no-window-calls))

(defun telnet-user:telnet (&rest ignored)
  (no-window-calls))

(defun telnet-user:zmail (&rest ignored)
  (no-window-calls))

(defun telnet:no-window-calls ()
  "You can't call a function that switches windows")


))