;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.196
;;; Reason:
;;;  MORE processing now looks the same on Supdup/Telnet server as on console:
;;;  If More exception occurs on bottom line, next line printed goes at top,
;;;  not on that line.  If More exception occurs above bottom line, the next
;;;  MORE will appear one line up, until less than 3/4 way to top, when it
;;;  will appear on bottom line.
;;; Written 27-Jan-88 12:31:34 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.194, 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#93 at 27-Jan-88 12:32:15
#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))))))))

))