;;; -*- MODE:LISP; BASE:8; IBASE:8; PACKAGE:KERMIT -*- ;****************************************************************************** ; 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 is now the toplevel user interface for ;;; the kermit system. (declare (special self kstate ;in calls.lisp kterm-state ;in term.lisp )) ;1; This is where the version string is defined! ;1; It's display is handled by the terminal-pane-label below. (defconst kermit-version "LMKERMIT Version 1.0a Alpha Test") (defvar kermit-frame :unbound "Frame for KERMIT") (defvar status-pane :unbound "Status pane in KERMIT frame") (defvar interaction-pane :unbound "Interaction pane in KERMIT frame") ;;; (actually just the interaction pane) (defvar debug-pane :unbound "Debugging pane in KERMIT frame") (defvar command-pane :unbound "Pane for menu commands") (defvar terminal-pane :unbound "Terminal emmulation pane in kermit for connecting to remote host The terminal emulated is a HEATH (or H19) type terminal.") (defconst terminal-pane-label `(:string ,(format nil "H-19//Z-29 Terminal Emulator -- ~A" kermit-version) ;1; ,@(if (boundp 'fonts:metsi) (list :font fonts:metsi)) #-3600 :centered)) ;1; :centered is not known keyword on 3600 (defconst interaction-pane-label `(:string "Interaction Pane" ,@(if (boundp 'fonts:hl12bi) (list :font fonts:hl12bi)) #-3600 :centered)) (defconst command-pane-label `(:string "Commands" ,@(if (boundp 'fonts:hl12bi) (list :font fonts:hl12bi)) #-3600 :centered)) (defconst status-pane-label `(:string "Kermit" ;this is just the top level ;waiting for a command label! ,@(if (boundp 'fonts:hl12bi) (list :font fonts:hl12bi)) #-3600 :centered)) ;;;------------------------------------------------------------ ;;;; K E R M I T F R A M E ;1; The next few were added for the 3600 version. ;#+3600 ;(defvar *kermit-modem-phone-number* 98706086. ; "The phone number for the Symbolics modem to dial upon opening the serial stream.") #+3600 (defvar *kermit-default-baud-rate* 9600. "The baud rate at which the generalized ports will be originally opened. Of course, you can change the rate after the stream is open using the Change Baud Rate command from the command menu.") ;1; I originally thought I needed to use ascii-translation character streams, but ;1; you don't. The kermit stuff does its own character translation as needed. #+3600 (defvar *kermit-serial-stream-open-form-list* `( ; ("Internal Modem" ; (or (aref si:*serial-streams* 2) ;1; if already open,just return the stream.... ; (si:make-serial-stream :flavor 'si:modem ; :phone-number ,*kermit-modem-phone-number* ; :unit 2 :baud 1200. ; :force-output t))) ("Port 1" (or (aref si:*serial-streams* 1) (si:make-serial-stream :unit 1 :force-output t :baud ,*kermit-default-baud-rate*))) ("Port 1 with flow control" (or (aref si:*serial-streams* 1) (si:make-serial-stream :unit 1 :force-output t :xon-xoff-protocol t :generate-xon-xoff t :baud ,*kermit-default-baud-rate*))) ("Port 2" (or (aref si:*serial-streams* 2) (si:make-serial-stream :unit 2 :force-output t :baud ,*kermit-default-baud-rate*))) ("Port 2 with flow control" (or (aref si:*serial-streams* 2) (si:make-serial-stream :unit 2 :force-output t :xon-xoff-protocol t :generate-xon-xoff t :baud ,*kermit-default-baud-rate*))) ("Port 3" (or (aref si:*serial-streams* 3) (si:make-serial-stream :unit 3 :force-output t :baud ,*kermit-default-baud-rate*))) ("Port 3 with flow control" (or (aref si:*serial-streams* 3) (si:make-serial-stream :unit 3 :force-output t :xon-xoff-protocol t :generate-xon-xoff t :baud ,*kermit-default-baud-rate*))) ) "The list of name-form pairs available for use in opening the serial stream.") (defconst *default-serial-stream-open-form* #-3600 ;1; 3600 does not have select-processor (select-processor (:cadr '(make-serial-stream)) (:lambda '(open "SDU-SERIAL-B:" ;; might not lose as badly with bigger buffers: :input-buffer-size (* 3 si:page-size) :output-buffer-size (* 2 si:page-size))) (:explorer '(make-serial-stream-perhaps))) #+3600 (cadr (first *kermit-serial-stream-open-form-list*)) ;1; Port 1 is the default. ) (defvar kermit-serial-stream :unbound "Special instance var of kermit-frame bound to serial stream or nil inside process.") (defvar kermit-ready-for-commands? :unbound "Nil means data structures unitialized or invalid.") (defvar kermit-connected-flag :unbound "Non-nil means locked into terminal CONNECTion.") (defflavor kermit-frame ((kermit-ready-for-commands? nil) (kermit-connected-flag nil) (kermit-serial-stream nil) (serial-stream-open-form *default-serial-stream-open-form*) kstate kterm-state ) ( #+3600 tv:window-with-typeout-mixin ;1; needed for with-kermit-typeout-stream tv:process-mixin tv:select-mixin ; just to get :set-process handler! #-3600 tv:inferiors-not-in-select-menu-mixin ;1; not for 3600 #-3600 tv:alias-for-inferiors-mixin tv:margin-choice-mixin tv:essential-mouse ;for asynchronous mouse cmds #+3600 tv:stream-mixin ;1; needed for 3600 to get :listen, etc. tv:bordered-constraint-frame-with-shared-io-buffer) :SPECIAL-INSTANCE-VARIABLES :initable-instance-variables ;1; changed inittable to initable, typo? :outside-accessible-instance-variables ;1; why?? (:accessor-prefix "") (:documentation :special-purpose "kermit command and terminal frame for file transfer and remote terminal emulation") (:default-init-plist #+3600 :typeout-window #+3600 '(tv:typeout-window) ;1; for with-kermit-typeout-stream :margin-choices '((" Abort " nil async-abort 0 0) (" Exit " nil async-exit 0 0) (" Break " nil async-break 0 0) (" Resume " nil async-resume 0 0)) :borders 3 ; 3 on frame + 3 on each pane :expose-p t ; expose w/o blink on instantiation :activate-p t ; activate on instantiation :save-bits :delayed ; make save bits array on deexposure :process '(run-kermit-process) :panes `((status-pane kermit-status-pane) (command-pane kermit-command-pane) (interaction-pane kermit-interaction-pane) (extra-pane kermit-status-pane) ;1; What is this pane for?? . ((terminal-pane kermit-terminal-pane))) ;1; Yup, As of release 6.0, the 3600 is going to a different way of ;1; specifying constraints... #-3600 :constraints #-3600 '((default . ((top-strip terminal-pane interaction-pane) ((top-strip :horizontal (:ask-window command-pane :pane-size) . ((status-pane command-pane) ((command-pane :ask :pane-size)) ((status-pane :even))))) ((terminal-pane 25. :lines)) ((interaction-pane :even)))) ;1; next one reduces size of the interaction pane to give a larger ;1; landscape terminal window. (long-terminal . ((top-strip terminal-pane interaction-pane) ((top-strip :horizontal (:ask-window command-pane :pane-size) . ((status-pane command-pane) ((command-pane :ask :pane-size)) ((status-pane :even))))) ((terminal-pane 50. :lines)) ;1; 3640 has smaller screen, can't handle 50. ((interaction-pane :even)))) ) ;1; This is the new way for 3600... rather nice, actually... #+3600 :configurations #+3600 '((default (:layout (default :column top-strip terminal-pane interaction-pane) (top-strip :row status-pane command-pane)) (:sizes (default (top-strip :ask-window command-pane :pane-size) :then (terminal-pane 25. :lines) :then (interaction-pane :even)) (top-strip (command-pane :ask :pane-size) :then (status-pane :even)))) (long-terminal ;actually, this is a large landscape... (:layout (long-terminal :column top-strip terminal-pane interaction-pane) (top-strip :row status-pane command-pane)) (:sizes (long-terminal (top-strip :ask-window command-pane :pane-size) :then (interaction-pane 3. :lines) :then (terminal-pane :even)) ;make terminal pane as large as possible (top-strip (command-pane :ask :pane-size) :then (status-pane :even)))) (portrait-terminal ;and this new one is a long, 80 char portrait (:layout (portrait-terminal :row terminal-pane totem-pane) (totem-pane :column command-pane status-pane interaction-pane)) (:sizes (portrait-terminal (terminal-pane 80. :characters) :then (totem-pane :even)) (totem-pane (command-pane :ask :pane-size) :then (status-pane 0.5) :then (interaction-pane :even))))) )) (defmethod (kermit-frame :before :select) (&optional ignore) ;1; added the &optional so it would work (fs:force-user-to-login) ;1; with no arguments. ;1; I had to add the following to ensure that kstate would be bound before ;1; we try to send it a message. If not, I got an unbound error upon initial invocation. #+3600 (make-kermit-ready-for-commands) ;1; Oh boy, did this cause me grief... it doesn't do at all what I want on 3600... ;1; Having this here makes it almost impossible to keep a non-default pathname ;1; set without having it reset to the default! #-3600 (send kstate :set-kermit-default-pathname (string (fs:user-homedir))) ) ;;;; scrolling mixin ;;; this should be part of the general system, but alot of people flame ;;; at the idea, so... (defflavor scrolling-mixin ((scroll-p t) (smooth-scroll-p nil)) () (:required-flavors tv:minimum-window) (:init-keywords :scroll-p :smooth-scroll-p) :settable-instance-variables :gettable-instance-variables (:default-init-plist :scroll-p t :smooth-scroll-p nil)) ;1; On 3600, we must now do this with a defwhopper (or defwrapper) #-3600 (defmethod (scrolling-mixin :around :end-of-page-exception) (cont mt original-argument-list &rest args) original-argument-list (cond ((or scroll-p smooth-scroll-p) (multiple-value-bind (ignore y) (send self :read-cursorpos :character) (send self :set-cursorpos 0 0 :character) ;; should have an option and a terminal escape for this ;; and should be able to vary from line to smooth scrolling ;; from terminal. (cond (smooth-scroll-p (send self :smooth-delete-line)) (t (send self :delete-line))) (send self :set-cursorpos 0 (1- y) :character)) (setf (tv:sheet-end-page-flag self) 0) (setf (tv:sheet-more-flag self) 0)) (t (lexpr-funcall-with-mapping-table cont mt :end-of-page-exception args)))) #+3600 (defwhopper (scrolling-mixin :end-of-page-exception) (&rest args) (cond ((or scroll-p smooth-scroll-p) (multiple-value-bind (ignore y) (send self :read-cursorpos :character) (send self :set-cursorpos 0 0 :character) ;; should have an option and a terminal escape for this ;; and should be able to vary from line to smooth scrolling ;; from terminal. (cond (smooth-scroll-p (send self :smooth-delete-line)) (t (send self :delete-line))) (send self :set-cursorpos 0 (1- y) :character)) (setf (tv:sheet-end-page-flag self) 0) (setf (tv:sheet-more-flag self) 0)) (t (lexpr-continue-whopper args)))) (defmethod (scrolling-mixin :smooth-delete-line) () (let ((line-height (tv:sheet-line-height self))) (loop for i from 1 to line-height by 1 do #+3600 (send self :delete-line 1 ':pixel) ;1; #-3600 (tv:sheet-delete-line self 1 :pixel)))) #-3600 (tv:add-escape-key #/R 'kbd-escape-scroll "terminal r -- toggle scrolling off, on, on-smooth terminal 0 r -- turn off scrolling terminal 1 r -- turn on scrolling terminal 2 r -- turn on smooth scrolling") #+3600 (tv:add-function-key #\scroll 'kbd-escape-scroll "Function Scroll - turns scrolling off, on, on-smooth (like for Kermit terminal) function 0 scroll -- turn off scrolling function 1 scroll -- turn on scrolling function 2 scroll -- turn on smooth scrolling") (defun kbd-escape-scroll (arg) (let ((window? tv:selected-window)) (and window? (memq :set-scroll-p (send window? :which-operations)) (memq :set-smooth-scroll-p (send window? :which-operations)) (select arg (nil (cond ((send window? :smooth-scroll-p) ;; go to no scroll (send window? :set-scroll-p nil) (send window? :set-smooth-scroll-p nil)) ((send window? :scroll-p) ;; go to smooth-scroll (send window? :set-smooth-scroll-p t)) (t ;; go to scroll (send window? :set-scroll-p t) (send window? :set-smooth-scroll-p nil)))) (0 (send window? :set-scroll-p nil) (send window? :set-smooth-scroll-p nil)) (1 (send window? :set-scroll-p t) (send window? :set-smooth-scroll-p nil)) (2 (send window? :set-scroll-p t) (send window? :set-smooth-scroll-p t)))))) ;1; also need to define these needed methods for kermit frame so scrolling will work ;1; Note that currently, scrolling is only for the interaction pane. #+3600 (defmethod (kermit-frame :scroll-p) () (send interaction-pane :scroll-p)) #+3600 (defmethod (kermit-frame :smooth-scroll-p) () (send interaction-pane :smooth-scroll-p)) #+3600 (defmethod (kermit-frame :set-scroll-p) (val) (send self :send-all-panes :send-if-handles :set-scroll-p val)) #+3600 (defmethod (kermit-frame :set-smooth-scroll-p) (val) (send self :send-all-panes :send-if-handles :set-smooth-scroll-p val)) (defflavor kermit-interaction-pane () (tv:notification-mixin #-3600 tv:list-mouse-buttons-mixin ;1; not needed (or defined) on 3600. scrolling-mixin ;the hack above ;(which strangely is not in the system) tv:window) (:documentation :special-purpose "Kermit interaction pane") (:default-init-plist :blinker-p t :borders 3 ; 3 on frame + 3 on each pane :reverse-video-p t :save-bits :delayed :more-p nil #+3600 :smooth-scroll-p #+3600 t ;1; I like it, and it gives you time to read it. :label interaction-pane-label :deexposed-typeout-action :permit :font-map '(medfnb) :vsp 3 ; 3 pixels between lines :right-margin-character-flag 1)) (defflavor kermit-status-pane () ( #-3600 tv:list-mouse-buttons-mixin ;1; not for 3600 tv:top-label-mixin tv:window) (:documentation :special-purpose "Kermit status pane") (:default-init-plist :borders 3 ; 3 on frame + 3 on each pane :font-map '(fonts:medfnt) :vsp 3 ; 5 pixels between lines :more-p nil :deexposed-typeout-action :permit :save-bits :delayed :reverse-video-p t :label status-pane-label :blinker-p nil ; no blinker )) (defflavor kermit-command-pane () (tv:top-label-mixin tv:menu-highlighting-mixin tv:command-menu) (:documentation :special-purpose "Kermit Command Pane") (:default-init-plist :borders 3 ; 3 on frame + 3 on each pane :label command-pane-label :columns 2 :save-bits :delayed :rows 10 ; if more items, they can be 'scrolled' to. :reverse-video-p t :default-font fonts:hl12bi :item-list all-kermit-command-pane-items)) ;1; I see what this does, but it doesn't work on 3600, and it is ;1; just too hairy to handle right now. ;1; After I get the basic stuff working, I can do this using ;1; a defwhopper. ;1; Actually, the normal menu selection seems ok, so I probably ;1; will not worry about this. #-3600 (defmethod (kermit-command-pane :around :execute) (cont mt original-argument-list item) original-argument-list (unwind-protect (progn (send self :add-highlighted-item item) (funcall-with-mapping-table cont mt :execute item)) (send self :remove-highlighted-item item))) ;; code for terminal in "kermit; term.lisp". ;1; Note that the terminal does not use the scrolling-mixin stuff ;1; since it handles its own display explicitly. (defflavor kermit-terminal-pane () (tv:notification-mixin #-3600 tv:box-label-mixin #+3600 tv:top-box-label-mixin ;1; #-3600 tv:list-mouse-buttons-mixin ;1; not for 3600 tv:window) (:documentation :special-purpose "A general Heath/Zenith terminal emulator for the Lisp Machine") (:default-init-plist :more-p nil #-3600 :label-box-p #-3600 t :border-margin-width 3 :borders 3 :label terminal-pane-label :font-map '(fonts:cptfont) :save-bits :delayed :deexposed-typeout-action :permit :vsp 1 :character-height 26. ;1+ standard # of lines (25 for Heath/Zenith) )) ;1; This is where the kermit program is "put into the system" for selection, etc. ;1; The kermit frame will show up in the select system window. ;1; Since we don't want individual panes to show up in the menu, ;1; we will define the following method so only the frame will appear. #+3600 (defmethod (kermit-frame :selectable-windows) () `((,(send self :name-for-selection) ,self))) ;1; We will also have kermit selectable using the select key on "select K". (tv:add-system-key #\K 'kermit-frame "Kermit" t) ;1; We might as well have it show up on the create system menu, too. #+3600 (tv:add-to-system-menu-create-menu "Kermit" 'kermit-frame "The Kermit file transfer and terminal emulation frame.") ;1; And also add it to the right column of the system menu. #+3600 (tv:add-to-system-menu-programs-column "Kermit" '(tv:select-or-create-window-of-flavor 'kermit-frame) "The Kermit file transfer and terminal emulation frame.") ;;;; this is a very important thing to do unless ;;;; you like to live in the cold load stream: #-3600 ;1; :set-selection-substitute not handled on 3600... (defmethod (kermit-frame :after :init) (ignore) (send self :set-selection-substitute (send self :get-pane 'interaction-pane))) ;;;; Asynchronous wizardry ;;; New: asynchronous mouse commands. EXPERIMENTAL. --MHD, 6/15/84 ;;; (also see changes to kermit-frame flavor def) (defun async-abort (&rest ignore) (format (send self :get-pane 'interaction-pane) "~&[ABORTING..]~%") (send (send self :process) :interrupt (function (lambda () (signal 'sys:abort #-3600 nil))))) ;1; (defun async-exit (&rest ignore) (async-abort) (send self :close-serial-stream) (send self :bury)) (defun async-break (&rest ignore) (send (send self :process) :interrupt #-3600 #'break #-3600 "Kermit" #+3600 #'dbg)) ;1; tv:io-buffer-push is not defined on the 3600, so let's try this. (defun async-resume (&rest ignore &aux (buf #-3600 (send (send self :get-pane 'interaction-pane) :io-buffer) #+3600 (send self :get-pane 'interaction-pane) )) #-3600 (tv:io-buffer-push buf #\resume) ;this doesn't work in the rubout handler! #+3600 (send buf :force-kbd-input #\resume) ) ;;;; Menu ;;; for later additions: (defconst aux1-menu-alist ()) (defun aux1-commands () ;;;for now: (if aux1-menu-alist (tv:menu-choose aux1-menu-alist) (format t "~&No Aux1 options available.~%"))) ;; could be (is at LMI): ; '(("LMI-to-OZ connection" ; :funcall kermit-oz-to-lmi-connection ; :documentation ; "experimental modem & file transfer service between Oz and LMI" ; ))) ;;;; Window Menu Interface ;;; all items: ( :funcall ;;; :documentation ) ;;; Note: all items beginning with the AUX1 item appear 'below' the menu-- ;;; have to get to them via scroll-bar technology. (defconst all-commands-requiring-kermit-serial-stream '(make-connection close-connection send-files receive-files send-files-to-server receive-files-from-server have-server-finish have-server-say-bye be-a-kermit-server-only be-a-server set-baud-rate ;may have to add to this list if you add ;to the one right below! ) "Commands that require KERMIT-SERIAL-STREAM to be bound to the apropriate open stream.") (defconst all-kermit-command-pane-items '(("Connect" :funcall make-connection :documentation "Establish a virtual terminal connection with remote host.") ("Disconnect" :funcall close-connection :documentation "Close the connection made by Connect.") ("Send files" :funcall send-files :documentation "Send files to a remote KERMIT.") ("Receive files" :funcall receive-files :documentation "Receive files from a remote KERMIT.") ("Server//send" :funcall send-files :documentation "Send files to a remote KERMIT that's in Server mode.") ("Server//receive" :funcall receive-files-from-server :documentation "Receive files from a remote KERMIT that's in Server mode.") ("Server//finish" :funcall finish-server :documentation "Finish with KERMIT that's in Server mode, not logging out.") ("Server//bye" :funcall bye-server :documentation "Finish and be logged out by remote KERMIT that's in Server mode.") ("Set baud rate" :funcall set-baud-rate :documentation "Set baud rate of the serial line.") ("Restart Program" :funcall restart-program :documentation "Abandon everything and start KERMIT from scratch") ("Review Parameters" :funcall review-parameters :documentation "Review parameters, and maybe make modifications") ("Refresh Windows" :funcall refresh-windows :documentation "Refresh all the windows in this display.") ("List directory" :funcall list-user-directory :documentation "List the default directory in the interaction pane") ;1; added this command, and put aux commands above remote server ;1; commands in anticipation of having aux commands. #+3600 ("Reconfigure Screen" :funcall kermit-reconfigure-screen :documentation "Reconfigure the kermit screen display using a menu.") ("Help" :funcall kermit-interactive-help :documentation "Interactive Help with Kermit") ("AUX1 Commands" :funcall aux1-commands :documentation "extra commands") ("Remote Login Server" :funcall be-a-server :documentation "Put Kermit in mode to process remote logins and file transfers.") ("Remote Kermit Server" :funcall be-a-kermit-server-only :documentation "Put Kermit directly into Kermit SERVER Mode.") )) (defmacro with-status ((status-pane-format-string . format-args?) &body body) `(let ((*--old-label--* (send status-pane :label))) (unwind-protect (progn (send status-pane :set-label ;which may be multi lines. (format nil ,status-pane-format-string . ,format-args?)) . ,body) (send status-pane :set-label *--old-label--*)))) ;1; The menu-based screen reconfiguration command... just 3600 for now. #+3600 (defun kermit-reconfigure-screen () "Reconfigure the kermit screen characteristics." (tv:menu-choose '(("Standard 25-line Terminal" :eval (progn (send kermit-frame ':set-configuration 'default) (refresh-windows)) :documentation "Goes to the 25-line landscape terminal configuration." ) ("Large Landscape Terminal" :eval (progn (send kermit-frame ':set-configuration 'long-terminal) (refresh-windows)) :documentation "Creates as large a landscape configuration as possible." ) ("Large Portrait Terminal" :eval (progn (send kermit-frame :set-configuration 'portrait-terminal) (refresh-windows)) :documentation "Creates as large a portrait configuration as possible." ) ("Scrolling Interaction Window" :eval (progn (send kermit-frame :set-scroll-p t) (send kermit-frame :set-smooth-scroll-p nil)) :documentation "Have interaction window do standard scrolling." ) ("Smooth Scrolling Interaction Window" :eval (progn (send kermit-frame :set-scroll-p t) (send kermit-frame :set-smooth-scroll-p t)) :documentation "Have interaction window do smooth scrolling." ) ("Wrapping Interaction Window" :eval (progn (send kermit-frame :set-scroll-p nil) (send kermit-frame :set-smooth-scroll-p nil)) :documentation "Have interaction window wrap to top rather than scroll." ) ) "Configuration and Scrolling Menu")) ;;;; Help (what?#@#$!!!) (defun kermit-interactive-help () "Get help interactively; just click on the command to document. The documentation is then displayed in the interaction pane." (with-status ("~&Help with Commands.~A~A" (format nil "~%Please mouse any command") (format nil "~%to see its documentation.~%")) (let ((blip? (send terminal-io :any-tyi))) (cond ((and (not (atom blip?)) (eq (car blip?) :menu)) (let* ((menu-item-name (car (cadr blip?))) (menu-item-function (get (cadr blip?) :funcall)) (documentation? (or (documentation menu-item-function) ;long doc? (get (cadr blip?) :documentation)) ;short doc? )) (cond (documentation? (format interaction-pane "~&~A:~% ~A~%" menu-item-name documentation?)) (t (format interaction-pane "~&Sorry, ~A is not documented.~%" menu-item-name))))) (t (beep)))))) (defun receive-files-from-server () (cond (kermit-connected-flag (beep) (format t "~%Disconnect first in order to receive.~%")) (t (let* ((default-pathname (send kstate ':kermit-default-pathname)) (filename ;don't merge with anything (prompt-and-read ':string-trim "~%Receive file:")) ;1; doesn't do it for 3600... Is it really what LMI needs? #-3600 (as-filename (fs:merge-pathname-defaults (prompt-and-read ':string-trim "~%Merging with (default: ~A):" (fs:merge-pathname-defaults filename default-pathname)) default-pathname)) #+3600 (temp (prompt-and-read ':string-trim "~%Merging with (default: ~A):" (fs:merge-pathname-defaults filename default-pathname))) #+3600 (as-filename (fs:merge-pathname-defaults (cond ((string-equal temp "") filename) (t temp)) default-pathname)) ) (send kstate ':server-receive kermit-serial-stream filename as-filename))))) (defun receive-files () (cond (kermit-connected-flag (beep) (format t "~%Disconnect first in order to receive.~%")) (t (with-status ("Receive:~A ~A ~A" kermit-serial-stream (format nil "~%Transfer started: ~\time\" (setq *kermit-beginning-time* (time:get-universal-time))) (let ((baud-rate? (lexpr-send kermit-serial-stream :send-if-handles ;1; changed this part... #-3600 (select-processor (:lambda (list :baud-rate)) (:cadr (list :get :baud))) #+3600 (list :get :baud) ;1; ))) (if baud-rate? (format nil "~%Baud Rate: ~D." baud-rate?) ""))) (send kstate ':simple-receive kermit-serial-stream))))) (defun send-files () (cond (kermit-connected-flag (beep) (format t "~%Disconnect first in order to send.~%")) (t (let* ((default-pathname (send kstate ':kermit-default-pathname)) (filename (prompt-and-read ':string-trim "~&send file or filegroup (default: ~A):" (fs:merge-pathname-defaults "" default-pathname))) (filelist (send kstate ':filelist (fs:merge-pathname-defaults filename default-pathname))) (filelist-broken-down-into-from-and-to-filenames (loop for file? in filelist with as-file? with tem nconcing (progn (format t "~&Send ~A as (default: ~A ):" file? (send kstate ':string-for-kermit file?)) (setq as-file? (if (zerop (string-length (setq tem (readline)))) (send kstate ':string-for-kermit file?) tem)) (and (y-or-n-p (format nil "~&Confirm sending ~A as ~A? " file? as-file?)) (if (string-equal file? as-file?) (list file?) (list (list file? as-file?)))))))) (cond (filelist-broken-down-into-from-and-to-filenames (with-status ("Send:~A ~A ~A ~%From: ~A" kermit-serial-stream (format nil "~%Transfer started: ~\time\" (setq *kermit-beginning-time* (time:get-universal-time))) (let ((baud-rate? (lexpr-send kermit-serial-stream :send-if-handles ;1; and changed this too. #-3600 (select-processor (:lambda (list :baud-rate)) (:cadr (list :get :baud))) #+3600 (list :get :baud) ;1; ))) (if baud-rate? (format nil "~%Baud Rate: ~D." baud-rate?) "")) filename) (format t "~%Starting transfer... hit control-Z to abort.") ;1; added this... (send kstate ':simple-send kermit-serial-stream filelist-broken-down-into-from-and-to-filenames) ;1; Changed to correct for bug... only sent first file of wildcard send. Then later removed. ;1; (This was fixed correctly at another location. See item #13 in lmbugs.doc ;1; (loop for loopfilelist on filelist-broken-down-into-from-and-to-filenames ;1; do (send kstate :simple-send kermit-serial-stream loopfilelist)) ))))))) ;;;; Kermit Server (see the file SERVER for details). (defun be-a-kermit-server-only () (with-status ("Remote Kermit Server~A~A~A" (format nil "~%Stream: ~A" kermit-serial-stream) (let ((current-baud-rate? (current-baud-rate))) (if current-baud-rate? (format nil "~%Baud Rate: ~D.~%" current-baud-rate?) "")) (format nil "~%Use Control-abort key to quit locally.")) (send kstate ':remote-server kermit-serial-stream))) ;;;; Login Server (see file S-TERM for the details). (defun be-a-server () (with-status ("Login Server ~%Stream: ~A ~A" kermit-serial-stream (let ((current-baud-rate? (current-baud-rate))) (if current-baud-rate? (format nil "~%Baud Rate: ~D.~%" current-baud-rate?) ""))) (let ((pst (make-instance 's-terminal:ps-terminal :serial kermit-serial-stream :peek-chars nil :read-ahead-chars nil :ttysync t))) (s-terminal:ps-kermit-login pst)))) ;;;; Close connection. ;;; This shuts off the connection in the same way as the user would: ;;; by "typing in" the escape sequence (c). (defun close-connection () (with-status ("Turning off Terminal 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) (format interaction-pane "~% ?? 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. ;;;; 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. (defun make-connection () (cond (kermit-connected-flag (tv:beep) (format interaction-pane "~&YOU ARE ALREADY CONNECTED: DO C TO DISCONNECT")) (kermit-serial-stream (with-status ("Terminal Connection:~A ~A ~A ~A" kermit-serial-stream (format nil "~%Connection started: ~\time\" (setq *kermit-beginning-time* (time:get-universal-time))) (let ((baud-rate? (lexpr-send kermit-serial-stream :send-if-handles ;1; one more time.. #-3600(select-processor (:lambda (list :baud-rate)) (:cadr (list :get :baud))) #+3600 (list :get :baud) ))) (if baud-rate? (format nil "~%Baud Rate: ~D." baud-rate?) "")) (format nil "~%Escape Character: ~:@C" #\network ;fix this! )) (unwind-protect (progn (setf kermit-connected-flag t) ;1; again, I will fake this for 3600 (cond ((eq (#-3600 tv:with-selection-substitute #-3600 (terminal-pane kermit-frame) #+3600 let #+3600 ((terminal-pane (if (boundp 'terminal-pane) terminal-pane kermit-frame))) (send kterm-state ':make-connection kermit-serial-stream terminal-pane)) :close) ;; well, you may want to use this condition some day, probably to ;; kill the serial stream. so keep this around. ) (t nil))) (setf kermit-connected-flag nil)))) (t (ferror nil "kermit-serial-stream is NIL.")))) ;;;; Bye (defun bye-server () (cond ((not kermit-serial-stream) (ferror nil "kermit-serial-stream is NIL.")) (kermit-connected-flag (beep) (format t "~%You must disconnect in order to say BYE.~%")) (t (with-status ("Bye Server") (send kstate ':bye-server kermit-serial-stream))))) ;;;; Finish (defun finish-server () (cond ((not kermit-serial-stream) (ferror nil "kermit-serial-stream is NIL.")) (kermit-connected-flag (beep) (format t "~%You must disconnect in order to say BYE.~%")) (t (with-status ("Finish Server") (send kstate ':finish-server kermit-serial-stream))))) (defun refresh-windows () (send kermit-frame :send-all-exposed-panes :clear-screen) (send (send kermit-frame :get-pane 'command-pane) :refresh)) (defconst all-baud-choices-items-alist '((" 50. " 50.) (" 75. " 75.) (" 110. " 110.) (" 134. " 134.) (" 150. " 150.) (" 300. " 300.) (" 600. " 600.) (" 1200. " 1200.) (" 1800. " 1800.) (" 2000. " 2000.) (" 2400. " 2400.) (" 3600. " 3600.) (" 4800. " 4800.) (" 7200. " 7200.) (" 9600. " 9600.) (" 19200. " 19200.))) (defun set-current-baud-rate (new-baud) ;1; modified this stuff #+LMI (send kermit-serial-stream :send-if-handles :set-baud-rate new-baud) #-LMI (send kermit-serial-stream :send-if-handles :put :baud new-baud)) (defun current-baud-rate () (cond (kermit-serial-stream (lexpr-send kermit-serial-stream :send-if-handles #+LMI (list :baud-rate) #-LMI (list :get :baud))))) (defun set-baud-rate () (let ((base 10.) (*nopoint nil)) ;just for printing (cond (kermit-serial-stream (let ((old-baud (current-baud-rate))) (with-status ("Change Baud~%Old 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 ; 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))))))) (t (ferror nil "kermit-serial-stream is NIL."))))) (defun review-parameters () (with-status ("Review Parameters") (send kstate :set-params))) (defun list-user-directory () ;1; another problem with with-help-stream here. (with-status ("List Directory:~A" (format nil "~% ~A" (send kstate :kermit-default-pathname))) ;1; for now, let's just send it to terminal-io #-3600 (si:with-help-stream (stream :superior terminal-pane) (listf (send kstate :kermit-default-pathname) stream)) #+3600 (with-kermit-typeout-stream stream `(:string ,(send kstate :kermit-default-pathname) :font fonts:metsi :top) (listf (send kstate :kermit-default-pathname) stream)) )) (defun restart-program (&aux really?) ;; do without status. maybe there's an emergency. (setq really? (y-or-n-p (format nil "~&Do you really want to restart and reinitialize Kermit?"))) (cond (really? (refresh-windows) (setf kermit-ready-for-commands? nil) (send command-pane :set-highlighted-items '()) (and kermit-serial-stream (progn (send kermit-serial-stream :close :abort))) (setf kermit-connected-flag nil) (funcall command-pane :set-item-list all-kermit-command-pane-items) (send status-pane :set-label status-pane-label) (process-reset-and-enable current-process)))) (defconst *unanticipated-chars* nil "Stores unanticipated characters input to the kermit frame for later scientific analysis?") (defun handle-unanticipated-terminal-input (char) (push char *unanticipated-chars*) (beep)) ;;;; top-level (defun run-kermit-process (kermit-frame-instance) (setq kermit-frame kermit-frame-instance) (kermit-initial-function kermit-frame-instance)) (defun kermit-initial-function (kermit-frame) (funcall kermit-frame :top-level kermit-frame)) (defmethod (kermit-frame :close-serial-stream) () (when kermit-serial-stream (send kermit-serial-stream ':close ':abort) (setq kermit-serial-stream nil))) (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)) (debug-pane (funcall kermit-frame :get-pane 'interaction-pane)) (ibase 10.) ;;;?? worry about this base (base 10.)) (let ((terminal-io interaction-pane) (standard-input interaction-pane) (standard-output interaction-pane) (query-io interaction-pane) (trace-output interaction-pane) (error-output interaction-pane) (debug-io debug-pane) ) ;; 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. (make-kermit-ready-for-commands) ;1; changed... see def of this function below ;; 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 ;1; The 3600 hates to have you reopen an open serial stream, and I had ;1; some special tests in the following cond to avoid that, but later ;1; changed it back and put the burden of checking on the open forms. (cond ((memq (get command? :funcall) all-commands-requiring-kermit-serial-stream) (setq kermit-serial-stream (eval serial-stream-open-form)) (funcall command-pane :execute command?)) (command? (funcall command-pane :execute command?)) ;1; added the following check to avoid errors for mouse blips ;1; in panes other than the command pane... #+3600 ((listp character) ;1; to catch other mouse blips (handle-unanticipated-terminal-input character)) ((= character #-3600 #\hand-down #+3600 #\super-l) ;1; L for Larger (send kermit-frame ':set-configuration 'long-terminal) #+3600 (refresh-windows)) ((= character #-3600 #\hand-up #+3600 #\super-s) ;1; S for Standard (send kermit-frame ':set-configuration 'default) #+3600 (refresh-windows)) #+3600 ((= character #\super-p) ;1; P for Portrait (send kermit-frame :set-configuration 'portrait-terminal) (refresh-windows)) (t (handle-unanticipated-terminal-input character)))))))) ;1; I added this since I needed to get kstate bound earlier in order to avoid ;1; an unbound error in (:method kermit-frame :before :select). (defun make-kermit-ready-for-commands () (cond ((not kermit-ready-for-commands?) (setq kterm-state (make-instance 'kterm-state)) (setq kstate (make-instance 'kstate)) ;have kstate bound to a kstate instance (setf kermit-ready-for-commands? t)))) (compile-flavor-methods kermit-frame kermit-status-pane kermit-interaction-pane kermit-command-pane kermit-terminal-pane)