From 54782f5b21d1aabd44fc15f05f38a94ea5b6b9d9 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Wed, 12 Apr 2023 22:26:23 -0700 Subject: [PATCH] tweak to WHO-LINE: hostname (don't use pup), change dir (don't offer directories that don't exist), package (sort so likely choices are at top) --- lispusers/WHO-LINE | 330 +++++++++++++++++++++------------------ lispusers/WHO-LINE.DFASL | Bin 35802 -> 36558 bytes 2 files changed, 177 insertions(+), 153 deletions(-) diff --git a/lispusers/WHO-LINE b/lispusers/WHO-LINE index d2472342..930e21dc 100644 --- a/lispusers/WHO-LINE +++ b/lispusers/WHO-LINE @@ -1,13 +1,16 @@ -(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP" BASE 10) -(FILECREATED "26-Mar-2021 11:01:59" {DSK}larry>ilisp>medley>lispusers>WHO-LINE.;4 74359 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (VARS WHO-LINECOMS) +(FILECREATED "12-Apr-2023 22:10:58" {DSK}larry>il>medley>lispusers>WHO-LINE.;5 75086 - previous date%: "26-Mar-2021 10:48:40" {DSK}larry>ilisp>medley>lispusers>WHO-LINE.;3) + :EDIT-BY "lmm" + + :CHANGES-TO (FNS WHO-LINE-HOST-NAME SET-PACKAGE-INTERACTIVELY) + + :PREVIOUS-DATE "12-Apr-2023 17:45:36" {DSK}larry>il>medley>lispusers>WHO-LINE.;4) (* ; " -Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. +Copyright (c) 1986-1989, 1994, 1998, 2001, 2021, 2023 by Xerox Corporation. ") (PRETTYCOMPRINT WHO-LINECOMS) @@ -184,7 +187,7 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. (FUNCTIONS INVERT-WHO-LINE-ENTRY) (DECLARE%: DONTCOPY (RECORDS WHO-LINE-ENTRY)) (* ; - "Macros that lets us lock down the Who-Line while we evaluate some forms") + "Macros that lets us lock down the Who-Line while we evaluate some forms") (FUNCTIONS WITH-WHO-LINE WITH-AVAILABLE-WHO-LINE) @@ -567,11 +570,10 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. "Cached name of the current logged in user") (CL:DEFPARAMETER *WHO-LINE-USER-ENTRY* '("User" (WHO-LINE-USERNAME) - 10 WHO-LINE-CHANGE-USER (SETQ - *WHO-LINE-CURRENT-USER* - NIL) - "Name of the currently logged in user") - + 10 WHO-LINE-CHANGE-USER (SETQ *WHO-LINE-CURRENT-USER* + NIL) + "Name of the currently logged in user") + "Who-Line entry for displaying the name of the currently logged in user") (DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE @@ -591,18 +593,35 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. (DEFINEQ -(WHO-LINE-HOST-NAME -(LAMBDA NIL (* ; "Edited 14-Jan-87 12:46 by smL") (* ;;; "") (* ;;; "Return the name of the curren workstation. Avoid consing up a new string if possible.") (* ;;; "") (* ;; "") (* ;; "The cached value in *WHO-LINE-HOST-NAME* gets invalidated by an entry on the list of \SYSTEMCACHEVARS") (* ;; "") (DECLARE (GLOBALVARS *WHO-LINE-HOST-NAME*)) (if *WHO-LINE-HOST-NAME* then *WHO-LINE-HOST-NAME* else (SETQ *WHO-LINE-HOST-NAME* (ETHERHOSTNAME)))) -) +(WHO-LINE-HOST-NAME + [LAMBDA NIL (* ; "Edited 12-Apr-2023 22:09 by lmm") + (* ; "Edited 14-Jan-87 12:46 by smL") + +(* ;;; "") + +(* ;;; "Return the name of the curren workstation. Avoid consing up a new string if possible.") + +(* ;;; "") + + (* ;; "") + + (* ;; "The cached value in *WHO-LINE-HOST-NAME* gets invalidated by an entry on the list of \SYSTEMCACHEVARS") + + (* ;; "") + + (DECLARE (GLOBALVARS *WHO-LINE-HOST-NAME*)) + (IF *WHO-LINE-HOST-NAME* + THEN *WHO-LINE-HOST-NAME* + ELSE (SETQ *WHO-LINE-HOST-NAME* (UNIX-GETPARM "HOSTNAME"]) ) (DEFGLOBALVAR *WHO-LINE-HOST-NAME* NIL "Cached name of the current machine, for the Who-Line") (CL:DEFPARAMETER *WHO-LINE-HOST-NAME-ENTRY* '("on" (WHO-LINE-HOST-NAME) - 10 NIL (SETQ *WHO-LINE-HOST-NAME* NIL) - "Name of the currently running machine") - + 10 NIL (SETQ *WHO-LINE-HOST-NAME* NIL) + "Name of the currently running machine") + "Who-Line entry for displaying the name of the current machine") (DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE @@ -647,33 +666,41 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. ":") *WHO-LINE-PACKAGE-NAME-CACHE*))))) -(SET-PACKAGE-INTERACTIVELY - (LAMBDA NIL (* ; "Edited 18-Mar-87 13:13 by smL") - - (* ;; "") - - (* ;; "Let the user interactivly change the current package") - - (* ;; "") +(SET-PACKAGE-INTERACTIVELY + [LAMBDA NIL (* ; "Edited 12-Apr-2023 17:44 by lmm") + (* ; "Edited 18-Mar-87 13:13 by smL") - (LET ((PACKAGE - (MENU (create MENU - TITLE _ "Select package" - ITEMS _ (SORT (for PACKAGE in (CL:LIST-ALL-PACKAGES) bind PACKAGE-NAME - collect (SETQ PACKAGE-NAME (CL:PACKAGE-NAME PACKAGE)) - `(,(CONCAT (OR (CAR (CL:PACKAGE-NICKNAMES PACKAGE)) - PACKAGE-NAME) - ":") ',PACKAGE-NAME - ,(CONCAT "Set the current package to " - PACKAGE-NAME ":"))) - (FUNCTION (LAMBDA (X Y) - (ALPHORDER (CAR X) - (CAR Y))))) - CENTERFLG _ T)))) - (if PACKAGE - then (if (SHIFTDOWNP 'SHIFT) - then (WHO-LINE-COPY-INSERT (CONCAT PACKAGE ":")) - else (CL:IN-PACKAGE PACKAGE)))))) + (* ;; "") + + (* ;; "Let the user interactivly change the current package") + + (* ;; "") + + (LET* [PKG (MAIN (FOR PN IN '("INTERLISP" "XCL-USER" "USER") WHEN (SETQ PKG (CL:FIND-PACKAGE + PN)) + COLLECT (LIST PKG PN))) + (SYSPKG (FOR PN + IN '("LISP" "XEROX-COMMON-LISP" "D-ASSEM" "FASL" "KEYWORD" "CASH-FILE" + "SEDIT" "SYSTEM" "COMPILER" "HASH-FILE" "CONDITIONS" "DEBUGGER") + WHEN (SETQ PKG (CL:FIND-PACKAGE PN)) COLLECT (LIST PKG PN))) + (BOTH (APPEND MAIN SYSPKG)) + [UNSORTED (FOR PKG IN (CL:LIST-ALL-PACKAGES) WHEN (NOT (ASSOC PKG BOTH)) + COLLECT (LIST PKG (OR (CAR (CL:PACKAGE-NICKNAMES PKG)) + (CL:PACKAGE-NAME PKG] + [USERS (SORT UNSORTED (FUNCTION (LAMBDA (X Y) + (ALPHORDER (CADR X) + (CADR Y] + [ITEMS (FOR X IN (APPEND MAIN USERS SYSPKG) COLLECT (LIST (CADR X) + (CAR X] + (SELECTION (MENU (create MENU + TITLE _ "Select package" + ITEMS _ ITEMS + CENTERFLG _ T] + (IF SELECTION + THEN (IF (SHIFTDOWNP 'SHIFT) + THEN (WHO-LINE-COPY-INSERT (CONCAT (CADR SELECTION) + ":")) + ELSE (CL:IN-PACKAGE (CAR SELECTION]) (SET-TTY-PACKAGE-INTERACTIVELY (LAMBDA NIL (* smL "28-Oct-86 09:49") (* ;;; "") (* ;;; "Interactivly let the user change the package of the current TTY process") (* ;;; "") (PROCESS.EVAL (TTY.PROCESS) (QUOTE (SET-PACKAGE-INTERACTIVELY)) T)) @@ -681,15 +708,15 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. ) (DEFGLOBALVAR *WHO-LINE-PACKAGE-NAME-CACHE* (LIST NIL) - + "An AList used to cache package names, together with their terminating ':'s") (CL:DEFPARAMETER *WHO-LINE-PACKAGE-ENTRY* '("Pkg" (CURRENT-TTY-PACKAGE) - 10 SET-TTY-PACKAGE-INTERACTIVELY (SETQ + 10 SET-TTY-PACKAGE-INTERACTIVELY (SETQ *WHO-LINE-PACKAGE-NAME-CACHE* - (LIST NIL)) - "Package of the current TTY process") - + (LIST NIL)) + "Package of the current TTY process") + "Who-Line entry for displaying the package of the current TTY process") @@ -717,9 +744,9 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. ) (CL:DEFPARAMETER *WHO-LINE-READTABLE-ENTRY* '("Rdtbl" (CURRENT-TTY-READTABLE-NAME) - 10 SET-TTY-READTABLE-INTERACTIVELY NIL - "Readtable of the current TTY process") - + 10 SET-TTY-READTABLE-INTERACTIVELY NIL + "Readtable of the current TTY process") + "Who-Line entry for displaying the name of the ReadTable of the current TTY process") @@ -743,9 +770,9 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. ) (CL:DEFPARAMETER *WHO-LINE-TTY-PROC-ENTRY* '("Tty" (WHO-LINE-TTY-PROCESS) - 15 CHANGE-TTY-PROCESS-INTERACTIVELY NIL - "The current TTY process") - + 15 CHANGE-TTY-PROCESS-INTERACTIVELY NIL + "The current TTY process") + "Who-Line entry for displaying the name of the current TTY process") @@ -763,58 +790,59 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. (LAMBDA NIL (* ; "Edited 3-Feb-89 14:52 by smL") (* ;;; "Get the currently connected directory") (* ;; "First, update the cached directory / namestring pair to reflect the current TTY proc") (DECLARE (GLOBALVARS *WHO-LINE-LAST-DIRECTORY*)) (* ;; "The connected directory is looked up in the TTY process, in case one day it becomes a per-process var") (LET ((CONNECTED-DIRECTORY (PROCESS.EVALV (TTY.PROCESS) (QUOTE *DEFAULT-PATHNAME-DEFAULTS*)))) (* ; "The CAR contains the path, the CDR contains a string version of the path") (if (NEQ CONNECTED-DIRECTORY (CAR *WHO-LINE-LAST-DIRECTORY*)) then (* ; "The connected directory has changed") (change (CAR *WHO-LINE-LAST-DIRECTORY*) CONNECTED-DIRECTORY) (* ; "Put the host name last, since that is least important") (change (CDR *WHO-LINE-LAST-DIRECTORY*) (if (CL:PATHNAME-DIRECTORY CONNECTED-DIRECTORY) then (CONCAT (CL:PATHNAME-DIRECTORY CONNECTED-DIRECTORY) " on {" (CL:PATHNAME-HOST CONNECTED-DIRECTORY) "}") else (CONCAT "{" (CL:PATHNAME-HOST CONNECTED-DIRECTORY) "}"))) (* ; "Update the list of known directories") (LET ((DIR-NAME (CL:NAMESTRING CONNECTED-DIRECTORY))) (if (NOT (CL:MEMBER DIR-NAME *WHO-LINE-DIRECTORIES* :TEST (CL:FUNCTION STRING-EQUAL))) then (MERGEINSERT DIR-NAME (SORT *WHO-LINE-DIRECTORIES* (CL:FUNCTION UALPHORDER))))))) (* ;; "Return the namestring of the current dir") (CDR *WHO-LINE-LAST-DIRECTORY*)) ) -(SET-CONNECTED-DIRECTORY-INTERACTIVELY - (LAMBDA NIL (* ; "Edited 9-Jun-87 08:57 by smL") +(SET-CONNECTED-DIRECTORY-INTERACTIVELY + [LAMBDA NIL (* ; "Edited 12-Apr-2023 08:00 by lmm") + (* ; "Edited 9-Jun-87 08:57 by smL") -(* ;;; "Let the user interactivly change the current connected directory") +(* ;;; "Let the user interactivly change the current connected directory") - (DECLARE (GLOBALVARS *WHO-LINE-DIRECTORIES*)) - - (* ;; "If the user selects an item while holding down a shift key, copy-insert the name of the directory instead of connecting to it") + (DECLARE (GLOBALVARS *WHO-LINE-DIRECTORIES*)) - (if (SHIFTDOWNP 'SHIFT) - then (LET ((NEW-DIRECTORY (MENU (create MENU + (* ;; "If the user selects an item while holding down a shift key, copy-insert the name of the directory instead of connecting to it") + + (SETQ *WHO-LINE-DIRECTORIES* (SUBSET *WHO-LINE-DIRECTORIES* (FUNCTION DIRECTORYNAMEP))) + (IF (SHIFTDOWNP 'SHIFT) + THEN (LET [(NEW-DIRECTORY (MENU (create MENU TITLE _ "Type in directory name:" - ITEMS _ *WHO-LINE-DIRECTORIES*)))) - (if NEW-DIRECTORY - then (WHO-LINE-COPY-INSERT NEW-DIRECTORY))) - else (LET ((NEW-DIRECTORY (MENU (create MENU + ITEMS _ *WHO-LINE-DIRECTORIES*] + (IF NEW-DIRECTORY + THEN (WHO-LINE-COPY-INSERT NEW-DIRECTORY))) + ELSE (LET [(NEW-DIRECTORY (MENU (create MENU TITLE _ "Connect to:" - ITEMS _ (CONS "* Other *" *WHO-LINE-DIRECTORIES*))))) - (if NEW-DIRECTORY - then (if (STRING-EQUAL NEW-DIRECTORY "* Other *") - then (CLEARW PROMPTWINDOW) + ITEMS _ (CONS "* Other *" *WHO-LINE-DIRECTORIES*] + (if NEW-DIRECTORY + then (if (STRING-EQUAL NEW-DIRECTORY "* Other *") + then (CLEARW PROMPTWINDOW) (SETQ NEW-DIRECTORY (PROMPTFORWORD "Connect to directory " (CL:NAMESTRING (PROCESS.EVALV (TTY.PROCESS) + ' *DEFAULT-PATHNAME-DEFAULTS* )) NIL PROMPTWINDOW NIL 'TTY NIL))) - (if NEW-DIRECTORY - then (ALLOW.BUTTON.EVENTS) (* ; - "Should do this in the current TTY process, in case the conntected directory is a per-process var") - - (CNDIR NEW-DIRECTORY))))))) + (if NEW-DIRECTORY + then (ALLOW.BUTTON.EVENTS) (* ; + "Should do this in the current TTY process, in case the conntected directory is a per-process var") + (CNDIR NEW-DIRECTORY]) ) (DEFGLOBALVAR *WHO-LINE-DIRECTORIES* `(,LOGINHOST/DIR) - + "Cached list of known directories for the Who-Line Directory entry") -(DEFGLOBALVAR *WHO-LINE-LAST-DIRECTORY* (LET ((NAMESTRING (CL:NAMESTRING - *DEFAULT-PATHNAME-DEFAULTS*))) - (CONS (PATHNAME NAMESTRING) - (MKSTRING NAMESTRING))) - +(DEFGLOBALVAR *WHO-LINE-LAST-DIRECTORY* (LET ((NAMESTRING (CL:NAMESTRING *DEFAULT-PATHNAME-DEFAULTS*) + )) + (CONS (PATHNAME NAMESTRING) + (MKSTRING NAMESTRING))) + "Cached name of the current connected directory for the Who-Line Directory entry") (CL:DEFPARAMETER *WHO-LINE-DIRECTORY-ENTRY* '("Dir" (WHO-LINE-CURRENT-DIRECTORY) - 30 SET-CONNECTED-DIRECTORY-INTERACTIVELY - (SETQ *WHO-LINE-LAST-DIRECTORY* - (CONS NIL NIL)) - "The currently connected directory") - + 30 SET-CONNECTED-DIRECTORY-INTERACTIVELY + (SETQ *WHO-LINE-LAST-DIRECTORY* (CONS NIL NIL)) + "The currently connected directory") + "Who-Line entry for displaying the name of the currently connected directory") @@ -887,15 +915,14 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. ) (DEFGLOBALVAR *WHO-LINE-LAST-VMEM* (LIST 0 NIL NIL) - + "Cached value for storing the last VMem information for the Who-Line VMem entry") (CL:DEFPARAMETER *WHO-LINE-VMEM-ENTRY* '("VMem" (WHO-LINE-VMEM) - 5 WHO-LINE-SAVE-VMEM (SETQ *WHO-LINE-LAST-VMEM* - (LIST 0 NIL NIL)) - "Percentage of VMem currently in use") - - "Who-Line entry for displaying the current VMem utilization") + 5 WHO-LINE-SAVE-VMEM (SETQ *WHO-LINE-LAST-VMEM* + (LIST 0 NIL NIL)) + "Percentage of VMem currently in use") + "Who-Line entry for displaying the current VMem utilization") (DECLARE%: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD (FILESLOAD (LOADCOMP) @@ -938,15 +965,13 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. (CL:THIRD *WHO-LINE-SYMBOL-SPACE*))) (DEFGLOBALVAR *WHO-LINE-SYMBOL-SPACE* (LIST NIL NIL NIL - "Remembers the previous who-line symbol space")) + "Remembers the previous who-line symbol space")) (CL:DEFPARAMETER *WHO-LINE-SYMBOL-SPACE-ENTRY* '("Syms" (WHO-LINE-SYMBOL-SPACE) - 4 NIL (SETQ *WHO-LINE-SYMBOL-SPACE* - (LIST NIL NIL NIL)) - - "Percentage of symbol space currently in use" - ) - + 4 NIL (SETQ *WHO-LINE-SYMBOL-SPACE* + (LIST NIL NIL NIL)) + "Percentage of symbol space currently in use") + "Who-line entry for displaying percent of symbol space in use") @@ -991,13 +1016,13 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. ) (DEFGLOBALVAR *WHO-LINE-TIMER* (SETUPTIMER (DIFFERENCE 60 (REMAINDER (IDATE) - 60)) - NIL - 'SECONDS) - "Timer for controlling updates of the Who-Line Time entry") + 60)) + NIL + 'SECONDS) + "Timer for controlling updates of the Who-Line Time entry") (DEFGLOBALVAR *WHO-LINE-OLD-TIME* (DATE (DATEFORMAT NO.SECONDS)) - "Cached value for the Who-Line Time entry") + "Cached value for the Who-Line Time entry") (CL:DEFPARAMETER *WHO-LINE-TIME-ENTRY* '("Time" (WHO-LINE-TIME) @@ -1082,15 +1107,14 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. "Interval between updating the Who-Line activity entry") (DEFGLOBALVAR *WHO-LINE-ACTIVE-TIMER* (SETUPTIMER *WHO-LINE-ACTIVE-PERIOD* NIL 'MILLISECONDS) - "Timer for controlling updating of the Who-Line activity entry") (CL:DEFPARAMETER *WHO-LINE-SHOW-ACTIVE-ENTRY* '("" (WHO-LINE-SHOW-ACTIVE) - 2 NIL (SETQ *WHO-LINE-ACTIVE-TIMER* - (SETUPTIMER *WHO-LINE-ACTIVE-PERIOD* - NIL 'MILLISECONDS)) - "Indication of machine activity") - + 2 NIL (SETQ *WHO-LINE-ACTIVE-TIMER* + (SETUPTIMER *WHO-LINE-ACTIVE-PERIOD* NIL + 'MILLISECONDS)) + "Indication of machine activity") + "Who-Line entry for displaying the activity of the machine") (DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE @@ -1122,10 +1146,10 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. ) (CL:DEFPARAMETER *WHO-LINE-PROFILE-ENTRY* '("Profile" (CURRENT-PROFILE) - 10 SET-TTY-PROFILE-INTERACTIVELY NIL + 10 SET-TTY-PROFILE-INTERACTIVELY NIL "The read/write profile of the current TTY process" - ) - + ) + "Who-Line entry for displaying the current read/write profile") @@ -1176,15 +1200,15 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. "Cached state shown in the Who-Line State entry") (DEFGLOBALVAR *WHO-LINE-STATE-UNINTERESTING-FNS* '(BLOCK ERRORSET OBTAIN.MONITORLOCK - MONITOR.AWAIT.EVENT AWAIT.EVENT - SI::*UNWIND-PROTECT*) - + MONITOR.AWAIT.EVENT AWAIT.EVENT + SI::*UNWIND-PROTECT*) + "Uninteresting fns to skip over in the Who-Line State entry") (CL:DEFPARAMETER *WHO-LINE-TTY-STATE-ENTRY* '("State" (WHO-LINE-TTY-STATE) - 15 NIL (SETQ *WHO-LINE-STATE* NIL) - "Running state of the current TTY process") - + 15 NIL (SETQ *WHO-LINE-STATE* NIL) + "Running state of the current TTY process") + "Who-Line entry for showing the running state of the current TTY process") (PUTPROPS AWAIT.EVENT WHO-LINE-STATE "Block") @@ -1222,9 +1246,8 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. (DEFGLOBALVAR *WHO-LINE-ENTRIES* - `(,*WHO-LINE-USER-ENTRY* ,*WHO-LINE-PACKAGE-ENTRY* ,*WHO-LINE-READTABLE-ENTRY* - ,*WHO-LINE-TTY-PROC-ENTRY* ,*WHO-LINE-DIRECTORY-ENTRY* ,*WHO-LINE-VMEM-ENTRY* - ,*WHO-LINE-TIME-ENTRY*) + `(,*WHO-LINE-PACKAGE-ENTRY* ,*WHO-LINE-READTABLE-ENTRY* ,*WHO-LINE-TTY-PROC-ENTRY* + ,*WHO-LINE-DIRECTORY-ENTRY* ,*WHO-LINE-VMEM-ENTRY* ,*WHO-LINE-TIME-ENTRY*) "List of all the entries to show in the Who-Line") (DEFGLOBALVAR *WHO-LINE-ENTRY-REGISTRY* @@ -1235,13 +1258,13 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. "List of all known Who-Line entries.") (DEFGLOBALVAR *WHO-LINE-ANCHOR* '(:CENTER :TOP) - "Location to place the Who-Line") + "Location to place the Who-Line") (DEFGLOBALVAR *WHO-LINE-NAME-FONT* (FONTCREATE '(HELVETICA 8 BOLD)) - "Font to use to show entry labels in the Who-Line") + "Font to use to show entry labels in the Who-Line") (DEFGLOBALVAR *WHO-LINE-VALUE-FONT* (FONTCREATE '(GACHA 8)) - "Font to use to show the entry values in the Who-Line") + "Font to use to show the entry values in the Who-Line") (DEFGLOBALVAR *WHO-LINE-DISPLAY-NAMES?* T "Flag for enabling or disabling the display of entry names in the Who-Line") @@ -1578,15 +1601,15 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. (DEFMACRO INVERT-WHO-LINE-ENTRY (ENTRY WINDOW) `(WITH WHO-LINE-ENTRY ,ENTRY (BLTSHADE BLACKSHADE ,WINDOW NAME-START 0 (DIFFERENCE VALUE-END - NAME-START) - NIL - 'INVERT) - (CHANGE INVERTED? (NOT INVERTED?)))) + NAME-START) + NIL + 'INVERT) + (CHANGE INVERTED? (NOT INVERTED?)))) (DECLARE%: DONTCOPY (DECLARE%: EVAL@COMPILE (RECORD WHO-LINE-ENTRY (NAME FORM NAME-START VALUE-START VALUE-END PREV-VALUE WHEN-SELECTED-FN - INVERTED? RESET-FORM DESCRIPTION)) + INVERTED? RESET-FORM DESCRIPTION)) ) ) @@ -1606,7 +1629,7 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. `(LET ((,LOCK (OBTAIN.MONITORLOCK (WINDOWPROP ,WHO-LINE 'LOCK) T))) (CL:UNWIND-PROTECT (* ; - "Only eval the forms if we got the lock") + "Only eval the forms if we got the lock") (COND (,LOCK ,@FORMS)) @@ -1614,13 +1637,13 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. [COND ((EQ ,LOCK T) (* ; - "Had the lock before, so no need to release it") + "Had the lock before, so no need to release it") NIL) ((NULL ,LOCK) (* ; - "Couldn't get the lock, so no need to release it") + "Couldn't get the lock, so no need to release it") NIL) (T (* ; - "We got the lock, and need to release it") + "We got the lock, and need to release it") (RELEASE.MONITORLOCK ,LOCK])]) @@ -1656,24 +1679,25 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. (PUTPROPS WHO-LINE FILETYPE :COMPILE-FILE) ) -(PUTPROPS WHO-LINE COPYRIGHT ("Xerox Corporation" 1986 1987 1988 1989 1994 1998 2001 2021)) +(PUTPROPS WHO-LINE COPYRIGHT ("Xerox Corporation" 1986 1987 1988 1989 1994 1998 2001 2021 2023)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (7778 23157 (INSTALL-WHO-LINE-OPTIONS 7788 . 23155)) (23433 24602 (WHO-LINE-USERNAME -23443 . 24090) (WHO-LINE-CHANGE-USER 24092 . 24398) (WHO-LINE-USER-AFTER-LOGIN 24400 . 24600)) (25504 -25983 (WHO-LINE-HOST-NAME 25514 . 25981)) (26695 29324 (CURRENT-TTY-PACKAGE 26705 . 27657) ( -SET-PACKAGE-INTERACTIVELY 27659 . 29078) (SET-TTY-PACKAGE-INTERACTIVELY 29080 . 29322)) (30244 31296 ( -CURRENT-TTY-READTABLE-NAME 30254 . 30508) (SET-READTABLE-INTERACTIVELY 30510 . 31044) ( -SET-TTY-READTABLE-INTERACTIVELY 31046 . 31294)) (31811 32383 (WHO-LINE-TTY-PROCESS 31821 . 31999) ( -CHANGE-TTY-PROCESS-INTERACTIVELY 32001 . 32381)) (32884 36355 (WHO-LINE-CURRENT-DIRECTORY 32894 . -34301) (SET-CONNECTED-DIRECTORY-INTERACTIVELY 34303 . 36353)) (37720 40173 (WHO-LINE-VMEM 37730 . -39920) (WHO-LINE-SAVE-VMEM 39922 . 40171)) (41097 42239 (WHO-LINE-SYMBOL-SPACE 41097 . 42239)) (43107 -44545 (WHO-LINE-TIME 43117 . 43859) (WHO-LINE-SET-TIME 43861 . 44543)) (46079 48712 ( -WHO-LINE-SHOW-ACTIVE 46089 . 46867) (\UPDATE-WHO-LINE-ACTIVE-FLAG 46869 . 47837) ( -\PERIODICALLY-WHO-LINE-SHOW-ACTIVE 47839 . 48710)) (49873 50798 (CURRENT-PROFILE 49883 . 50128) ( -SET-PROFILE-INTERACTIVELY 50130 . 50533) (SET-TTY-PROFILE-INTERACTIVELY 50535 . 50796)) (51360 53343 ( -WHO-LINE-TTY-STATE 51370 . 52531) (WHO-LINE-WHAT-IS-RUNNING 52533 . 53341)) (56897 70023 ( -REDISPLAY-WHO-LINE 56907 . 59467) (PERIODICALLY-UPDATE-WHO-LINE 59469 . 60607) (SETUP-WHOLINE-TIMER -60609 . 60827) (UPDATE-WHO-LINE 60829 . 63897) (WHEN-WHO-LINE-SELECTED-FN 63899 . 67166) ( -WHO-LINE-CONTROL-SELECT 67168 . 69627) (WHO-LINE-COPY-INSERT 69629 . 70021)) (70024 71158 ( -WHO-LINE-REDISPLAY-INTERRUPT 70034 . 71156))))) + (FILEMAP (NIL (7838 23217 (INSTALL-WHO-LINE-OPTIONS 7848 . 23215)) (23493 24662 (WHO-LINE-USERNAME +23503 . 24150) (WHO-LINE-CHANGE-USER 24152 . 24458) (WHO-LINE-USER-AFTER-LOGIN 24460 . 24660)) (25470 +26206 (WHO-LINE-HOST-NAME 25480 . 26204)) (26906 30232 (CURRENT-TTY-PACKAGE 26916 . 27868) ( +SET-PACKAGE-INTERACTIVELY 27870 . 29986) (SET-TTY-PACKAGE-INTERACTIVELY 29988 . 30230)) (31132 32184 ( +CURRENT-TTY-READTABLE-NAME 31142 . 31396) (SET-READTABLE-INTERACTIVELY 31398 . 31932) ( +SET-TTY-READTABLE-INTERACTIVELY 31934 . 32182)) (32687 33259 (WHO-LINE-TTY-PROCESS 32697 . 32875) ( +CHANGE-TTY-PROCESS-INTERACTIVELY 32877 . 33257)) (33748 37557 (WHO-LINE-CURRENT-DIRECTORY 33758 . +35165) (SET-CONNECTED-DIRECTORY-INTERACTIVELY 35167 . 37555)) (38817 41270 (WHO-LINE-VMEM 38827 . +41017) (WHO-LINE-SAVE-VMEM 41019 . 41268)) (42132 43274 (WHO-LINE-SYMBOL-SPACE 42132 . 43274)) (44005 +45443 (WHO-LINE-TIME 44015 . 44757) (WHO-LINE-SET-TIME 44759 . 45441)) (46957 49590 ( +WHO-LINE-SHOW-ACTIVE 46967 . 47745) (\UPDATE-WHO-LINE-ACTIVE-FLAG 47747 . 48715) ( +\PERIODICALLY-WHO-LINE-SHOW-ACTIVE 48717 . 49588)) (50687 51612 (CURRENT-PROFILE 50697 . 50942) ( +SET-PROFILE-INTERACTIVELY 50944 . 51347) (SET-TTY-PROFILE-INTERACTIVELY 51349 . 51610)) (52162 54145 ( +WHO-LINE-TTY-STATE 52172 . 53333) (WHO-LINE-WHAT-IS-RUNNING 53335 . 54143)) (57628 70754 ( +REDISPLAY-WHO-LINE 57638 . 60198) (PERIODICALLY-UPDATE-WHO-LINE 60200 . 61338) (SETUP-WHOLINE-TIMER +61340 . 61558) (UPDATE-WHO-LINE 61560 . 64628) (WHEN-WHO-LINE-SELECTED-FN 64630 . 67897) ( +WHO-LINE-CONTROL-SELECT 67899 . 70358) (WHO-LINE-COPY-INSERT 70360 . 70752)) (70755 71889 ( +WHO-LINE-REDISPLAY-INTERRUPT 70765 . 71887)) (72291 72677 (INVERT-WHO-LINE-ENTRY 72291 . 72677)) ( +72981 73153 (WITH-WHO-LINE 72981 . 73153)) (73155 74399 (WITH-AVAILABLE-WHO-LINE 73155 . 74399))))) STOP diff --git a/lispusers/WHO-LINE.DFASL b/lispusers/WHO-LINE.DFASL index 5fdbe0ac205e436ac2c0f2b8b416ba4410cff65d..9ab904e6d5cc42a4087f330212e334690017568e 100644 GIT binary patch delta 4380 zcmb7HdsNfc9sk|?3xq_#Btp=XLbOPIG!9TGAQNNqgM|F@`^Ef%fi?vxriK=S;$!pG zfU8)P(@t;I$>i7Y^5l^w)OPsYLB|d>FhdpzxNlgcI_YY zaQuGn_x-*1dq2OMvxo5?pTysT+m4)ukoX<(2w6yCU9d77VY6hBvNh+jIzZYd!6 zMYrNhK8&87vEb{X9~>yz?o>QGYa(6i!pl0_y1Tb7>*$0MQF*d6_hD^%T77BB-HVf# z^M92!gz7y?kE6p-ngt{mY6EWVmD{ zAlbbFd8?y_+z@6arG;8ZgS zmp5XujCh{#h{eN?h!M-Z$J}^m@Jxet7BV6&^BULx!mO7o%3gWPn_kY@iW_ z8lGry7ax1X9kJXq924=#;J8O?p&@i~wrtWvHY3t!0G%plTB@9K)M}P<%=-uLl+Ci4 z1xB>az7+p;_5G$nn@@vh$}^)JSIDZ&;Zj+$o>Sav9eq@u6S1^fTMI_zeB7EpI{3N~%~%Z` z6o!UHHK%FRLwUJ4N5hzooJ^oGaV?nTSea1e^G7`+4?Y-;-JpLom&GzH9uqw|`q2i~ zuo30R^NuWJwoGuuEYHJ;Wnn!qp+TO9R3>8Ja1Nafog#>WBjA=LJcBON+yTL>+=F3k zP!l%B4-90_Eh_TbeKu<66{J7{MxzWHsK%7i_ywg=4A=s8x0upSr`oJrv?)b4nO0R0 z!SQ4#zK&ZKNcqom0GfZ)W_=!*Aw>am_OniX=ug>{rmSDF=&W>6mcB&-Fk*Y1{Z z8Vmd$<{14;LdvBZm*C@s?_rYi-fSp%EdKa_-YwaDc8A9vs~14_J22or2ljPldlJ~A zG_+oEx$6Q>IVkx+^c>Un0n1ZuM#%2-36isn3b_9;-N(RQfuf)fSp1U7-vah1W8Vh$ z04>8P#@tH4W*0@ZntDM2)m}AF3$@6sb4$)i2xl$F$c_=45d$@)DNr-r zLU21vmX_FKXBmHm{a@aTVDEKy(dUx=PQg#3IO8NUKA-_Kiw_u^1i##5bI4w=EZJ0< z)@idVir}S2fSBc#A#=O(;bMj!=_V6!HGukxn)uCQ$yEH zL%lo*QO$-D<&+n59B@JjSIj?jZ&Nziw zS7YR*#h)N6IlN>Exro9Ly@a*eLL9 z=Wr2uvD~4xL3CV5{#L$Phjpo3$xuZU>BdlcN_pz;4+~fo=dgy+^O$G!0>+G9B=f5Z zEMrjo%S_N0VdRn>2)2{9s#&OzY_D4MrLvDyxxS&~q@lVB(>5DwO55-0fO`S>uLS&V zslJT`J{hFaET28#0*wtm5e=$hIm>uoIn|q{^iH>*B8cp7R@-fv#%!my_F~PRSOzT= z^{l2HP!#8k24pl~qk(rl=hkMU!7>*BX_}WI6QSReo``9feh)meMteO&9)5pEPvnq? zX^*+^F9zStgFvHS!n(DqK~fkxJ_V~1<(ZHos}!S)Nkj$3B%(^UBI<#p8@)a?6NB-6fGGl(VOjSVw8X<^M-UooqT1lub8* z`$$DFhtw^z#)3H!R(K>!OPl3dO{22uN%lpg%p|Gt-wp++ z-gUAcZaU}~GT{)gk~$*5IvESojjE_yx} z$jC>vbRadNT?x#lA+o31hVk`fL97s!^MOD!@NV$I_d}@b%pD+<`;@T&q1;3w3giSx zVyGYZe${ZNYP2B{4Kc3Y$H?V|L=+{W40CJa1G$c_XcVw^QplVy0=x#DH86sE`YdWUlqI=ADDL2y*iwnz5D^Bxj#Noe4s9${McTDLdo~+&tY^jx!0-Z zF*YX;)gNGVfu{p$KHw(aCx^x3=p(Yqdk4Bqws~KfK0XJ^#HVj#SVVY;a0SPWbZXjsv37uc6ajS10%d$syEGi5eEn4I<&Lnc zk0;0%D?h-ziM;QB4ULoMl{si4`CH}Z2#qIWjXjhc2=2hVo;)1vz6rsf1uvqdTKr{E!x8F0CkMReR8f}*H{JVp$mGw8nL z$03KNen$rjx1&WRYz+AwE_L;7m6WOEPL<@V#HbPm)clU*# zjjJN$YWv(7ejX=6Jf8^jn#6iOEwPPHC&u>q)6&%ogL?R-WJ61CK`8`8Pu>ND`=D4Q znJU2*$?vv*%A*%Z=z;v?_tqNIth|Y-{(-3zd(xy12^|DEZ%Y2G^9Km_d1Z8_`eWd3 z(iwdoy+dYnEu>emw(I($S6SC+T|KyK|E z=+K5-(;oi!BG6~*Gd=gCF_PZfs?KgD>F6CQ ztbzcjmP6DDxaAbH;7={9iq!5}ig^p!v8x$X(UCQ)_xw`w+O8|e!0Xl9uUDmda_x~r zXcej5Q$~h&=VCsWyuEuFY9YqH+lu~8_fp4Re>VEFfR)|ele(*1AFO#Z@%24M{r}Y0 ziZ;+FZ_j-weIc{#WH5lt>NR zlQ0Lug)bT1H9IN-otylX?Y>}eTV-3joEj;Tx@Nwt5@~gb^lkcwnuJ*`0{CcCPxjbsDVTcf|Qh zvM%AMBOzq#1X&y`8)2~pv|1F&ig=K5k#@M|wHoW9p}p3Cw(+cmo;iJLjcOX{5QI#$ zP7&gmv(dhDa0#MdguxU?;zM*4B{~vi8b}mqY!s6Fn8r*}B|pwIr`}MbuQuhtX`+~E zRE#h&gf_*y;<=0PL*&(PoW-6qX$zunK`%_~gmoNkM}fV;A>-U;%W99&(O`Fi=u_10 z1NI=-D%=j2$0vK3Wm1CV(lR8Urtn}%R*Tz{qqkb8Lb{dU|2g+pB0B6&b9=Ku_5=S8 z`u5p?2>S@``eR`8k4Tu51G6`BjK)_HJ;A$AIlV$|kJ6tR;!uo=iX>F%d?h zUiL;&fi!)25mAp3ED=hXwfrk>W7m zx$CS`YRVNUlZw?A7k^N9-70uk*`3v{m{T+c*YYbA>f4}(p~&4Hm&IP~L&(tvF4Z{o9y4fipsUx& ziYkm{WLGLPrkmnX_Ta%{R_;&6KA-bQ?>*1na?B(xY{XGfoJ7Q$V>MHa*TRn|WP0DX z$c>vkVm^Z$%C+xX&RWbVijg&J*~=x#3hSWL`ml!w3+mV(t8_c-0vIWvQ32Ml_2;ob zN32sJpt}{kS~Yf4LypnnG8sG$mzRoo2!|*)y31j6dKxTt-kH&MCE-=}XroW#w@y+x zhSFf?2(W{3H-k5!gB{n;s0I*?6G2uxTn)S@;O)M{5C&lH$hQRSSIFYyLeIt+tR}sy z0W^PNcl6qw!iQ+E&ksbHSS#=3xpW0b&VRX^=<#?#e;d@)0_@vpi7kH|**=i=Mmsj) zuD@K?=gPWy(GHC)mrMN%EUKFkHoQu^Oc;%X)mb_R@8h5@3t&Qz3bsbV@rKTh4(Q?T z&hk`AZP-AFg>@Mli9!0<_%0=*Qm{Hsq~v?)UOsjSBtojx=VGNZ$@k(`s})%u8P1UDZ@2VB$1lCcP*xSy2r zsSI0k3RdBb2veYTh+S}N`TurO7F5y>OLSt>`?tY za$fpP{ci~wk~TgY;)MO(yPeW;wqb4X;b6MH_OC?8MjE}bS8+Cr8BEs{Qa>0R(y6A; zh`Nx}eo+4bf$GRFSX{1>uHy0p%qsP?r%E~2klCT^MF>=%8{$h!iWES5>S zOp;`RWg+^c#`Tqis*G%|F)eOZEuSZK^$iIDc4 zZRyhbpCl=D^e(FYO}P`c&*U4C0g%(X(m?0yBty0$D-}c@%A|@%g#R$DE@RFYe?iW& zyDw&wIyOIeFZU!~4B1o-5M&dUFr6rboj8)s`#@>2JL^0PP;gSJ*(?%;Se;+MJl!kE zd3Lz_NXAF#x{~}~JZ@LWs?2r`Vy4Kg{|oc za_-`1812u}*IRo?F1;(N<-Hh(6t!e!toZo(c)TJu@YAANdXFOuU!(O9us4xC3+(3) z*)d>cTlhH_#9=V#=Z999_)i#YLMXq+wA)st(Fu@z0(W9^>D?x|mPXj-Z4t;{)057L zl-)Cj7Eir_`bl?EJd@*)`+!VfjFEp$1_^DSH4D=r8$lwoi)EIb-kwgy+w9`@7Pa`z zT=W=cr90-AU|Ph7W{@F4rJQV(CmUzgyFE5Xo!jK)TH!Txy)7Ny5v5J|z8;g!O<~+B z`PW2n8^r>oOQ_twODWzu&7$}UG@Hh9Q#H(bsB14(A>ag6BK?8FPcnarQfY7KO~St| z7Va)1lr`@zA_i3=@nJlq)7T*@+vE1GjP+>3hdNVS?ne+(o`vM%4eu&6rGb-Ka z{e~pcaqMh5E`Mc=vm5)5kqVZ3pn(0dZziSp*oD4IVm#VEdjWh;s_|QfAJvF?SwfRN zC+vegonR~b4{`U4{p&~r2f4hkHYOV_U5hY-RJqFE#h@e=gDM)Ng$I)f4Jg>M19_}1 zJcEp~9pOyU#ZH8uB2Daf;rCWOhLiRqoHQ9HfK!*G(L6q$BjMNvvm?i9v70b~R`%;x zPR{q?Ymz|{oh#5}nBu8$Ducu6by=#-o(NO3?n4z%sitNLUZL=v@H2RZ{`>d;2Pm=M A!T