;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.68
;;; Reason:
;;;  For Peek File System on FTP-ACCESS host units:
;;;    Show the file stream, if there is one.
;;;    Show state of control and data connections.
;;; Written 23-Oct-87 15:40:03 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.67, Experimental Local-File 73.0, Experimental FILE-Server 22.0, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.0, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, microcode 1754, SDU Boot Tape 3.12, SDU ROM 8.


; From modified file DJ: L.WINDOW; PEEKFS.LISP#10 at 23-Oct-87 15:40:04
#8R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: WINDOW; PEEKFS  "

(defmethod (ftp-access :peek-file-system) ()
  (tv:scroll-maintain-list
    `(lambda () ',(send self :host-units))
    #'peek-ftp-host-unit))

))

; From modified file DJ: L.WINDOW; PEEKFS.LISP#10 at 23-Oct-87 15:40:14
#8R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: WINDOW; PEEKFS  "

(defun peek-ftp-host-unit (unit &optional (indent 2))
  "Generate a scroll item describing a host unit"
  (list ()
    (tv:scroll-parse-item ':mouse
			  `(nil :menu-choose
				("Host-unit operations"
				 ("Reset" :eval (funcall thisunit ':reset)
				  :documentation
				  "Click left to close this connection")
				 ("History" :eval (send tv:selected-window :force-kbd-input `(:eval (ftp-history ,thisunit)))
				  :documentation
				  "Show command history for this unit")
				 ("Inspect" :eval (send tv:selected-window :force-kbd-input `(inspect ,thisunit))
				  :documentation
				  "Click left to INSPECT this host-unit.")
				 ("Describe" :eval (send tv:selected-window :force-kbd-input `(describe ,thisunit))
				  :documentation
				  "Click left to DESCRIBE this host-unit."))
				:documentation
				"Menu of things to do to this host-unit."
				:bindings
				((thisunit ',unit)
				 (typwin ',(funcall self ':typeout-window))))
			  (format nil "~V@THost unit for ~A"
				  indent (send unit :host))
			  `(:FUNCTION ,#'(LAMBDA (UNIT)
					   (let* ((control (symeval-in-instance unit 'ftp:*cin*))
						  (control-socket (and control (send control :socket)))
						  (data (symeval-in-instance unit 'ftp:*data*))
						  (data-socket (and data (send data :socket))))
					     (format nil
						   " with ~A control connection and ~A data connection"
						   (if control-socket
						       (tcp:tcp-user-state control-socket)
						     :non-existent)
						   (if data-socket
						       (tcp:tcp-user-state data-socket)
						     :non-existent)
						   )))
				      (,UNIT)))
    (tv:scroll-maintain-list `(lambda () (send ',unit :open-streams))
			     `(lambda (stream)
				(funcall stream ':peek-file-system (+ 2 ,indent))))
    ))

))