;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for Kermit version 35.1
;;; Reason:
;;;  Robustifications to Kermit open forms:
;;;  
;;;  1. The unix-serial-stream stuff only worked at LMI, a long time ago, if Pace's
;;;  personal directory was present, etc.
;;;  2. Fix incorrect sdu-serial stream open calls
;;;  3. Parse host specs and warn user when they type the wrong thing
;;; Written 18-Jul-88 17:12:02 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 3
;;; with System 125.5, ZWEI 125.1, ZMail 73.0, Local-File 75.0, File-Server 24.0, Unix-Interface 13.0, Tape 24.0, Lambda-Diag 17.0, Experimental Kermit 35.0, microcode 1761, SDU Boot Tape 3.14, SDU ROM 103.


(fmakunbound 'kermit:open-remote-unix-serial-stream)

; From modified file DJ: L.NETWORK.KERMIT; CALLS.LISP#60 at 18-Jul-88 17:13:34
#8R KERMIT#: 
(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
		 *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
			*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
	    `("     MODIFY PARAMETERS used by KERMIT by clicking with the mouse     "
	      "     over the appropriate value, typing a new value, and hitting the     "
	      "     return key. When all values are satisfactory, click the box      "
	      "     labelled /"EXECUTE:/" in the lower left corner.     "
	      
	      "================================================================================"
	      
	      (kermit-default-pathname
		:documentation "Where to write to or read from by default"
		:pathname kermit-default-pathname)

	      (serial-stream-open-form
		:documentation "The serial stream//device for connections."
		:menu-alist
		(
		 ;;>>one could map over fs:*pathname-host-list* to get these devices...
		 ;; ("Serial Port A" (open "SDU-SERIAL-A:"))
		 ;; ("Serial Port B" (open "SDU-SERIAL-B:"))
		 ;;Ok, this computes the serial devices on a Lambda:
		 #+lambda
		 ,@(loop for p in fs:*pathname-host-list*
			 when (typep p 'si:sdu-serial-b-shared-device)
			 collect `(,(send p :name) (open ,(send p :name))))
		 ,@(IF (FIND-PACKAGE "TCP") '(("TCP TELNET" (OPEN-TCP-TELNET-SERIAL-STREAM))))
		 ;;Does this work anymore???
		 ("CHAOS TELNET" (OPEN-CHAOS-TELNET-STREAM))
		 ;; SUPDUP doesnt work because we are not sending the right negotiations.
		 ;; ("CHAOS SUPDUP" (OPEN-CHAOS-TELNET-STREAM "SUPDUP"))
		 ;;This was pace's own hack, and doesn't work anywhere anymore:
		 ;("REMOTE SERIAL STREAM" (OPEN-REMOTE-SERIAL-STREAM))
		 ;("REMOTE UNIX SERIAL" (OPEN-REMOTE-UNIX-SERIAL-STREAM))
		 ("Prompt User" (prompt-and-read :eval-read "~&Form to Eval and return a stream: "))
		 ;; 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))))))

	      "--------------------------------------------------------------------------------"
	      
	      
	      (*filnamcnv* :documentation "Specify your OS for filename conversion purposes."
			   :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)))))
	      (*8-bit-lispm* :documentation
	       "Yes if you can send 8-bit characters, want lispm//ascii chars translated right."
	       :boolean)

	      (ascii-extra-safe-filter?
		:documentation
		"Either nil, or a lisp function that filters wierd ctrl characters.")

	      (*image* :documentation
		         "Yes if you want 8-bit, binary mode. (no character translation)"
		       :boolean)
	      (*debug* :documentation
		         "Yes, if you want verbose debugging information during xfer"
		       :boolean)
	      (*terminal-debug-mode* :documentation "Yes for debugging the terminal emulator"
				     :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)))
	      "--------------------------------------------------------------------------------"
	      "Some less commonly changed, packet level parameters requiring a more advanced"
              "knowledge of the Kermit Protocol and//or the specific operating system"
              "being dealt with and their (mis)features."

	      (*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)))
	      "      ")
	    
	    :near-mode `(:point ,menux ,menuy)
	    :superior kermit-frame
	    :margin-choices '("EXECUTE:" ("abort:" (*throw 'legal-abortion 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#60 at 18-Jul-88 17:13:42
#8R KERMIT#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; CALLS  "


(defun open-tcp-telnet-serial-stream (&optional auto-force-output)
  (declare (ignore auto-force-output))
  (enable-telnet-iac)
  (let (host stream)
    (do-forever
      (setq host (prompt-and-read :string-or-nil "~&Telnet to host: "))
      (if (catch-error (ip:parse-internet-address host))
	(return nil)
	(warn "~s is not an Internet host" host)))
    (format t "~&Connecting to ~S" host)
    (setq stream (open (format nil "TCP-HOST:~A#TELNET" host)
		       :keyword "Kermit User Telnet"
		       :auto-force-output t
		       :coroutine-input t))
    (send-initial-telnet-frobs stream)
    stream))

))

; From modified file DJ: L.NETWORK.KERMIT; CALLS.LISP#60 at 18-Jul-88 17:13:44
#8R KERMIT#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; CALLS  "


(defun open-chaos-telnet-stream (&OPTIONAL (CONTACT "TELNET"))
  (enable-telnet-iac)
  (let (host)
    (do-forever
      (setq host (prompt-and-read :string-or-nil "~&Telnet to host: "))
      (if (catch-error (si:parse-host host))
	  (return nil)))
    (format t "~&Connecting to ~S" host)
    (make-input-force-output-stream (chaos:open-stream host CONTACT))))


))

; From modified file DJ: L.NETWORK.KERMIT; CALLS.LISP#60 at 18-Jul-88 17:13:46
#8R KERMIT#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "KERMIT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; CALLS  "


(defun open-REMOTE-SERIAL-STREAM ()
  (let (host BAUD)
    (do-forever
      (setq host (prompt-and-read :string-or-nil "~&Use serial port on 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"))))


))

; From modified file DJ: L.NETWORK.KERMIT; S-TERM.LISP#23 at 18-Jul-88 17:14:14
#10R S-TERMINAL#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "S-TERMINAL")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERMIT; S-TERM  "

(defun make-ps-terminal ()
  (make-instance 'ps-terminal
		 ':serial (open "Sdu-serial-b:")
		 ':peek-chars nil
		 ':read-ahead-chars nil
		 ':ttysync t))

))

; From modified file DJ: L.NETWORK.KERMIT; TERM.LISP#68 at 18-Jul-88 17:14:38
#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))
	   (send *serial-stream* :describe-status))
	  (t (describe *serial-stream*)))
    ))

))