;;; -*- Mode: Lisp; Package: User; Base: 8.; Patch-File: T -*- ;;; Patch file for System version 78.26 ;;; Reason: Peek S mode for servers. ;;; Written 12/22/81 15:22:04 by BSG, ;;; while running on Spaniel from band 1 ;;; with System 78.24, ZMail 38.4, Symbolics 8.7, Tape 6.2, LMFS 21.15, Canon 9.3, microcode 841. ; From file tvdefs.lisp >LMWIN POINTER: #8R TV:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "TV"))) ;; Server structure used by WHOLIN and PEEK (DEFSTRUCT (SERVER-DESC :CONC-NAME (:TYPE :LIST)) CONNECTION HOST-NAME CONTACT-NAME PROCESS FUNCTION ARGS) ) ; From file wholin.lisp >lmwin POINTER: #8R TV:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "TV"))) (DEFMETHOD (WHO-LINE-FILE-SHEET :ADD-SERVER) (CONNECTION CONTACT-NAME &OPTIONAL (PROCESS SI:CURRENT-PROCESS) FUNCTION &REST ARGS) (PUSH (MAKE-SERVER-DESC CONNECTION CONNECTION HOST-NAME (CHAOS:HOST-SHORT-NAME (CHAOS:FOREIGN-ADDRESS CONNECTION)) CONTACT-NAME CONTACT-NAME PROCESS PROCESS FUNCTION FUNCTION ARGS ARGS) SERVERS-LIST)) ;This isn't usually called; Normally servers are deleted automatically when ;it is noticed that the connection has been closed. (DEFMETHOD (WHO-LINE-FILE-SHEET :DELETE-SERVER) (CONNECTION) (SETQ SERVERS-LIST (DEL #'(LAMBDA (X Y) (EQ X (SERVER-DESC-CONNECTION Y))) CONNECTION SERVERS-LIST))) (DEFMETHOD (WHO-LINE-FILE-SHEET :DELETE-ALL-SERVERS) () (SETQ SERVERS-LIST NIL)) (DEFMETHOD (WHO-LINE-FILE-SHEET :CLOSE-ALL-SERVERS) (REASON) (LOOP FOR SERVER IN SERVERS-LIST FINALLY (SETQ SERVERS-LIST NIL) DO (CHAOS:CLOSE (SERVER-DESC-CONNECTION SERVER) REASON))) (DEFMETHOD (WHO-LINE-FILE-SHEET :SERVERS) () (PURGE-SERVERS) SERVERS-LIST) ;; User level functions (DEFUN DESCRIBE-SERVERS () (DOLIST (S (FUNCALL TV:WHO-LINE-FILE-STATE-SHEET ':SERVERS)) (FORMAT T "~%~A serving ~A in ~A" (SERVER-DESC-CONTACT-NAME S) (SERVER-DESC-HOST-NAME S) (SERVER-DESC-PROCESS S)))) ) ; From file PEEK.LISP >LMWIN POINTER: #8R TV:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "TV"))) (DEFINE-PEEK-MODE PEEK-SERVERS #/S "Active Servers") (DEFUN PEEK-SERVERS (IGNORE) (LIST () (SCROLL-PARSE-ITEM "Active Servers") (SCROLL-PARSE-ITEM "Contact Name Host Process // State") (SCROLL-PARSE-ITEM " Connection") (SCROLL-PARSE-ITEM "") (SCROLL-MAINTAIN-LIST #'(LAMBDA () (FUNCALL TV:WHO-LINE-FILE-STATE-SHEET ':SERVERS)) #'(LAMBDA (SERVER-DESC) (LET* ((PROCESS (SERVER-DESC-PROCESS SERVER-DESC)) (CONN (SERVER-DESC-CONNECTION SERVER-DESC)) (HOST (SI:GET-HOST-FROM-ADDRESS (CHAOS:FOREIGN-ADDRESS CONN) ':CHAOS))) (LIST '(:PRE-PROCESS-FUNCTION PEEK-SERVER-PREPROCESS) (SCROLL-PARSE-ITEM ':LEADER '(NIL NIL NIL) `(:FUNCTION ,#'SERVER-DESC-CONTACT-NAME (,SERVER-DESC) 20. ("~A")) `(:MOUSE-ITEM (NIL :EVAL (CHAOS:PEEK-CHAOS-HOST-MENU ',HOST 'TV:ITEM 0) :DOCUMENTATION "Menu of useful things to do to this host.") :FUNCTION ,#'VALUES (,HOST) 20. ("~A")) `(:MOUSE (NIL :EVAL (PEEK-PROCESS-MENU ',PROCESS) :DOCUMENTATION "Menu of useful things to do to this process.") :STRING ,(FORMAT NIL "~S" PROCESS)) " " `(:FUNCTION ,#'PEEK-WHOSTATE ,(NCONS PROCESS))) (SCROLL-PARSE-ITEM ':LEADER '(NIL NIL NIL NIL NIL NIL) ;6 " " `(:MOUSE-ITEM (NIL :EVAL (PEEK-CONNECTION-MENU ',CONN 'ITEM) :DOCUMENTATION "Menu of useful things to do this connection") :STRING ,(FORMAT NIL "~S" CONN))) NIL ;Connection stat NIL ;hostat (AND (SERVER-DESC-FUNCTION SERVER-DESC) (APPLY (SERVER-DESC-FUNCTION SERVER-DESC) (SERVER-DESC-ARGS SERVER-DESC))))))))) (DEFUN PEEK-CONNECTION-MENU (CONN ITEM) (LEXPR-FUNCALL #'PROCESS-RUN-FUNCTION "Peek Server Connection Menu" SELF ':FUNCALL-INSIDE-YOURSELF #'PEEK-SERVER-CONNECTION-MENU-INTERNAL (LIST CONN ITEM))) (DECLARE-FLAVOR-INSTANCE-VARIABLES (BASIC-PEEK) (DEFUN PEEK-SERVER-CONNECTION-MENU-INTERNAL (CONN ITEM) (LET ((TERMINAL-IO TYPEOUT-WINDOW)) (LET ((CHOICE (MENU-CHOOSE `(("Close" :VALUE :CLOSE :DOCUMENTATION "Close connection forcibly.") ("Insert Detail" :VALUE :DETAIL :DOCUMENTATION "Insert detailed info about chaos connection.") ("Remove Detail" :VALUE :UNDETAIL :DOCUMENTATION "Remove detailed info from Peek display.") ("Inspect" :VALUE :INSPECT :DOCUMENTATION "Inspect the connection"))))) (SELECTQ CHOICE (:CLOSE (CHAOS:CLOSE CONN "Manual Close from PEEK")) (:INSPECT (INSPECT CONN)) (:DETAIL (STORE-ARRAY-LEADER CONN ITEM (+ 4 TV:SCROLL-ITEM-LEADER-OFFSET)) (STORE-ARRAY-LEADER T ITEM (+ 5 TV:SCROLL-ITEM-LEADER-OFFSET))) (:UNDETAIL (STORE-ARRAY-LEADER NIL ITEM (+ 4 TV:SCROLL-ITEM-LEADER-OFFSET)) (STORE-ARRAY-LEADER NIL ITEM (+ 5 TV:SCROLL-ITEM-LEADER-OFFSET)))))))) (DEFUN PEEK-SERVER-PREPROCESS (LIST-ITEM &AUX HOST) (LET* ((LINE-ITEM (THIRD LIST-ITEM)) (HOST-ITEM (SECOND LIST-ITEM)) (WANTED (ARRAY-LEADER LINE-ITEM (+ 4 TV:SCROLL-ITEM-LEADER-OFFSET))) (GOT (ARRAY-LEADER LINE-ITEM (+ 5 TV:SCROLL-ITEM-LEADER-OFFSET)))) (COND ((NULL WANTED) (STORE-ARRAY-LEADER NIL LINE-ITEM (+ 5 TV:SCROLL-ITEM-LEADER-OFFSET)) (SETF (FOURTH LIST-ITEM) NIL)) ((EQ WANTED GOT)) (T (SETF (FOURTH LIST-ITEM) (CHAOS:PEEK-CHAOS-CONN WANTED)) (STORE-ARRAY-LEADER WANTED LINE-ITEM (+ 5 TV:SCROLL-ITEM-LEADER-OFFSET)))) ;;Hack hostat (COND ((ARRAY-LEADER HOST-ITEM TV:SCROLL-ITEM-LEADER-OFFSET) ;; Want a hostat, make sure it's there and for the right host (IF (AND (EQ (SETQ HOST (ARRAY-LEADER HOST-ITEM (1+ TV:SCROLL-ITEM-LEADER-OFFSET))) (ARRAY-LEADER HOST-ITEM (+ TV:SCROLL-ITEM-LEADER-OFFSET 2))) (FIFTH LIST-ITEM)) NIL (SETF (FIFTH LIST-ITEM) (CONS '() (CHAOS:PEEK-CHAOS-HOSTAT HOST 1))) (SETF (ARRAY-LEADER HOST-ITEM (+ TV:SCROLL-ITEM-LEADER-OFFSET 2)) HOST))) (T (SETF (FIFTH LIST-ITEM) NIL) (SETF (ARRAY-LEADER HOST-ITEM (+ TV:SCROLL-ITEM-LEADER-OFFSET 2)) NIL))))) )