Mercurial > emacs
comparison src/keymap.c @ 250:7e94ea5958e0
Initial revision
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Mon, 06 May 1991 03:30:56 +0000 |
parents | |
children | d1e5cf833d37 |
comparison
equal
deleted
inserted
replaced
249:43cdaf2db624 | 250:7e94ea5958e0 |
---|---|
1 /* Manipulation of keymaps | |
2 Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc. | |
3 | |
4 This file is part of GNU Emacs. | |
5 | |
6 GNU Emacs is free software; you can redistribute it and/or modify | |
7 it under the terms of the GNU General Public License as published by | |
8 the Free Software Foundation; either version 1, or (at your option) | |
9 any later version. | |
10 | |
11 GNU Emacs is distributed in the hope that it will be useful, | |
12 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 GNU General Public License for more details. | |
15 | |
16 You should have received a copy of the GNU General Public License | |
17 along with GNU Emacs; see the file COPYING. If not, write to | |
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
19 | |
20 | |
21 #include "config.h" | |
22 #include <stdio.h> | |
23 #undef NULL | |
24 #include "lisp.h" | |
25 #include "commands.h" | |
26 #include "buffer.h" | |
27 | |
28 #define min(a, b) ((a) < (b) ? (a) : (b)) | |
29 | |
30 /* Dense keymaps look like (keymap VECTOR . ALIST), where VECTOR is a | |
31 128-element vector used to look up bindings for ASCII characters, | |
32 and ALIST is an assoc list for looking up symbols. */ | |
33 #define DENSE_TABLE_SIZE (0200) | |
34 | |
35 /* Actually allocate storage for these variables */ | |
36 | |
37 Lisp_Object current_global_map; /* Current global keymap */ | |
38 | |
39 Lisp_Object global_map; /* default global key bindings */ | |
40 | |
41 Lisp_Object meta_map; /* The keymap used for globally bound | |
42 ESC-prefixed default commands */ | |
43 | |
44 Lisp_Object control_x_map; /* The keymap used for globally bound | |
45 C-x-prefixed default commands */ | |
46 | |
47 /* was MinibufLocalMap */ | |
48 Lisp_Object Vminibuffer_local_map; | |
49 /* The keymap used by the minibuf for local | |
50 bindings when spaces are allowed in the | |
51 minibuf */ | |
52 | |
53 /* was MinibufLocalNSMap */ | |
54 Lisp_Object Vminibuffer_local_ns_map; | |
55 /* The keymap used by the minibuf for local | |
56 bindings when spaces are not encouraged | |
57 in the minibuf */ | |
58 | |
59 /* keymap used for minibuffers when doing completion */ | |
60 /* was MinibufLocalCompletionMap */ | |
61 Lisp_Object Vminibuffer_local_completion_map; | |
62 | |
63 /* keymap used for minibuffers when doing completion and require a match */ | |
64 /* was MinibufLocalMustMatchMap */ | |
65 Lisp_Object Vminibuffer_local_must_match_map; | |
66 | |
67 Lisp_Object Qkeymapp, Qkeymap; | |
68 | |
69 /* A char over 0200 in a key sequence | |
70 is equivalent to prefixing with this character. */ | |
71 | |
72 extern Lisp_Object meta_prefix_char; | |
73 | |
74 void describe_map_tree (); | |
75 static Lisp_Object describe_buffer_bindings (); | |
76 static void describe_command (); | |
77 static void describe_map (); | |
78 static void describe_alist (); | |
79 | |
80 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 0, 0, | |
81 "Construct and return a new keymap, of the form (keymap VECTOR . ALIST).\n\ | |
82 VECTOR is a 128-element vector which holds the bindings for the ASCII\n\ | |
83 characters. ALIST is an assoc-list which holds bindings for function keys,\n\ | |
84 mouse events, and any other things that appear in the input stream.\n\ | |
85 All entries in it are initially nil, meaning \"command undefined\".") | |
86 () | |
87 { | |
88 return Fcons (Qkeymap, | |
89 Fcons (Fmake_vector (make_number (DENSE_TABLE_SIZE), Qnil), | |
90 Qnil)); | |
91 } | |
92 | |
93 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 0, 0, | |
94 "Construct and return a new sparse-keymap list.\n\ | |
95 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\ | |
96 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\ | |
97 which binds the function key or mouse event SYMBOL to DEFINITION.\n\ | |
98 Initially the alist is nil.") | |
99 () | |
100 { | |
101 return Fcons (Qkeymap, Qnil); | |
102 } | |
103 | |
104 /* This function is used for installing the standard key bindings | |
105 at initialization time. | |
106 | |
107 For example: | |
108 | |
109 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); | |
110 | |
111 I haven't extended these to allow the initializing code to bind | |
112 function keys and mouse events; since they are called by many files, | |
113 I'd have to fix lots of callers, and nobody right now would be using | |
114 the new functionality, so it seems like a waste of time. But there's | |
115 no technical reason not to. -JimB */ | |
116 | |
117 void | |
118 initial_define_key (keymap, key, defname) | |
119 Lisp_Object keymap; | |
120 int key; | |
121 char *defname; | |
122 { | |
123 store_in_keymap (keymap, make_number (key), intern (defname)); | |
124 } | |
125 | |
126 /* Define character fromchar in map frommap as an alias for character | |
127 tochar in map tomap. Subsequent redefinitions of the latter WILL | |
128 affect the former. */ | |
129 | |
130 #if 0 | |
131 void | |
132 synkey (frommap, fromchar, tomap, tochar) | |
133 struct Lisp_Vector *frommap, *tomap; | |
134 int fromchar, tochar; | |
135 { | |
136 Lisp_Object v, c; | |
137 XSET (v, Lisp_Vector, tomap); | |
138 XFASTINT (c) = tochar; | |
139 frommap->contents[fromchar] = Fcons (v, c); | |
140 } | |
141 #endif /* 0 */ | |
142 | |
143 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0, | |
144 "Return t if ARG is a keymap.\n\ | |
145 A keymap is list (keymap . ALIST), where alist elements look like | |
146 (CHAR . DEFN) or (SYMBOL . DEFN), or a list (keymap VECTOR . ALIST) | |
147 where VECTOR is a 128-element vector of bindings for ASCII characters, | |
148 and ALIST is as above.") | |
149 (object) | |
150 Lisp_Object object; | |
151 { | |
152 return (NULL (get_keymap_1 (object, 0)) ? Qnil : Qt); | |
153 } | |
154 | |
155 /* Check that OBJECT is a keymap (after dereferencing through any | |
156 symbols). If it is, return it; otherwise, return nil, or signal an | |
157 error if ERROR != 0. */ | |
158 Lisp_Object | |
159 get_keymap_1 (object, error) | |
160 Lisp_Object object; | |
161 int error; | |
162 { | |
163 register Lisp_Object tem; | |
164 | |
165 tem = object; | |
166 while (XTYPE (tem) == Lisp_Symbol && !EQ (tem, Qunbound)) | |
167 { | |
168 tem = XSYMBOL (tem)->function; | |
169 QUIT; | |
170 } | |
171 if (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap)) | |
172 return tem; | |
173 if (error) | |
174 wrong_type_argument (Qkeymapp, object); | |
175 else return Qnil; | |
176 } | |
177 | |
178 Lisp_Object | |
179 get_keymap (object) | |
180 Lisp_Object object; | |
181 { | |
182 return get_keymap_1 (object, 1); | |
183 } | |
184 | |
185 | |
186 /* If KEYMAP is a dense keymap, return the vector from its cadr. | |
187 Otherwise, return nil. */ | |
188 | |
189 static Lisp_Object | |
190 keymap_table (keymap) | |
191 Lisp_Object keymap; | |
192 { | |
193 Lisp_Object cadr; | |
194 | |
195 if (CONSP (XCONS (keymap)->cdr) | |
196 && XTYPE (cadr = XCONS (XCONS (keymap)->cdr)->car) == Lisp_Vector | |
197 && XVECTOR (cadr)->size == DENSE_TABLE_SIZE) | |
198 return cadr; | |
199 else | |
200 return Qnil; | |
201 } | |
202 | |
203 | |
204 /* Look up IDX in MAP. IDX may be any sort of event. | |
205 Note that this does only one level of lookup; IDX must | |
206 be a single event, not a sequence. */ | |
207 | |
208 Lisp_Object | |
209 access_keymap (map, idx) | |
210 Lisp_Object map; | |
211 Lisp_Object idx; | |
212 { | |
213 /* If idx is a list (some sort of mouse click, perhaps?), | |
214 the index we want to use is the car of the list, which | |
215 ought to be a symbol. */ | |
216 if (XTYPE (idx) == Lisp_Cons) | |
217 idx = XCONS (idx)->car; | |
218 | |
219 if (XTYPE (idx) == Lisp_Int | |
220 && (XINT (idx) < 0 || XINT (idx) >= DENSE_TABLE_SIZE)) | |
221 error ("Command key is not an ASCII character"); | |
222 | |
223 { | |
224 Lisp_Object table = keymap_table (map); | |
225 | |
226 /* A dense keymap indexed by a character? */ | |
227 if (XTYPE (idx) == Lisp_Int | |
228 && ! NULL (table)) | |
229 return XVECTOR (table)->contents[XFASTINT (idx)]; | |
230 | |
231 /* This lookup will not involve a vector reference. */ | |
232 else | |
233 { | |
234 /* If idx is a symbol, it might have modifiers, which need to | |
235 be put in the canonical order. */ | |
236 if (XTYPE (idx) == Lisp_Symbol) | |
237 idx = reorder_modifiers (idx); | |
238 | |
239 return Fcdr (Fassq (idx, map)); | |
240 } | |
241 } | |
242 } | |
243 | |
244 /* Given OBJECT which was found in a slot in a keymap, | |
245 trace indirect definitions to get the actual definition of that slot. | |
246 An indirect definition is a list of the form | |
247 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one | |
248 and INDEX is the object to look up in KEYMAP to yield the definition. | |
249 | |
250 Also if OBJECT has a menu string as the first element, | |
251 remove that. */ | |
252 | |
253 Lisp_Object | |
254 get_keyelt (object) | |
255 register Lisp_Object object; | |
256 { | |
257 while (1) | |
258 { | |
259 register Lisp_Object map, tem; | |
260 | |
261 map = get_keymap_1 (Fcar_safe (object), 0); | |
262 tem = Fkeymapp (map); | |
263 | |
264 /* If the contents are (KEYMAP . ELEMENT), go indirect. */ | |
265 if (!NULL (tem)) | |
266 object = access_keymap (map, Fcdr (object)); | |
267 | |
268 /* If the keymap contents looks like (STRING . DEFN), | |
269 use DEFN. | |
270 Keymap alist elements like (CHAR MENUSTRING . DEFN) | |
271 will be used by HierarKey menus. */ | |
272 else if (XTYPE (object) == Lisp_Cons | |
273 && XTYPE (XCONS (object)->car) == Lisp_String) | |
274 object = XCONS (object)->cdr; | |
275 | |
276 else | |
277 /* Anything else is really the value. */ | |
278 return object; | |
279 } | |
280 } | |
281 | |
282 Lisp_Object | |
283 store_in_keymap (keymap, idx, def) | |
284 Lisp_Object keymap; | |
285 register Lisp_Object idx; | |
286 register Lisp_Object def; | |
287 { | |
288 /* If idx is a list (some sort of mouse click, perhaps?), | |
289 the index we want to use is the car of the list, which | |
290 ought to be a symbol. */ | |
291 if (XTYPE (idx) == Lisp_Cons) | |
292 idx = Fcar (idx); | |
293 | |
294 if (XTYPE (idx) == Lisp_Int | |
295 && (XINT (idx) < 0 || XINT (idx) >= DENSE_TABLE_SIZE)) | |
296 error ("Command key is a character outside of the ASCII set."); | |
297 | |
298 { | |
299 Lisp_Object table = keymap_table (keymap); | |
300 | |
301 /* A dense keymap indexed by a character? */ | |
302 if (XTYPE (idx) == Lisp_Int && !NULL (table)) | |
303 XVECTOR (table)->contents[XFASTINT (idx)] = def; | |
304 | |
305 /* Must be a sparse keymap, or a dense keymap indexed by a symbol. */ | |
306 else | |
307 { | |
308 /* Point to the pointer to the start of the assoc-list part | |
309 of the keymap. */ | |
310 register Lisp_Object *assoc_head | |
311 = (NULL (table) | |
312 ? & XCONS (keymap)->cdr | |
313 : & XCONS (XCONS (keymap)->cdr)->cdr); | |
314 register Lisp_Object defining_pair; | |
315 | |
316 /* If idx is a symbol, it might have modifiers, which need to | |
317 be put in the canonical order. */ | |
318 if (XTYPE (idx) == Lisp_Symbol) | |
319 idx = reorder_modifiers (idx); | |
320 | |
321 /* Point to the pair where idx is bound, if any. */ | |
322 defining_pair = Fassq (idx, *assoc_head); | |
323 | |
324 if (NULL (defining_pair)) | |
325 *assoc_head = Fcons (Fcons (idx, def), *assoc_head); | |
326 else | |
327 Fsetcdr (defining_pair, def); | |
328 } | |
329 } | |
330 | |
331 return def; | |
332 } | |
333 | |
334 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0, | |
335 "Return a copy of the keymap KEYMAP.\n\ | |
336 The copy starts out with the same definitions of KEYMAP,\n\ | |
337 but changing either the copy or KEYMAP does not affect the other.\n\ | |
338 Any key definitions that are subkeymaps are recursively copied.") | |
339 (keymap) | |
340 Lisp_Object keymap; | |
341 { | |
342 register Lisp_Object copy, tail; | |
343 | |
344 copy = Fcopy_alist (get_keymap (keymap)); | |
345 tail = XCONS (copy)->cdr; | |
346 | |
347 /* If this is a dense keymap, copy the vector. */ | |
348 if (CONSP (tail)) | |
349 { | |
350 register Lisp_Object table = XCONS (tail)->car; | |
351 | |
352 if (XTYPE (table) == Lisp_Vector | |
353 && XVECTOR (table)->size == DENSE_TABLE_SIZE) | |
354 { | |
355 register int i; | |
356 | |
357 table = Fcopy_sequence (table); | |
358 | |
359 for (i = 0; i < DENSE_TABLE_SIZE; i++) | |
360 if (! NULL (Fkeymapp (XVECTOR (table)->contents[i]))) | |
361 XVECTOR (table)->contents[i] | |
362 = Fcopy_keymap (XVECTOR (table)->contents[i]); | |
363 XCONS (tail)->car = table; | |
364 | |
365 tail = XCONS (tail)->cdr; | |
366 } | |
367 } | |
368 | |
369 /* Copy the alist portion of the keymap. */ | |
370 while (CONSP (tail)) | |
371 { | |
372 register Lisp_Object elt; | |
373 | |
374 elt = XCONS (tail)->car; | |
375 if (CONSP (elt) && ! NULL (Fkeymapp (XCONS (elt)->cdr))) | |
376 XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr); | |
377 | |
378 tail = XCONS (tail)->cdr; | |
379 } | |
380 | |
381 return copy; | |
382 } | |
383 | |
384 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0, | |
385 "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\ | |
386 KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\ | |
387 meaning a sequence of keystrokes and events.\n\ | |
388 DEF is anything that can be a key's definition:\n\ | |
389 nil (means key is undefined in this keymap),\n\ | |
390 a command (a Lisp function suitable for interactive calling)\n\ | |
391 a string (treated as a keyboard macro),\n\ | |
392 a keymap (to define a prefix key),\n\ | |
393 a symbol. When the key is looked up, the symbol will stand for its\n\ | |
394 function definition, which should at that time be one of the above,\n\ | |
395 or another symbol whose function definition is used, etc.\n\ | |
396 a cons (STRING . DEFN), meaning that DEFN is the definition\n\ | |
397 (DEFN should be a valid definition in its own right),\n\ | |
398 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.") | |
399 (keymap, key, def) | |
400 register Lisp_Object keymap; | |
401 Lisp_Object key; | |
402 Lisp_Object def; | |
403 { | |
404 register int idx; | |
405 register Lisp_Object c; | |
406 register Lisp_Object tem; | |
407 register Lisp_Object cmd; | |
408 int metized = 0; | |
409 int length; | |
410 | |
411 keymap = get_keymap (keymap); | |
412 | |
413 if (XTYPE (key) != Lisp_Vector | |
414 && XTYPE (key) != Lisp_String) | |
415 key = wrong_type_argument (Qarrayp, key); | |
416 | |
417 length = Flength (key); | |
418 if (length == 0) | |
419 return Qnil; | |
420 | |
421 idx = 0; | |
422 while (1) | |
423 { | |
424 c = Faref (key, make_number (idx)); | |
425 | |
426 if (XTYPE (c) == Lisp_Int | |
427 && XINT (c) >= 0200 | |
428 && !metized) | |
429 { | |
430 c = meta_prefix_char; | |
431 metized = 1; | |
432 } | |
433 else | |
434 { | |
435 if (XTYPE (c) == Lisp_Int) | |
436 XSETINT (c, XINT (c) & 0177); | |
437 | |
438 metized = 0; | |
439 idx++; | |
440 } | |
441 | |
442 if (idx == length) | |
443 return store_in_keymap (keymap, c, def); | |
444 | |
445 cmd = get_keyelt (access_keymap (keymap, c)); | |
446 | |
447 if (NULL (cmd)) | |
448 { | |
449 cmd = Fmake_sparse_keymap (); | |
450 store_in_keymap (keymap, c, cmd); | |
451 } | |
452 | |
453 tem = Fkeymapp (cmd); | |
454 if (NULL (tem)) | |
455 error ("Key sequence %s uses invalid prefix characters", | |
456 XSTRING (key)->data); | |
457 | |
458 keymap = get_keymap (cmd); | |
459 } | |
460 } | |
461 | |
462 /* Value is number if KEY is too long; NIL if valid but has no definition. */ | |
463 | |
464 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 2, 0, | |
465 "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\ | |
466 nil means undefined. See doc of `define-key' for kinds of definitions.\n\ | |
467 A number as value means KEY is \"too long\";\n\ | |
468 that is, characters or symbols in it except for the last one\n\ | |
469 fail to be a valid sequence of prefix characters in KEYMAP.\n\ | |
470 The number is how many characters at the front of KEY\n\ | |
471 it takes to reach a non-prefix command.") | |
472 (keymap, key) | |
473 register Lisp_Object keymap; | |
474 Lisp_Object key; | |
475 { | |
476 register int idx; | |
477 register Lisp_Object tem; | |
478 register Lisp_Object cmd; | |
479 register Lisp_Object c; | |
480 int metized = 0; | |
481 int length; | |
482 | |
483 keymap = get_keymap (keymap); | |
484 | |
485 if (XTYPE (key) != Lisp_Vector | |
486 && XTYPE (key) != Lisp_String) | |
487 key = wrong_type_argument (Qarrayp, key); | |
488 | |
489 length = Flength (key); | |
490 if (length == 0) | |
491 return keymap; | |
492 | |
493 idx = 0; | |
494 while (1) | |
495 { | |
496 c = Faref (key, make_number (idx)); | |
497 | |
498 if (XTYPE (c) == Lisp_Int | |
499 && XINT (c) >= 0200 | |
500 && !metized) | |
501 { | |
502 c = meta_prefix_char; | |
503 metized = 1; | |
504 } | |
505 else | |
506 { | |
507 if (XTYPE (c) == Lisp_Int) | |
508 XSETINT (c, XINT (c) & 0177); | |
509 | |
510 metized = 0; | |
511 idx++; | |
512 } | |
513 | |
514 cmd = get_keyelt (access_keymap (keymap, c)); | |
515 if (idx == length) | |
516 return cmd; | |
517 | |
518 tem = Fkeymapp (cmd); | |
519 if (NULL (tem)) | |
520 return make_number (idx); | |
521 | |
522 keymap = get_keymap (cmd); | |
523 QUIT; | |
524 } | |
525 } | |
526 | |
527 /* Append a key to the end of a key sequence. If key_sequence is a | |
528 string and key is a character, the result will be another string; | |
529 otherwise, it will be a vector. */ | |
530 Lisp_Object | |
531 append_key (key_sequence, key) | |
532 Lisp_Object key_sequence, key; | |
533 { | |
534 Lisp_Object args[2]; | |
535 | |
536 args[0] = key_sequence; | |
537 | |
538 if (XTYPE (key_sequence) == Lisp_String | |
539 && XTYPE (key) == Lisp_Int) | |
540 { | |
541 args[1] = Fchar_to_string (key); | |
542 return Fconcat (2, args); | |
543 } | |
544 else | |
545 { | |
546 args[1] = Fcons (key, Qnil); | |
547 return Fvconcat (2, args); | |
548 } | |
549 } | |
550 | |
551 | |
552 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 1, 0, | |
553 "Return the binding for command KEY in current keymaps.\n\ | |
554 KEY is a string, a sequence of keystrokes.\n\ | |
555 The binding is probably a symbol with a function definition.") | |
556 (key) | |
557 Lisp_Object key; | |
558 { | |
559 register Lisp_Object map, value, value1; | |
560 map = current_buffer->keymap; | |
561 if (!NULL (map)) | |
562 { | |
563 value = Flookup_key (map, key); | |
564 if (NULL (value)) | |
565 { | |
566 value1 = Flookup_key (current_global_map, key); | |
567 if (XTYPE (value1) == Lisp_Int) | |
568 return Qnil; | |
569 return value1; | |
570 } | |
571 else if (XTYPE (value) != Lisp_Int) | |
572 return value; | |
573 } | |
574 return Flookup_key (current_global_map, key); | |
575 } | |
576 | |
577 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 1, 0, | |
578 "Return the binding for command KEYS in current local keymap only.\n\ | |
579 KEYS is a string, a sequence of keystrokes.\n\ | |
580 The binding is probably a symbol with a function definition.") | |
581 (keys) | |
582 Lisp_Object keys; | |
583 { | |
584 register Lisp_Object map; | |
585 map = current_buffer->keymap; | |
586 if (NULL (map)) | |
587 return Qnil; | |
588 return Flookup_key (map, keys); | |
589 } | |
590 | |
591 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 1, 0, | |
592 "Return the binding for command KEYS in current global keymap only.\n\ | |
593 KEYS is a string, a sequence of keystrokes.\n\ | |
594 The binding is probably a symbol with a function definition.") | |
595 (keys) | |
596 Lisp_Object keys; | |
597 { | |
598 return Flookup_key (current_global_map, keys); | |
599 } | |
600 | |
601 DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2, | |
602 "kSet key globally: \nCSet key %s to command: ", | |
603 "Give KEY a global binding as COMMAND.\n\ | |
604 COMMAND is a symbol naming an interactively-callable function.\n\ | |
605 KEY is a string representing a sequence of keystrokes.\n\ | |
606 Note that if KEY has a local binding in the current buffer\n\ | |
607 that local binding will continue to shadow any global binding.") | |
608 (keys, function) | |
609 Lisp_Object keys, function; | |
610 { | |
611 if (XTYPE (keys) != Lisp_Vector | |
612 && XTYPE (keys) != Lisp_String) | |
613 keys = wrong_type_argument (Qarrayp, keys); | |
614 | |
615 Fdefine_key (current_global_map, keys, function); | |
616 return Qnil; | |
617 } | |
618 | |
619 DEFUN ("local-set-key", Flocal_set_key, Slocal_set_key, 2, 2, | |
620 "kSet key locally: \nCSet key %s locally to command: ", | |
621 "Give KEY a local binding as COMMAND.\n\ | |
622 COMMAND is a symbol naming an interactively-callable function.\n\ | |
623 KEY is a string representing a sequence of keystrokes.\n\ | |
624 The binding goes in the current buffer's local map,\n\ | |
625 which is shared with other buffers in the same major mode.") | |
626 (keys, function) | |
627 Lisp_Object keys, function; | |
628 { | |
629 register Lisp_Object map; | |
630 map = current_buffer->keymap; | |
631 if (NULL (map)) | |
632 { | |
633 map = Fmake_sparse_keymap (); | |
634 current_buffer->keymap = map; | |
635 } | |
636 | |
637 if (XTYPE (keys) != Lisp_Vector | |
638 && XTYPE (keys) != Lisp_String) | |
639 keys = wrong_type_argument (Qarrayp, keys); | |
640 | |
641 Fdefine_key (map, keys, function); | |
642 return Qnil; | |
643 } | |
644 | |
645 DEFUN ("global-unset-key", Fglobal_unset_key, Sglobal_unset_key, | |
646 1, 1, "kUnset key globally: ", | |
647 "Remove global binding of KEY.\n\ | |
648 KEY is a string representing a sequence of keystrokes.") | |
649 (keys) | |
650 Lisp_Object keys; | |
651 { | |
652 return Fglobal_set_key (keys, Qnil); | |
653 } | |
654 | |
655 DEFUN ("local-unset-key", Flocal_unset_key, Slocal_unset_key, 1, 1, | |
656 "kUnset key locally: ", | |
657 "Remove local binding of KEY.\n\ | |
658 KEY is a string representing a sequence of keystrokes.") | |
659 (keys) | |
660 Lisp_Object keys; | |
661 { | |
662 if (!NULL (current_buffer->keymap)) | |
663 Flocal_set_key (keys, Qnil); | |
664 return Qnil; | |
665 } | |
666 | |
667 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 2, 0, | |
668 "Define COMMAND as a prefix command.\n\ | |
669 A new sparse keymap is stored as COMMAND's function definition and its value.\n\ | |
670 If a second optional argument MAPVAR is given, the map is stored as its\n\ | |
671 value instead of as COMMAND's value; but COMMAND is still defined as a function.") | |
672 (name, mapvar) | |
673 Lisp_Object name, mapvar; | |
674 { | |
675 Lisp_Object map; | |
676 map = Fmake_sparse_keymap (); | |
677 Ffset (name, map); | |
678 if (!NULL (mapvar)) | |
679 Fset (mapvar, map); | |
680 else | |
681 Fset (name, map); | |
682 return name; | |
683 } | |
684 | |
685 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0, | |
686 "Select KEYMAP as the global keymap.") | |
687 (keymap) | |
688 Lisp_Object keymap; | |
689 { | |
690 keymap = get_keymap (keymap); | |
691 current_global_map = keymap; | |
692 return Qnil; | |
693 } | |
694 | |
695 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0, | |
696 "Select KEYMAP as the local keymap.\n\ | |
697 If KEYMAP is nil, that means no local keymap.") | |
698 (keymap) | |
699 Lisp_Object keymap; | |
700 { | |
701 if (!NULL (keymap)) | |
702 keymap = get_keymap (keymap); | |
703 | |
704 current_buffer->keymap = keymap; | |
705 | |
706 return Qnil; | |
707 } | |
708 | |
709 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0, | |
710 "Return current buffer's local keymap, or nil if it has none.") | |
711 () | |
712 { | |
713 return current_buffer->keymap; | |
714 } | |
715 | |
716 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0, | |
717 "Return the current global keymap.") | |
718 () | |
719 { | |
720 return current_global_map; | |
721 } | |
722 | |
723 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, | |
724 1, 1, 0, | |
725 "Find all keymaps accessible via prefix characters from KEYMAP.\n\ | |
726 Returns a list of elements of the form (KEYS . MAP), where the sequence\n\ | |
727 KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\ | |
728 so that the KEYS increase in length. The first element is (\"\" . KEYMAP).") | |
729 (startmap) | |
730 Lisp_Object startmap; | |
731 { | |
732 Lisp_Object maps, tail; | |
733 | |
734 maps = Fcons (Fcons (build_string (""), get_keymap (startmap)), Qnil); | |
735 tail = maps; | |
736 | |
737 /* For each map in the list maps, | |
738 look at any other maps it points to, | |
739 and stick them at the end if they are not already in the list. | |
740 | |
741 This is a breadth-first traversal, where tail is the queue of | |
742 nodes, and maps accumulates a list of all nodes visited. */ | |
743 | |
744 while (!NULL (tail)) | |
745 { | |
746 register Lisp_Object thisseq = Fcar (Fcar (tail)); | |
747 register Lisp_Object thismap = Fcdr (Fcar (tail)); | |
748 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1); | |
749 | |
750 /* Does the current sequence end in the meta-prefix-char? */ | |
751 int is_metized = (XINT (last) >= 0 | |
752 && EQ (Faref (thisseq, last), meta_prefix_char)); | |
753 | |
754 /* Skip the 'keymap element of the list. */ | |
755 thismap = Fcdr (thismap); | |
756 | |
757 if (CONSP (thismap)) | |
758 { | |
759 register Lisp_Object table = XCONS (thismap)->car; | |
760 | |
761 if (XTYPE (table) == Lisp_Vector) | |
762 { | |
763 register int i; | |
764 | |
765 /* Vector keymap. Scan all the elements. */ | |
766 for (i = 0; i < DENSE_TABLE_SIZE; i++) | |
767 { | |
768 register Lisp_Object tem; | |
769 register Lisp_Object cmd; | |
770 | |
771 cmd = get_keyelt (XVECTOR (table)->contents[i]); | |
772 if (NULL (cmd)) continue; | |
773 tem = Fkeymapp (cmd); | |
774 if (!NULL (tem)) | |
775 { | |
776 cmd = get_keymap (cmd); | |
777 /* Ignore keymaps that are already added to maps. */ | |
778 tem = Frassq (cmd, maps); | |
779 if (NULL (tem)) | |
780 { | |
781 /* If the last key in thisseq is meta-prefix-char, | |
782 turn it into a meta-ized keystroke. We know | |
783 that the event we're about to append is an | |
784 ascii keystroke. */ | |
785 if (is_metized) | |
786 { | |
787 tem = Fcopy_sequence (thisseq); | |
788 Faset (tem, last, make_number (i | 0200)); | |
789 | |
790 /* This new sequence is the same length as | |
791 thisseq, so stick it in the list right | |
792 after this one. */ | |
793 XCONS (tail)->cdr = | |
794 Fcons (Fcons (tem, cmd), XCONS (tail)->cdr); | |
795 } | |
796 else | |
797 { | |
798 tem = append_key (thisseq, make_number (i)); | |
799 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil)); | |
800 } | |
801 } | |
802 } | |
803 } | |
804 | |
805 /* Once finished with the lookup elements of the dense | |
806 keymap, go on to scan its assoc list. */ | |
807 thismap = XCONS (thismap)->cdr; | |
808 } | |
809 } | |
810 | |
811 /* The rest is an alist. Scan all the alist elements. */ | |
812 while (CONSP (thismap)) | |
813 { | |
814 Lisp_Object elt = XCONS (thismap)->car; | |
815 | |
816 /* Ignore elements that are not conses. */ | |
817 if (CONSP (elt)) | |
818 { | |
819 register Lisp_Object cmd = get_keyelt (XCONS (elt)->cdr); | |
820 register Lisp_Object tem; | |
821 | |
822 /* Ignore definitions that aren't keymaps themselves. */ | |
823 tem = Fkeymapp (cmd); | |
824 if (!NULL (tem)) | |
825 { | |
826 /* Ignore keymaps that have been seen already. */ | |
827 cmd = get_keymap (cmd); | |
828 tem = Frassq (cmd, maps); | |
829 if (NULL (tem)) | |
830 { | |
831 /* let elt be the event defined by this map entry. */ | |
832 elt = XCONS (elt)->car; | |
833 | |
834 /* If the last key in thisseq is meta-prefix-char, and | |
835 this entry is a binding for an ascii keystroke, | |
836 turn it into a meta-ized keystroke. */ | |
837 if (is_metized && XTYPE (elt) == Lisp_Int) | |
838 { | |
839 tem = Fcopy_sequence (thisseq); | |
840 Faset (tem, last, make_number (XINT (elt) | 0200)); | |
841 | |
842 /* This new sequence is the same length as | |
843 thisseq, so stick it in the list right | |
844 after this one. */ | |
845 XCONS (tail)->cdr = | |
846 Fcons (Fcons (tem, cmd), XCONS (tail)->cdr); | |
847 } | |
848 else | |
849 nconc2 (tail, | |
850 Fcons (Fcons (append_key (thisseq, elt), cmd), | |
851 Qnil)); | |
852 } | |
853 } | |
854 } | |
855 | |
856 thismap = XCONS (thismap)->cdr; | |
857 } | |
858 | |
859 tail = Fcdr (tail); | |
860 } | |
861 | |
862 return maps; | |
863 } | |
864 | |
865 Lisp_Object Qsingle_key_description, Qkey_description; | |
866 | |
867 DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0, | |
868 "Return a pretty description of key-sequence KEYS.\n\ | |
869 Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\ | |
870 spaces are put between sequence elements, etc.") | |
871 (keys) | |
872 Lisp_Object keys; | |
873 { | |
874 return Fmapconcat (Qsingle_key_description, keys, build_string (" ")); | |
875 } | |
876 | |
877 char * | |
878 push_key_description (c, p) | |
879 register unsigned int c; | |
880 register char *p; | |
881 { | |
882 if (c >= 0200) | |
883 { | |
884 *p++ = 'M'; | |
885 *p++ = '-'; | |
886 c -= 0200; | |
887 } | |
888 if (c < 040) | |
889 { | |
890 if (c == 033) | |
891 { | |
892 *p++ = 'E'; | |
893 *p++ = 'S'; | |
894 *p++ = 'C'; | |
895 } | |
896 else if (c == Ctl('I')) | |
897 { | |
898 *p++ = 'T'; | |
899 *p++ = 'A'; | |
900 *p++ = 'B'; | |
901 } | |
902 else if (c == Ctl('J')) | |
903 { | |
904 *p++ = 'L'; | |
905 *p++ = 'F'; | |
906 *p++ = 'D'; | |
907 } | |
908 else if (c == Ctl('M')) | |
909 { | |
910 *p++ = 'R'; | |
911 *p++ = 'E'; | |
912 *p++ = 'T'; | |
913 } | |
914 else | |
915 { | |
916 *p++ = 'C'; | |
917 *p++ = '-'; | |
918 if (c > 0 && c <= Ctl ('Z')) | |
919 *p++ = c + 0140; | |
920 else | |
921 *p++ = c + 0100; | |
922 } | |
923 } | |
924 else if (c == 0177) | |
925 { | |
926 *p++ = 'D'; | |
927 *p++ = 'E'; | |
928 *p++ = 'L'; | |
929 } | |
930 else if (c == ' ') | |
931 { | |
932 *p++ = 'S'; | |
933 *p++ = 'P'; | |
934 *p++ = 'C'; | |
935 } | |
936 else | |
937 *p++ = c; | |
938 | |
939 return p; | |
940 } | |
941 | |
942 DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0, | |
943 "Return a pretty description of command character KEY.\n\ | |
944 Control characters turn into C-whatever, etc.") | |
945 (key) | |
946 Lisp_Object key; | |
947 { | |
948 register unsigned char c; | |
949 char tem[6]; | |
950 | |
951 switch (XTYPE (key)) | |
952 { | |
953 case Lisp_Int: /* Normal character */ | |
954 c = XINT (key) & 0377; | |
955 *push_key_description (c, tem) = 0; | |
956 return build_string (tem); | |
957 | |
958 case Lisp_Symbol: /* Function key or event-symbol */ | |
959 return Fsymbol_name (key); | |
960 | |
961 case Lisp_Cons: /* Mouse event */ | |
962 key = XCONS (key)->cdr; | |
963 if (XTYPE (key) == Lisp_Symbol) | |
964 return Fsymbol_name (key); | |
965 /* Mouse events should have an identifying symbol as their car; | |
966 fall through when this isn't the case. */ | |
967 | |
968 default: | |
969 error ("KEY must be an integer, cons, or symbol."); | |
970 } | |
971 } | |
972 | |
973 char * | |
974 push_text_char_description (c, p) | |
975 register unsigned int c; | |
976 register char *p; | |
977 { | |
978 if (c >= 0200) | |
979 { | |
980 *p++ = 'M'; | |
981 *p++ = '-'; | |
982 c -= 0200; | |
983 } | |
984 if (c < 040) | |
985 { | |
986 *p++ = '^'; | |
987 *p++ = c + 64; /* 'A' - 1 */ | |
988 } | |
989 else if (c == 0177) | |
990 { | |
991 *p++ = '^'; | |
992 *p++ = '?'; | |
993 } | |
994 else | |
995 *p++ = c; | |
996 return p; | |
997 } | |
998 | |
999 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0, | |
1000 "Return a pretty description of file-character CHAR.\n\ | |
1001 Control characters turn into \"^char\", etc.") | |
1002 (chr) | |
1003 Lisp_Object chr; | |
1004 { | |
1005 char tem[6]; | |
1006 | |
1007 CHECK_NUMBER (chr, 0); | |
1008 | |
1009 *push_text_char_description (XINT (chr) & 0377, tem) = 0; | |
1010 | |
1011 return build_string (tem); | |
1012 } | |
1013 | |
1014 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0, | |
1015 "Return list of keys that invoke DEFINITION in KEYMAP or KEYMAP1.\n\ | |
1016 If KEYMAP is nil, search only KEYMAP1.\n\ | |
1017 If KEYMAP1 is nil, use the current global map.\n\ | |
1018 \n\ | |
1019 If optional 4th arg FIRSTONLY is non-nil,\n\ | |
1020 return a string representing the first key sequence found,\n\ | |
1021 rather than a list of all possible key sequences.\n\ | |
1022 \n\ | |
1023 If optional 5th arg NOINDIRECT is non-nil, don't follow indirections\n\ | |
1024 to other keymaps or slots. This makes it possible to search for an\n\ | |
1025 indirect definition itself.") | |
1026 (definition, local_keymap, global_keymap, firstonly, noindirect) | |
1027 Lisp_Object definition, local_keymap, global_keymap; | |
1028 Lisp_Object firstonly, noindirect; | |
1029 { | |
1030 register Lisp_Object maps; | |
1031 Lisp_Object found; | |
1032 | |
1033 if (NULL (global_keymap)) | |
1034 global_keymap = current_global_map; | |
1035 | |
1036 if (!NULL (local_keymap)) | |
1037 maps = nconc2 (Faccessible_keymaps (get_keymap (local_keymap)), | |
1038 Faccessible_keymaps (get_keymap (global_keymap))); | |
1039 else | |
1040 maps = Faccessible_keymaps (get_keymap (global_keymap)); | |
1041 | |
1042 found = Qnil; | |
1043 | |
1044 for (; !NULL (maps); maps = Fcdr (maps)) | |
1045 { | |
1046 register this = Fcar (Fcar (maps)); /* Key sequence to reach map */ | |
1047 register map = Fcdr (Fcar (maps)); /* The map that it reaches */ | |
1048 register dense_alist; | |
1049 register int i = 0; | |
1050 | |
1051 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into | |
1052 [M-CHAR] sequences, check if last character of the sequence | |
1053 is the meta-prefix char. */ | |
1054 Lisp_Object last = make_number (XINT (Flength (this)) - 1); | |
1055 int last_is_meta = (XINT (last) >= 0 | |
1056 && EQ (Faref (this, last), meta_prefix_char)); | |
1057 | |
1058 /* Skip the 'keymap element of the list. */ | |
1059 map = Fcdr (map); | |
1060 | |
1061 /* If the keymap is sparse, map traverses the alist to the end. | |
1062 | |
1063 If the keymap is dense, we set map to the vector and | |
1064 dense_alist to the assoc-list portion of the keymap. When we | |
1065 are finished dealing with the vector portion, we set map to | |
1066 dense_alist, and handle the rest like a sparse keymap. */ | |
1067 if (XTYPE (XCONS (map)->car) == Lisp_Vector) | |
1068 { | |
1069 dense_alist = XCONS (map)->cdr; | |
1070 map = XCONS (map)->car; | |
1071 } | |
1072 | |
1073 while (1) | |
1074 { | |
1075 register Lisp_Object key, binding, sequence; | |
1076 | |
1077 QUIT; | |
1078 if (XTYPE (map) == Lisp_Vector) | |
1079 { | |
1080 /* In a vector, look at each element. */ | |
1081 binding = XVECTOR (map)->contents[i]; | |
1082 XFASTINT (key) = i; | |
1083 i++; | |
1084 | |
1085 /* If we've just finished scanning a vector, switch map to | |
1086 the assoc-list at the end of the vector. */ | |
1087 if (i >= DENSE_TABLE_SIZE) | |
1088 map = dense_alist; | |
1089 } | |
1090 else if (CONSP (map)) | |
1091 { | |
1092 /* In an alist, ignore elements that aren't conses. */ | |
1093 if (! CONSP (XCONS (map)->car)) | |
1094 { | |
1095 /* Ignore other elements. */ | |
1096 map = Fcdr (map); | |
1097 continue; | |
1098 } | |
1099 binding = Fcdr (Fcar (map)); | |
1100 key = Fcar (Fcar (map)); | |
1101 map = Fcdr (map); | |
1102 } | |
1103 else | |
1104 break; | |
1105 | |
1106 /* Search through indirections unless that's not wanted. */ | |
1107 if (NULL (noindirect)) | |
1108 binding = get_keyelt (binding); | |
1109 | |
1110 /* End this iteration if this element does not match | |
1111 the target. */ | |
1112 | |
1113 if (XTYPE (definition) == Lisp_Cons) | |
1114 { | |
1115 Lisp_Object tem; | |
1116 tem = Fequal (binding, definition); | |
1117 if (NULL (tem)) | |
1118 continue; | |
1119 } | |
1120 else | |
1121 if (!EQ (binding, definition)) | |
1122 continue; | |
1123 | |
1124 /* We have found a match. | |
1125 Construct the key sequence where we found it. */ | |
1126 if (XTYPE (key) == Lisp_Int && last_is_meta) | |
1127 { | |
1128 sequence = Fcopy_sequence (this); | |
1129 Faset (sequence, last, make_number (XINT (key) | 0200)); | |
1130 } | |
1131 else | |
1132 sequence = append_key (this, key); | |
1133 | |
1134 /* Verify that this key binding is not shadowed by another | |
1135 binding for the same key, before we say it exists. | |
1136 | |
1137 Mechanism: look for local definition of this key and if | |
1138 it is defined and does not match what we found then | |
1139 ignore this key. | |
1140 | |
1141 Either nil or number as value from Flookup_key | |
1142 means undefined. */ | |
1143 if (!NULL (local_keymap)) | |
1144 { | |
1145 binding = Flookup_key (local_keymap, sequence); | |
1146 if (!NULL (binding) && XTYPE (binding) != Lisp_Int) | |
1147 { | |
1148 if (XTYPE (definition) == Lisp_Cons) | |
1149 { | |
1150 Lisp_Object tem; | |
1151 tem = Fequal (binding, definition); | |
1152 if (NULL (tem)) | |
1153 continue; | |
1154 } | |
1155 else | |
1156 if (!EQ (binding, definition)) | |
1157 continue; | |
1158 } | |
1159 } | |
1160 | |
1161 /* It is a true unshadowed match. Record it. */ | |
1162 | |
1163 if (!NULL (firstonly)) | |
1164 return sequence; | |
1165 found = Fcons (sequence, found); | |
1166 } | |
1167 } | |
1168 return Fnreverse (found); | |
1169 } | |
1170 | |
1171 /* Return a string listing the keys and buttons that run DEFINITION. */ | |
1172 | |
1173 static Lisp_Object | |
1174 where_is_string (definition) | |
1175 Lisp_Object definition; | |
1176 { | |
1177 register Lisp_Object keys, keys1; | |
1178 | |
1179 keys = Fwhere_is_internal (definition, | |
1180 current_buffer->keymap, Qnil, Qnil, Qnil); | |
1181 keys1 = Fmapconcat (Qkey_description, keys, build_string (", ")); | |
1182 | |
1183 return keys1; | |
1184 } | |
1185 | |
1186 DEFUN ("where-is", Fwhere_is, Swhere_is, 1, 1, "CWhere is command: ", | |
1187 "Print message listing key sequences that invoke specified command.\n\ | |
1188 Argument is a command definition, usually a symbol with a function definition.") | |
1189 (definition) | |
1190 Lisp_Object definition; | |
1191 { | |
1192 register Lisp_Object string; | |
1193 | |
1194 CHECK_SYMBOL (definition, 0); | |
1195 string = where_is_string (definition); | |
1196 | |
1197 if (XSTRING (string)->size) | |
1198 message ("%s is on %s", XSYMBOL (definition)->name->data, | |
1199 XSTRING (string)->data); | |
1200 else | |
1201 message ("%s is not on any key", XSYMBOL (definition)->name->data); | |
1202 return Qnil; | |
1203 } | |
1204 | |
1205 DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 0, "", | |
1206 "Show a list of all defined keys, and their definitions.\n\ | |
1207 The list is put in a buffer, which is displayed.") | |
1208 () | |
1209 { | |
1210 register Lisp_Object thisbuf; | |
1211 XSET (thisbuf, Lisp_Buffer, current_buffer); | |
1212 internal_with_output_to_temp_buffer ("*Help*", | |
1213 describe_buffer_bindings, | |
1214 thisbuf); | |
1215 return Qnil; | |
1216 } | |
1217 | |
1218 static Lisp_Object | |
1219 describe_buffer_bindings (descbuf) | |
1220 Lisp_Object descbuf; | |
1221 { | |
1222 register Lisp_Object start1, start2; | |
1223 | |
1224 char *heading | |
1225 = "key binding\n--- -------\n"; | |
1226 | |
1227 Fset_buffer (Vstandard_output); | |
1228 | |
1229 start1 = XBUFFER (descbuf)->keymap; | |
1230 if (!NULL (start1)) | |
1231 { | |
1232 insert_string ("Local Bindings:\n"); | |
1233 insert_string (heading); | |
1234 describe_map_tree (start1, 0, Qnil, Qnil); | |
1235 insert_string ("\n"); | |
1236 } | |
1237 | |
1238 insert_string ("Global Bindings:\n"); | |
1239 insert_string (heading); | |
1240 | |
1241 describe_map_tree (current_global_map, 0, XBUFFER (descbuf)->keymap, Qnil); | |
1242 | |
1243 Fset_buffer (descbuf); | |
1244 return Qnil; | |
1245 } | |
1246 | |
1247 /* Insert a desription of the key bindings in STARTMAP, | |
1248 followed by those of all maps reachable through STARTMAP. | |
1249 If PARTIAL is nonzero, omit certain "uninteresting" commands | |
1250 (such as `undefined'). | |
1251 If SHADOW is non-nil, it is another map; | |
1252 don't mention keys which would be shadowed by it. */ | |
1253 | |
1254 void | |
1255 describe_map_tree (startmap, partial, shadow) | |
1256 Lisp_Object startmap, shadow; | |
1257 int partial; | |
1258 { | |
1259 register Lisp_Object elt, sh; | |
1260 Lisp_Object maps; | |
1261 struct gcpro gcpro1; | |
1262 | |
1263 maps = Faccessible_keymaps (startmap); | |
1264 GCPRO1 (maps); | |
1265 | |
1266 for (; !NULL (maps); maps = Fcdr (maps)) | |
1267 { | |
1268 elt = Fcar (maps); | |
1269 sh = Fcar (elt); | |
1270 | |
1271 /* If there is no shadow keymap given, don't shadow. */ | |
1272 if (NULL (shadow)) | |
1273 sh = Qnil; | |
1274 | |
1275 /* If the sequence by which we reach this keymap is zero-length, | |
1276 then the shadow map for this keymap is just SHADOW. */ | |
1277 else if ((XTYPE (sh) == Lisp_String | |
1278 && XSTRING (sh)->size == 0) | |
1279 || (XTYPE (sh) == Lisp_Vector | |
1280 && XVECTOR (sh)->size == 0)) | |
1281 sh = shadow; | |
1282 | |
1283 /* If the sequence by which we reach this keymap actually has | |
1284 some elements, then the sequence's definition in SHADOW is | |
1285 what we should use. */ | |
1286 else | |
1287 { | |
1288 sh = Flookup_key (shadow, Fcar (elt)); | |
1289 if (XTYPE (sh) == Lisp_Int) | |
1290 sh = Qnil; | |
1291 } | |
1292 | |
1293 /* If sh is null (meaning that the current map is not shadowed), | |
1294 or a keymap (meaning that bindings from the current map might | |
1295 show through), describe the map. Otherwise, sh is a command | |
1296 that completely shadows the current map, and we shouldn't | |
1297 bother. */ | |
1298 if (NULL (sh) || !NULL (Fkeymapp (sh))) | |
1299 describe_map (Fcdr (elt), Fcar (elt), partial, sh); | |
1300 } | |
1301 | |
1302 UNGCPRO; | |
1303 } | |
1304 | |
1305 static void | |
1306 describe_command (definition) | |
1307 Lisp_Object definition; | |
1308 { | |
1309 register Lisp_Object tem1; | |
1310 | |
1311 Findent_to (make_number (16), make_number (1)); | |
1312 | |
1313 if (XTYPE (definition) == Lisp_Symbol) | |
1314 { | |
1315 XSET (tem1, Lisp_String, XSYMBOL (definition)->name); | |
1316 insert1 (tem1); | |
1317 insert_string ("\n"); | |
1318 } | |
1319 else | |
1320 { | |
1321 tem1 = Fkeymapp (definition); | |
1322 if (!NULL (tem1)) | |
1323 insert_string ("Prefix Command\n"); | |
1324 else | |
1325 insert_string ("??\n"); | |
1326 } | |
1327 } | |
1328 | |
1329 /* Describe the contents of map MAP, assuming that this map itself is | |
1330 reached by the sequence of prefix keys KEYS (a string or vector). | |
1331 PARTIAL, SHADOW is as in `describe_map_tree' above. */ | |
1332 | |
1333 static void | |
1334 describe_map (map, keys, partial, shadow) | |
1335 Lisp_Object map, keys; | |
1336 int partial; | |
1337 Lisp_Object shadow; | |
1338 { | |
1339 register Lisp_Object keysdesc; | |
1340 | |
1341 if (!NULL (keys) && Flength (keys) > 0) | |
1342 keysdesc = concat2 (Fkey_description (keys), | |
1343 build_string (" ")); | |
1344 else | |
1345 keysdesc = Qnil; | |
1346 | |
1347 /* Skip the 'keymap element of the list. */ | |
1348 map = Fcdr (map); | |
1349 | |
1350 /* If this is a dense keymap, take care of the table. */ | |
1351 if (CONSP (map) | |
1352 && XTYPE (XCONS (map)->car) == Lisp_Vector) | |
1353 { | |
1354 describe_vector (XCONS (map)->car, keysdesc, describe_command, | |
1355 partial, shadow); | |
1356 map = XCONS (map)->cdr; | |
1357 } | |
1358 | |
1359 /* Now map is an alist. */ | |
1360 describe_alist (map, keysdesc, describe_command, partial, shadow); | |
1361 } | |
1362 | |
1363 /* Insert a description of ALIST into the current buffer. | |
1364 Note that ALIST is just a plain association list, not a keymap. */ | |
1365 | |
1366 static void | |
1367 describe_alist (alist, elt_prefix, elt_describer, partial, shadow) | |
1368 register Lisp_Object alist; | |
1369 Lisp_Object elt_prefix; | |
1370 int (*elt_describer) (); | |
1371 int partial; | |
1372 Lisp_Object shadow; | |
1373 { | |
1374 Lisp_Object this; | |
1375 Lisp_Object tem1, tem2 = Qnil; | |
1376 Lisp_Object suppress; | |
1377 Lisp_Object kludge; | |
1378 int first = 1; | |
1379 struct gcpro gcpro1, gcpro2, gcpro3; | |
1380 | |
1381 if (partial) | |
1382 suppress = intern ("suppress-keymap"); | |
1383 | |
1384 /* This vector gets used to present single keys to Flookup_key. Since | |
1385 that is done once per alist element, we don't want to cons up a | |
1386 fresh vector every time. */ | |
1387 kludge = Fmake_vector (make_number (1), Qnil); | |
1388 | |
1389 GCPRO3 (elt_prefix, tem2, kludge); | |
1390 | |
1391 for (; CONSP (alist); alist = Fcdr (alist)) | |
1392 { | |
1393 QUIT; | |
1394 tem1 = Fcar_safe (Fcar (alist)); | |
1395 tem2 = get_keyelt (Fcdr_safe (Fcar (alist))); | |
1396 | |
1397 /* Don't show undefined commands or suppressed commands. */ | |
1398 if (NULL (tem2)) continue; | |
1399 if (XTYPE (tem2) == Lisp_Symbol && partial) | |
1400 { | |
1401 this = Fget (tem2, suppress); | |
1402 if (!NULL (this)) | |
1403 continue; | |
1404 } | |
1405 | |
1406 /* Don't show a command that isn't really visible | |
1407 because a local definition of the same key shadows it. */ | |
1408 | |
1409 if (!NULL (shadow)) | |
1410 { | |
1411 Lisp_Object tem; | |
1412 | |
1413 XVECTOR (kludge)->contents[0] = tem1; | |
1414 tem = Flookup_key (shadow, kludge); | |
1415 if (!NULL (tem)) continue; | |
1416 } | |
1417 | |
1418 if (first) | |
1419 { | |
1420 insert ("\n", 1); | |
1421 first = 0; | |
1422 } | |
1423 | |
1424 if (!NULL (elt_prefix)) | |
1425 insert1 (elt_prefix); | |
1426 | |
1427 /* THIS gets the string to describe the character TEM1. */ | |
1428 this = Fsingle_key_description (tem1); | |
1429 insert1 (this); | |
1430 | |
1431 /* Print a description of the definition of this character. | |
1432 elt_describer will take care of spacing out far enough | |
1433 for alignment purposes. */ | |
1434 (*elt_describer) (tem2); | |
1435 } | |
1436 | |
1437 UNGCPRO; | |
1438 } | |
1439 | |
1440 static int | |
1441 describe_vector_princ (elt) | |
1442 Lisp_Object elt; | |
1443 { | |
1444 Fprinc (elt, Qnil); | |
1445 } | |
1446 | |
1447 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0, | |
1448 "Print on `standard-output' a description of contents of VECTOR.\n\ | |
1449 This is text showing the elements of vector matched against indices.") | |
1450 (vector) | |
1451 Lisp_Object vector; | |
1452 { | |
1453 CHECK_VECTOR (vector, 0); | |
1454 describe_vector (vector, Qnil, describe_vector_princ, 0, Qnil, Qnil); | |
1455 } | |
1456 | |
1457 describe_vector (vector, elt_prefix, elt_describer, partial, shadow) | |
1458 register Lisp_Object vector; | |
1459 Lisp_Object elt_prefix; | |
1460 int (*elt_describer) (); | |
1461 int partial; | |
1462 Lisp_Object shadow; | |
1463 { | |
1464 Lisp_Object this; | |
1465 Lisp_Object dummy; | |
1466 Lisp_Object tem1, tem2; | |
1467 register int i; | |
1468 Lisp_Object suppress; | |
1469 Lisp_Object kludge; | |
1470 int first = 1; | |
1471 struct gcpro gcpro1, gcpro2, gcpro3; | |
1472 | |
1473 tem1 = Qnil; | |
1474 | |
1475 /* This vector gets used to present single keys to Flookup_key. Since | |
1476 that is done once per vector element, we don't want to cons up a | |
1477 fresh vector every time. */ | |
1478 kludge = Fmake_vector (make_number (1), Qnil); | |
1479 GCPRO3 (elt_prefix, tem1, kludge); | |
1480 | |
1481 if (partial) | |
1482 suppress = intern ("suppress-keymap"); | |
1483 | |
1484 for (i = 0; i < DENSE_TABLE_SIZE; i++) | |
1485 { | |
1486 QUIT; | |
1487 tem1 = get_keyelt (XVECTOR (vector)->contents[i]); | |
1488 | |
1489 if (NULL (tem1)) continue; | |
1490 | |
1491 /* Don't mention suppressed commands. */ | |
1492 if (XTYPE (tem1) == Lisp_Symbol && partial) | |
1493 { | |
1494 this = Fget (tem1, suppress); | |
1495 if (!NULL (this)) | |
1496 continue; | |
1497 } | |
1498 | |
1499 /* If this command in this map is shadowed by some other map, | |
1500 ignore it. */ | |
1501 if (!NULL (shadow)) | |
1502 { | |
1503 Lisp_Object tem; | |
1504 | |
1505 XVECTOR (kludge)->contents[0] = make_number (i); | |
1506 tem = Flookup_key (shadow, kludge); | |
1507 | |
1508 if (!NULL (tem)) continue; | |
1509 } | |
1510 | |
1511 if (first) | |
1512 { | |
1513 insert ("\n", 1); | |
1514 first = 0; | |
1515 } | |
1516 | |
1517 /* Output the prefix that applies to every entry in this map. */ | |
1518 if (!NULL (elt_prefix)) | |
1519 insert1 (elt_prefix); | |
1520 | |
1521 /* Get the string to describe the character I, and print it. */ | |
1522 XFASTINT (dummy) = i; | |
1523 | |
1524 /* THIS gets the string to describe the character DUMMY. */ | |
1525 this = Fsingle_key_description (dummy); | |
1526 insert1 (this); | |
1527 | |
1528 /* Find all consecutive characters that have the same definition. */ | |
1529 while (i + 1 < DENSE_TABLE_SIZE | |
1530 && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1]), | |
1531 EQ (tem2, tem1))) | |
1532 i++; | |
1533 | |
1534 /* If we have a range of more than one character, | |
1535 print where the range reaches to. */ | |
1536 | |
1537 if (i != XINT (dummy)) | |
1538 { | |
1539 insert (" .. ", 4); | |
1540 if (!NULL (elt_prefix)) | |
1541 insert1 (elt_prefix); | |
1542 | |
1543 XFASTINT (dummy) = i; | |
1544 insert1 (Fsingle_key_description (dummy)); | |
1545 } | |
1546 | |
1547 /* Print a description of the definition of this character. | |
1548 elt_describer will take care of spacing out far enough | |
1549 for alignment purposes. */ | |
1550 (*elt_describer) (tem1); | |
1551 } | |
1552 | |
1553 UNGCPRO; | |
1554 } | |
1555 | |
1556 /* Apropos */ | |
1557 Lisp_Object apropos_predicate; | |
1558 Lisp_Object apropos_accumulate; | |
1559 | |
1560 static void | |
1561 apropos_accum (symbol, string) | |
1562 Lisp_Object symbol, string; | |
1563 { | |
1564 register Lisp_Object tem; | |
1565 | |
1566 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil); | |
1567 if (!NULL (tem) && !NULL (apropos_predicate)) | |
1568 tem = call1 (apropos_predicate, symbol); | |
1569 if (!NULL (tem)) | |
1570 apropos_accumulate = Fcons (symbol, apropos_accumulate); | |
1571 } | |
1572 | |
1573 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0, | |
1574 "Show all symbols whose names contain match for REGEXP.\n\ | |
1575 If optional 2nd arg PRED is non-nil, (funcall PRED SYM) is done\n\ | |
1576 for each symbol and a symbol is mentioned only if that returns non-nil.\n\ | |
1577 Return list of symbols found.") | |
1578 (string, pred) | |
1579 Lisp_Object string, pred; | |
1580 { | |
1581 struct gcpro gcpro1, gcpro2; | |
1582 CHECK_STRING (string, 0); | |
1583 apropos_predicate = pred; | |
1584 GCPRO2 (apropos_predicate, apropos_accumulate); | |
1585 apropos_accumulate = Qnil; | |
1586 map_obarray (Vobarray, apropos_accum, string); | |
1587 apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp); | |
1588 UNGCPRO; | |
1589 return apropos_accumulate; | |
1590 } | |
1591 | |
1592 syms_of_keymap () | |
1593 { | |
1594 Lisp_Object tem; | |
1595 | |
1596 Qkeymap = intern ("keymap"); | |
1597 staticpro (&Qkeymap); | |
1598 | |
1599 /* Initialize the keymaps standardly used. | |
1600 Each one is the value of a Lisp variable, and is also | |
1601 pointed to by a C variable */ | |
1602 | |
1603 global_map = Fmake_keymap (); | |
1604 Fset (intern ("global-map"), global_map); | |
1605 | |
1606 meta_map = Fmake_keymap (); | |
1607 Fset (intern ("esc-map"), meta_map); | |
1608 Ffset (intern ("ESC-prefix"), meta_map); | |
1609 | |
1610 control_x_map = Fmake_keymap (); | |
1611 Fset (intern ("ctl-x-map"), control_x_map); | |
1612 Ffset (intern ("Control-X-prefix"), control_x_map); | |
1613 | |
1614 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map, | |
1615 "Default keymap to use when reading from the minibuffer."); | |
1616 Vminibuffer_local_map = Fmake_sparse_keymap (); | |
1617 | |
1618 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map, | |
1619 "Local keymap for the minibuffer when spaces are not allowed."); | |
1620 Vminibuffer_local_ns_map = Fmake_sparse_keymap (); | |
1621 | |
1622 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map, | |
1623 "Local keymap for minibuffer input with completion."); | |
1624 Vminibuffer_local_completion_map = Fmake_sparse_keymap (); | |
1625 | |
1626 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map, | |
1627 "Local keymap for minibuffer input with completion, for exact match."); | |
1628 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (); | |
1629 | |
1630 current_global_map = global_map; | |
1631 | |
1632 Qsingle_key_description = intern ("single-key-description"); | |
1633 staticpro (&Qsingle_key_description); | |
1634 | |
1635 Qkey_description = intern ("key-description"); | |
1636 staticpro (&Qkey_description); | |
1637 | |
1638 Qkeymapp = intern ("keymapp"); | |
1639 staticpro (&Qkeymapp); | |
1640 | |
1641 defsubr (&Skeymapp); | |
1642 defsubr (&Smake_keymap); | |
1643 defsubr (&Smake_sparse_keymap); | |
1644 defsubr (&Scopy_keymap); | |
1645 defsubr (&Skey_binding); | |
1646 defsubr (&Slocal_key_binding); | |
1647 defsubr (&Sglobal_key_binding); | |
1648 defsubr (&Sglobal_set_key); | |
1649 defsubr (&Slocal_set_key); | |
1650 defsubr (&Sdefine_key); | |
1651 defsubr (&Slookup_key); | |
1652 defsubr (&Sglobal_unset_key); | |
1653 defsubr (&Slocal_unset_key); | |
1654 defsubr (&Sdefine_prefix_command); | |
1655 defsubr (&Suse_global_map); | |
1656 defsubr (&Suse_local_map); | |
1657 defsubr (&Scurrent_local_map); | |
1658 defsubr (&Scurrent_global_map); | |
1659 defsubr (&Saccessible_keymaps); | |
1660 defsubr (&Skey_description); | |
1661 defsubr (&Sdescribe_vector); | |
1662 defsubr (&Ssingle_key_description); | |
1663 defsubr (&Stext_char_description); | |
1664 defsubr (&Swhere_is_internal); | |
1665 defsubr (&Swhere_is); | |
1666 defsubr (&Sdescribe_bindings); | |
1667 defsubr (&Sapropos_internal); | |
1668 } | |
1669 | |
1670 keys_of_keymap () | |
1671 { | |
1672 Lisp_Object tem; | |
1673 | |
1674 initial_define_key (global_map, 033, "ESC-prefix"); | |
1675 initial_define_key (global_map, Ctl('X'), "Control-X-prefix"); | |
1676 } |