;;; -*- mode:lisp; package:kermit; base:8; ibase:8 -*- ;1; Note that ibase will not be recognized on the 3600. ;****************************************************************************** ; 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 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. ;1; for lack of a better place to put it... ;1; The 3600 does not have the si:with-help-stream stuff. ;1; I am guessing that this does something like typeout windows ;1; on the 3600, so I will implement it that way. ;1; I will have it be a typeout window that comes down over the ;1; kermit frame. ;GJC: good guess. In the LMI software it actually ends up in the terminal ;GJC: emulation window only. This seems to work fine though. #+3600 (defmacro with-kermit-typeout-stream (stream label &body body) `(let ((,stream (send kermit-frame :typeout-window))) (unwind-protect (progn (send ,stream :expose-for-typeout) (send ,stream :select) (if ,label (send ,stream :set-label ,label)) ,@body (format ,stream "~&~%~%Type any character to get rid of this display:") (send ,stream :tyi)) (send ,stream :deexpose) ;1; (send kermit-frame :refresh) ;1; used to have :refresh :complete-redisplay ))) ;1; tried just removing it to avoid erasing. ;1; Yup, that did it... (defvar kstate) #+3600 (declare (special *kermit-serial-stream-open-form-list*)) ;1; I added this... this should be the first occurance of kermit-default-pathname. (defvar kermit-default-pathname nil) (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) ;1; OK, OK, OK.... ;1; In absolute frustration, I am changing things to try to straighten out the ;1; confusion between the global and instance kermit-default-pathname. I took ;1; it out of here entirely, and now handle it a a global with faked messges, ;1; and have it initialized in the make-kermit-ready-for-commands function ;1; in lmiwin. ;#+3600 ;(defmethod (kstate :kermit-default-pathname) () ; kermit-default-pathname) ; ;#+3600 ;(defmethod (kstate :set-kermit-default-pathname) (name) ; (setq kermit-default-pathname name)) (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) (declare (special *ttyfd*)) ;1; (let ((*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.") (DECLARE (SPECIAL *FILNAM* *FILELIST*)) ;1; The filelist sent to the :simple-send method is either ;1; a list of filenames or a list of (filename asfilename) ;1; pairs. The strange thing, as it appears to me, is that ;1; :simple-send only calls sendsw with the first ;1; file in the list, and just hangs the rest on ;1; *filelist*. This would seem to cause the bug I observed, ;1; namely that only the first file was sent for a wildcard send. ;1; But since I interpret "simple send" as just sending a single ;1; file, I will put the needed loop in the higher level send-files ;1; function rather than here, and I hope that I don't break ;1; anything else. (defmethod (kstate :simple-send) (stream filelist) (declare (special *filnam* *as-filnam* *filelist* *ttyfd*)) ;1; added to avoid warnings (let ((*filnam* (if (#-3600 consp #+3600 listp (car filelist)) ;1; see comment below regarding consp vs listp (first (car filelist)) (car filelist))) (*as-filnam* (if (#-3600 consp #+3600 listp (car filelist)) ;1; no consp on 3600 anymore, if consp is still (second (car filelist)))) ;1; equivalent to listp on LMI, this can simply be changed to listp ;1; Wrongooo... changed by MLA 6/17/85 ;1; (*filelist* (cdr filelist)) ;GJC: really, next time around you should just say #+3600 (DEFMACRO CONSP ...) ;GJC: not that important of course, but LISTP in common-lisp will be true for () also. (*filelist* filelist) (*ttyfd* stream)) (sendsw))) (defmethod (kstate :server-receive) (stream filename as-filename) (declare (special *filnam* *as-filnam* kermit-default-pathname *ttyfd*)) ;1; (let ((*filnam* filename) (*as-filnam* as-filename) (kermit-default-pathname as-filename) ;for multi files, option to win (*ttyfd* stream)) (flushinput) ;1; the length gave an error on 3600... #-3600 (spack #/R 0 (length *filnam*) *filnam*) #+3600 (spack #/R 0 (string-length *filnam*) *filnam*) (recsw))) (defmethod (kstate :remote-server) (stream &optional working-directory?) (declare (special kermit-default-pathname *ttyfd* *remote*)) ;1; (let-if working-directory? ((kermit-default-pathname working-directory?)) (let ((*ttyfd* stream) (*remote* t)) (server-command-wait)))) (defmethod (kstate :bye-server) (stream) (declare (special *ttyfd*)) ;1; (let ((*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) (declare (special *ttyfd*)) ;1; (let ((*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 kermit-default-pathname file-closing-disposition* *local-echo-mode* *use-bit-7-for-meta* *auto-cr-on-lf-flag* *auto-lf-on-cr-flag*)) ;1; (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* ;1; let's add a few more for term emulation *local-echo-mode* *use-bit-7-for-meta* *auto-cr-on-lf-flag* *auto-lf-on-cr-flag* )) (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* *local-echo-mode* *use-bit-7-for-meta* *auto-cr-on-lf-flag* *auto-lf-on-cr-flag* )) ;1; also add the following so that kermit-default-pathname merging works better. #+3600 (fs:*default-pathname-defaults* (send (fs:parse-pathname kermit-default-pathname) :new-pathname :name :wild :type :wild)) ) (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... #+3600 ;1; different for 3600 ,*kermit-serial-stream-open-form-list* ;1; defined in lmiwin #-3600 (("Serial Port B" (open "SDU-SERIAL-B:")) ;; 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 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))))) ) ;1; just changed format for clarity "--------------------------------------------------------------------------------" (*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))) ;1; changed this as best I could figure out... ;1; what I think it does it get canonical type names ;1; for all types which have a :LISP entry. --mla #+3600 (loop for item in fs:*canonical-types-alist* when (assq ':LISP (cdr item)) collect item) #-3600 (get (locf fs:canonical-types) ;1; ':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))) "--------------------------------------------------------------------------------" ;1; added by mla... "Parameters for terminal emulation characteristics..." (*local-echo-mode* :documentation "Yes if local character echoing should be done." :boolean) (*use-bit-7-for-meta* :documentation "Yes if remote host will support bit 7 as Meta bit." :boolean) (*auto-cr-on-lf-flag* :documentation "Yes if linefeed should display as a ." :boolean) (*auto-lf-on-cr-flag* :documentation "Yes if return should display as a ." :boolean) "--------------------------------------------------------------------------------" "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 (use displayed values)" ("ABORT (ignore changes)" (*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))) (defconst kstate () ;should be bound during program "The flavor instance of kstate which calls Kermit programs and bind globals.") (compile-flavor-methods kstate)