Context Navigation

escape.lisp @ 252

Revision 252, 17.7 KB (checked in by rjs, 21 months ago)
Initial versions.

Line
1	;;; --Mode:LISP; Package:SYSTEM-INTERNALS --
2
3	;;; Functions to hang things off the <esc> keys.
4	;;; See the documentaion for the function KBD-ESC-INSTALL-FUNCTION for
5	;;; instruction on how to use it to install things on the <esc> keys.
6	;;; Note that the two <esc> keys and are helpful in defining or
7	;;; undefining keys in realtime.
8
9	;;; Note that the the items hung on <esc> keys are run in their own process
10	;;; to protect the kbd process.
11
12	;;; The end of this file contains various key definitions.
13
14
15	;;; Various things hang on this variable. Its value is an alist of
16	;;; (character form documentation). Form is either evaled of funcalled.
17	;;; If it is a list that is a lambda expression that takes arguments or
18	;;; a symbol it is funcalled with the <esc> arg as its arguments. Other-
19	;;; wise it is just evaled.
20	;;; Various properties hold information pertaining to the window used
21	;;; by some of the <esc> function.
22	;(DEFVAR KBD-ESC-REPOSITORY NIL)
23
24	;;; The KBD-ESC-UTILITY-WINDOW property hold the window.
25	(PUTPROP 'KBD-ESC-REPOSITORY (<- POP-UP-TEXT-WINDOW-CLASS ':NEW)
26	'KBD-ESC-UTILITY-WINDOW)
27
28	;;; Properties holding information pertaining to window size and position.
29	(LET ((WID)(HGT)(XPOS)(YPOS)(W)(SCR)(HGT2)(YPOS2))
30	(SETQ W (GET 'KBD-ESC-REPOSITORY 'KBD-ESC-UTILITY-WINDOW)
31	SCR (<- W ':SCREEN)
32	STR (<- W ':STREAM)
33	WID (// (* 3 (- (SCREEN-X2 SCR) (SCREEN-X1 SCR))) 4)
34	HGT (// (- (SCREEN-Y2 SCR) (SCREEN-Y1 SCR)) 4)
35	HGT2 (// (- (SCREEN-Y2 SCR) (SCREEN-Y1 SCR)) 2)
36	XPOS (// (- (SCREEN-X2 SCR) (SCREEN-X1 SCR)) 2)
37	YPOS (// (- (SCREEN-Y2 SCR) (SCREEN-Y1 SCR)) 3)
38	YPOS2 (- (SCREEN-Y2 SCR) YPOS))
39	(PUTPROP 'KBD-ESC-REPOSITORY (LIST WID HGT) 'SMALL-SIZE)
40	(PUTPROP 'KBD-ESC-REPOSITORY (LIST WID HGT2) 'MEDIUM-SIZE)
41	(PUTPROP 'KBD-ESC-REPOSITORY (LIST XPOS YPOS) 'UPPER-PORTION-CENTERED-POSITION)
42	(PUTPROP 'KBD-ESC-REPOSITORY (LIST XPOS YPOS2) 'LOWER-PORTION-CENTERED-POSITION))
43
44	(DEFUN KBD-ESC-PREPARE-WINDOW (LBL &REST OPT &AUX W STR)
45	"Prepare the kbde-esc window for use.
46	Gets the window, sets it size, label and location as requested
47	and pops it up."
48	(OR OPT (SETQ OPT '(FULL-SCREEN)))
49	(SETQ W (GET 'KBD-ESC-REPOSITORY 'KBD-ESC-UTILITY-WINDOW))
50	(AND (<- W ':STATUS)(<- W ':DEACTIVATE))
51	(<- W ':LABEL<- LBL)
52	(COND
53	((MEMQ 'FULL-SCREEN OPT)
54	(<- W ':FULL-SCREEN))
55	(T
56	(COND ((MEMQ 'SMALL-SIZE OPT)
57	(LEXPR-FUNCALL W ':SIZE<- (GET 'KBD-ESC-REPOSITORY 'SMALL-SIZE)))
58	((MEMQ 'MEDIUM-SIZE OPT)
59	(LEXPR-FUNCALL W ':SIZE<- (GET 'KBD-ESC-REPOSITORY 'MEDIUM-SIZE))))
60	(COND ((MEMQ 'UPPER-PORTION-CENTERED-POSITION OPT)
61	(LEXPR-FUNCALL W ':MOVE-NEAR
62	(GET 'KBD-ESC-REPOSITORY 'UPPER-PORTION-CENTERED-POSITION)))
63	((MEMQ 'LOWER-PORTION-CENTERED-POSITION OPT)
64	(LEXPR-FUNCALL W ':MOVE-NEAR
65	(GET 'KBD-ESC-REPOSITORY 'LOWER-PORTION-CENTERED-POSITION))))))
66	(SETQ STR (<- W ':STREAM))
67	(<- W ':POP-UP)
68	(PROG () (RETURN W STR)))
69
70	(DEFUN KBD-ESC-INSTALL-FUNCTION (FCTN CHAR-VALUE &OPTIONAL DOC)
71	"This is used to install an item on an <esc> key.
72	The second arg is the key in question or a list of such keys for
73	multiple installations. How the first item is treated depends on the options:
74	If it is a list and not a lambda expression of at least one
75	arg it is evaled when selected.
76	If it a lambda escpresion that takes at least arg it is funcalled
77	with the <esc> arg as argument.
78	If it is a symbol it is funcalled with the <esc> arg.
79	If no documentation is supplied then an attempt is made to find some using the
80	FUNCTION-DOCUMENTATION function. If all attempts fail to find some documentation
81	then the item itself is used."
82
83	(OR (LISTP CHAR-VALUE) (SETQ CHAR-VALUE (LIST CHAR-VALUE)))
84	;; We eval the documentation when asked to print it so quote correctly.
85	(COND ((LISTP DOC)
86	(SETQ DOC `',DOC))
87	((NULL DOC)
88	(SETQ DOC (IF (LISTP FCTN)
89	; If we are given a list of one item then get doc from it.
90	(IF (= (LENGTH FCTN) 1)
91	`(FUNCTION-DOCUMENTATION ',(CAR FCTN))
92	(FORMAT NIL "~S" FCTN))
93	`(FUNCTION-DOCUMENTATION ',FCTN)))))
94	(DOLIST (CHAR CHAR-VALUE)
95	(KBD-ESC-REMOVE-FUNCTION CHAR)
96	(PUSH (LIST (CHAR-UPCASE CHAR) FCTN DOC) KBD-ESC-REPOSITORY)))
97
98	(DEFUN KBD-ESC-REMOVE-FUNCTION (CHAR)
99	"Given a character removes its associated form and doc from the <esc> keys."
100	(SETQ KBD-ESC-REPOSITORY (DELQ (ASSQ CHAR KBD-ESC-REPOSITORY) KBD-ESC-REPOSITORY)))
101
102
103	;;; What follows are various functions that are hung on the <esc> keys.
104
105	(DEFUN KBD-ESC-FINGER (ARG)
106	"Finger the local machines.
107	No arg => Who's on AI
108	0 => Finger a user
109	1 => Who's on Lisp Machines
110	2 => Who's on MC
111	3 => Who's on AI and MC"
112	(OR ARG (SETQ ARG -1)) ;Distinguish ESC F from ESC 0 F
113	(LET ((WINDOW)(STREAM))
114	(MULTIPLE-VALUE (WINDOW STREAM)
115	(KBD-ESC-PREPARE-WINDOW (COND ((= ARG 0) "Finger")
116	((= ARG 1) "Who's on Lisp Machines")
117	((= ARG 2) "Who's on MC")
118	((= ARG 3) "Who's on AI and MC")
119	(T "Who's on AI"))
120	'FULL-SCREEN))
121	(SELECTQ ARG
122	(0 (FORMAT STREAM "~&Finger:~%")
123	(FUNCALL #'CHAOS:FINGER (READLINE STREAM) STREAM))
124	(1 (CHAOS:FINGER-ALL-LMS STREAM))
125	(2 (CHAOS:FINGER "//L@MC" STREAM))
126	(3 (CHAOS:FINGER "@AI" STREAM)
127	(TERPRI STREAM)
128	(CHAOS:FINGER "@MC" STREAM))
129	(:OTHERWISE (CHAOS:FINGER "@AI" STREAM)))
130	(FORMAT STREAM "~&~%Type a space to flush: ")
131	(TYI STREAM)
132	(<- WINDOW ':POP-DOWN)))
133
134	(DEFUN KBD-ESC-DOCUMENT-ALL-KEYS (IGNORE &AUX STREAM WINDOW)
135	"Document all the Escape keys."
136	(MULTIPLE-VALUE (WINDOW STREAM)
137	(KBD-ESC-PREPARE-WINDOW "Documenting all the <esc> keys, <esc>? documents single keys."
138	'FULL-SCREEN))
139	(FORMAT STREAM "Documentation of ESC keys:~%")
140	(DOLIST (ITEM (REVERSE KBD-ESC-REPOSITORY))
141	(KBD-ESC-PRINT-DOCUMENTATION STREAM ITEM))
142	(FORMAT STREAM "~2%Type a space to flush:")
143	(TYI STREAM)
144	(<- WINDOW ':POP-DOWN))
145
146	;;; Used to rebind the kbd-tyi-hook so we quit on Z.
147	;;; Throw to first tag when all done, throw to second when want to retry.
148	(DEFMACRO KBD-ESC-TYI-HOOK-BIND (QUIT-TAG RETRY-TAG &REST FORMS)
149	`(LET ((KBD-TYI-HOOK
150	#'(LAMBDA (C) (IF (= (CHAR-UPCASE C) #/Z) (*THROW ,QUIT-TAG NIL) C))))
151	(*CATCH ,QUIT-TAG
152	(DO ()
153	(NIL)
154	(*CATCH ,RETRY-TAG
155	(PROGN ,@FORMS))))))
156
157	(DEFUN KBD-ESC-DOCUMENT-A-KEY (IGNORE &AUX W STR C)
158	"Document an <esc> key."
159	(MULTIPLE-VALUE (W STR)
160	(KBD-ESC-PREPARE-WINDOW "Document an <esc> key, Z quits, <esc><help> documents all keys."
161	'SMALL-SIZE
162	'UPPER-PORTION-CENTERED-POSITION))
163	(KBD-ESC-TYI-HOOK-BIND
164	'ALL-DONE-SINGLE-KEY-DOCUMENTATION
165	'TRY-AGAIN
166	(FORMAT STR "~%What is key? ")
167	(SETQ C (CHAR-UPCASE (TYI STR)))
168	(KBD-ESC-PRINT-DOCUMENTATION STR C))
169	(<- W ':POP-DOWN))
170
171	(DEFUN KBD-ESC-PRINT-DOCUMENTATION (STREAM KEY &AUX SAVE-KEY (INDENT 10.))
172	"Given a key this function finds its documentation and outputs it to STREAM.
173	The key may also be an alist elemnt."
174	(IF (NUMBERP KEY)
175	(SETQ SAVE-KEY KEY KEY (ASSQ KEY KBD-ESC-REPOSITORY)))
176	(COND ((NULL KEY)
177	(FORMAT STREAM "~%The key ~C is not defined" SAVE-KEY))
178	(T ;Print for all other cases.
179	(LET ((DOC (OR (EVAL (CADDR KEY))
180	(FORMAT NIL "~S" (CADR KEY)))))
181	(IF (NOT (LISTP DOC))
182	(DO ((D DOC (SUBSTRING D (1+ (STRING-SEARCH-CHAR #\CR D))))
183	(L NIL (CONS (SUBSTRING D 0 (STRING-SEARCH-CHAR #\CR D)) L)))
184	((NOT (STRING-SEARCH-CHAR #\CR D)) (SETQ DOC (NREVERSE (CONS D L))))))
185	(FORMAT STREAM "~%~C~VT" (CAR KEY) INDENT)
186	(FORMAT STREAM "~A" (IF (LISTP DOC) (CAR DOC) DOC))
187	(IF (LISTP DOC)
188	(DO ((D (CDR DOC) (CDR D)))
189	((NULL D))
190	(FORMAT STREAM "~%~VT~A" INDENT (CAR D))))
191	(TERPRI STREAM)))))
192
193	(DEFUN FIND-A-WINDOW-OF-CLASS (CLASS &OPTIONAL (NTH 1))
194	"Given a class and an optional n, find nth window of that class on ACTIVE-WINDOWS-LIST."
195	(AND (SYMBOLP CLASS) (SETQ CLASS (SYMEVAL CLASS)))
196	(DO ((W ACTIVE-WINDOWS (CDR W))
197	(CNT 1))
198	((NULL W) NIL)
199	(IF (OR (EQ (CLASS (CAR W)) CLASS)
200	(AND (EQ (CLASS (CAR W)) SI:WINDOW-SINGLE-FRAME-CLASS)
201	(EQ (CLASS (<- (CAR W) ':PANE)) CLASS)))
202	(IF (= CNT NTH)
203	(RETURN (CAR W))
204	(SETQ CNT (1+ CNT))))))
205
206	(DEFUN KBD-ESC-CREATE-WINDOW-WITH-FRAME (CLASS &AUX P W)
207	(SETQ P (<- WINDOW-SINGLE-FRAME-CLASS ':NEW))
208	(SETQ W (<- CLASS ':NEW))
209	(<- P ':FULL-SCREEN)
210	(<- P ':PANE<- W)
211	P)
212
213
214	(DEFUN KBD-ESC-FIND-OR-MAKE-SUPDUP-OR-TELNET (ARG &AUX W (NTH 1))
215	"Network: Get or make a SUPDUP or TELNET
216	0 or no arg => find a SUPDUP, make one if none around
217	1 => find a TELNET, make one if none around
218	2 => make a new SUPDUP
219	3 => make a new TELNET
220	precomma arg is nth one to find."
221	(IF (LISTP ARG)
222	(SETQ NTH (CAR ARG) ARG (CADR ARG)))
223	(SELECTQ ARG
224	((0 NIL)
225	(IF (NOT (SETQ W (FIND-A-WINDOW-OF-CLASS SUPDUP:SUPDUP-CLASS NTH)))
226	(SETQ W (KBD-ESC-CREATE-WINDOW-WITH-FRAME SUPDUP:SUPDUP-CLASS)))
227	(WINDOW-SELECT W))
228	(1
229	(IF (NOT (SETQ W (FIND-A-WINDOW-OF-CLASS SUPDUP:TELNET-CLASS NTH)))
230	(SETQ W (KBD-ESC-CREATE-WINDOW-WITH-FRAME SUPDUP:TELNET-CLASS)))
231	(WINDOW-SELECT W))
232	(2 (WINDOW-SELECT (KBD-ESC-CREATE-WINDOW-WITH-FRAME SUPDUP:SUPDUP-CLASS)))
233	(3 (WINDOW-SELECT (KBD-ESC-CREATE-WINDOW-WITH-FRAME SUPDUP:TELNET-CLASS)))))
234
235	(DEFUN KBD-ESC-ASK-AND-INSTALL-FUNCTION-REALTIME (IGNORE &AUX W STR FCTN CHAR DOC)
236	"Install a function on an <esc> key.
237	Z at anytime aborts the operation."
238	(MULTIPLE-VALUE (W STR)
239	(KBD-ESC-PREPARE-WINDOW "Installing a new <esc> function. (Z aborts)"
240	'SMALL-SIZE
241	'UPPER-PORTION-CENTERED-POSITION))
242	(KBD-ESC-TYI-HOOK-BIND
243	'GIVE-IT-UP-BOYS
244	'TRY-AGAIN
245	(FORMAT STR "~%What is form to eval and store on character? ")
246	(SETQ
247	FCTN
248	(LET ((ITEM (EVAL (READ STR))))
249	(IF (AND (SYMBOLP ITEM) (NOT (FBOUNDP ITEM))) ;If we can, check if its defined.
250	(PROGN
251	(FORMAT STR "~%I can't find a definition for ~S" ITEM)
252	(*THROW 'TRY-AGAIN NIL)))
253	(FUNCALL STR ':CLEAR-INPUT)
254	(FORMAT STR "~%Object is ~S, confirm: " ITEM)
255	(IF (Y-OR-N-P NIL STR)
256	ITEM
257	(*THROW 'TRY-AGAIN NIL))))
258	(FORMAT STR "~%What is character? ")
259	;; If it is alread defined make sure he knows it.
260	(SETQ CHAR (DO ((TRY (CHAR-UPCASE (TYI STR))(CHAR-UPCASE (TYI STR))))
261	((NOT (ASSQ TRY KBD-ESC-REPOSITORY)) TRY)
262	(TERPRI STR)
263	(FORMAT
264	STR
265	"~%This character is already defined as: ~% ~S, go on? "
266	(CADR (ASSQ TRY KBD-ESC-REPOSITORY)))
267	(IF (Y-OR-N-P NIL STR)
268	(RETURN TRY))
269	(FORMAT STR "~%Another character please: ")))
270	(FORMAT STR "~%What is form to eval for documentation? ")
271	(SETQ DOC (READ STR))
272	(FUNCALL STR ':CLEAR-INPUT)
273	(KBD-ESC-INSTALL-FUNCTION FCTN CHAR DOC)
274	(*THROW 'GIVE-IT-UP-BOYS NIL))
275	(<- W ':POP-DOWN))
276
277	(DEFUN KBD-ESC-DEINSTALL-FUNCTION-REALTIME (IGNORE &AUX W STR CHAR)
278	"Remove the function bound to a key, Z at anytime aborts the operation."
279	(MULTIPLE-VALUE (W STR)
280	(KBD-ESC-PREPARE-WINDOW "Deleting an <esc> character definition. (Z aborts)"
281	'SMALL-SIZE
282	'UPPER-PORTION-CENTERED-POSITION))
283	(KBD-ESC-TYI-HOOK-BIND
284	'ALL-DONE
285	'LOSE-LOSE
286	(FORMAT STR "~% What is Character? ")
287	(SETQ CHAR (CHAR-UPCASE (TYI STR)))
288	(IF (NULL (ASSQ CHAR KBD-ESC-REPOSITORY))
289	(PROGN
290	(FORMAT STR "~%There is nothing defined for this character.~%")
291	(*THROW 'LOSE-LOSE NIL)))
292	(FORMAT STR "~% Clobber ~%~S~% on character: ~:C, (confirm)? "
293	(CADR (ASSQ CHAR KBD-ESC-REPOSITORY))
294	CHAR)
295	(IF (Y-OR-N-P NIL STR)
296	(PROGN
297	(KBD-ESC-REMOVE-FUNCTION CHAR)
298	(*THROW 'ALL-DONE NIL))
299	(*THROW 'LOSE-LOSE NIL)))
300	(<- W ':POP-DOWN))
301
302	(DEFUN KBD-ESC-WINDOW-OPERATION (ARG &AUX W STR KILLEE)
303	"Perform a window operation depending on ARG:
304	-1 => unbury a window, ie, select last buried window.
305	0 => bury SELECTED-WINDOW
306	1 => Kill SELECTED-WINDOW, with confirmation
307	2 => invoke the window selection menu."
308	(OR ARG (SETQ ARG 0))
309	(COND ((= ARG -1) ;Unbury a window.
310	(WINDOW-SELECT (CAR (LAST ACTIVE-WINDOWS))))
311	((AND SELECTED-WINDOW (EQ ARG 0)) ; Just bury the window.
312	(<- SELECTED-WINDOW ':BURY))
313	((AND (SETQ KILLEE SELECTED-WINDOW) (EQ ARG 1)) ; Kill with confirmation.
314	(MULTIPLE-VALUE (W STR)
315	(KBD-ESC-PREPARE-WINDOW "Killing a window"
316	'SMALL-SIZE
317	'UPPER-PORTION-CENTERED-POSITION))
318	(FORMAT STR "~2% Killing window:~2%~A,~2%confirm: " KILLEE)
319	(FUNCALL STR ':CLEAR-INPUT)
320	(AND (PROG1
321	(Y-OR-N-P NIL STR)
322	(<- W ':POP-DOWN))
323	(<- KILLEE ':KILL)))
324	((= ARG 2) ; Get the window selection menu.
325	(LEXPR-FUNCALL #'MOUSE-WARP
326	(GET 'KBD-ESC-REPOSITORY 'UPPER-PORTION-CENTERED-POSITION))
327	(REDEFINE-ACTIVE-WINDOWS-MENU))))
328
329	(DEFUN KBD-ESC-FIND-OR-CREATE-PEEK-WINDOW (ARG &AUX PW PANE)
330	"Find or create a peek window and select it.
331	Arg is nth window to choose. (Default is first.)"
332	(OR ARG (SETQ ARG 1))
333	(COND ((SETQ PW (FIND-A-WINDOW-OF-CLASS PEEK-WINDOW-CLASS ARG)))
334	(T
335	(SETQ PANE (<- PEEK-WINDOW-CLASS ':NEW))
336	(SETQ PW (<- WINDOW-SINGLE-FRAME-CLASS ':NEW))
337	(LEXPR-FUNCALL PW ':SIZE<- (GET 'KBD-ESC-REPOSITORY 'MEDIUM-SIZE))
338	(LEXPR-FUNCALL PW ':MOVE-NEAR
339	(GET 'KBD-ESC-REPOSITORY 'LOWER-PORTION-CENTERED-POSITION))
340	(<- PW ':PANE<- PANE)))
341	(WINDOW-SELECT PW))
342
343	(DEFUN KBD-ESC-SELECT-A-WINDOW (ARG &AUX (OLD-W SELECTED-WINDOW))
344	"Select a window:
345	-1 or - => least recent selected window
346	1 (default) => last selected window
347	n => nth most recent selected window.
348	The nth most recent selected window is interpreted to be the n+1th window on the
349	active windows list."
350	(OR ARG (SETQ ARG 1))
351	(COND ((< ARG 0)
352	(SETQ ARG (1- (LENGTH ACTIVE-WINDOWS))))
353	((= ARG 0))
354	(T
355	(IF (NOT SELECTED-WINDOW)
356	(SETQ ARG (1- ARG)))
357	(IF (< ARG (LENGTH ACTIVE-WINDOWS))
358	NIL
359	(SETQ ARG (1- (LENGTH ACTIVE-WINDOWS))))))
360	;; Try to select a window until we get one that is not what we had
361	;; or we get to the end of the list.
362	(WINDOW-SELECT (NTH ARG ACTIVE-WINDOWS))
363	(DO ((ARG ARG (1+ ARG)))
364	((OR (AND SELECTED-WINDOW (NEQ SELECTED-WINDOW OLD-W))
365	(= ARG (1- (LENGTH ACTIVE-WINDOWS)))))
366	(WINDOW-SELECT (NTH ARG ACTIVE-WINDOWS))))
367
368	(DEFUN KBD-ESC-DESCRIBE-OR-DOCUMENT (ARG &AUX W STR THING LBL)
369	"Describe an object or document a function accorging to args.
370	0 => describe an object (default)
371	1 => document a function."
372	(IF (OR (NOT ARG) (= ARG 0))
373	(SETQ LBL "Describe an object (Z terminates)")
374	(SETQ LBL "Document a function (Z terminates)"))
375	(MULTIPLE-VALUE (W STR)
376	(KBD-ESC-PREPARE-WINDOW LBL
377	'MEDIUM-SIZE 'UPPER-PORTION-CENTERED-POSITION))
378	(KBD-ESC-TYI-HOOK-BIND
379	'ALL-DONE
380	'LOSE-LOSE
381	(SELECTQ ARG
382	((NIL 0)
383	(FORMAT STR "~2& What is form to eval and describe? ")
384	(SETQ THING (EVAL (READ STR)))
385	(FUNCALL STR ':FRESH-LINE)
386	(LET ((STANDARD-OUTPUT STR))
387	(DESCRIBE THING)))
388	(1
389	(FORMAT STR "~2& What is form to eval and document? ")
390	(SETQ THING (EVAL (READ STR)))
391	(FORMAT STR "~&~A" (FUNCTION-DOCUMENTATION THING))))
392	(FUNCALL STR ':CLEAR-INPUT)
393	(*THROW 'LOSE-LOSE NIL))
394	(<- W ':POP-DOWN))
395
396
397
398	;;; The binding of various keys follows.
399
400	;; <esc> - Unbind the function from a key.
401	(KBD-ESC-INSTALL-FUNCTION 'KBD-ESC-DEINSTALL-FUNCTION-REALTIME #/)
402
403	;; <esc> - Bind a function to a key.
404	(KBD-ESC-INSTALL-FUNCTION 'KBD-ESC-ASK-AND-INSTALL-FUNCTION-REALTIME #/)
405
406	;; <esc> BREAK or B - Send a supervisory signal to the selected window.
407	(KBD-ESC-INSTALL-FUNCTION '(AND SELECTED-WINDOW
408	(<- SELECTED-WINDOW ':SUPERVISORY-SIGNAL ':BREAK))
409	'(#\BREAK #/B) ;also B for compatibility.
410	"Send a SUPERVISORY-SIGNAL BREAK to selected-window.")
411
412	;; <esc> C - Complement black on white mode.
413	(KBD-ESC-INSTALL-FUNCTION '(TV-COMPLEMENT-BOW-MODE)
414	#/C
415	"Complement TV's black on white mode.")
416
417	;; <esc> D - Describe or document a thing.
418	;(KBD-ESC-INSTALL-FUNCTION 'KBD-ESC-DESCRIBE-OR-DOCUMENT #/D)
419
420	;; <esc> D - Buzz the 9th floor door.
421	(KBD-ESC-INSTALL-FUNCTION '(PROGN (CHAOS:BUZZ-DOOR)(%BEEP 34000 4000000))
422	#/D
423	"Buzz the 9th floor door.")
424
425	;; <esc> E - Call the elevator.
426	(KBD-ESC-INSTALL-FUNCTION '(PROGN (CHAOS:CALL-ELEVATOR) (%BEEP 1000 140000))
427	#/E
428	"Call the elevator.")
429
430	;; <esc> F - Finger local machines.
431	(KBD-ESC-INSTALL-FUNCTION 'KBD-ESC-FINGER #/F)
432
433	;; <esc> L - select the first lisp listener that comes to mind.
434	(KBD-ESC-INSTALL-FUNCTION '(LAMBDA (ARGS &AUX W)
435	(OR ARGS (SETQ ARGS 1))
436	(AND
437	(SETQ W (FIND-A-WINDOW-OF-CLASS SI:LISP-LISTENER-CLASS ARGS))
438	(WINDOW-SELECT W)))
439	#/L
440	(LIST "Find and select a LISP-LISTENER"
441	"Arg is nth window to select"))
442
443	;; <esc> M - Control more processing.
444	(KBD-ESC-INSTALL-FUNCTION
445	'(LAMBDA (ARG)
446	(SETQ TV-MORE-PROCESSING-GLOBAL-ENABLE
447	(COND ((NOT ARG) (NOT TV-MORE-PROCESSING-GLOBAL-ENABLE))
448	((= ARG 0) NIL) ;ESC 0 M MORE PROC OFF
449	(T T))))
450	#/M
451	"More processing, no arg => complement, 0 => off, 1 => on.")
452
453	;; <esc> N - Network, get a supdup or telnet.
454	(KBD-ESC-INSTALL-FUNCTION 'KBD-ESC-FIND-OR-MAKE-SUPDUP-OR-TELNET #/N)
455
456	;; <esc> Q - Hardcopy the screen.
457	(KBD-ESC-INSTALL-FUNCTION '(SCREEN-XGP-HARDCOPY-BACKGROUND)
458	#/Q
459	"Hardcopy of the screen.")
460
461	;; <esc> P - Select or create a Peek window.
462	(KBD-ESC-INSTALL-FUNCTION 'KBD-ESC-FIND-OR-CREATE-PEEK-WINDOW #/P)
463
464	;; <esc> S - Select windows
465	(KBD-ESC-INSTALL-FUNCTION 'KBD-ESC-SELECT-A-WINDOW #/S)
466
467	;; <esc> W - Bury or kill the selected window.
468	(KBD-ESC-INSTALL-FUNCTION 'KBD-ESC-WINDOW-OPERATION #/W)
469
470	;; <esc> Z - Find an editor window.
471	(KBD-ESC-INSTALL-FUNCTION '(LAMBDA (ARGS &AUX W)
472	(OR ARGS (SETQ ARGS 1))
473	(IF
474	(SETQ W (FIND-A-WINDOW-OF-CLASS ZWEI:ZWEI-WINDOW-CLASS ARGS))
475	(WINDOW-SELECT W)
476	(ED)))
477	#/Z
478	(LIST "Find and select a Zwei window."
479	"Arg is nth window to choose."))
480
481	;; <esc> ? - document a key.
482	(KBD-ESC-INSTALL-FUNCTION 'KBD-ESC-DOCUMENT-A-KEY #/?)
483
484	;; <esc> <help> - document the escape keys.
485	(KBD-ESC-INSTALL-FUNCTION 'KBD-ESC-DOCUMENT-ALL-KEYS #\HELP)

Note: See TracBrowser for help on using the browser.

Download in other formats:

Original Format