;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.165
;;; Reason:
;;;  When I souped up telnet:send-iac for Telnet, I broke it for FTP and SMTP.
;;; Written 21-Dec-87 15:34:33 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.163, 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#85 at 21-Dec-87 15:34:33
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TERMCAP  "

(defun send-iac (stream &rest commands)
  (send stream :tyo iac)
  (dolist (char commands)
    (send stream :tyo (if (symbolp char)
			  (symbol-value char)
			char)))
  (send stream :force-output))

(defun send-option (command option)
  (declare (:self-flavor telnet-server))
  (let ((item (find-option telnet-options-sent option (case command
							((do dont) '(do dont))
							((will wont) '(will wont))))))
    (cond ((null item)
	   (unless (member command '(dont wont))
	     (push (cons option command) telnet-options-sent)
	     (send-iac output command option)))
	  ((eq (cdr item) command))
	  (t
	   (setf (cdr item) command)
	   (send-iac output command option)))))

(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 output 'ga))
     t)
    (:error			;Error in process using this window as its *TERMINAL-IO*.
     t)
    (otherwise nil)))

))