;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for Kermit version 36.1
;;; Reason:
;;;  1. Rationalize defaulting/remembering of serial port baud rates.
;;;  2. Bind sdu-serial special variables, so each Kermit gets its own.
;;;  3. Clean up Review Parameters menus, choices; give some useful info.
;;; Written 19-Jul-88 12:48:19 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 1
;;; with System 125.6, ZWEI 125.2, ZMail 73.0, Local-File 75.0, File-Server 24.0, Unix-Interface 13.0, Tape 24.0, Lambda-Diag 17.0, Experimental Kermit 36.0, microcode 1761, SDU Boot Tape 3.14, SDU ROM 103, 7/19.



; From modified file DJ: L.NETWORK.KERMIT; LAMBDA-SDU-SERIAL.LISP#1 at 19-Jul-88 12:48:28
#10R KERMIT#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; LAMBDA-SDU-SERIAL  "


(defvar *sdu-serial-default-device-name* "SDU-SERIAL-B")

;;;Modify these to (re)init serial port on open with parameters:

))

; From modified file DJ: L.NETWORK.KERMIT; LAMBDA-SDU-SERIAL.LISP#1 at 19-Jul-88 12:48:30
#10R KERMIT#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; LAMBDA-SDU-SERIAL  "


(defvar *sdu-serial-xon-xoff-p* T)

))

; From modified file DJ: L.NETWORK.KERMIT; LAMBDA-SDU-SERIAL.LISP#1 at 19-Jul-88 12:48:31
#10R KERMIT#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; LAMBDA-SDU-SERIAL  "

(defvar *sdu-serial-ascii-p* NIL)

))

; From modified file DJ: L.NETWORK.KERMIT; LAMBDA-SDU-SERIAL.LISP#1 at 19-Jul-88 12:48:32
#10R KERMIT#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; LAMBDA-SDU-SERIAL  "

(defvar *sdu-serial-default-baud-rate* 9600.)

;;;Make a list of device names and suitable open forms:

))

; From modified file DJ: L.NETWORK.KERMIT; LAMBDA-SDU-SERIAL.LISP#1 at 19-Jul-88 12:48:32
#10R KERMIT#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; LAMBDA-SDU-SERIAL  "


(defvar *sdu-serial-device-alist*
	(gather-sdu-serial-devices)
  "An a-list of SDU-SERIAL-B-SHARED-DEVICE type devices.
The CADR of each entry is a form suitable for opening the associated device.")

))

; From modified file DJ: L.NETWORK.KERMIT; LAMBDA-SDU-SERIAL.LISP#1 at 19-Jul-88 12:48:33
#10R KERMIT#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; LAMBDA-SDU-SERIAL  "


(defun sdu-serial-open (&optional
			(name *sdu-serial-default-device-name*)
			(new-baud-rate *sdu-serial-default-baud-rate*))
  (unless (member name *sdu-serial-device-alist* :test #'string-equal :key #'car)
    (cerror "Proceed to open ~s anyway"
	    "~s is not the name of a known serial port shared device / pathname host" name))
  (let ((device (make-pathname :host name)))
    (check-type device si:shared-device-pathname)
    (open device
	  :flavor-and-init-options
	  (list
	    (si:combined-sdu-serial-stream-flavor :ascii    *sdu-serial-ascii-p*
						  :xon-xoff *sdu-serial-xon-xoff-p*)
	    :input-buffer-size (* 3 si:page-size)
	    :output-buffer-size (* 2 si:page-size)
	    :baud-rate new-baud-rate))))

))

; From modified file DJ: L.NETWORK.KERMIT; WINDOW.LISP#78 at 19-Jul-88 12:48:38
#8R KERMIT#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; WINDOW  "


(defconst all-commands-requiring-kermit-serial-stream
	  ;;;You may have to add to this list if you add to the one right below!
	  '(make-connection close-connection
	    send-files receive-files send-files-to-server receive-files-from-server
	    finish-server bye-server
	    be-a-kermit-server-only be-a-server
	    )
  "Commands that require KERMIT-SERIAL-STREAM to be bound to the apropriate open stream.")

))

; From modified file DJ: L.NETWORK.KERMIT; WINDOW.LISP#78 at 19-Jul-88 12:48:39
#8R KERMIT#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; WINDOW  "


(defun close-connection ()
  (with-status ("Turning off Kermit//Login Connection.")
    (cond (kermit-connected-flag
	   (send terminal-pane :force-kbd-input
		 #\network)
	   (send terminal-pane :force-kbd-input
		 #\C)
	   (setf kermit-connected-flag nil))
	  (t (beep-at-user "You are not connected")))))

;;;; Make connection
;;; This is the call to the code in the TERMinal file for terminal emulation.
;;; Note that the terminal emulator will intercept and execute command menu mouse
;;; blips.

))

; From modified file DJ: L.NETWORK.KERMIT; WINDOW.LISP#78 at 19-Jul-88 12:48:39
#8R KERMIT#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; WINDOW  "


(defun make-connection ()
  (cond (kermit-connected-flag
	 (beep-at-user "~&You are already connected: do <NETWORK>-C to disconnect"))
	(kermit-serial-stream
	 (with-status ("Connection started: ~\time\~%~A~%~@[~A~]~%~A"
		       (setq *kermit-beginning-time* (time:get-universal-time))
		       (within-status "~A" kermit-serial-stream)
		       (let ((baud-rate?
			       (lexpr-send
				 kermit-serial-stream
				 :send-if-handles
				 (select-processor
				   ((:lambda :explorer) (list :baud-rate))
				   (:cadr (list :get :baud))))))
			 (if baud-rate? (format nil "Baud Rate: ~D." baud-rate?)))
		       (format nil "Escape Character: ~:@C" #\network))
	   (unwind-protect
	       (progn (setf kermit-connected-flag t)
		      (tv:with-selection-substitute (terminal-pane kermit-frame)
			(send kterm-state
			      ':make-connection
			      kermit-serial-stream
			      terminal-pane)))
	     (setf kermit-connected-flag nil))))
	(t (ferror nil "kermit-serial-stream is NIL."))))


;;;; Bye

))

; From modified file DJ: L.NETWORK.KERMIT; WINDOW.LISP#78 at 19-Jul-88 12:48:40
#8R KERMIT#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; WINDOW  "


(defun set-current-baud-rate (new-baud)
  (select-processor
    ((:lambda :explorer)
     (when (si:sdu-serial-stream-p kermit-serial-stream)
       (send kermit-serial-stream :set-baud-rate new-baud))
     (setq *sdu-serial-default-baud-rate* new-baud))
    (:cadr
     (send kermit-serial-stream
	   :send-if-handles
	   :put
	   :baud
	   new-baud))))

))

; From modified file DJ: L.NETWORK.KERMIT; WINDOW.LISP#78 at 19-Jul-88 12:48:41
#8R KERMIT#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; WINDOW  "


(defun current-baud-rate ()
  (if kermit-serial-stream
      (lexpr-send
	kermit-serial-stream
	:send-if-handles
	(select-processor
	  ((:lambda :explorer) (list :baud-rate))
	  (:cadr (list :get :baud))))
    ;;Return current default
    *sdu-serial-default-baud-rate*))

))

; From modified file DJ: L.NETWORK.KERMIT; WINDOW.LISP#78 at 19-Jul-88 12:48:42
#8R KERMIT#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; WINDOW  "


(defun set-baud-rate ()
  (let ((base 10.) (*nopoint nil))		;just for printing
    (let ((old-baud (current-baud-rate)))
      (with-status ("Change Baud Rate or Extended Serial Port Parameters~%Current Baud Rate: ~S" old-baud)
	(let ((new-baud
		(tv:menu-choose
		  all-baud-choices-items-alist
		  "Choose the Baud Rate:"
		  '(:mouse)
		  nil
		  terminal-pane)))
	  (cond ((and new-baud (zerop new-baud))
		 ;;If there's a real stream we can process more serial options
		 (if kermit-serial-stream
		     (extended-set-baud-rate)
		   (beep-at-user "Cannot set extended serial port parameters without an open stream")))
		((and new-baud		; nil if they move out of the window
		      (not (= old-baud new-baud)))	;really have to change it
		 (set-current-baud-rate new-baud)
		 (format t "~&New Baud Rate: ~S~%" new-baud))))))))

))

; From modified file DJ: L.NETWORK.KERMIT; WINDOW.LISP#78 at 19-Jul-88 12:48:42
#8R KERMIT#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; WINDOW  "


(defun extended-set-baud-rate ()
  (select-processor
    (:lambda
      (when (si:sdu-serial-stream-p kermit-serial-stream)
	(let ((old-char-length (symeval-in-instance kermit-serial-stream 'si:char-length))
	      (old-stop-bits (symeval-in-instance kermit-serial-stream 'si:stop-bits))
	      (old-parity (symeval-in-instance kermit-serial-stream 'si:parity))
	      (old-baud-rate (symeval-in-instance kermit-serial-stream 'si:baud-rate)))
	  (let ((char-length old-char-length)
		(stop-bits old-stop-bits)
		(parity old-parity)
		(baud-rate old-baud-rate))
	    (tv:choose-variable-values
	      `((,(locf char-length) "Character Length" :choose (:5bits :6bits :7bits :8bits))
		(,(locf stop-bits)   "Stop Bits       " :choose (:1bit :1.5bits :2bits))
		(,(locf parity)      "Parity or None  " :choose (:even :odd NIL))
		(,(locf baud-rate)   "Baud Rate       " :number))
	      :label "Extended Choice of Serial Characteristics")
	    (or (equal old-char-length char-length)
		(send kermit-serial-stream :set-char-length char-length))
	    (or (equal old-stop-bits stop-bits)
		(send kermit-serial-stream :set-stop-bits stop-bits))
	    (or (equal old-parity parity)
		(send kermit-serial-stream :Set-parity parity))
	    (or (equal old-baud-rate baud-rate)
		(set-current-baud-rate (fix baud-rate)))))
	t))))

;;;; Review parameters

))

; From modified file DJ: L.NETWORK.KERMIT; WINDOW.LISP#78 at 19-Jul-88 12:48:43
#8R KERMIT#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; WINDOW  "


(defmethod (kermit-frame :top-level) (kermit-frame)
  (let ((status-pane (funcall kermit-frame :get-pane 'status-pane))
	(command-pane (funcall kermit-frame :get-pane 'command-pane))
	(interaction-pane (funcall kermit-frame :get-pane 'interaction-pane))
	(terminal-pane (funcall kermit-frame :get-pane 'terminal-pane))
	(terminal-io-syn-stream (make-syn-stream 'terminal-io))
	(*sdu-serial-default-baud-rate* *sdu-serial-default-baud-rate*)
	(*sdu-serial-xon-xoff-p* *sdu-serial-xon-xoff-p*)
	(*sdu-serial-ascii-p* *sdu-serial-ascii-p*)
	)
    (let ((terminal-io interaction-pane)
	  (standard-input terminal-io-syn-stream)
	  (standard-output terminal-io-syn-stream)
	  (query-io terminal-io-syn-stream)
	  (trace-output terminal-io-syn-stream)
	  (error-output terminal-io-syn-stream)
	  (debug-io terminal-io-syn-stream)
	  (ibase 10.)
	  (base 10.)
	  )
      
      ;; if kermit is not yet ready to accept commands, either because it is
      ;; just being started up or because a reset or warm boot has been done
      ;; before it was ready for commands, do various initialization actions.
      
      (cond
	((not kermit-ready-for-commands?)
	 
	 (setq kterm-state (make-instance 'kterm-state))
	 (setq kstate				;have kstate bound to a kstate instance
	       (progn
		 (fs:force-user-to-login)	;default-pathname setup depends on user
		 (make-instance 'kstate)	;  being logged in!
		 ))
	 (setf kermit-ready-for-commands? t)))      
      ;;;
      ;; this is kermit's top-level command execution loop.      
      ;;
      (error-restart-loop (sys:abort "Restart kermit process")
	(loop as character = (funcall terminal-io :any-tyi)	      
	      as command?
	      = (cond
		  ((and (not (atom character))
			(eq (car character) :menu))
		   (cadr character)))
	      doing
	      (cond
		((memq (get command? :funcall) all-commands-requiring-kermit-serial-stream)
		 (or kermit-serial-stream
		     (setq kermit-serial-stream (eval serial-stream-open-form)))
		 (if (eq (funcall command-pane :execute command?) :close)
		     (send self :close-serial-stream)))
		(command?
		 (funcall command-pane :execute command?))
		((not (atom character))
		 (beep-at-user))
		((= character #\hand-down)
		 (send kermit-frame ':set-configuration 'long-terminal)
		 (setq debug-io terminal-pane))
		((= character #\hand-up)
		 (send kermit-frame ':set-configuration 'default)
		 (setq debug-io terminal-io-syn-stream)
		 (send kermit-frame :refresh))
		('else
		 (handle-unanticipated-terminal-input character))))))))

))

; From modified file DJ: L.NETWORK.KERMIT; CALLS.LISP#64 at 19-Jul-88 12:48:47
#8R KERMIT#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; CALLS  "


(defmethod (kstate :set-params) ()
  (declare (special kermit-frame serial-stream-open-form))
  (let ((oldx tv:mouse-x) (oldy tv:mouse-y)
	(menux (tv:sheet-inside-right kermit-frame))
	(menuy (tv:sheet-inside-bottom kermit-frame))
	;;
	;; APPEND NEW SYMBOLS TO THESE TWO LISTS!
	;;
	(vars '(kermit-default-pathname
		 serial-stream-open-form
		 *sdu-serial-xon-xoff-p* *sdu-serial-ascii-p*
		 *file-closing-disposition* *filnamcnv* *8-bit-lispm* *image*
		 ascii-extra-safe-filter?
		 *soh* *mytime* *myquote* *mypad* *mypchar* *image* *debug*
		 *checksum-type*
		  ))
	(old-vals (list kermit-default-pathname
			serial-stream-open-form
			*sdu-serial-xon-xoff-p* *sdu-serial-ascii-p*
			*file-closing-disposition* *filnamcnv* *8-bit-lispm* *image*
			ascii-extra-safe-filter?
			*soh* *mytime* *myquote* *mypad* *mypchar* *image* *debug*
			*checksum-type*
			)))
    ;;
    (tv:mouse-warp (- menux 50.) (- menuy 50.))	;try to put the mouse around the ctr of menu

    (multiple-value-bind (nil abort-p)
	(*catch 'legal-abortion
	  (tv:choose-variable-values
	    `("Mouse-click on the desired option, type a new value, and press <RETURN>.        "
	      "When you are done modifying parameters, click in the margin on /"Execute:/"     "
	      "================================================================================"
	      "The follow parameters determine the form of login or Kermit I//O connection.    "
	      "Note that they take effect after the current connection, if any, is closed.     "
	      "                                                                                "
	      (serial-stream-open-form
		:documentation "The serial stream//device for login or Kermit connections."
		:menu-alist
		(
		 ;;Map over fs:*pathname-host-list* to get serial-port open forms:
		 ;; ("Serial Port A" (sdu-serial-open "SDU-SERIAL-A:"))
		 ;; ("Serial Port B" (sdu-serial-open "SDU-SERIAL-B:"))
		 ,@(gather-sdu-serial-devices)

		 ,@(IF (FIND-PACKAGE "TCP") '(("TCP TELNET" (OPEN-TCP-TELNET-SERIAL-STREAM))))
		 ("CHAOS TELNET" (OPEN-CHAOS-TELNET-STREAM))

		 ;; SUPDUP doesnt work because we are not sending the right negotiations.
		 ;; ("CHAOS SUPDUP" (OPEN-CHAOS-TELNET-STREAM "SUPDUP"))

		 ("REMOTE SERIAL STREAM" (OPEN-REMOTE-SERIAL-STREAM))

		 ;;This was pace's own hack, and doesn't work anywhere anymore:
		 ;("REMOTE UNIX SERIAL" (OPEN-REMOTE-UNIX-SERIAL-STREAM))

		 ("Prompt User" (prompt-and-read :eval-read "~&Form to EVAL and return a stream: "))

		 ;;Unix share ttys
		 ;; One should make sure the pathname exists; otherwise, you'll
		 ;; open an 'i//o stream' to some random file probably.
		 . ,(loop for share-tty in (and (boundp 'unix:*share-ttys*)
						unix:*share-ttys*)
			  as port-number from 0
			  collect
			   (list
			     (format nil "Unix Port ~D (//dev//ttyl~D)"
				     port-number port-number)
			     `(open
				,(format nil "UNIX-STREAM-~D:"
					 port-number))))))

	      (*sdu-serial-ascii-p*
		:documentation "For serial ports, Yes to perform ASCII//LISPM character conversion."
		:boolean)
	      (*sdu-serial-xon-xoff-p*
		:documentation "For serial ports, Yes to use software Xon//Xoff flow control."
		:boolean)

	      "--------------------------------------------------------------------------------"
	      "The remaining parameters affect the ongoing behavior of Kermit transfers.       "
	      "Note that they take effect after the current connection, if any, is closed.     "
	      "                                                                                "

	      (kermit-default-pathname
		:documentation "Default local pathname/directory for Kermit file transfers"
		:pathname kermit-default-pathname)
	      
	      (*filnamcnv* :documentation "Specify mode of filename conversion, if any."
			   :menu-alist ,(cons '("Raw - no conversion" :raw)
					      (cons '("Unknown - generic" :generic)
						    (mapcar #'(lambda (x)
								(list (car x) (car x)))
							    (get (locf fs:canonical-types)
								 :lisp)))))

	      (ascii-extra-safe-filter?
		:documentation
		"Either NIL, or a LISP function that filters unwanted control characters.")

	      (*8-bit-lispm* :documentation
	       "Yes if you can send 8-bit characters, and want LISPM//ASCII character translation."
	       :boolean)

	      (*image* :documentation
		         "Yes, if you want 8-bit, binary mode (no character translation)."
		       :boolean)

	      (*file-closing-disposition*
		:documentation
		  "Decide whether files only partially written due to interrupt should be saved."
		:menu-alist (("delete-if-abort" :abort)
			     ("dont-delete" nil)))

	      (*debug* :documentation
		         "Yes, if you want verbose debugging information during transfer."
		       :boolean)
	      (*terminal-debug-mode* :documentation "Yes for debugging the terminal emulator"
				     :boolean)

	      "--------------------------------------------------------------------------------"
	      "Some less commonly changed, Kermit packet level parameters - for expert users   "
              "with knowledge of the remote Kermit Protocol and//or operating system           "
              "and their features//problems:"

	      (*soh* :documentation
		       "mark for start of packet (a non-printing character)"
		     :number)
	      (*mytime* :documentation
			  "max time to wait for packet"
			:number)
	      (*myquote* :documentation "Character to use to quote non-printing chars."
			 :number)
	      (*myeol* :documentation "mark for end of packet"
		       :number)
	      (*mypad* :documentation
		         "Number of padding characters to use in packet (usually 0)"
		       :number)
	      (*mypchar* :documentation
			   "Padding character to use in packet (usually NUL (0))" 
			 :number)
	      (*checksum-type* :documentation
			       "[Only one character checksums are supported at this time]"
			       :menu-alist (("Normal-one-character" 1)))
	      "      ")
	    
	    :label "Review//Modify Kermit Parameters"
	    :near-mode `(:point ,menux ,menuy)
	    :superior kermit-frame
	    :margin-choices '("Execute:" ("Abort:" (*throw 'legal-abortion nil)))
	    :function #'(lambda(window var old new)
			  (if (and (member var '(*sdu-serial-ascii-p* *image*))
				   new
				   *sdu-serial-ascii-p* *image*)
			      (progn
				(beep)
				(send window :clear-window)
				(send window :fat-string-out *invalid-image-opt-msg*)
				(send window :tyi)
				(send window :refresh)
				(set var old))
			    nil))
	    ))
      (and abort-p
	   (loop for var in vars and old-val in old-vals doing (set var old-val)))
      nil)
    
    (tv:mouse-warp oldx oldy)))

))

; From modified file DJ: L.NETWORK.KERMIT; CALLS.LISP#64 at 19-Jul-88 12:48:48
#8R KERMIT#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; CALLS  "


(defun open-REMOTE-SERIAL-STREAM ()
  (format t "~%Connect to remote Lambda serial port B server.")
  (let (host BAUD)
    (do-forever
      (setq host (prompt-and-read :string-or-nil "~&Lambda host: "))
      (if (catch-error (si:parse-host host))
	  (return nil)))
    (SETQ BAUD (PROMPT-AND-READ :NUMBER "~&Baud rate: "))
    (format t "~&Connecting to ~S" host)
    (make-input-force-output-stream (CHAOS:OPEN-STREAM HOST (FORMAT NIL "SDU-SERIAL-B ~D" BAUD)))))

;;;How can people be so crude???
;(defun open-remote-unix-serial-stream ()
;  (let (host ;BAUD
;	)
;    (do-forever
;      (setq host (prompt-and-read :string-or-nil "~&Use serial port on host: "))
;      (if (catch-error (si:parse-host host))
;	  (return nil)))
;    ;(SETQ BAUD (PROMPT-AND-READ :NUMBER "~&Baud rate: "))
;    (format t "~&Connecting to ~S" host)
;    (make-input-force-output-stream (CHAOS:OPEN-STREAM HOST
;						       "EVAL //lmi//pace//xtip//tip -p vadic"))))


))