;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.226
;;; Reason:
;;;  Supdup and Telnet servers now look even more like normal Lisp consoles --
;;;  they don't erase the **MORE** when you type Abort while waiting.
;;; Written 7-Apr-88 17:38:13 by pld at site LMI
;;; while running on Opus from band 2
;;; with Experimental System 123.225, Experimental Local-File 73.4, Experimental FILE-Server 22.2, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Tiger 27.0, Experimental Site Data Editor 9.0, Experimental Tape 22.0, microcode 1755, SDU Boot Tape 3.14, SDU ROM 8, Beta II/site/patch.



; From modified file OPUS: L.NETWORK.IP-TCP.SERVER; TERMCAP.LISP#94 at 7-Apr-88 17:38:13
#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 :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))
	(cond ((= tv:cursor-y (- tv:height tv:line-height))
	       ;;At bottom, wrap around.  Next MORE in same place
	       (send self :home-cursor)
	       (send self :clear-rest-of-line))
	      ((null tv:more-vpos))		;MORE inhibited
	      ((< (* (- 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))))))))

))