TAB-WINDOWS: A lispusers package that lets you step through open windows (#1789)
Start it running with `(START-TAB-WINDOWS)`. Bonus debug tool: `(KEY-WINDOW)` starts a process that monitors keyboard and mouse button events and displays them in a little window.
This commit is contained in:
73
lispusers/TAB-WINDOWS
Normal file
73
lispusers/TAB-WINDOWS
Normal file
@@ -0,0 +1,73 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Aug-2024 11:31:37" {DSK}<Users>hjellinek>Projects>IL>TAB-WINDOWS.;13 3078
|
||||
|
||||
:CHANGES-TO (FNS START-TAB-WINDOWS TAB-WINDOWS SHOW-KEYS IS-KEY-DOWN? KEY-WINDOW)
|
||||
(VARS TAB-WINDOWSCOMS)
|
||||
(PROPS (TAB-WINDOWS :COMPILE-FILE))
|
||||
|
||||
:PREVIOUS-DATE " 4-Jun-2024 09:48:34" {DSK}<Users>hjellinek>Projects>IL>TAB-WINDOWS.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TAB-WINDOWSCOMS)
|
||||
|
||||
(RPAQQ TAB-WINDOWSCOMS ((FNS IS-KEY-DOWN? START-TAB-WINDOWS TAB-WINDOWS SHOW-KEYS KEY-WINDOW)
|
||||
(PROP :COMPILE-FILE TAB-WINDOWS)))
|
||||
(DEFINEQ
|
||||
|
||||
(IS-KEY-DOWN?
|
||||
[LAMBDA (KEY-NAME KEYS-DOWN)
|
||||
(for KEY-NAME-LIST in KEYS-DOWN thereis (FMEMB KEY-NAME KEY-NAME-LIST])
|
||||
|
||||
(START-TAB-WINDOWS
|
||||
[LAMBDA (META-KEY-NAME)
|
||||
(ADD.PROCESS (LIST 'TAB-WINDOWS (KWOTE META-KEY-NAME))
|
||||
'NAME "Window Tabber" 'RESTARTABLE T])
|
||||
|
||||
(TAB-WINDOWS
|
||||
[LAMBDA (META-KEY-NAME)
|
||||
|
||||
(* ;; "When the meta and tab keys go down, TOTOPW the next window in OPENWINDOWS")
|
||||
|
||||
(DECLARE (CL:SPECIAL \KEYNAMES))
|
||||
(LET ((CURRENT-WINDOW NIL)
|
||||
(OPEN-WINDOWS (OPENWINDOWS)))
|
||||
(CL:UNWIND-PROTECT
|
||||
[PROGN (while T
|
||||
do ([LET ((KEYS-DOWN (for K in \KEYNAMES when (KEYDOWNP K) collect K)))
|
||||
[if (AND (IS-KEY-DOWN? 'TAB KEYS-DOWN)
|
||||
(IS-KEY-DOWN? META-KEY-NAME KEYS-DOWN))
|
||||
then (if CURRENT-WINDOW
|
||||
then (TOTOPW CURRENT-WINDOW)
|
||||
(SETQ CURRENT-WINDOW (CADR (FMEMB CURRENT-WINDOW
|
||||
OPEN-WINDOWS)))
|
||||
else (SETQ CURRENT-WINDOW (CAR OPEN-WINDOWS]
|
||||
(if (NOT KEYS-DOWN)
|
||||
then (SETQ CURRENT-WINDOW NIL)
|
||||
(SETQ OPEN-WINDOWS (OPENWINDOWS]
|
||||
(BLOCK 20])])
|
||||
|
||||
(SHOW-KEYS
|
||||
[LAMBDA NIL
|
||||
(DECLARE (CL:SPECIAL \KEYNAMES))
|
||||
(LET ((WINDOW (CREATEW NIL "Keys down")))
|
||||
(WINDOWPROP WINDOW 'PROCESS (THIS.PROCESS))
|
||||
[WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
|
||||
(DEL.PROCESS (WINDOWPROP W 'PROCESS]
|
||||
(CL:UNWIND-PROTECT
|
||||
[PROGN (while T do (LET ((DOWN-KEYS (for K in \KEYNAMES when (KEYDOWNP K) collect K)))
|
||||
(BLOCK 100)
|
||||
(CLEARW WINDOW)
|
||||
(COND
|
||||
(DOWN-KEYS (PRIN1 DOWN-KEYS WINDOW]
|
||||
(CLOSEW WINDOW))])
|
||||
|
||||
(KEY-WINDOW
|
||||
[LAMBDA NIL
|
||||
(ADD.PROCESS '(SHOW-KEYS)
|
||||
'NAME "Showing Keys" 'RESTARTABLE T])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (645 3055 (IS-KEY-DOWN? 655 . 791) (START-TAB-WINDOWS 793 . 950) (TAB-WINDOWS 952 . 2219
|
||||
) (SHOW-KEYS 2221 . 2939) (KEY-WINDOW 2941 . 3053)))))
|
||||
STOP
|
||||
BIN
lispusers/TAB-WINDOWS.DFASL
Normal file
BIN
lispusers/TAB-WINDOWS.DFASL
Normal file
Binary file not shown.
BIN
lispusers/TAB-WINDOWS.TEdit
Normal file
BIN
lispusers/TAB-WINDOWS.TEdit
Normal file
Binary file not shown.
Reference in New Issue
Block a user