;;; -*- PACKAGE:KERMIT; BASE: 8; IBASE: 8; MODE:LISP -*-


;******************************************************************************
; Copyright (c) 1984, 1985 by Lisp Machine Inc.
; Symbolics-specific portions Copyright (c) 1985 by Honeywell, Inc.
; Permission to copy all or part of this material is granted, provided
; that the copies are not made or distributed for resale, and the 
; copyright notices and reference to the source file and the software
; distribution version appear, and that notice is given that copying is
; by permission of Lisp Machine Inc.  LMI reserves for itself the 
; sole commercial right to use any part of this KERMIT/H19-Emulator
; not covered by any Columbia University copyright.  Inquiries concerning
; copyright should be directed to Mr. Damon Lawrence at (213) 642-1116.
;
; Version Information:
;      LMKERMIT 1.0     --      Original LMI code, plus edit ;1; for 3600 port
;
; Authorship Information:
;      Mark David (LMI)           Original version, using KERMIT.C as a guide
;      George Carrette (LMI)      Various enhancements
;      Mark Ahlstrom (Honeywell)  Port to 3600 (edits marked with ";1;" comments)
;
; Author Addresses:
;      George Carrette     ARPANET: GJC at MIT-MC
;
;      Mark Ahlstrom       ARPANET: Ahlstrom at HI-Multics
;                          PHONE:   (612) 887-4006
;                          USMAIL:  Honeywell MN09-1400
;                                   Computer Sciences Center
;                                   10701 Lyndale Avenue South
;                                   Bloomington, MN  55420
;******************************************************************************



;;; This program is KERMIT-TERMINAL.
;;;
;;; This is to be used to make your lisp machine terminal
;;; act like it is an "H19" terminal.
;;;
;;; No flavors are defined in this file. None of this code
;;; depends on anything having to do with flavors, except
;;; in so far as the lisp machine graphics operations require.
;;; This code contains a refreshingly low density of "messages."
;;; This makes the code so simple, I consider it ALMOST self explanatory.
;;;
;;; No "special" window is required. That is, a lisp listener
;;; should do fine. A tv:minimum-window will not, of course, work.
;;;
;;; For the H19 graphics protocol, see the Zenith manual for
;;; the Z29 terminal, which is available from the documentation
;;; department of LMI.
;;; ("Z-29 user's & technical guide"
;;;  Appendix B -- Zenith Mode Code Info
;;;  1983, Zenith Data Systems.)
;;;
;;;




;;;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

;;;       special variables

;;;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>



;;; To use this, you only need to bind three special variables:

;;; 1. *TERMINAL*  This must be bound to a local input output window
;;;                           that gets input from the lisp machine's keyboard
;;;                           and mouse.
;;; 2. *SERIAL-STREAM*
;;;                    This must be bound to an serial stream (or some stream
;;;                           than supports the operations we use in this code.)
;;;                           To get this stream, on a Lambda Lisp Machine,
;;;                     you usually just call si:make-sdu-serial-stream
;;;                           with no arguments.
;;; 3. interaction-pane
;;;                    This is a pane in which to bind debug-io, trace-output, query-io, use
;;;                           the NETWORK key interactions and in general any thing not involved
;;;                           in normal terminal interaction.
;;;                           It will work (if you have a normal window for example) to just
;;;                           have this be the same stream as *terminal* is bound to. The requirement
;;;                           is that IT MUST BE AN EXPOSED WINDOW!!
;;;


(DEFCONST *ESCAPE-DISPATCH-TABLE* (MAKE-HASH-TABLE))


(DECLARE (SPECIAL INTERACTION-PANE
		  kermit-frame			;1;
		  ))

(DEFCONST *SERIAL-STREAM* :unbound)

(DEFCONST *TERMINAL* :unbound)


(DEFCONST *BAD-ESCAPES* ())


(defconst *local-echo-mode* nil)


(DEFCONST *LOGFILE* NIL)                                    ;where to log terminal session, if desired


(DEFCONST TURN-ON-LOGGING? NIL)



(DEFCONST *TERMINAL-DEBUG-MODE* NIL)





				    



;;;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

;;; TERMINAL GRAPHICS  AND OUTPUT "PRIMITIVES"

;;;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<




(DEFCONST *INSERT-FLAG* ())



(DEFCONST *REVERSE-VIDEO-FLAG* ())



(DEFCONST *CURSOR-SAVE* '(0 0))



(DEFCONST *SYSTEM-POSITION* '(0 0))


(DEFCONST *USE-BIT-7-FOR-META* NIL)



(DEFCONST *AUTO-CR-ON-LF-FLAG* NIL)



(DEFCONST *AUTO-LF-ON-CR-FLAG* NIL)

;1; #+3600
;1; (defconst *disable-outgoing-cr-to-crlf-conversion* t	
;1;   "Yes if you want return to just send a <cr> during terminal emulation.")	;1; see the following note

;1; **************** some experimental new stuff for 3600 ****************
;1; 
;1; The 3600 ascii translation that is "build in" to all :ascii-character
;1; streams has the unfortunate convention of turning outgoing <return> characters
;1; into <CR><LF> pairs, and converting incoming <CR><LF> pairs in <return> characters.
;1; This is usually ok, but with certain hosts, it works better if <return> actually
;1; sends just a <CR>.  For example, I found that I could only get proper Heath19
;1; emulation with our LAN and with Multics if I set *disable-return-to-crlf-conversion* 
;1; and *auto-lf-on-cr-flag* to true.

;1; Note that this is pulled from >rel-6-sys>io>stream.lisp and modified...
;1; Also note that this should only be in effect when connected for terminal
;1; emulation.  It must work in the usual way for file transfers, etc.

;1; #+3600
;1; (defvar kermit-connected-flag nil)		;1; defined in lmiwin.

;1; #+3600
;1; (DEFWHOPPER (si:ASCII-TRANSLATING-OUTPUT-STREAM-MIXIN :TYO) (CH)
;1;   (COND ((and					;1; This first condition is the changed part.
;1; 	   kermit-connected-flag		;1; if we are connected for terminal emulation and...
;1; 	   (char= ch #\CR)			;1; char is <return> and...
;1; 	   *disable-outgoing-cr-to-crlf-conversion*)	;1; and we want return to just send <cr>,
;1; 	 (continue-whopper #O015))		;1; then do it that way.
;1; 	((CHAR= CH #\CR)			;1; This rest is the normal function...
;1; 	 (CONTINUE-WHOPPER #O015)
;1; 	 (CONTINUE-WHOPPER #O012))
;1; 	(T (CONTINUE-WHOPPER (CHAR-TO-ASCII CH)))))


(DEFSUBST TERMINAL-INSERT-CHAR ()
  (SEND *TERMINAL* ':INSERT-CHAR 1 ':CHARACTER))





(DEFSUBST TERMINAL-ERASE-ALUF ()
  (SEND *TERMINAL* ':ERASE-ALUF))





(DEFSUBST TERMINAL-SET-ERASE-ALUF (ALU)
  (SEND *TERMINAL* ':SET-ERASE-ALUF ALU))





(DEFSUBST TERMINAL-TYO (CHAR-CODE)
  (SEND *TERMINAL* ':TYO CHAR-CODE))






(DEFSUBST TERMINAL-READ-CURSORPOS ()
  (SEND *TERMINAL* ':READ-CURSORPOS ':CHARACTER))






(DEFSUBST TERMINAL-SET-CURSORPOS (X Y)
  (SEND *TERMINAL* ':SET-CURSORPOS
          X Y
          ':CHARACTER))





(DEFSUBST TERMINAL-INSERT-LINE (&OPTIONAL (NTIMES 1))
  #+3600 (send *terminal* :insert-line ntimes)	;1; tv:sheet-insert-line is obsolete on 3600
  #-3600 (TV:SHEET-INSERT-LINE *TERMINAL* NTIMES))






(DEFSUBST TERMINAL-DELETE-LINE (&OPTIONAL (NTIMES 1))
  #+3600 (send *terminal* :delete-line ntimes)	;1; tv:sheet-delete-line obsolete on 3600
  #-3600 (TV:SHEET-DELETE-LINE *TERMINAL* NTIMES))






(DEFSUBST TERMINAL-CLEAR-CHAR ()
  (SEND *TERMINAL* ':CLEAR-CHAR))









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






(DEFSUBST TERMINAL-CHARACTER-HEIGHT ()
  (MULTIPLE-VALUE-BIND (IGNORE HEIGHT)
      (SEND *TERMINAL* ':SIZE-IN-CHARACTERS)
    HEIGHT))






(DEFSUBST TERMINAL-END-OF-PAGE-EXCEPTION ()
  (SEND *TERMINAL* ':HOME-CURSOR)
  (SEND *TERMINAL* ':DELETE-LINE)
  (TERMINAL-SET-CURSORPOS 0 (- (TERMINAL-CHARACTER-HEIGHT) 2)))








(DEFSUBST TERMINAL-CR ()
  (MULTIPLE-VALUE-BIND (IGNORE Y)
      (TERMINAL-READ-CURSORPOS)
    (TERMINAL-SET-CURSORPOS 0 Y)
    (AND *AUTO-LF-ON-CR-FLAG*
           (COND ((EQ Y (- (TERMINAL-CHARACTER-HEIGHT) 2))
                    (TERMINAL-END-OF-PAGE-EXCEPTION))
                 (T (TERMINAL-SET-CURSORPOS 0 (1+ Y)))))
    NIL))






(DEFSUBST TERMINAL-LINEFEED ()
  (MULTIPLE-VALUE-BIND (X Y)
      (TERMINAL-READ-CURSORPOS)
    (COND ((EQ Y (- (TERMINAL-CHARACTER-HEIGHT) 2))
             (TERMINAL-END-OF-PAGE-EXCEPTION))
            (T (TERMINAL-SET-CURSORPOS
                 (IF *AUTO-CR-ON-LF-FLAG* 0 X)
                 (1+ Y))))
    NIL))







(defsubst serial-tyi ()
  (let ((ch? (send *serial-stream* ':tyi)))
    (and ch? (logand ch? #o177))))




(DEFSUBST TERMINAL-SAVE-POS-1 ()
  (SETQ *SYSTEM-POSITION* (MULTIPLE-VALUE-LIST (TERMINAL-READ-CURSORPOS))))




(DEFSUBST TERMINAL-RESTORE-POS-1 ()
  (TERMINAL-SET-CURSORPOS (CAR *SYSTEM-POSITION*) (CADR *SYSTEM-POSITION*)))






(DEFSUBST TERMINAL-GOTO-BEG-OF-LINE ()
  (MULTIPLE-VALUE-BIND (IGNORE Y)
      (TERMINAL-READ-CURSORPOS)
    (TERMINAL-SET-CURSORPOS 0 Y)))












(DEFSUBST TERMINAL-BACKSPACE ()
  (TERMINAL-TYO #\BACKSPACE))



(DEFSUBST TERMINAL-BEEP ()
  (BEEP))




(DEFSUBST TERMINAL-TAB ()
  (TERMINAL-TYO #\TAB))












;;;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

;;;       definition of DEF-TERMINAL-ESCAPE

;;;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<





(DEFMACRO DEF-TERMINAL-ESCAPE (KEY-NUMBER NEED-TO-DEFINE-P FUNCTION-NAME &BODY BODY)
  (COND (NEED-TO-DEFINE-P
           `(PROGN 'COMPILE
                     (PUTHASH ,KEY-NUMBER ',FUNCTION-NAME *ESCAPE-DISPATCH-TABLE*)
                     (DEFUN ,FUNCTION-NAME () . ,BODY)))
          ('ALREADY-DEFINED-BY-SYSTEM-OR-USER
           `(PUTHASH ,KEY-NUMBER ',FUNCTION-NAME *ESCAPE-DISPATCH-TABLE*))))



;;;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

;;;       terminal escape definitions

;;;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<






(DEF-TERMINAL-ESCAPE #/[ T TERMINAL-EAT-TEMP      ; this may be wrong
  ;; 'Enter Hold Screen Mode' ZEHS
  (LET (I1 I2 FLAG)
    (SETQ I1 (SERIAL-TYI))
    (SETQ I2 (SERIAL-TYI))
    (COND ((EQ I1 #\?) (SETQ FLAG T) (SERIAL-TYI))
            ((OR (> I2 #\9) (< I2 #\0))
             (SETQ I1 (- I1 #\0)))
            (T (SETQ I1 (+ (* 10. (- I1 #\0)) (- I2 #\0)))
               (SETQ I2 (SERIAL-TYI))))
    (COND ((NOT FLAG)
             (SELECTQ I2
               (#\L (TERMINAL-INSERT-LINE I1))
               (#\M (TERMINAL-DELETE-LINE I1)))))))






(DEF-TERMINAL-ESCAPE #\\ T EXIT-EAT-TEMP
  (TERMINAL-CLEAR-SCREEN))                        ; this may be wrong






(DEF-TERMINAL-ESCAPE #\H T TERMINAL-HOME-CURSOR
  (SEND *TERMINAL* ':HOME-CURSOR))





(DEF-TERMINAL-ESCAPE #\p T TERMINAL-REVERSE-VIDEO
  (SETQ *REVERSE-VIDEO-FLAG* T)
  NIL)





(DEF-TERMINAL-ESCAPE #\q T TERMINAL-NORMAL-VIDEO
  (SETQ *REVERSE-VIDEO-FLAG* NIL)
  NIL)






(DEF-TERMINAL-ESCAPE #\x T TERMINAL-SET-MODE
  (SELECTQ (SERIAL-TYI)
    (#O10 (SETQ *AUTO-LF-ON-CR-FLAG* T))
    (#O11 (SETQ *AUTO-CR-ON-LF-FLAG* T))
    (:OTHERWISE ()))
  (COND (*TERMINAL-DEBUG-MODE* (FORMAT INTERACTION-PANE "~% SET MODE:  ~O [~C] ")))
  NIL)






(DEF-TERMINAL-ESCAPE #\y T TERMINAL-RESET-MODE
  (SELECTQ (SERIAL-TYI)
    (#O10 (SETQ *AUTO-LF-ON-CR-FLAG* NIL))
    (#O11 (SETQ *AUTO-CR-ON-LF-FLAG* NIL))
    (:OTHERWISE ()))
  (COND (*TERMINAL-DEBUG-MODE* (FORMAT INTERACTION-PANE "~% SET MODE:  ~O [~C] ")))
  NIL)









(DEF-TERMINAL-ESCAPE #\C T TERMINAL-CURSOR-FORWARD
  (MULTIPLE-VALUE-BIND (X Y)
      (TERMINAL-READ-CURSORPOS)
    (UNLESS (EQ X 79.)
      (TERMINAL-SET-CURSORPOS (1+ X) Y))))





(DEF-TERMINAL-ESCAPE #\D T TERMINAL-CURSOR-BACKWARDS
  (MULTIPLE-VALUE-BIND (X Y)
      (TERMINAL-READ-CURSORPOS)
    (UNLESS (EQ X 0)
      (TERMINAL-SET-CURSORPOS (1- X) Y))))






(DEF-TERMINAL-ESCAPE #\B T TERMINAL-CURSOR-DOWN
  (MULTIPLE-VALUE-BIND (X Y)
      (TERMINAL-READ-CURSORPOS)
    (UNLESS (EQ Y (- (TERMINAL-CHARACTER-HEIGHT) 2))
      (TERMINAL-SET-CURSORPOS X (1+ Y)))))





(DEF-TERMINAL-ESCAPE #\A T TERMINAL-CURSOR-UP
  (MULTIPLE-VALUE-BIND (X Y)
      (TERMINAL-READ-CURSORPOS)
    (UNLESS (EQ Y 0)
      (TERMINAL-SET-CURSORPOS X (1- Y)))))




(DEF-TERMINAL-ESCAPE #\I T TERMINAL-REVERSE-INDEX
  (MULTIPLE-VALUE-BIND (X Y)
      (TERMINAL-READ-CURSORPOS)
    (COND ((ZEROP X)
             (TERMINAL-SET-CURSORPOS 0 (- (TERMINAL-CHARACTER-HEIGHT) 2))
             (TERMINAL-DELETE-LINE)
             (TERMINAL-SET-CURSORPOS X Y)
             (TERMINAL-INSERT-LINE))
            (T (TERMINAL-CURSOR-UP)))))






(DEF-TERMINAL-ESCAPE #\n T TERMINAL-REPORT-CURSOR
  (MULTIPLE-VALUE-BIND (X Y)
      (TERMINAL-READ-CURSORPOS)
    (SEND *SERIAL-STREAM* ':TYO #O33)             ;33 is ascii <altmode>
    (SEND *SERIAL-STREAM* ':TYO #\Y)
    (SEND *SERIAL-STREAM* ':TYO (+ 32. Y))
    (SEND *SERIAL-STREAM* ':TYO (+ 32. X))))






(DEF-TERMINAL-ESCAPE #\J T TERMINAL-CLEAR-EOF
  (SEND *TERMINAL* #+3600 :clear-rest-of-window #-3600 ':CLEAR-EOF)	;1;
  )






(DEF-TERMINAL-ESCAPE #\j T TERMINAL-SAVE-POS
  (SETQ *CURSOR-SAVE*
          (MULTIPLE-VALUE-LIST (TERMINAL-READ-CURSORPOS))))






(DEF-TERMINAL-ESCAPE #\k T TERMINAL-RESTORE-POS
  (TERMINAL-SET-CURSORPOS (CAR *CURSOR-SAVE*) (CADR *CURSOR-SAVE*)))





(DEF-TERMINAL-ESCAPE #\Y T TERMINAL-SET-POS
  (LET ((Y (SERIAL-TYI))
          (X (SERIAL-TYI)))
    (cond (*terminal-debug-mode*
             (format t "~&  setpos X=~D Y=~D" (- x 32.) (- y 32.))))
    (TERMINAL-SET-CURSORPOS (- X 32.) (- Y 32.))))






(DEF-TERMINAL-ESCAPE #\E T TERMINAL-CLEAR-SCREEN
  (SEND *TERMINAL* #+3600 :clear-window #-3600 ':CLEAR-SCREEN))	;1;





(DEF-TERMINAL-ESCAPE #\b T TERMINAL-CLEAR-BOD
  (MULTIPLE-VALUE-BIND (X Y)
      (TERMINAL-READ-CURSORPOS)
    (DOTIMES (LINE (1- Y))
      (TERMINAL-SET-CURSORPOS 0 LINE)
      (TERMINAL-CLEAR-EOL))
    (TERMINAL-SET-CURSORPOS 0 Y)
    (DOTIMES (DUMMY X)
      (TERMINAL-CLEAR-CHAR)
      (TERMINAL-CURSOR-FORWARD))
    (TERMINAL-CURSOR-BACKWARDS)))








(DEF-TERMINAL-ESCAPE #\l T TERMINAL-CLEAR-LINE
  (MULTIPLE-VALUE-BIND (X Y)
      (TERMINAL-READ-CURSORPOS)
    (TERMINAL-SET-CURSORPOS 0 Y)
    (TERMINAL-CLEAR-EOL)
    (TERMINAL-SET-CURSORPOS X Y)))








(DEF-TERMINAL-ESCAPE #\o T TERMINAL-ERASE-BOL
  (MULTIPLE-VALUE-BIND (X Y)
      (TERMINAL-READ-CURSORPOS)
    (TERMINAL-SET-CURSORPOS 0 Y)
    (DOTIMES (DUMMY X)
      (TERMINAL-CLEAR-CHAR)
      (TERMINAL-CURSOR-FORWARD))
    (TERMINAL-CURSOR-BACKWARDS)))






(DEF-TERMINAL-ESCAPE #\K T TERMINAL-CLEAR-EOL
  (SEND *TERMINAL* #+3600 :clear-rest-of-line #-3600 ':CLEAR-EOL))	;1;







(DEF-TERMINAL-ESCAPE #\L T TERMINAL-INSERT-ONE-LINE
  (TERMINAL-SAVE-POS-1)
  (TERMINAL-SET-CURSORPOS 0 (- (TERMINAL-CHARACTER-HEIGHT) 2))
  (TERMINAL-DELETE-LINE)
  (TERMINAL-RESTORE-POS-1)
  (TERMINAL-INSERT-LINE)
  (TERMINAL-GOTO-BEG-OF-LINE))








(DEF-TERMINAL-ESCAPE #\M T TERMINAL-DELETE-ONE-LINE
  (TERMINAL-DELETE-LINE)
  (TERMINAL-SAVE-POS-1)
  (TERMINAL-SET-CURSORPOS 0 (- (TERMINAL-CHARACTER-HEIGHT) 2))
  (TERMINAL-INSERT-LINE)
  (TERMINAL-RESTORE-POS-1)
  (TERMINAL-GOTO-BEG-OF-LINE))






(DEF-TERMINAL-ESCAPE #\N T TERMINAL-DELETE-CHAR
  (SEND *TERMINAL* ':DELETE-CHAR))







(DEF-TERMINAL-ESCAPE #\@ T TERMINAL-INSERT-MODE
  (SETQ *INSERT-FLAG* T)
  NIL)








(DEF-TERMINAL-ESCAPE #\O T TERMINAL-EXIT-INSERT-MODE
  (SETQ *INSERT-FLAG* NIL))




(DEFSUBST ESCAPE-DISPATCH ()
  (LET* ((KEYSTROKE (SERIAL-TYI))
           (METHOD (GETHASH KEYSTROKE *ESCAPE-DISPATCH-TABLE*)))
    (COND (METHOD
             (FUNCALL METHOD)
             (COND (*TERMINAL-DEBUG-MODE*
                      (FORMAT INTERACTION-PANE "~%  ~O  [~:@C]  ~S " KEYSTROKE KEYSTROKE METHOD))))
            (T (PUSH KEYSTROKE *BAD-ESCAPES*)
               (COND (*TERMINAL-DEBUG-MODE*
                        (FORMAT INTERACTION-PANE "~% ~O [~C] <<*** BAD ESCAPE CHARACTER"
                                  KEYSTROKE KEYSTROKE)))))))






(DEFUN READ-CHAR-FROM-SERIAL-STREAM-TO-TERMINAL ()
  (LET ((KEYSTROKE (SERIAL-TYI)))

    (COND ((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))
             (COND ((> (TERMINAL-READ-CURSORPOS) (TERMINAL-CHARACTER-WIDTH))
                      (TERMINAL-CR)))

             (TERMINAL-TYO KEYSTROKE))

            (T (SELECTQ KEYSTROKE
                 (#O7 (TERMINAL-BEEP))
                 (#O10 (TERMINAL-BACKSPACE))
                 (#O11 (TERMINAL-TAB)
                         (AND *LOGFILE* TURN-ON-LOGGING? (SEND *LOGFILE* ':TYO #O211)))
                 (#O12 (TERMINAL-LINEFEED))
                 (#O15 (TERMINAL-CR)
                         (AND *LOGFILE* TURN-ON-LOGGING? (SEND *LOGFILE* ':TYO #O215)))
                 (T (COND (*TERMINAL-DEBUG-MODE*
                               (FORMAT INTERACTION-PANE
                                         "~%Unrecognized /"control character/": ~O [~:@C]"
                                         KEYSTROKE KEYSTROKE))))
                 )))))














(defun process-wait-listen (&rest streams)
  "waits on input on the streams, returns the stream which has input ready."
  (let ((stream1 (car streams)))
    (cond
      ((send stream1 ':listen) stream1)
      (t
       (with-stack-list (return-value nil)
           (process-wait "wait-listen"
                           #'(lambda (return-value streams)
                                 (dolist (stream streams)
                                   (if (send stream ':listen)
                                         (return (setf (car return-value) stream)))))
                           return-value
                           streams)
           (car return-value))))))








;;; sending characters from terminal to serial-stream:




(DEFSUBST TERMINAL-TYI ()
  (SEND *TERMINAL* ':TYI))



(defsubst serial-tyo (char)
  (send *serial-stream* ':tyo char))




;;; this is now somewhat specialize for
;;; kermit by having this mouse menu tracking
;;; business, but its just the easiest way to
;;; keep the menu active while Connect is running.
;;; See the file "sys:kermit;kermit-window" for
;;; the extra meaning to this.



(defsubst terminal-any-tyi ()
  (send *terminal* ':any-tyi))

(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 #+(not 3600) #\Delete))	;1;
                 (setq key-stroke (dpb 177 %%kbd-char key-stroke)))
               (select key-stroke
                 (*escchr* (network-keystroke-handler))
                 (#\Call (serial-tyo #\ ))        ; send a [top-c] (for ascii ctrl-z)
		 #+3600
		 (#\Escape (serial-tyo #o33))	;1; send escape character, too.
                 (t (let

                        ((char (ldb %%kbd-char key-stroke))
                         (control (ldb %%kbd-control key-stroke))
                         (meta (ldb %%kbd-meta key-stroke)))

                        (cond ((and (eq meta 1) (eq control 1))
                                 (serial-tyo
				   #+3600 #\c-Z	;1; Will this do it??
				   #-3600 #\top-c)                 ;;   [TOP-C] IS An Ascii CTRL-Z
                                 (serial-tyo char))
                                (t (cond ((eq control 1) (setq char (logand char 37))))
                                   (cond ((not (zerop meta))
                                            (cond (*use-bit-7-for-meta*
                                                     (setq char (logior #o200 (logand char #o177))))
                                                    (t (serial-tyo #o33)
                                                       (setq char (logior char #o40))))))
                                   (serial-tyo char)))
                        nil)))))))







(defun network-keystroke-handler ()
  (declare (special kermit-frame *escchr*))
  (terminal-network-prompt)                       ;PROMPT THE USER

  (let ((terminal-io interaction-pane))

    ;1; I think that tv:with-selection-substitute on LMI would substitute kermit-frame for
    ;1; interaction-pane if interaction-pane is unbound, so that is what I will explicitly do for 3600.
    (#-3600 tv:with-selection-substitute #-3600 (interaction-pane kermit-frame)
     #+3600 let #+3600 ((interaction-pane (if (boundp 'interaction-pane) interaction-pane kermit-frame)))

      (let ((key-stroke (char-upcase (terminal-tyi))))

          (unless (eq key-stroke #\rubout)
            (format interaction-pane "~:@C" key-stroke))

          (condition-case ()

              (prog1                                        ; hey, return ':close sometimes
               (selectq key-stroke

                 (#\CLEAR-SCREEN (terminal-clear-screen))
                 (#\CONTROL-CLEAR-SCREEN (send interaction-pane
					       #+3600 :clear-window	;1; clear-screen is
					       #-3600 ':clear-screen))	;1; obsolete on 3600
                 ((#\HELP #/H) (terminal-network-help))
                 (#\SPACE nil)
                 (#\control-y (terminal-control-y-pop-up-ed-string-hack))
                 (#/E (terminal-read-eval-print))
                 (#\control-d
                    (format t "~&Turning ~A Terminal Debug mode.~%"
                              (if (setq *terminal-debug-mode* (not *terminal-debug-mode*))
                                  "ON" "OFF")))
                 (#/D (format t "~&Turning ~A Local Echo mode.~%"
                              (if (setq *local-echo-mode* (not *local-echo-mode*))
                                  "ON" "OFF")))
                 (#\CONTROL-B (terminal-get-and-set-new-baud-rate))
                 (#\CONTROL-S (terminal-set-status-of-connection))
                 (#\STATUS (terminal-show-status-of-connection))
                 (#/F (terminal-flush-input-buffer))
                 (#/L (terminal-start-logging))
                 (#\C-L (terminal-close-logging))
                 (#/K (format interaction-pane "...closing stream ~S..."
                                  *serial-stream*)
                        (send *serial-stream* ':close ':abort)
                        (format interaction-pane "and disconnecting.~%")
                        ':close)

                 ;;KERMIT PROTOCOL:

                 (#/0 (terminal-transmit-nul))
                 (#/B (terminal-transmit-break))
                 (#/C (format interaction-pane "...disconnecting.~%")
                        ':close)
                 (#/P (terminal-push-to-system-command-processor))
                 (#/Q (terminal-quit-logging))
                 (#/R (terminal-resume-logging))
                 (#/S (terminal-show-status-of-connection))
                 (#/? (terminal-network-help))
                 (#\NETWORK (terminal-transmit-network-escape-character))
                 (#\RUBOUT)                       ;do nothing
                 (:otherwise (if (eq key-stroke kermit:*escchr*)
                                     (terminal-transmit-network-escape-character)
                                   (if (not (eq key-stroke #\RUBOUT))
                                         (format interaction-pane
                                                   "  <-- ?? Unknown argument to <NETWORK> ??")))))
               (terpri interaction-pane))
            (sys:abort nil))))))


(defun terminal-control-y-pop-up-ed-string-hack ()
  (let
    ((string-to-transmit?                         ;null if aborted
       (zwei:pop-up-edstring ""
                                   '(:mouse)
                                   ()
                                   (- (tv:sheet-inside-right *terminal*)
                                        (tv:sheet-inside-left *terminal*))
                                   (- (tv:sheet-inside-bottom *terminal*)
                                        (tv:sheet-inside-top *terminal*))
                                   "Edit Text and hit <END> to transmit.")))
    (if string-to-transmit?
          (loop for i from 0 below (array-active-length string-to-transmit?)
                as char = (aref string-to-transmit? i)
                doing (send *serial-stream* ':tyo char)))))

(DEFUN TERMINAL-NETWORK-HELP ()
  ;1; with-help-stream not on 3600...
  (#-3600 SI:WITH-HELP-STREAM #-3600 (S :LABEL '(:STRING "Terminal Network Help"
                                                     :FONT FONTS:METSI :TOP :CENTERED)
                                :SUPERIOR *TERMINAL*)
   #+3600 with-kermit-typeout-stream   #+3600 S  #+3600 '(:STRING "Terminal Network Help"
							  :FONT FONTS:METSI :TOP)
   #-3600
    (FORMAT S "  
Single-keystroke Arguments to the <NETWORK> escape:

 C                Close -- escape back to kermit command level
 <ctrl> Y       Yank some text into a pop up window and send it thru serial stream
 <ctrl> D       Debug toggle -- toggles terminal debug mode
 D              Duplex toggle -- switch between local and remote terminal echoing
 K              Kill stream -- send current stream a :close message and disconnect
 <clear-screen>     Clear terminal screen
 <ctrl><clear>  Clear interaction screen
 F              Flush serial input buffer
 <ctrl>B        Control Baud -- set baud rate
 E                Eval -- evaluate lisp expression
 P              Push -- break to lisp. Hit <resume> to return
 B                Transmit a break
 0                Transmit a nul
 s,<status>     Show serial stream status
 L              Log connection in a disk file
 <control>L     Close logging to disk file
 Q              Quit logging temporarily
 R              Resume logging
 ?,<help>,h     type this stuff  ~%")

    #+3600
    (FORMAT S "  
Single-keystroke Arguments to the <NETWORK> escape:

 C               Close -- escape back to kermit command level
 <ctrl> Y        Yank some text into a pop up window and send it thru serial stream
 <ctrl> D        Debug toggle -- toggles terminal debug mode
 D               Duplex toggle -- switch between local and remote terminal echoing
 K               Kill stream -- send current stream a :close message and disconnect
 <refresh>       Clear terminal screen
 <ctrl><refresh> Clear interaction screen
 F               Flush serial input buffer
 <ctrl>B         Control Baud -- set baud rate
 E               Eval -- evaluate lisp expression
 P               Push -- break to lisp. Hit <resume> to return
 B               Transmit a break
 0               Transmit a nul
 S               Show serial stream status
 L               Log connection in a disk file
 <control>L      Close logging to disk file
 Q               Quit logging temporarily
 R               Resume logging
 ?,<help>,h      Help, type this stuff  ~%")
    ))



(defun toggle-duplex ()
  (format t "~&Local Echo mode being turned ~A.~%"
            (if *local-echo-mode* "OFF" "ON"))
  (setq *local-echo-mode* (not *local-echo-mode*)))

(defun terminal-flush-input-buffer ()
  (send *serial-stream* ':clear-input))

;;; this macro here because this gets compiled first (before kermit-window).

(defmacro with-second-font-and-more-processing (window &body body)
  "sets window's font to its second font and turns on more processing during body.
sets them back to the way they were afterwards."
  (let ((font (gensym))
          (more-p (gensym)))

       `(let ((,font (send ,window ':current-font))
               (,more-p (send ,window ':more-p)))
            (unwind-protect
                (progn
                    (send ,window ':set-current-font 1)
                    (send ,window ':set-more-p t)
                    ,@body)
              (send ,window ':set-current-font ,font)
              (send ,window ':set-more-p ,more-p)))))

(DEFUN TERMINAL-TRANSMIT-NETWORK-ESCAPE-CHARACTER ()
  (declare (special *escchr*))
  (serial-tyo *escchr*))



(defun terminal-show-status-of-connection ()
  ;1; Once again, I changed this since 3600 doesn't have with-help-stream.
  (#-3600 si:with-help-stream #-3600 (standard-output
                               :label `(:string "Terminal Status"
                                                    ,@(if (boundp 'fonts:metsi)
                                                            '(:font fonts:metsi))
                                                    :top :centered)
                               :superior *terminal*)
   #+3600 with-kermit-typeout-stream #+3600 standard-output
   #+3600 `(:string "Terminal Status"
	    ,@(if (boundp 'fonts:metsi) '(:font fonts:metsi)) :top)
    ;; 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))))

    ;; line status:
    (cond
     #-3600 ((typep *serial-stream* 'unix:unix-stream)	;1; no unix package on 3600
             (describe *serial-stream*))
     #-3600 ((typep *serial-stream* 'si:sdu-serial-stream)	;1; no sdu stuff on 3600
             (format t "~%baud rate of ~A: ~d"
                       *serial-stream*
                       (send *serial-stream* ':baud-rate))
             (si:sdu-serial-status))
            ((typep *serial-stream* 'si:serial-stream)
             (format t "~%baud rate of ~A: ~d"
                       *serial-stream*
                       (send *serial-stream* ':get ':baud))
             #-3600 (si:serial-status)		;1; no serial-status on 3600, so guess at what it describes...
	     #+3600 (progn
		      (format t "~%parity is ~d ~
                                 ~%number of data bits is ~d ~
                                 ~%number of stop bits is ~d ~
                                 ~%xon-xoff protocol is ~d"
			      (send *serial-stream* ':get ':parity)
			      (send *serial-stream* ':get ':number-of-data-bits)
			      (send *serial-stream* ':get ':number-of-stop-bits)
			      (send *serial-stream* ':get ':xon-xoff-protocol)))
	     )
            (t (describe *serial-stream*)))

    ))




;;; LOGGING: here it is.

;;; All we do is this: if the incoming character from the
;;; serial stream is a printing ascii character, we put it
;;; in the log file. Printing characters are in the range
;;; 32 to 177 plus 11, 14, and 15 (octal). Linefeeds and any
;;; other control characters are not sent. No input from  the
;;; user's side is included whatsoever. The code for the actual
;;; capture of characters is thus isolated within the function
;;; read-char-from-serial-stream-to-terminal.





(defun terminal-start-logging ()
  (cond (*logfile*
           (format interaction-pane "~& Cannot open a new logfile!!")
           (tv:beep))
          ((setq *logfile*
                 (open (terminal-get-logfile-name-from-user) '(:out)))
           (setq turn-on-logging? t)
           (format interaction-pane "~& Logging output to file ~A~%"
                     (send *logfile* ':truename)))
          (t (format interaction-pane "~& Unable to open logfile.")
             (tv:beep)))
  nil)












(defun terminal-get-logfile-name-from-user ()
  (let ((default-pathname
            (fs:merge-pathname-defaults
              "TERMINAL.LOG"
              (if (and (boundp 'kermit-default-pathname)	;1; added :unbound check
		       (neq kermit-default-pathname :unbound))
                    kermit-default-pathname
                (fs:user-homedir)))))
    (fs:merge-pathname-defaults
      (prompt-and-read
          ':string-trim
          (format nil
                    "~&Name log file: (DEFAULT: ~A) "	;1; just removed ">" from end...
                    default-pathname))
      default-pathname)))











(defun terminal-quit-logging ()
  (cond ((and *logfile* turn-on-logging?)
           (format interaction-pane
                     "~&Turning off logged output to ~A~%"
                     (send *logfile* ':truename))
           (setq turn-on-logging? nil))
          ((not *logfile*)
           (format interaction-pane
                     "~& ?? There is no logging being done.~%"))
          ((not turn-on-logging?)
           (format interaction-pane
                     "~& ?? Logging is not turned on.~%"))))












(DEFUN TERMINAL-RESUME-LOGGING ()
  (COND ((AND *LOGFILE* (NOT TURN-ON-LOGGING?))
           (FORMAT INTERACTION-PANE "~&Turning on logged output to ~A~%"
                     (SEND *LOGFILE* ':TRUENAME))
           (SETQ TURN-ON-LOGGING? T))
          ((NOT *LOGFILE*)
           (FORMAT INTERACTION-PANE
                     "~& ?? There is no logging being done.~%"))
          (TURN-ON-LOGGING?
           (FORMAT INTERACTION-PANE
                     "~& ?? Logging is not turned off.~%"))))









(DEFUN TERMINAL-CLOSE-LOGGING ()
  (COND (*LOGFILE*
           (FORMAT INTERACTION-PANE "~&Closing logged output to ~A" (SEND *LOGFILE* ':TRUENAME))
           (SEND *LOGFILE* ':CLOSE)
           (SETQ *LOGFILE* NIL)
           (SETQ TURN-ON-LOGGING? NIL))
          (T (FORMAT INTERACTION-PANE
                       " ?? There is no log file to close~%"))))


#-common
(DEFUN TERMINAL-PUSH-TO-SYSTEM-COMMAND-PROCESSOR ()
  (LET ((TERMINAL-IO INTERACTION-PANE))
      (BREAK KERMIT)))

#+common
(DEFUN TERMINAL-PUSH-TO-SYSTEM-COMMAND-PROCESSOR ()
  (LET ((TERMINAL-IO INTERACTION-PANE))
      (BREAK "Kermit Break while in Connect.")))







(DEFUN TERMINAL-TRANSMIT-NUL ()
  (SERIAL-TYO 0))

(DEFUN TERMINAL-CLOSE-CONNECTION ()
  NIL)








(DEFUN TERMINAL-GET-AND-SET-NEW-BAUD-RATE ()	;1; had to change this since 3600 will not be object-code compatible,
  (LET (TO-WHAT)				;1; and does not have stuff for selecting processor type.
    #-3600 (SELECTOR SI:PROCESSOR-TYPE-CODE EQ
	     (SI:LAMBDA-TYPE-CODE
	       (SEND *SERIAL-STREAM*
		     ':SET-BAUD-RATE
		     (IF (ZEROP (SETQ TO-WHAT
				      (PROMPT-AND-READ ':NUMBER
						       "~%The current baud rate is ~D. Answering with 0 keeps it.~%Baud rate? >>"
						       (SEND *SERIAL-STREAM* ':BAUD-RATE))))
			 (SEND *SERIAL-STREAM* ':BAUD-RATE)
			 TO-WHAT)))
	     (SI:CADR-TYPE-CODE
	       (SEND *SERIAL-STREAM*
		     ':PUT
		     ':BAUD
		     (IF (ZEROP (SETQ TO-WHAT
				      (PROMPT-AND-READ ':NUMBER
						       "~%The current baud rate is ~D. Answering with 0 keeps it.~%Baud rate? >>"
						       (SEND *SERIAL-STREAM* ':GET ':BAUD))))
			 (SEND *SERIAL-STREAM* ':GET ':BAUD)
			 TO-WHAT))))
    #+3600 (SEND *SERIAL-STREAM*
		 ':PUT
		 ':BAUD
		 (IF (ZEROP (SETQ TO-WHAT
				  (PROMPT-AND-READ ':NUMBER
						   "~%The current baud rate is ~D. Answering with 0 keeps it.~%Baud rate? >>"
						   (SEND *SERIAL-STREAM* ':GET ':BAUD))))
		     (SEND *SERIAL-STREAM* ':GET ':BAUD)
		     TO-WHAT))
    ))






(DEFUN TERMINAL-SET-STATUS-OF-CONNECTION ()
  NIL)










(DEFUN TERMINAL-READ-EVAL-PRINT ()
  (FORMAT INTERACTION-PANE "~%EVAL>")
  (LET ((DEBUG-IO INTERACTION-PANE)
          (QUERY-IO INTERACTION-PANE)
          (ERROR-OUTPUT INTERACTION-PANE)
          (TERMINAL-IO INTERACTION-PANE)
          (STANDARD-INPUT INTERACTION-PANE)
          (STANDARD-OUTPUT INTERACTION-PANE))
    (CONDITION-CASE ()
          (PRINT (EVAL (READ)))
      (SYS:ABORT NIL))))











#-3600
(DEFUN TERMINAL-TRANSMIT-BREAK ()

  ;;PUT ASCII NUL [0] ON LINE FOR 1/4 SECOND
  ;1; Weird, but for 3600, the first parameter to time-difference
  ;1; is assumed to be later than the second, so had to change this.
  ;1; But.... this still doesn't work.... what you need is next version.
  (LOOP WITH TIME = (TIME)
          DOING (COND ((> #-3600 (TIME-DIFFERENCE TIME (TIME))
			  #+3600 (time-difference (time) time)
			  15.)
                         (RETURN))
                        (T (SERIAL-TYO 0)))))

#+3600
(defun terminal-transmit-break ()
  (send *serial-stream* :send-break))		;1; makes sense...

(DEFUN TERMINAL-NETWORK-PROMPT ()
  (FORMAT INTERACTION-PANE "~&NETWORK>"))





;1; The defaults for these instance variable seem to have to be set here,
;1; as well as in the defconst/defvar of the corresponding globals.
;1; If not, they appear to take the global value when not connected,
;1; and the following value during connection.

(defflavor kterm-state
             ;; analogous to kstate.
             ;; these are all used free by connect & its subroutines.
             ((*logfile* nil)
              (turn-on-logging? nil)
              (*local-echo-mode* nil)
              (*terminal-debug-mode* nil)
              (*insert-flag* nil)
              (*reverse-video-flag* nil)
              (*cursor-save* '(0 0))
              (*system-position* '(0 0))
              (*use-bit-7-for-meta* nil)
              (*auto-cr-on-lf-flag* nil)
	      (*auto-lf-on-cr-flag* nil)	;1; accidentally left out?
	      )
             ()
  :special-instance-variables)


;; for kermit window interface to call

(defmethod (kterm-state :make-connection)
	     (serial-stream terminal-stream)
  ;; now all the special instance variables are bound.
  (connect serial-stream terminal-stream))


;;;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
;;;       CONNECT
;;;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<








(defun connect

       ;; bind various streams

       (*serial-stream* *terminal*

          &optional
          (error-output error-output)
          (debug-io debug-io)

          &aux
          (interaction-pane (if (boundp 'interaction-pane)
                                    interaction-pane *terminal*))   
          (*ttyfd* *serial-stream*))

  "Make *terminal* a virtual terminal connected with *serial-stream*, a serial stream.

          A simulation of a Heath//H19//Z29 terminal is attempted
          for communication with ASCII terminals. Do <NETWORK> <HELP>
          for help and feature explanation. <Network>C to Close (disconnect)"
  (declare (special *ttyfd*))

  (let ((char-aluf (send *terminal* ':char-aluf)))

    (loop initially

            (send *terminal* ':set-char-aluf tv:alu-xor)

            with winner = (process-wait-listen *serial-stream* *terminal*)

            doing

            (cond ((eq winner *serial-stream*)
                     (read-char-from-serial-stream-to-terminal)
                     (setq winner (process-wait-listen *terminal* *serial-stream*)))

                    (t (cond ((eq (read-char-from-keyboard-to-serial-stream) ':close)
                                (loop-finish))    ; we're done
                               (t (setq winner (process-wait-listen *serial-stream* *terminal*))))))

            finally
            (send *terminal* ':set-char-aluf char-aluf)
            (return nil))))