;;; -*- Mode:LISP; Package:KERMIT; Base:8; Readtable:ZL -*-


;; Copyright LISP Machine, Inc. 1984, 1985, 1986
;;   See filename "Copyright.text" for
;; licensing and release information.







;;; this code is designed to unify the protocol and
;;; perform the basic protol in which globals are safely
;;; bound to their proper values. This also makes "cold
;;; boots" of the system easier.


;;; all these instance variables are declared special
;;; in elsewhere in the sources (mostly in the kermit-protocol
;;; file).


;;; kstate should be a special instance variable of the kermit
;;; frame for this to really work for it.




(defvar kstate)

(defflavor kstate
	   (

	    ;; main user settables
	    (*soh* 1)
	    (*mytime* #o12)
	    (*myquote* #\#)
	    (*myeol* #o15)
	    (*mypad* 0)
	    (*mypchar* 0)
	    (*filnamcnv* ':generic)
	    (*8-bit-lispm* t)			;to do lispm-ascii translation right
	    (*image* nil)
	    (*debug* nil)
	    (*checksum-type* 1)

	    (ascii-extra-safe-filter?
	      '(lambda (char)
		 (if (< char #\space) #\space char)))

	    (kermit-default-pathname (string (fs:user-homedir)))

	    (*rpsiz* 0)
	    (*spsiz* 0)
	    (*pad* 0)
	    (*timint* 0)

	    (*remote* nil)
	    (*filecount* 0)
	    (*size* 0)
	    (*packet-number* 0)
	    (*numtry* 0)
	    (*oldtry* 0)

	    (*state* 0)

	    (*padchar* 0)
	    (*quote* 0)
	    (*eol* #o15)
	    (*escchr* 0)
	    (*eof* 0)

	    (bufemp-ignore-line-feed nil)

	    (*recpkt* (make-array *maxpacksiz* ':type 'art-string ':fill-pointer 0))
	    (*packet* (make-array *maxpacksiz* ':type 'art-string ':fill-pointer 0))
	    (*string-array-buffer* (make-array (* 2 *maxpacksiz*)
					       ;; should be enough for padding
					       ;; soh, eol, type, num, len, and data
					       ':type 'art-string ':fill-pointer 0))



	    (*filnam* nil)
	    (*filelist* ())

	    (*ttyfd* nil)
	    (*fp* nil)
	    (*kermit-beginning-time* nil)
	    (*packcount-wraparound* 0))

	   ()
  (:settable-instance-variables
    kermit-default-pathname)
  :special-instance-variables)


(defmethod (kstate :string-for-kermit)
	   (filename)				;*filnamcnv* is specially bound by method
  (string-for-kermit filename))

(defmethod (kstate :filelist)
	   (filename)
  (kermit-filelist filename))

(defmethod (kstate :simple-receive)
	   (stream)
  (si:%bind (variable-location *ttyfd*) stream)
  (recsw))







;;;..............................



(defconst kermit-max-delay-before-transaction 500.
  "Maximum time Kermit will delay before doing a file send or receive.")





(defvar kermit-delay-before-transaction 0
  "Time to delay before starting a send transaction.")


(SPECIAL *FILNAM* *FILELIST*)

(defmethod (kstate :simple-send) (stream filelist)
  (si:%bind (variable-location *filnam*)
	    (if (consp (car filelist))
		(first (car filelist))
	      (car filelist)))
  
  (si:%bind (variable-location *as-filnam*)
	    (if (consp (car filelist))
		(second (car filelist))))
  
  (si:%bind (variable-location *filelist*) (cdr filelist))
  (si:%bind (variable-location *ttyfd*) stream)

  (sendsw))



(defmethod (kstate :server-receive)
	   (stream filename as-filename)
  (si:%bind (variable-location *filnam*) filename)
  (si:%bind (variable-location *ttyfd*) stream)
  (si:%bind (variable-location kermit-default-pathname) as-filename)
  (flushinput)
  (spack #/R 0 (length *filnam*) *filnam*)
  (recsw))


(defmethod (kstate :remote-server) (stream
				    &optional
				    working-directory?)
  (if working-directory?
      (si:%bind (variable-location kermit-default-pathname) working-directory?))
  (si:%bind (variable-location *ttyfd*) stream)
  (si:%bind (variable-location *remote*) t)
  (server-command-wait))


(defmethod (kstate :bye-server)   (stream)
  (si:%bind (variable-location *ttyfd*) stream)
  (flushinput)
  (spack #\G *packet-number* 1 "L")
  (selectq (rpack)
    (#\Y (format interaction-pane "~% ...BYE~%"))
    (#\N (format interaction-pane "~% ...unable to say BYE~%"))
    (t (format interaction-pane "~% ...error saying BYE~%"))))


(defmethod (kstate :finish-server) (stream)
  (si:%bind (variable-location *ttyfd*) stream)
  (flushinput)
  (spack #\G *packet-number* 1 "F")
  (selectq (rpack)
    (#\Y (format interaction-pane "~% ...Finished~%"))
    (#\N (format interaction-pane "~% ...unable to finish~%"))
    (t (format interaction-pane "~% ...error finishing~%"))))



(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:"))
		 ,@(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))
		 ("REMOTE UNIX SERIAL" (OPEN-REMOTE-UNIX-SERIAL-STREAM))
		 ("Prompt User" (prompt-and-read :eval-read "~&Serial 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)))


(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: "))
      (when (catch-error (funcall (intern "GET-INTERNET-ADDRESS" "TCP") host))
	(return nil)))
    (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 stream :set-force-output-p nil)
    (send stream :tyo iac)
    (send stream :tyo do)
    (send stream :tyo telopt_echo)
    (send stream :tyo iac)
    (send stream :tyo do)
    (send stream :tyo telopt_sga)
    (send stream :tyo iac)
    (send stream :tyo will)
    (send stream :tyo telopt_sga)
    (send stream :set-force-output-p t)
    (force-output stream)
    stream))

(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: "))
      (when host (return nil)))
    (format t "~&Connecting to ~S" host)
    (make-input-force-output-stream (chaos:open-stream host CONTACT))))


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


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




(defun make-input-force-output-stream (substream &aux stream need-forcep)
  (setq stream #'(lambda (op &optional arg1 &rest args)
		   (si:selectq-with-which-operations op
		     ((:tyi :listen)
		       (when need-forcep
			 (send substream :force-output)
			 (setq need-forcep nil))
		       (send substream op))
		     (:tyo
		       (setq need-forcep t)
		       (send substream :tyo arg1))
		     (:close
		       (send substream :close))
		     (t
		       (stream-default-handler stream op arg1 args))))))


  

(defconst kstate ()				;should be bound during program
  "The flavor instance of kstate which calls Kermit programs and bind globals.")


(defun telnet-h19 (&optional to-host)
  (let ((status-pane terminal-io)
	(command-pane terminal-io)
	(interaction-pane terminal-io)
	(terminal-pane terminal-io)
	(kterm-state (make-instance 'kterm-state))
	(kermit-frame nil))
    (declare (special status-pane command-pane interaction-pane terminal-pane kterm-state
		      kermit-frame))
    (enable-telnet-iac)
    (let ((host to-host))
      (do-forever
	(setq host (or host (prompt-and-read :string-or-nil "~&Telnet to host: ")))
	(when (catch-error (funcall (intern "GET-INTERNET-ADDRESS" "TCP") host))
	  (return nil))
	(setq host nil))
      (format t "~&Connecting to ~S" host)
      (with-open-file (stream (format nil "TCP-HOST:~A#TELNET" host)
			      :keyword "Kermit User Telnet"
			      :auto-force-output t
			      :coroutine-input t)
	(send kterm-state
	      ':make-connection
	      stream
	      terminal-pane)))))


(compile-flavor-methods kstate)