;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for KERMIT version 34.2
;;; Reason:
;;;  Agree with Lispm Machine keyboard standards:  Super means prefix
;;;  with Control-\, Meta means prefix with Escape, Control-Meta does
;;;  NOT mean prefix with Control-Z (controlled by *use-control-z-for
;;;  -control-meta*)
;;; Written 16-Dec-87 13:56:49 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.1, 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#64 at 16-Dec-87 13:57:27
#10R KERMIT#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; TERM  "

(defconst *use-control-z-for-control-meta* nil)

))

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

(defun read-char-from-keyboard-to-serial-stream ()
  (declare (special *escchr*))
  (let ((key-stroke (terminal-any-tyi)))
    (cond ((and (not (atom key-stroke)) (eq (car key-stroke) ':menu))
	   (funcall (cadddr key-stroke) ':execute (cadr key-stroke)))
	  ((not (fixnump key-stroke)) (beep))
	  (t (if *local-echo-mode*
		 (format *terminal* "~C" key-stroke))
	     (when (memq (ldb %%kbd-char key-stroke) '(#\Rubout #\Delete))
	       (setq key-stroke (dpb #o177 %%kbd-char key-stroke)))
	     (select key-stroke
	       (*escchr* (network-keystroke-handler))
	       (#\Call (serial-tyo #\))	; send a [top-c] (for ascii ctrl-z)
	       (t (let ((char (ldb %%kbd-char key-stroke))
			(control (ldb %%kbd-control key-stroke))
			(meta (ldb %%kbd-meta key-stroke))
			(super (ldb %%kbd-super key-stroke)))
		    (when (memq char '(#\return #\tab #\form #\line))
		      ;; wasnt handled before. only noticed it when telneting
		      ;; to another lambda.
		      (setq char (- char #o200)))
		    (when (eq super 1)
		      (serial-tyo #o34)		;Control-\
		      (setq char (logior char #o40)))
		    (cond ((and *use-control-z-for-control-meta* (eq control 1) (eq meta 1))
			   (serial-tyo #\top-c))		;;  [TOP-C] IS An Ascii CTRL-Z
			  (t
			   (when (eq meta 1)
			     (cond (*use-bit-7-for-meta*
				    (setq char (logior #o200 (logand char #o177))))
				   (t
				    (serial-tyo #o33)	;Escape
				    (setq char (logior char #o40)))))
			   (when (eq control 1)
			     (setq char (logand char #o37)))))
		    (serial-tyo char))
		  nil))))))

))