Frank Halasz
GitHub
commit
730fc5b678
@ -1,13 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "26-Mar-2021 11:01:59" {DSK}<home>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}<home>larry>il>medley>lispusers>WHO-LINE.;5 75086
|
||||
|
||||
previous date%: "26-Mar-2021 10:48:40" {DSK}<home>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}<home>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
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user