;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.210
;;; Reason:
;;;  Move special knowledge of type of network interface, network protocol, transport protocol,
;;;  sockets, etc. out of NETSTAT.  A Network Interface, for example,  now can provide a
;;;  :peek-special-fields method if it wants special things available from peek.
;;; Written 7-Mar-88 11:37:56 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.209, Experimental Local-File 73.3, Experimental FILE-Server 22.1, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Tape 21.1, microcode 1755, SDU Boot Tape 3.12, SDU ROM 8.



; From modified file DJ: L.NETWORK.KERNEL; NETSTAT.LISP#103 at 7-Mar-88 12:20:14
#10R NETWORK#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "NETWORK")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERNEL; NETSTAT  "


(DEFUN peek-network-insert-ni-special-fields (ITEM &aux new-lines ni)
  "A pre-process function to insert network interface specific fields in the display"
  (unless (ARRAY-LEADER (car (last (TV:SCROLL-ITEM-component-items ITEM))) TV:SCROLL-ITEM-LEADER-OFFSET)
    (setq ni (getf (tv:scroll-item-plist item) :interface))
    (when (setq new-lines (send ni :peek-special-fields ni))
      (setf (tv:scroll-item-component-items item)
	    (nconc (butlast (tv:scroll-item-component-items item))
		   new-lines
		   (last (tv:scroll-item-component-items item)))))
    (SETF (ARRAY-LEADER (car (last (TV:SCROLL-ITEM-component-items ITEM))) TV:SCROLL-ITEM-LEADER-OFFSET) t)))

))

; From modified file DJ: L.NETWORK.KERNEL; NETSTAT.LISP#103 at 7-Mar-88 12:20:16
#10R NETWORK#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "NETWORK")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERNEL; NETSTAT  "


(DEFUN peek-network-insert-np-special-fields (ITEM &aux new-lines np)
  "A pre-process function to insert network protocol specific fields in the display"
  (unless (ARRAY-LEADER (car (last (TV:SCROLL-ITEM-component-items ITEM))) TV:SCROLL-ITEM-LEADER-OFFSET)
    (setq np (getf (tv:scroll-item-plist item) :stream))
    (when (setq new-lines (send np :peek-special-fields np))
      (setf (tv:scroll-item-component-items item)
	    (nconc (butlast (tv:scroll-item-component-items item))
		   new-lines
		   (last (tv:scroll-item-component-items item)))))
    (SETF (ARRAY-LEADER (car (last (TV:SCROLL-ITEM-component-items ITEM))) TV:SCROLL-ITEM-LEADER-OFFSET) t)))

))

; From modified file DJ: L.NETWORK.KERNEL; NETSTAT.LISP#103 at 7-Mar-88 12:20:44
#10R NETWORK#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "NETWORK")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERNEL; NETSTAT  "


(defun peek-transport-protocol (protocol &aux (tp (cdr protocol)))
  (list `( :PRE-PROCESS-FUNCTION peek-network-insert-tp-special-fields
	  :stream ,tp)
	(tv:scroll-parse-item
	  :leader 2
	  `(:MOUSE-ITEM
	     (NIL :MENU-CHOOSE
		  ("Transport protocol Operations"
		   ("Close" :EVAL (when (tv:mouse-y-or-n-p "Close this transport protocol")
				    (funcall tp :close))
		    :DOCUMENTATION
		    "Click left to close this transport protocol.")
		   ("Reset" :EVAL (when (tv:mouse-y-or-n-p "Reset this transport protocol")
				    (funcall tp :reset))
		    :DOCUMENTATION
		    "Click left to reset this transport protocol.")
		   ("Inspect" :EVAL (send tv:selected-input :force-kbd-input `(inspect ,tp))
		    :DOCUMENTATION
		    "Click left to INSPECT this transport protocol.")
		   ("Describe" :EVAL (send tv:selected-window :force-kbd-input `(describe ,tp))
		    :DOCUMENTATION
		    "Click left to DESCRIBE this transport protocol.")
		   ("Normal" :eval (transport-protocol-level tv:item :normal)
		    :documentation
		    "Click left to choose normal display for this transport protocol.")
		   ("Verbose" :eval (transport-protocol-level tv:item :verbose)
		    :documentation
		    "Click left to choose verbose display for this transport protocol."))
		  :DOCUMENTATION
		  "Menu of things to do to this transport protocol."
		  :BINDINGS
		  ((tp ',tp)))
	     :FUNCTION tp-keyword (,tp) NIL (" Transport protocol ~A"))
	  `(:function tp-type (,tp) NIL (" (~D) is "))
	  `(:mouse-item
	     (nil :buttons
		  ,(make-list 3 :initial-element
			      `(nil :eval (funcall tp (if (tp-enabled tp) :disable :enable))
				    :bindings ((tp ',tp))))
		  :DOCUMENTATION
		  "Click to toggle state of transport protocol"
		  :BINDINGS
		  ((tp ',tp)))
	     :function tp-enabled (,tp) NIL ("~:[dis~;en~]abled"))
	  `(:function peek-check-tp-next-identification (,tp) NIL ("~@[ with next packet identifier ~D~]"))
	  ",  "
	  `(:mouse-item
	     (nil :buttons
		  ((nil :eval (funcall tp (if (tp-active-gauges tp) :kill-gauges :make-gauges))
			:bindings ((tp ',tp)))
		   (nil :eval (ignore))
		   (nil :eval (gauge-menu tp (tp-active-gauges tp))
			:bindings ((tp ',tp))))
		  :documentation
		  "Click left for default, right for menu"
		  ((tp ',tp)))
	     :function ,#'(lambda (n) (mapcar 'car (tp-active-gauges n))) (,tp) NIL ("Gauges: ~A")))))

))

; From modified file DJ: L.NETWORK.KERNEL; NETSTAT.LISP#103 at 7-Mar-88 12:20:46
#10R NETWORK#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "NETWORK")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERNEL; NETSTAT  "


(DEFUN peek-network-insert-tp-special-fields (ITEM &aux level tp)
  "A pre-process function to insert transport protocol specific fields in the display"
  (let ((first-item (first (tv:scroll-item-component-items item))))
    (unless (array-leader first-item tv:scroll-item-leader-offset)
      (setq level (array-leader first-item (1+ tv:scroll-item-leader-offset)))
      (setq tp (getf (tv:scroll-item-plist item) :stream))
      (setf (tv:scroll-item-component-items item)
	    (nconc (list (first (tv:scroll-item-component-items item)))
		   (ncons (sent-statistics (tp-statistics-block tp) "  "))
		   (ncons (rcvd-statistics (tp-statistics-block tp) "  "))
		   (ncons (TV:SCROLL-PARSE-ITEM
			    `(:function tp-packets-sent-discarded (,tp) NIL ("  Packets sent/disc ~D"))
			    `(:function tp-packets-received-discarded (,tp) NIL (" rcvd/disc ~D"))
			    `(:function tp-bytes-sent-discarded (,tp) NIL (" Bytes sent/disc ~D"))
			    `(:function tp-bytes-received-discarded (,tp) NIL (" rcvd/disc ~D"))
			    `(:function tp-broadcast-packets-sent (,tp) NIL (" Broadcast sent ~D"))
			    `(:function tp-broadcast-packets-received (,tp) NIL (" rcvd ~D"))))
		   (send tp :peek-normal-fields tp)
		   (if (eq level :verbose) (send tp :peek-verbose-fields tp))
		   (send tp :peek-final-fields tp)))
      (setf (array-leader first-item tv:scroll-item-leader-offset) t))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#287 at 7-Mar-88 12:21:09
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "


(defop (tcp-ip-transport-protocol :peek-normal-fields) (tp)
  (ncons (tv:scroll-parse-item
	   `(:function tcp-next-local-port (,tp) NIL ("  Next local port assigned = ~D"))
	   `(:function tcp-checksum-failures (,tp) NIL ("  Checksum failures ~D"))
	   `(:mouse-item
	      (nil :buttons
		   ,(make-list 3 :initial-element
			       `(nil :eval (setf (tcp-local-checksums tp)
						 (not (tcp-local-checksums tp)))
				     :bindings ((tp ',tp))))
		   :DOCUMENTATION
		   "Click to toggle local checksums"
		   :BINDINGS
		   ((tp ',tp)))
	      :function tcp-local-checksums (,tp) NIL (" Local checksums: ~A")))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#287 at 7-Mar-88 12:21:10
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "


(defop (tcp-ip-transport-protocol :peek-verbose-fields) (tp)
  (let ((stats (tcp-stats tp)))
    (list
      (tv:scroll-parse-item
	" "
	`(:function ts-out-connection-requests (,stats) NIL (" INIT: requests = ~D"))
	`(:function ts-out-connection-accepts (,stats) NIL (" accepts = ~D"))
	`(:function ts-out-connection-refused (,stats) NIL (" refused = ~D"))
	`(:function ts-out-connection-timeouts (,stats) NIL (" timeout = ~D"))
	`(:function ts-out-connection-aborts (,stats) NIL (" aborted = ~D"))
	)
      (tv:scroll-parse-item
	" "
	`(:function ts-in-connection-requests (,stats) NIL (" LISTEN: requests = ~D"))
	`(:function ts-in-connection-accepts (,stats) NIL (" accepts = ~D"))
	`(:function ts-in-connection-refused (,stats) NIL (" refused = ~D"))
	`(:function ts-in-connection-timeouts (,stats) NIL (" timeouts = ~D"))
	`(:function ts-in-connection-aborts (,stats) NIL (" aborted = ~D"))
	)
      (tv:scroll-parse-item
	" "
	`(:function ts-data-packets-sent (,stats) NIL (" Data sent: packets = ~D"))
	`(:function ts-data-bytes-sent (,stats) NIL (", bytes = ~D"))
	`(:function ts-ack-bytes-received (,stats) NIL (", ACKed = ~D"))
	`(:function ts-data-bytes-received (,stats) NIL ("   Data received: bytes = ~D"))
	)
      (tv:scroll-parse-item
	" "
	`(:function ts-ack-packets-requested (,stats) NIL (" ACK packets sent: req = ~D"))
	`(:function ts-ack-packets-sent (,stats) NIL (" sent = ~D"))
	`(:function ts-ack-packets-delayed (,stats) NIL (" delay = ~D"))
	`(:function ts-urg-packets-sent (,stats) NIL (" urg = ~D"))
	`(:function ts-window-probes-sent (,stats) NIL (" probe = ~D"))
	`(:function ts-rst-packets-sent (,stats) NIL (" rst = ~D"))
	)
      (tv:scroll-parse-item
	" "
	`(:function ts-ack-packets-received (,stats) NIL (" ACK packets rcvd = ~D"))
	`(:function ts-duplicate-ack-packets-received (,stats) NIL (" dup = ~D"))
	`(:function ts-unsent-data-acks (,stats) NIL (" unsent = ~D"))
	`(:function ts-useless-ack-packets-received (,stats) NIL (" useless = ~D"))
	`(:function ts-urg-packets-received (,stats) NIL (" URG = ~D"))
	`(:function ts-window-probes-received (,stats) NIL (" probe = ~D"))
	`(:function ts-window-updates-received (,stats) NIL (" update = ~D"))
	`(:function ts-shrinking-window-updates (,stats) NIL (" shrink = ~D"))
	)
      (tv:scroll-parse-item
	" "
	`(:function ts-in-sequence-packets (,stats) NIL (" Data packets rcvd: in-seq = ~D"))
	`(:function ts-total-duplicate-packets (,stats) NIL (" total = ~D"))
	`(:function ts-partially-duplicate-packets (,stats) NIL (" partial = ~D"))
	`(:function ts-out-of-order-packets (,stats) NIL (" order = ~D"))
	`(:function ts-out-of-window-packets (,stats) NIL (" window = ~D"))
	`(:function ts-bad-sequence-packets (,stats) NIL (" bad-seq = ~D"))
	)
      (tv:scroll-parse-item
	" "
	`(:function ts-in-sequence-bytes (,stats) NIL (" Data bytes rcvd: in-seq = ~D"))
	`(:function ts-total-duplicate-bytes (,stats) NIL (" total = ~D"))
	`(:function ts-partially-duplicate-bytes (,stats) NIL (" partial = ~D"))
	`(:function ts-out-of-order-bytes (,stats) NIL (" order = ~D"))
	`(:function ts-out-of-window-bytes (,stats) NIL (" window = ~D"))
	`(:function ts-failed-sends (,stats) NIL ("   Failed sends = ~D"))
	)
      (tv:scroll-parse-item
	" "
	`(:function ts-saved-bytes (,stats) NIL (" Bytes saved = ~D"))
	`(:function ts-retrieved-bytes (,stats) NIL (" retrieved = ~D"))
	`(:function ts-dropped-bytes (,stats) NIL (" dropped = ~D"))
	`(:function ts-packet-allocation-delays (,stats) NIL ("   Alloc delays = ~D"))
	`(:function ts-bad-header-offset (,stats) NIL ("  Header bad = ~D"))
	`(:function ts-too-short (,stats) NIL (" short = ~D"))
	)
      (tv:scroll-parse-item
	" "
	`(:function ts-rtt-attempts (,stats) NIL (" RTT: attempts = ~D"))
	`(:function ts-rtt-updates (,stats) NIL (" updates = ~D"))
	`(:function ts-retransmission-timeouts (,stats) NIL ("   Timeouts: RTO = ~D"))
	`(:function ts-user-timeouts (,stats) NIL (" user = ~D"))
	`(:function ts-acks-sent-due-to-timer (,stats) NIL (" ACK = ~D"))
	`(:function ts-packets-while-ack-delayed (,stats) NIL (" (useful = ~D)"))
	`(:function ts-failed-send-timeouts (,stats) NIL (" failed send = ~D"))
	)
      ))
  )

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#287 at 7-Mar-88 12:21:12
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "

(defop (tcp-ip-transport-protocol :peek-final-fields) (tp)
  (ncons (TV:SCROLL-MAINTAIN-LIST
	   #'(LAMBDA () (tcp-user-socket-alist tp))
	   'peek-tcp-socket)))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#287 at 7-Mar-88 12:21:13
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "


(defun peek-tcp-socket (elt)
  (let ((socket (cdr elt)))
    (send socket :peek-item elt)))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#287 at 7-Mar-88 12:21:18
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "


(defop (tcp-socket :peek-item) (elt)
  (let ((socket (cdr elt)))
    (list `(:PRE-PROCESS-FUNCTION tcp-socket-insert-special-fields :socket ,socket)
	  (tv:scroll-parse-item
	    :leader 2
	    `(:MOUSE-ITEM
	       (NIL :MENU-CHOOSE
		    ("TCP socket operations"
		     ("Close" :EVAL  (when (tv:mouse-y-or-n-p "Close this TCP socket")
				       (funcall socket :close))
		      :DOCUMENTATION
		      "Click left to close this TCP socket.")
		     ("Abort" :EVAL  (when (tv:mouse-y-or-n-p "Abort this TCP socket")
				       (funcall socket :abort))
		      :DOCUMENTATION
		      "Click left to abort this TCP socket.")
		     ("Inspect" :EVAL (send tv:selected-window :force-kbd-input `(inspect ,socket))
		      :DOCUMENTATION
		      "Click left to INSPECT this TCP socket.")
		     ("Describe" :EVAL (send tv:selected-window :force-kbd-input `(describe ,socket))
		      :DOCUMENTATION
		      "Click left to DESCRIBE this TCP socket.")
		     ("Brief" :eval (tcp-socket-level tv:item :brief)
		      :documentation
		      "Click left to choose brief display for this TCP socket.")
		     ("Normal" :eval (tcp-socket-level tv:item :normal)
		      :documentation
		      "Click left to choose normal display for this TCP socket.")
		     ("Verbose" :eval (tcp-socket-level tv:item :verbose)
		      :documentation
		      "Click left to choose verbose display for this TCP socket."))
		    :DOCUMENTATION
		    "Menu of things to do to this TCP socket."
		    :BINDINGS
		    ((socket ',socket)))
	       :FUNCTION tcp-user-keyword (,socket) NIL ("   TCP socket ~D"))
	    `(:function tcp-user-active (,socket) NIL (" is ~:[passive~;active~]"))
	    `(:function tcp-user-state (,socket) NIL (" in state ~A"))
	    `(:function tcp-user-local-port (,socket) NIL ("  ~D"))
	    `(:function tcp-user-remote-port (,socket) NIL (" -> ~D"))
	    `(:function ,#'(lambda (socket)
			     (if (tcp-user-remote-address socket)
				 (ip:canonical-ip (tcp-user-remote-address socket))
			       nil)) (,socket) NIL (" [~A] "))
	    `(:mouse-item
	       (nil :buttons
		    ((nil :eval (funcall socket (if (tcp-user-active-gauges socket) :kill-gauges :make-gauges))
			  :bindings ((socket ',socket)))
		     (nil :eval (ignore))
		     (nil :eval (gauge-menu socket (tcp-user-active-gauges socket))
			  :bindings ((socket ',socket))))
		    :documentation
		    "Click left for default, right for menu"
		    ((socket ',socket)))
	       :function ,#'(lambda (n) (mapcar 'car (tcp-user-active-gauges n))) (,socket) NIL ("Gauges: ~A"))))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#287 at 7-Mar-88 12:21:22
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "


(defun tcp-socket-level (item level)
  (when (null (array-leader item (1+ tv:scroll-item-leader-offset)))
    (setf (array-leader item (1+ tv:scroll-item-leader-offset)) :brief))
  (unless (eq level (array-leader item (1+ tv:scroll-item-leader-offset)))
    (setf (array-leader item tv:scroll-item-leader-offset) nil)
    (setf (array-leader item (1+ tv:scroll-item-leader-offset)) level)))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#287 at 7-Mar-88 12:21:22
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "


(defun tcp-socket-insert-special-fields (item &aux socket level)
  "A pre-process function to insert tcp-socket specific fields in the display"
  (let ((first-item (first (tv:scroll-item-component-items item))))
    (unless (array-leader first-item tv:scroll-item-leader-offset)
      (setq level (array-leader first-item (1+ tv:scroll-item-leader-offset)))
      (setq socket (getf (tv:scroll-item-plist item) :socket))
      (setf (tv:scroll-item-component-items item)
	    (nconc (list (first (tv:scroll-item-component-items item)))
		   (if (member level '(:normal :verbose)) (tcp-socket-normal-fields socket))
		   (if (member level '(:verbose)) (tcp-socket-verbose-fields socket))))
      (setf (array-leader first-item tv:scroll-item-leader-offset) t))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#287 at 7-Mar-88 12:21:23
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "


(defun tcp-socket-normal-fields (socket)
  (list
    (net:sent-statistics (tcp-user-statistics-block socket) "    ")
    (net:rcvd-statistics (tcp-user-statistics-block socket) "    ")
    (tv:scroll-parse-item
      `(:function ,#'(lambda (n) (or (ISS n) 0)) (,socket) NIL ("    ISS = ~16,8,'0R"))
      `(:function ,#'(lambda (n) (or (SND.WND n) 0)) (,socket) NIL (" SND.WND = ~5D"))
      `(:function ,#'(lambda (n) (or (SND.NXT n) 0)) (,socket) NIL (" SND.NXT = ~16,8,'0R"))
      `(:function ,#'(lambda (n) (or (SND.UP n) 0)) (,socket) NIL (" SND.UP = ~16,8,'0R"))
      `(:function ,#'(lambda (n) (or (SND.WL2 n) 0)) (,socket) NIL (" SND.WL2 = ~16,8,'0R"))
      `(:function ,#'(lambda (n) (or (SND.UNA n) 0)) (,socket) NIL (" SND.UNA = ~16,8,'0R")))
    (tv:scroll-parse-item
      `(:function ,#'(lambda (n) (or (IRS n) 0)) (,socket) NIL ("    IRS = ~16,8,'0R"))
      `(:function ,#'(lambda (n) (or (RCV.WND n) 0)) (,socket) NIL (" RCV.WND = ~5D"))
      `(:function ,#'(lambda (n) (or (RCV.NXT n) 0)) (,socket) NIL (" RCV.NXT = ~16,8,'0R"))
      `(:function ,#'(lambda (n) (or (RCV.UP n) 0)) (,socket) NIL (" RCV.UP = ~16,8,'0R"))
      `(:function ,#'(lambda (n) (or (SND.WL1 n) 0)) (,socket) NIL (" SND.WL1 = ~16,8,'0R"))
      `(:function ,#'(lambda (n) (or (tcp-user-remote-fin-sequence-number n) 0))
		  (,socket) NIL ("     FIN = ~16,8,'0R")))
    (tv:scroll-parse-item
      `(:function tcp-user-remote-mss (,socket) NIL ("    Remote MSS = ~D"))
      `(:function tcp-user-interface-mss (,socket) NIL (" Local MSS = ~D"))
      `(:function tcp-user-precedence (,socket) NIL (" Precedence = ~D"))
      `(:function tcp-user-security (,socket) NIL (" Security = ~D"))
      `(:function tcp-user-compartment (,socket) NIL (" Compartment = ~D"))
      `(:function tcp-user-handling (,socket) NIL (" Handling = ~D"))
      `(:function tcp-user-tcc (,socket) NIL (" TCC = ~D")))
    (tv:scroll-parse-item
      `(:function tcp-user-open-timeout (,socket) NIL ("    Timeouts: Open = ~D"))
      `(:function tcp-user-send-timeout (,socket) NIL (" Send = ~D"))
      `(:function tcp-user-cumulative-timeout (,socket) NIL (" Cumulative = ~D"))
      `(:function tcp-user-ack-delay (,socket) NIL (" ACK = ~D"))
      `(:function tcp-user-smoothed-round-trip-time (,socket) NIL (" SRTT = ~4F"))
      `(:function tcp-user-retransmission-timeout (,socket) NIL (" RTO = ~4F"))
      `(:function tcp-user-closed-p (,socket) NIL (" Closed = ~D")))
    (tv:scroll-parse-item
      `(:function tcp-user-send-data-length (,socket) NIL ("    Send Length = ~D"))
      `(:function tcp-user-send-data-offset (,socket) NIL (" Sent Unacknowledged = ~D"))
      `(:function ,#'(lambda (n) (- (tcp-user-send-data-length n)
				    (tcp-user-send-data-offset n)))
		  (,socket) NIL (" Unsent = ~D"))
      `(:function tcp-user-receive-data-length (,socket) NIL (" Receive Length = ~D"))
      `(:function ,#'(lambda (n) (- (tcp-user-receive-data-length n)
				    (tcp-user-receive-data-offset n)))
		  (,socket) NIL (" Receive Free = ~D")))
    ))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#287 at 7-Mar-88 12:21:25
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "


(defun tcp-socket-verbose-fields (socket)
  (let ((stats (tcp-user-stats socket)))
    (list
      (tv:scroll-parse-item
	"   "
	`(:function ts-data-packets-sent (,stats) NIL (" Data sent: packets = ~D"))
	`(:function ts-data-bytes-sent (,stats) NIL (", bytes = ~D"))
	`(:function ts-ack-bytes-received (,stats) NIL (", ACKed = ~D"))
	`(:function ts-data-bytes-received (,stats) NIL ("   Data received: bytes = ~D"))
	)
      (tv:scroll-parse-item
	"   "
	`(:function ts-ack-packets-requested (,stats) NIL (" ACK packets sent: req = ~D"))
	`(:function ts-ack-packets-sent (,stats) NIL (" sent = ~D"))
	`(:function ts-ack-packets-delayed (,stats) NIL (" delay = ~D"))
	`(:function ts-urg-packets-sent (,stats) NIL (" urg = ~D"))
	`(:function ts-window-probes-sent (,stats) NIL (" probe = ~D"))
	`(:function ts-rst-packets-sent (,stats) NIL (" rst = ~D"))
	)
      (tv:scroll-parse-item
	"   "
	`(:function ts-ack-packets-received (,stats) NIL (" ACK packets rcvd = ~D"))
	`(:function ts-duplicate-ack-packets-received (,stats) NIL (" dup = ~D"))
	`(:function ts-unsent-data-acks (,stats) NIL (" unsent = ~D"))
	`(:function ts-useless-ack-packets-received (,stats) NIL (" useless = ~D"))
	`(:function ts-urg-packets-received (,stats) NIL (" URG = ~D"))
	`(:function ts-window-probes-received (,stats) NIL (" probe = ~D"))
	`(:function ts-window-updates-received (,stats) NIL (" update = ~D"))
	`(:function ts-shrinking-window-updates (,stats) NIL (" shrink = ~D"))
	)
      (tv:scroll-parse-item
	"   "
	`(:function ts-in-sequence-packets (,stats) NIL (" Data packets rcvd: in-seq = ~D"))
	`(:function ts-total-duplicate-packets (,stats) NIL (" total = ~D"))
	`(:function ts-partially-duplicate-packets (,stats) NIL (" partial = ~D"))
	`(:function ts-out-of-order-packets (,stats) NIL (" order = ~D"))
	`(:function ts-out-of-window-packets (,stats) NIL (" window = ~D"))
	`(:function ts-bad-sequence-packets (,stats) NIL (" bad-seq = ~D"))
	)
      (tv:scroll-parse-item
	"   "
	`(:function ts-in-sequence-bytes (,stats) NIL (" Data bytes rcvd: in-seq = ~D"))
	`(:function ts-total-duplicate-bytes (,stats) NIL (" total = ~D"))
	`(:function ts-partially-duplicate-bytes (,stats) NIL (" partial = ~D"))
	`(:function ts-out-of-order-bytes (,stats) NIL (" order = ~D"))
	`(:function ts-out-of-window-bytes (,stats) NIL (" window = ~D"))
	)
      (tv:scroll-parse-item
	"   "
	`(:function ts-saved-bytes (,stats) NIL (" Bytes saved = ~D"))
	`(:function ts-retrieved-bytes (,stats) NIL (" retrieved = ~D"))
	`(:function ts-dropped-bytes (,stats) NIL (" dropped = ~D"))
	`(:function ts-packet-allocation-delays (,stats) NIL ("   Alloc delays = ~D"))
	`(:function ts-failed-sends (,stats) NIL ("   Failed sends = ~D"))
	)
      (tv:scroll-parse-item
	"   "
	`(:function ts-rtt-attempts (,stats) NIL (" RTT: attempts = ~D"))
	`(:function ts-rtt-updates (,stats) NIL (" updates = ~D"))
	`(:function ts-retransmission-timeouts (,stats) NIL ("   Timeouts: RTO = ~D"))
	`(:function ts-user-timeouts (,stats) NIL (" user = ~D"))
	`(:function ts-acks-sent-due-to-timer (,stats) NIL (" ACK = ~D"))
	`(:function ts-packets-while-ack-delayed (,stats) NIL (" (useful = ~D)"))
	`(:function ts-failed-send-timeouts (,stats) NIL (" failed send = ~D"))
	)
      )))

;;;Sequence number manipulation functions, courtesy of Pace Willison

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; ICMP.LISP#91 at 7-Mar-88 12:21:28
#10R ICMP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "ICMP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; ICMP  "


(defop (icmp-ip-transport-protocol :peek-normal-fields) (tp)
  (ncons (tv:scroll-parse-item
	   `(:function icmp-next-identifier (,tp) NIL ("  Next identifier assigned = ~D"))
	   `(:function icmp-checksum-failures (,tp) NIL ("  Checksum failures ~D"))
	   `(:mouse-item
	      (nil :buttons
		   ,(make-list 3 :initial-element
			       `(nil :eval (setf (icmp-local-checksums tp)
						 (not (icmp-local-checksums tp)))
				     :bindings ((tp ',tp))))
		   :DOCUMENTATION
		   "Click to toggle local checksums"
		   :BINDINGS
		   ((tp ',tp)))
	      :function icmp-local-checksums (,tp) NIL (" Local checksums: ~A")))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; ICMP.LISP#91 at 7-Mar-88 12:21:30
#10R ICMP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "ICMP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; ICMP  "


(defop (icmp-ip-transport-protocol :peek-verbose-fields) (tp)
  (list (tv:scroll-parse-item
	  "  ****** Echo/Rply Info/Rply Time/Rply Mask/Rply RDIR QNCH TEXC UNRC PARM")
	(tv:scroll-parse-item
	  "  Sent: "
	  `(:function icmp-echo-sent (,tp) NIL ("~5d"))
	  `(:function icmp-echo-reply-sent (,tp) NIL ("~5d"))
	  `(:function icmp-info-sent (,tp) NIL ("~5d"))
	  `(:function icmp-info-reply-sent (,tp) NIL ("~5d"))
	  `(:function icmp-timestamp-sent (,tp) NIL ("~5d"))
	  `(:function icmp-timestamp-reply-sent (,tp) NIL ("~5d"))
	  `(:function icmp-address-mask-sent (,tp) NIL ("~5d"))
	  `(:function icmp-address-mask-reply-sent (,tp) NIL ("~5d"))
	  `(:function icmp-redirect-sent (,tp) NIL ("~5d"))
	  `(:function icmp-source-quench-sent (,tp) NIL ("~5d"))
	  `(:function icmp-time-exceeded-sent (,tp) NIL ("~5d"))
	  `(:function icmp-destination-unreachable-sent (,tp) NIL ("~5d"))
	  `(:function icmp-parameter-problem-sent (,tp) NIL ("~5d"))
	  )
	(tv:scroll-parse-item
	  "  Rcvd: "
	  `(:function icmp-echo-received (,tp) NIL ("~5d"))
	  `(:function icmp-echo-reply-received (,tp) NIL ("~5d"))
	  `(:function icmp-info-received (,tp) NIL ("~5d"))
	  `(:function icmp-info-reply-received (,tp) NIL ("~5d"))
	  `(:function icmp-timestamp-received (,tp) NIL ("~5d"))
	  `(:function icmp-timestamp-reply-received (,tp) NIL ("~5d"))
	  `(:function icmp-address-mask-received (,tp) NIL ("~5d"))
	  `(:function icmp-address-mask-reply-received (,tp) NIL ("~5d"))
	  `(:function icmp-redirect-received (,tp) NIL ("~5d"))
	  `(:function icmp-source-quench-received (,tp) NIL ("~5d"))
	  `(:function icmp-time-exceeded-received (,tp) NIL ("~5d"))
	  `(:function icmp-destination-unreachable-received (,tp) NIL ("~5d"))
	  `(:function icmp-parameter-problem-received (,tp) NIL ("~5d"))
	  )))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; ICMP.LISP#91 at 7-Mar-88 12:21:32
#10R ICMP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "ICMP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; ICMP  "


(defop (icmp-ip-transport-protocol :peek-final-fields) (tp)
  (ncons (TV:SCROLL-MAINTAIN-LIST
	   #'(LAMBDA () (icmp-user-socket-alist tp))
	   'peek-icmp-socket)))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; ICMP.LISP#91 at 7-Mar-88 12:21:33
#10R ICMP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "ICMP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; ICMP  "


(defun peek-icmp-socket (elt)
  (let ((socket (cdr elt)))
    (send socket :peek-item elt)))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; ICMP.LISP#91 at 7-Mar-88 12:21:35
#10R ICMP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "ICMP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; ICMP  "


(defop (icmp-socket :peek-item) (elt)
  (let ((socket (cdr elt)))
    (list nil
	  (tv:scroll-parse-item
	    `(:MOUSE-ITEM
	       (NIL :MENU-CHOOSE
		    ("ICMP socket operations"
		     ("Close" :EVAL  (when (tv:mouse-y-or-n-p "Close this ICMP socket")
				       (funcall socket :close))
		      :DOCUMENTATION
		      "Click left to close this ICMP socket.")
		     ("Inspect" :EVAL (send tv:selected-window :force-kbd-input `(inspect ,socket))
		      :DOCUMENTATION
		      "Click left to INSPECT this ICMP socket.")
		     ("Describe" :EVAL (send tv:selected-window :force-kbd-input `(describe ,socket))
		      :DOCUMENTATION
		      "Click left to DESCRIBE this ICMP socket."))
		    :DOCUMENTATION
		    "Menu of things to do to this ICMP socket."
		    :BINDINGS
		    ((socket ',socket)))
	       :FUNCTION car (,elt) NIL ("   ICMP socket ~D:"))
	    `(:function icmp-user-sequence (,socket) NIL (" Next sequence = ~D"))
	    `(:function icmp-user-echo-sent (,socket) NIL ("  Echo S/R: ~D"))
	    `(:function icmp-user-echo-received (,socket) NIL ("/~D"))
	    `(:function icmp-user-info-sent (,socket) NIL (" Info S/R: ~D"))
	    `(:function icmp-user-info-received (,socket) NIL ("/~D"))
	    `(:function icmp-user-timestamp-sent (,socket) NIL (" Timestamp S/R: ~D"))
	    `(:function icmp-user-timestamp-received (,socket) NIL ("/~D"))
	    `(:function icmp-user-address-mask-sent (,socket) NIL (" Mask S/R: ~D"))
	    `(:function icmp-user-address-mask-received (,socket) NIL ("/~D"))))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; UDP.LISP#111 at 7-Mar-88 12:21:38
#10R UDP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "UDP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; UDP  "


(defop (udp-ip-transport-protocol :peek-normal-fields) (tp)
  (ncons (tv:scroll-parse-item
	   `(:function udp-next-local-port (,tp) NIL ("  Next local port assigned = ~D"))
	   `(:function udp-checksum-failures (,tp) NIL ("  Checksum failures ~D"))
	   `(:mouse-item
	      (nil :buttons
		   ,(make-list 3 :initial-element
			       `(nil :eval (setf (udp-local-checksums tp)
						 (not (udp-local-checksums tp)))
				     :bindings ((tp ',tp))))
		   :DOCUMENTATION
		   "Click to toggle local checksums"
		   :BINDINGS
		   ((tp ',tp)))
	      :function udp-local-checksums (,tp) NIL (" Local checksums: ~A")))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; UDP.LISP#111 at 7-Mar-88 12:21:41
#10R UDP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "UDP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; UDP  "


(defop (udp-ip-transport-protocol :peek-final-fields) (tp)
  (ncons (TV:SCROLL-MAINTAIN-LIST
	   #'(LAMBDA () (udp-user-socket-alist tp))
	   'peek-udp-socket)))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; UDP.LISP#111 at 7-Mar-88 12:21:42
#10R UDP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "UDP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; UDP  "


(defun peek-udp-socket (elt)
  (let ((socket (cdr elt)))
    (send socket :peek-item elt)))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; UDP.LISP#111 at 7-Mar-88 12:21:44
#10R UDP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "UDP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; UDP  "


(defop (udp-socket :peek-item) (elt)
  (let ((socket (cdr elt)))
    (list `(:PRE-PROCESS-FUNCTION udp-socket-insert-special-fields :socket ,socket)
	  (tv:scroll-parse-item
	    :leader 2
	    `(:MOUSE-ITEM
	       (NIL :MENU-CHOOSE
		    ("UDP socket operations"
		     ("Close" :EVAL  (when (tv:mouse-y-or-n-p "Close this UDP socket")
				       (funcall socket :close))
		      :DOCUMENTATION
		      "Click left to close this UDP socket.")
		     ("Inspect" :EVAL (send tv:selected-window :force-kbd-input `(inspect ,socket))
		      :DOCUMENTATION
		      "Click left to INSPECT this UDP socket.")
		     ("Describe" :EVAL (send tv:selected-window :force-kbd-input `(describe ,socket))
		      :DOCUMENTATION
		      "Click left to DESCRIBE this UDP socket.")
		     ("Brief" :eval (udp-socket-level tv:item :brief)
		      :documentation
		      "Click left to choose brief display for this UDP socket.")
		     ("Normal" :eval (udp-socket-level tv:item :normal)
		      :documentation
		      "Click left to choose normal display for this UDP socket."))
		    :DOCUMENTATION
		    "Menu of things to do to this UDP socket."
		    :BINDINGS
		    ((socket ',socket)))
	       :FUNCTION udp-user-keyword (,socket) NIL ("   UDP socket ~D:"))
	    `(:function udp-user-local-port (,socket) NIL (" ~D"))
	    `(:function udp-user-remote-port (,socket) NIL (" -> ~D"))
	    `(:function ,#'(lambda (socket)
			     (if (udp-user-remote-address socket)
				 (ip:canonical-ip (udp-user-remote-address socket))
			       nil)) (,socket) NIL (" [~A] "))
	    `(:mouse-item
	       (nil :buttons
		    ((nil :eval (funcall socket
					 (if (udp-user-active-gauges socket) :kill-gauges :make-gauges))
			  :bindings ((socket ',socket)))
		     (nil :eval (ignore))
		     (nil :eval (gauge-menu socket (udp-user-active-gauges socket))
			  :bindings ((socket ',socket))))
		    :documentation
		    "Click left for default, right for menu"
		    ((socket ',socket)))
	       :function ,#'(lambda (n) (mapcar 'car (udp-user-active-gauges n))) (,socket) NIL ("Gauges: ~A"))))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; UDP.LISP#111 at 7-Mar-88 12:21:46
#10R UDP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "UDP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; UDP  "


(defun udp-socket-level (item level)
  (when (null (array-leader item (1+ tv:scroll-item-leader-offset)))
    (setf (array-leader item (1+ tv:scroll-item-leader-offset)) :brief))
  (unless (eq level (array-leader item (1+ tv:scroll-item-leader-offset)))
    (setf (array-leader item tv:scroll-item-leader-offset) nil)
    (setf (array-leader item (1+ tv:scroll-item-leader-offset)) level)))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; UDP.LISP#111 at 7-Mar-88 12:21:47
#10R UDP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "UDP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; UDP  "


(defun udp-socket-insert-special-fields (item &aux socket level)
  "A pre-process function to insert udp-socket specific fields in the display"
  (let ((first-item (first (tv:scroll-item-component-items item))))
    (unless (array-leader first-item tv:scroll-item-leader-offset)
      (setq level (array-leader first-item (1+ tv:scroll-item-leader-offset)))
      (setq socket (getf (tv:scroll-item-plist item) :socket))
      (setf (tv:scroll-item-component-items item)
	    (nconc (list (first (tv:scroll-item-component-items item)))
		   (if (member level '(:normal)) (udp-socket-normal-fields socket))))
      (setf (array-leader first-item tv:scroll-item-leader-offset) t))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; UDP.LISP#111 at 7-Mar-88 12:21:48
#10R UDP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "UDP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; UDP  "


(defun udp-socket-normal-fields (socket)
  (list
    (net:sent-statistics (udp-user-statistics-block socket) "    ")
    (net:rcvd-statistics (udp-user-statistics-block socket) "    ")
    (TV:SCROLL-PARSE-ITEM
      `(:function udp-user-packets-sent-discarded (,socket) NIL ("    Packets sent/disc ~D"))
      `(:function udp-user-packets-received-discarded (,socket) NIL (" rcvd/disc ~D"))
      `(:function udp-user-bytes-sent-discarded (,socket) NIL (" Bytes sent/disc ~D"))
      `(:function udp-user-bytes-received-discarded (,socket) NIL (" rcvd/disc ~D")))
    ))


))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; IP.LISP#287 at 7-Mar-88 12:21:55
#10R INTERNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "INTERNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; IP  "


(defop (ip-network-protocol :peek-special-fields) (np)
  (list (tv:scroll-parse-item
	  `(:function ip-checksum-failures (,np) NIL ("Bad checksum ~D"))
	  `(:function ip-bad-header (,np) NIL (" bad header ~D"))
	  `(:function ip-bad-options (,np) NIL (" bad options ~D"))
	  `(:function ip-unknown-protocol-packets (,np) NIL (" bad protocol ~D"))
	  `(:function ip-fragment-timeouts (,np) NIL (" frag timeouts ~D")))
	(tv:scroll-parse-item
	  `(:function ip-hardware-broadcast-packets (,np) NIL ("Hardware Broadcast packets = ~D"))
	  `(:function ip-ip-broadcast-packets (,np) NIL ("  IP Broadcast packets ~D"))
	  `(:function ip-self-address-packets (,np) NIL ("  Self Address packets ~D"))
	  `(:mouse-item
	     (nil :buttons
		  ,(make-list 3 :initial-element
			      `(nil :eval (setf (ip-local-checksums np)
						(not (ip-local-checksums np)))
				    :bindings ((np ',np))))
		  :DOCUMENTATION
		  "Click to toggle local checksums"
		  :BINDINGS
		  ((np ',np)))
	     :function ip-local-checksums (,np) NIL (" Local checksums: ~A")))
	(tv:scroll-parse-item
	  `(:mouse-item
	     (nil :buttons
		  ,(make-list 3 :initial-element
			      `(nil :eval (setf (ip-gateway np) (not (ip-gateway np)))
				    :bindings ((np ',np))))
		  :DOCUMENTATION
		  "Click to toggle IP gateway functions"
		  :BINDINGS
		  ((np ',np)))
	     :function ip-gateway (,np) NIL ("IP gateway: ~A"))
	  `(:function ip-packets-forwarded (,np) NIL (" forwarded ~D"))
	  `(:function ip-packets-queued (,np) NIL (" queued ~D"))
	  `(:function ip-not-for-me (,np) NIL (" not for me ~D"))
	  `(:function ip-no-forwarding-address (,np) NIL (" no address ~D"))
	  `(:function ip-cant-forward (,np) NIL (" queue full ~D"))
	  `(:function ip-ttl-expired (,np) NIL (" TTL expired ~D")))
	(TV:SCROLL-MAINTAIN-LIST #'(LAMBDA () (ip-protocols np))
				 'net:peek-transport-protocol)))

))

; From modified file DJ: L.NETWORK.DRIVERS; LOOPBACK.LISP#20 at 7-Mar-88 12:21:59
#10R NETWORK#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "NETWORK")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; DRIVERS; LOOPBACK  "


(defop (loopback-interface :peek-special-fields) (ni)
  (declare (ignore ni))
  (list (tv:scroll-parse-item
	  `(:mouse-item
	     (nil :buttons
		  ,(make-list 3 :initial-element
			      `(nil :eval (process-run-function "Set Loopback Debug Variables"
								#'set-loopback-debugging-variables)))
		  :documentation
		  "Click to set Loopback Debugging Variables")
	     :string "Debugging Variables:")
	  `(:symeval net:*damage-percentage* nil ("  Damage ~A%"))
	  `(:symeval net:*delay-percentage* nil ("  Delay ~A%"))
	  `(:symeval net:*delay-maximum-interval* nil (" up to ~A seconds"))
	  `(:symeval net:*drop-percentage* nil ("  Drop ~A%"))
	  `(:symeval net:*duplicate-percentage* nil ("  Duplicate ~A%")))))

))

; From modified file DJ: L.NETWORK.DRIVERS; LOOPBACK.LISP#20 at 7-Mar-88 12:22:01
#10R NETWORK#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "NETWORK")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; DRIVERS; LOOPBACK  "


(defun set-loopback-debugging-variables ()
  (tv:choose-variable-values '((*damage-percentage* "Damage %" :number-or-nil)
			       (*delay-percentage* "Delay %" :number-or-nil)
			       (*delay-maximum-interval* "Delay max" :number-or-nil)
			       (*drop-percentage* "Drop %" :number-or-nil)
			       (*duplicate-percentage* "Duplicate %" :number or-nil))
			     :label "Loopback Debugging Parameters"
			     :function #'(lambda (ignore variable old-value new-value)
					   (if new-value
					       (case variable
						 ((*damage-percentage* *delay-percentage*
						   *drop-percentage* *duplicate-percentage*)
						  (unless (<= 0 new-value 100)
						    (set variable old-value)))
						 (*delay-maximum-interval*
						  (unless (<= 0 new-value 60)
						    (set variable old-value))))
					     (set variable old-value))
					   nil)))

))

; From modified file DJ: L.NETWORK.DRIVERS; SHARE.LISP#76 at 7-Mar-88 12:22:03
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; DRIVERS; SHARE  "


(net:defop (share-interface :peek-special-fields) (ni)
  (list (tv:scroll-parse-item
	  `(:function share-transmit-buffer-timeout-period (,ni) NIL ("Timeout period: ~D"))
	  `(:function share-transmit-buffer-not-available-timeouts (,ni) NIL (" time outs: ~D")))))

))

; From modified file DJ: L.NETWORK.DRIVERS; EXCELAN.LISP#139 at 7-Mar-88 12:22:09
#10R ETHERNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "ETHERNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; DRIVERS; EXCELAN  "


(defop (excelan-interface :peek-special-fields) (ni)
  (list (tv:scroll-parse-item
	  `(:function exc-exintr-called-by-user (,ni) NIL ("Exintr calls: user ~D"))
	  `(:function exc-exintr-called-by-system (,ni) NIL (" system: ~D"))
	  `(:function exc-exintr-called-by-alloc (,ni) NIL (" alloc: ~D"))
	  `(:function exc-exintr-calls (,ni) NIL (" User requests: ~D"))
	  `(:function exc-exintr-wins (,ni) NIL (" wins: ~D"))
	  `(:function exc-exintr-busy-loops (,ni) NIL (" Loop Constant = ~D")))))

))

; From modified file DJ: L.NETWORK.DRIVERS; 3COM.LISP#95 at 7-Mar-88 12:22:11
#10R ETHERNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "ETHERNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; DRIVERS; 3COM  "


(defop (3com-interface :peek-special-fields) (ni)
  (list (tv:scroll-parse-item
	  `(:mouse-item
	     (nil :buttons
		  ,(make-list 3 :initial-element
			      `(nil :eval (let ((enabled (3com-microcode-enabled ni)))
					    (funcall ni :disable)
					    (funcall ni :enable :microcode (not enabled)))
				    :bindings ((ni ',ni))))
		  :DOCUMENTATION
		  "Click to toggle usage of microcode"
		  :BINDINGS
		  ((ni ',ni)))
	     :function 3com-microcode-enabled (,ni) NIL ("Microcode enabled: ~A"))
	  `(:function 3com-transmit-time-outs (,ni) NIL (" time outs ~D"))
	  `(:function 3com-buffer-not-available (,ni) NIL (" no buffer ~D"))
	  `(:function 3com-jam-count (,ni) NIL (" jam count ~D"))
	  `(:function 3com-fcs-errors (,ni) NIL (" fcs error ~D")))))

))