;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for KERMIT version 34.1
;;; Reason:
;;;  Kermit's H19 emulation was broken: a REAL H19 is 80 characters wide and will
;;;  automatically go to the next line when you write into the 80th column.  Some
;;;  programs depend on this...
;;; Written 15-Dec-87 16:43:06 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.160, 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.KERMIT; TERM.LISP#61 at 15-Dec-87 16:44:12
#10R KERMIT#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; TERM  "


(DEFSUBST TERMINAL-CHARACTER-WIDTH ()
  (MULTIPLE-VALUE-BIND (WIDTH IGNORE)
      (SEND *TERMINAL* ':SIZE-IN-CHARACTERS)
    (min 80. WIDTH)))

))

; From modified file DJ: L.NETWORK.KERMIT; TERM.LISP#61 at 15-Dec-87 16:44:50
#10R KERMIT#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; TERM  "

(DEFUN READ-CHAR-FROM-SERIAL-STREAM-TO-TERMINAL ()
  (LET ((KEYSTROKE (SERIAL-TYI)))
    (when (not keystroke)
      (return-from READ-CHAR-FROM-SERIAL-STREAM-TO-TERMINAL :eof))
    (when (eq keystroke #o377)
      ;; telnet IAC which can only be seen if *serial-stream-mask* is set to #o377
      (return-from READ-CHAR-FROM-SERIAL-STREAM-TO-TERMINAL (handle-telnet-iac)))
    (COND (*INPUT-FLOW-CONTROL*
	   ;; of course, instead of doing this we might just as well work a bit
	   ;; on speeding up the terminal emulation itself so that we wouldnt fall
	   ;; behind at 9600 baud. but we make it fine at 1200 baud already, the
	   ;; most usual operating speed over dial up lines. It is losers in the field
	   ;; who want to flow-control. On the other hand would also be nice to have
	   ;; a termcap entry for this "terminal" that had sufficient padding.
	   ;; the worlds slowest and most expensive H19.
	   ;; With a unibus channel of 5k characters we never fall behind, which is
	   ;; the solution I prefer. On the other hand it should be the microcode
	   ;; that implements hardware and software flow control on input.
	   ;; But even that may lose depending on the uart's silo characterists.
	   (MULTIPLE-VALUE-BIND (AMOUNT MAX)
	       ;; a reasonable optimization regardless of flow control nonsense
	       ;; is to look ahead and process all easy characters if available,
	       ;; collect them into a string and do a string out.
	       (SEND *SERIAL-STREAM* :INPUT-CHARACTERS-AVAILABLE)
	     (COND ((EQ *INPUT-FLOW-CONTROL* :CATCHING-UP)
		    (COND ((< (* 3 AMOUNT) (* 1 MAX))
			   ;; less than 1/3 full, must be catching up now, so let 'em rip.
			   (SEND *SERIAL-STREAM* :TYO #o21)
			   (SETQ *INPUT-FLOW-CONTROL* :READY))))
		   ((> (* 3 AMOUNT) (* 2 MAX))
		    ;; if more than 2/3 full we must be falling behind, so make 'em stop.
		    (SETQ *INPUT-FLOW-CONTROL* :CATCHING-UP)
		    (SEND *SERIAL-STREAM* :TYO #o23))))))

    (COND (*tek-in-graphics-mode*
	   (COND ((eq keystroke *tek-pad*))
		 ((EQ KEYSTROKE *TEK-PRINTMODE*)
		  (SETQ *TEK-IN-GRAPHICS-MODE* NIL))
		 ((EQ KEYSTROKE *CR*)
		  (SETQ *TEK-IN-GRAPHICS-MODE* NIL)
		  (SEND *SERIAL-STREAM* :UNTYI KEYSTROKE))
		 ((EQ KEYSTROKE *TEK-GRAPHMODE*)
		  (setq *tek-firstp* t))
		 ((EQ KEYSTROKE #\ALT)
		  (escape-dispatch))
		 ((EQ KEYSTROKE #O12)
		  (TERMINAL-LINEFEED))
		 ((>= KEYSTROKE #O40)
		  (SEND *SERIAL-STREAM* :UNTYI KEYSTROKE)
		  (MULTIPLE-VALUE-BIND (X Y)
		      (get-tek-vector)
		    (COND (*tek-firstp*
			   (SETQ *tek-firstp* NIL)
			   (TEK-MOVE X Y))
			  ('ELSE
			   (TEK-DRAW X Y)))))))
	  ((AND *TEK-EMULATIONP* (EQ KEYSTROKE *TEK-GRAPHMODE*))
	   (setq *tek-in-graphics-mode* t)
	   (setq *tek-firstp* t))

	  ((EQ KEYSTROKE #O33)			;ASCII <ALTMODE> [ESCAPE]
	   (ESCAPE-DISPATCH))

	  ((< #O31 KEYSTROKE #O200)
	   (AND *LOGFILE* TURN-ON-LOGGING? (SEND *LOGFILE* ':TYO KEYSTROKE))	;LOGFILE KLUDGE
	   (COND (*INSERT-FLAG* (TERMINAL-INSERT-CHAR)))
	   (LET ((STORE (TERMINAL-ERASE-ALUF)))
	     (TERMINAL-SET-ERASE-ALUF (IF *REVERSE-VIDEO-FLAG* TV:ALU-IOR TV:ALU-ANDCA))
	     (TERMINAL-CLEAR-CHAR)
	     (TERMINAL-SET-ERASE-ALUF STORE))
	   (TERMINAL-TYO KEYSTROKE)
	   (when (>= (TERMINAL-READ-CURSORPOS) (TERMINAL-CHARACTER-WIDTH))
	     (TERMINAL-CR)
	     (terminal-linefeed)))

	  (T (SELECTQ KEYSTROKE
	       (0)
	       (#O7 (TERMINAL-BEEP))
	       (#O10 (TERMINAL-BACKSPACE))
	       (#O11 (TERMINAL-TAB)
		     (AND *LOGFILE* TURN-ON-LOGGING? (SEND *LOGFILE* ':TYO #O211)))
	       (#O12 (TERMINAL-LINEFEED)
		     (if *auto-clear-eol-on-linefeed-flag* (terminal-clear-eol)))
	       (#O15 (TERMINAL-CR)
		     (AND *TEK-EMULATIONP* (TEK-RESET-MEMORY))
		     (AND *LOGFILE* TURN-ON-LOGGING? (SEND *LOGFILE* ':TYO #O215)))
	       (T (terminal-tyo keystroke)
		  (COND (*TERMINAL-DEBUG-MODE*
			 (FORMAT INTERACTION-PANE
				 "~%Unrecognized /"control character/": ~O [~:@C]"
				 KEYSTROKE KEYSTROKE)))) 
	       )))))

))

; From modified file DJ: L.NETWORK.KERMIT; TERM.LISP#61 at 15-Dec-87 16:45:01
#10R KERMIT#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; TERM  "

(defun terminal-show-status-of-connection ()
  (si:with-help-stream (standard-output
			 :label `(:string "Terminal Status"
					  ,@(if (boundp 'fonts:metsi)
						'(:font fonts:metsi))
					  :top :centered)		    
			 :superior *terminal*)
    ;; status of logging:
    (format t "~&Logging is ~A~A."
	    (if *logfile* "ON" "OFF")
	    (if *logfile*
		(if turn-on-logging? " and ENABLED" " but DISABLED")
	      ""))
    ;; and show logfile name if any:
    (if *logfile*
	(format t "~&Logfile name is: ~A" *logfile*))
    ;; status of echo:
    (format t "~&Local-echo-mode is ~A."
	    (if *local-echo-mode* "ON" "OFF"))
    ;; terminal sizes:
    (let ((font (send *terminal* ':current-font)))
      (format t "~&Terminal sizes:~% Height: ~D lines; ~D pixels per line.~A"
	      (terminal-character-height)
	      (tv:font-char-height font)
	      (format nil "~% Width: ~D characters; ~D pixels per character."
		      (terminal-character-width)
		      (tv:font-char-width font))))
    ;; graphics emulation
    (format t "~&Tektronics 4010 emulation is ~:[OFF~;ON~]." *TEK-EMULATIONP*)

    ;; line status:
    (format t "~%Remote input flow control processing is ~:[not active~;enabled~]."
	    *input-flow-control*)
    (cond ((and (get 'unix:unix-stream 'si:flavor)
		(typep *serial-stream* 'unix:unix-stream))
	   (describe *serial-stream*))
	  ((typep *serial-stream* 'si:sdu-serial-stream)
	   (MULTIPLE-VALUE-BIND (AMOUNT MAX)
	       ;; a reasonable optimization regardless of flow control nonsense
	       ;; is to look ahead and process all easy characters if available,
	       ;; collect them into a string and do a string out.
	       (SEND-IF-HANDLES *SERIAL-STREAM* :INPUT-CHARACTERS-AVAILABLE)
	     (format t "~%baud rate of ~A: ~d,~
                        ~%~D input character~p unprocessed, ~D buffer capacity."
	      *serial-stream*
	      (send *serial-stream* ':baud-rate)
	      amount amount max))
	   (si:sdu-serial-status))
	  (t (describe *serial-stream*)))
    
    ))

))