![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to keymap.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / src|
Return to keymap.c CVS log | Up to [Apple XNU] / GNUtools / emacs / src |
1.1 root 1: /* Manipulation of keymaps
2: Copyright (C) 1985, 1986, 1987, 1988, 1990 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: /* Actually allocate storage for these variables */
31:
32: #ifdef HAVE_X_WINDOWS
33: Lisp_Object MouseMap; /* Keymap for mouse commands */
34: #endif /* HAVE_X_WINDOWS */
35:
36: Lisp_Object global_map;
37:
38: Lisp_Object Vglobal_map;
39:
40: Lisp_Object Vesc_map;
41:
42: Lisp_Object Vctl_x_map;
43:
44: /* Keymap used for minibuffers with self-inserting space. */
45: Lisp_Object Vminibuffer_local_map;
46:
47: /* Keymap used for minibuffers when space does not self insert. */
48: Lisp_Object Vminibuffer_local_ns_map;
49:
50: /* Keymap used for minibuffers when doing completion */
51: Lisp_Object Vminibuffer_local_completion_map;
52:
53: /* Keymap used for minibuffers when doing completion and require a match */
54: Lisp_Object Vminibuffer_local_must_match_map;
55:
56: Lisp_Object Qkeymapp, Qkeymap;
57:
58: /* A char over 0200 in a key sequence
59: is equivalent to prefixing with this character. */
60:
61: extern int meta_prefix_char;
62:
63: static void insert_first_line ();
64:
65: DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 0, 0,
66: "Construct and return a new keymap, a vector of length 128.\n\
67: All entries in it are nil, meaning \"command undefined\".")
68: ()
69: {
70: register Lisp_Object val;
71: XFASTINT (val) = 0200;
72: return Fmake_vector (val, Qnil);
73: }
74:
75: DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 0, 0,
76: "Construct and return a new sparse-keymap list.\n\
77: Its car is 'keymap and its cdr is an alist of (CHAR . DEFINITION).\n\
78: Initially the alist is nil.")
79: ()
80: {
81: return Fcons (Qkeymap, Qnil);
82: }
83:
84: /* Install a standard key binding at initialization time.
85: For example,
86: ndefkey (Vctl_x_map, Ctl ('X'), "exchange-point-and-mark"); */
87:
88: void
89: ndefkey (keymap, key, defname)
90: Lisp_Object keymap;
91: int key;
92: char *defname;
93: {
94: store_in_keymap (keymap, key, intern (defname));
95: }
96:
97: /* Define character fromchar in map frommap as an alias for character tochar in map tomap.
98: Subsequent redefinitions of the latter WILL affect the former. */
99:
100: #ifdef NOTDEF
101: void
102: synkey (frommap, fromchar, tomap, tochar)
103: struct Lisp_Vector *frommap, *tomap;
104: int fromchar, tochar;
105: {
106: Lisp_Object v, c;
107: XSET (v, Lisp_Vector, tomap);
108: XFASTINT (c) = tochar;
109: frommap->contents[fromchar] = Fcons (v, c);
110: }
111: #endif /* NOTDEF */
112:
113: DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
114: "Return t if ARG is a keymap.\n\
115: A keymap is a vector of length 128, or a list (keymap . ALIST),\n\
116: where alist elements look like (CHAR . DEFN).\n\
117: A symbol whose function definition is a keymap is itself a keymap.")
118: (object)
119: Lisp_Object object;
120: {
121: register Lisp_Object tem;
122: tem = object;
123: while (XTYPE (tem) == Lisp_Symbol)
124: {
125: tem = XSYMBOL (tem)->function;
126: if (EQ (tem, Qunbound))
127: return Qnil;
128: QUIT;
129: }
130:
131: if ((XTYPE (tem) == Lisp_Vector && XVECTOR (tem)->size == 0200)
132: || (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap)))
133: return Qt;
134: return Qnil;
135: }
136:
137: Lisp_Object
138: get_keymap_1 (object, error)
139: Lisp_Object object;
140: int error;
141: {
142: register Lisp_Object tem;
143:
144: while (1)
145: {
146: tem = object;
147: while (XTYPE (tem) == Lisp_Symbol && !EQ (tem, Qunbound))
148: {
149: tem = XSYMBOL (tem)->function;
150: QUIT;
151: }
152: if ((XTYPE (tem) == Lisp_Vector && XVECTOR (tem)->size == 0200)
153: || (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap)))
154: return tem;
155: if (error)
156: object = wrong_type_argument (Qkeymapp, object);
157: else return Qnil;
158: }
159: }
160:
161: Lisp_Object
162: get_keymap (object)
163: Lisp_Object object;
164: {
165: return get_keymap_1 (object, 1);
166: }
167:
168: Lisp_Object
169: get_keyelt (object)
170: register Lisp_Object object;
171: {
172: register Lisp_Object map, tem;
173:
174: while (map = get_keymap_1 (Fcar_safe (object), 0),
175: tem = Fkeymapp (map),
176: !NULL (tem))
177: /*(XTYPE (object) == Lisp_Cons && !EQ (XCONS (object)->car, Qkeymap))*/
178: {
179: object = Fcdr (object);
180: if (CONSP (map))
181: object = Fcdr (Fassq (object, Fcdr (map)));
182: else
183: object = Faref (map, object);
184: }
185: return object;
186: }
187:
188: Lisp_Object
189: access_keymap (map, idx)
190: Lisp_Object map;
191: register int idx;
192: {
193: register Lisp_Object val;
194: if (idx < 0 || idx >= 0200)
195: error ("Command key out of range 0-127");
196:
197: /* Get definition for character `idx' proper. */
198: if (CONSP (map))
199: val = Fcdr (Fassq (make_number (idx), Fcdr (map)));
200: else
201: val = XVECTOR (map)->contents[idx];
202:
203: return val;
204: }
205:
206: Lisp_Object
207: store_in_keymap (keymap, idx, def)
208: Lisp_Object keymap;
209: register int idx;
210: register Lisp_Object def;
211: {
212: register Lisp_Object tem;
213:
214: if (idx < 0 || idx >= 0200)
215: error ("Command key out of range 0-127");
216:
217: if (CONSP (keymap))
218: {
219: tem = Fassq (make_number (idx), Fcdr (keymap));
220: if (!NULL (tem))
221: Fsetcdr (tem, def);
222: else
223: Fsetcdr (keymap, Fcons (Fcons (make_number (idx), def),
224: Fcdr (keymap)));
225: }
226: else
227: XVECTOR (keymap)->contents[idx] = def;
228:
229: return def;
230: }
231:
232: DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
233: "Return a copy of the keymap KEYMAP.\n\
234: The copy starts out with the same definitions of KEYMAP,\n\
235: but changing either the copy or KEYMAP does not affect the other.\n\
236: Any key definitions that are subkeymaps are recursively copied.\n\
237: However, a key definition which is a symbol whose definition is a keymap\n\
238: is not copied.")
239: (keymap)
240: Lisp_Object keymap;
241: {
242: register Lisp_Object copy, tem;
243:
244: keymap = get_keymap (keymap);
245: if (XTYPE (keymap) == Lisp_Vector)
246: {
247: register int i;
248: copy = Fcopy_sequence (keymap);
249: for (i = 0; i < XVECTOR (copy)->size; i++)
250: if (XTYPE (XVECTOR (copy)->contents[i]) != Lisp_Symbol)
251: if (tem = Fkeymapp (XVECTOR (copy)->contents[i]), !NULL (tem))
252: XVECTOR (copy)->contents[i]
253: = Fcopy_keymap (XVECTOR (copy)->contents[i]);
254: }
255: else
256: {
257: register Lisp_Object tail;
258: copy = Fcopy_alist (keymap);
259: for (tail = copy; CONSP (tail); tail = XCONS (tail)->cdr)
260: {
261: register Lisp_Object elt;
262: elt = XCONS (tail)->car;
263: if (CONSP (elt)
264: && XTYPE (XCONS (elt)->cdr) != Lisp_Symbol
265: && (tem = Fkeymapp (XCONS (elt)->cdr), !NULL (tem)))
266: XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr);
267: }
268: }
269: return copy;
270: }
271:
272: DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
273: "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\
274: KEYMAP is a keymap. KEY is a string meaning a sequence of keystrokes.\n\
275: DEF is anything that can be a key's definition:\n\
276: nil (means key is undefined in this keymap),\n\
277: a command (a Lisp function suitable for interactive calling)\n\
278: a string (treated as a keyboard macro),\n\
279: a keymap (to define a prefix key),\n\
280: a list (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP,\n\
281: or a symbol. The symbol's function definition is used as the key's\n\
282: definition, and may be any of the above (including another symbol).")
283: (keymap, key, def)
284: register Lisp_Object keymap;
285: Lisp_Object key;
286: Lisp_Object def;
287: {
288: register int idx;
289: register int c;
290: register Lisp_Object tem;
291: register Lisp_Object cmd;
292: int metized = 0;
293:
294: keymap = get_keymap (keymap);
295:
296: CHECK_STRING (key, 1);
297: if (XSTRING (key)->size == 0)
298: return Qnil;
299:
300: idx = 0;
301: while (1)
302: {
303: c = XSTRING (key)->data[idx];
304: if (c >= 0200 && !metized)
305: {
306: c = meta_prefix_char;
307: metized = 1;
308: }
309: else
310: {
311: c &= 0177;
312: metized = 0;
313: idx++;
314: }
315:
316: if (idx == XSTRING (key)->size)
317: return store_in_keymap (keymap, c, def);
318:
319: cmd = get_keyelt (access_keymap (keymap, c));
320: if (NULL (cmd))
321: {
322: cmd = Fmake_sparse_keymap ();
323: store_in_keymap (keymap, c, cmd);
324: }
325: tem = Fkeymapp (cmd);
326: if (NULL (tem))
327: error ("Key sequence %s uses invalid prefix characters",
328: XSTRING (key)->data);
329:
330: keymap = get_keymap (cmd);
331: }
332: }
333:
334: /* Value is number if KEY is too long; nil if valid but has no definition. */
335:
336: DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 2, 0,
337: "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\
338: nil means undefined. See doc of define-key for kinds of definitions.\n\
339: Number as value means KEY is \"too long\";\n\
340: that is, characters in it except for the last one\n\
341: fail to be a valid sequence of prefix characters in KEYMAP.\n\
342: The number is how many characters at the front of KEY\n\
343: it takes to reach a non-prefix command.")
344: (keymap, key)
345: register Lisp_Object keymap;
346: Lisp_Object key;
347: {
348: register int idx;
349: register Lisp_Object tem;
350: register Lisp_Object cmd;
351: register int c;
352: int metized = 0;
353:
354: keymap = get_keymap (keymap);
355:
356: CHECK_STRING (key, 1);
357: if (XSTRING (key)->size == 0)
358: return Qnil;
359:
360: idx = 0;
361: while (1)
362: {
363: c = XSTRING (key)->data[idx];
364: if (c >= 0200 && !metized)
365: {
366: c = meta_prefix_char;
367: metized = 1;
368: }
369: else
370: {
371: c &= 0177;
372: metized = 0;
373: idx++;
374: }
375:
376: cmd = get_keyelt (access_keymap (keymap, c));
377: if (idx == XSTRING (key)->size)
378: return cmd;
379:
380: tem = Fkeymapp (cmd);
381: if (NULL (tem))
382: return make_number (idx);
383:
384: keymap = get_keymap (cmd);
385: QUIT;
386: }
387: }
388:
389: DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 1, 0,
390: "Return the definition for command KEYS in current keymaps.\n\
391: KEYS is a string, a sequence of keystrokes.\n\
392: The definition is probably a symbol with a function definition.")
393: (keys)
394: Lisp_Object keys;
395: {
396: register Lisp_Object map, value, value1;
397: map = current_buffer->keymap;
398: if (!NULL (map))
399: {
400: value = Flookup_key (map, keys);
401: if (NULL (value))
402: {
403: XSET (map, Lisp_Vector, global_map);
404: value1 = Flookup_key (map, keys);
405: if (XTYPE (value1) == Lisp_Int)
406: return Qnil;
407: return value1;
408: }
409: else if (XTYPE (value) != Lisp_Int)
410: return value;
411: }
412: XSET (map, Lisp_Vector, global_map);
413: return Flookup_key (map, keys);
414: }
415:
416: DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 1, 0,
417: "Return the definition for command KEYS in current local keymap only.\n\
418: KEYS is a string, a sequence of keystrokes.\n\
419: The definition is probably a symbol with a function definition.")
420: (keys)
421: Lisp_Object keys;
422: {
423: register Lisp_Object map;
424: map = current_buffer->keymap;
425: if (NULL (map))
426: return Qnil;
427: return Flookup_key (map, keys);
428: }
429:
430: DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 1, 0,
431: "Return the definition for command KEYS in current global keymap only.\n\
432: KEYS is a string, a sequence of keystrokes.\n\
433: The definition is probably a symbol with a function definition.")
434: (keys)
435: Lisp_Object keys;
436: {
437: register Lisp_Object map;
438: XSET (map, Lisp_Vector, global_map);
439: return Flookup_key (map, keys);
440: }
441:
442: DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2,
443: "kSet key globally: \nCSet key %s to command: ",
444: "Give KEY a definition of COMMAND.\n\
445: COMMAND is a symbol naming an interactively-callable function.\n\
446: KEY is a string representing a sequence of keystrokes.\n\
447: Note that if KEY has a local definition in the current buffer\n\
448: that local definition will continue to shadow any global definition.")
449: (keys, function)
450: Lisp_Object keys, function;
451: {
452: register Lisp_Object map;
453: XSET (map, Lisp_Vector, global_map);
454: CHECK_STRING (keys, 1);
455: Fdefine_key (map, keys, function);
456: return Qnil;
457: }
458:
459: DEFUN ("local-set-key", Flocal_set_key, Slocal_set_key, 2, 2,
460: "kSet key locally: \nCSet key %s locally to command: ",
461: "Give KEY a local definition of COMMAND.\n\
462: COMMAND is a symbol naming an interactively-callable function.\n\
463: KEY is a string representing a sequence of keystrokes.\n\
464: The definition goes in the current buffer's local map,\n\
465: which is shared with other buffers in the same major mode.")
466: (keys, function)
467: Lisp_Object keys, function;
468: {
469: register Lisp_Object map;
470: map = current_buffer->keymap;
471: if (NULL (map))
472: {
473: map = Fmake_sparse_keymap ();
474: current_buffer->keymap = map;
475: }
476:
477: CHECK_STRING (keys, 1);
478: Fdefine_key (map, keys, function);
479: return Qnil;
480: }
481:
482: DEFUN ("global-unset-key", Fglobal_unset_key, Sglobal_unset_key,
483: 1, 1, "kUnset key globally: ",
484: "Remove global definition of KEY.\n\
485: KEY is a string representing a sequence of keystrokes.")
486: (keys)
487: Lisp_Object keys;
488: {
489: return Fglobal_set_key (keys, Qnil);
490: }
491:
492: DEFUN ("local-unset-key", Flocal_unset_key, Slocal_unset_key, 1, 1,
493: "kUnset key locally: ",
494: "Remove local definition of KEY.\n\
495: KEY is a string representing a sequence of keystrokes.")
496: (keys)
497: Lisp_Object keys;
498: {
499: if (!NULL (current_buffer->keymap))
500: Flocal_set_key (keys, Qnil);
501: return Qnil;
502: }
503:
504: DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 1, 0,
505: "Define SYMBOL as a prefix command.\n\
506: A keymap is created and stored as SYMBOL's function definition.")
507: (name)
508: Lisp_Object name;
509: {
510: Ffset (name, Fmake_keymap ());
511: return name;
512: }
513:
514: DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
515: "Selects KEYMAP as the global keymap.")
516: (keymap)
517: Lisp_Object keymap;
518: {
519: keymap = get_keymap (keymap);
520: CHECK_VECTOR (keymap, 0);
521: global_map = keymap;
522: return Qnil;
523: }
524:
525: DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
526: "Selects KEYMAP as the local keymap.\n\
527: nil for KEYMAP means no local keymap.")
528: (keymap)
529: Lisp_Object keymap;
530: {
531: if (!NULL (keymap))
532: keymap = get_keymap (keymap);
533:
534: current_buffer->keymap = keymap;
535:
536: return Qnil;
537: }
538:
539: DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
540: "Return current buffer's local keymap, or nil if it has none.")
541: ()
542: {
543: return current_buffer->keymap;
544: }
545:
546: DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
547: "Return the current global keymap.")
548: ()
549: {
550: return global_map;
551: }
552:
553: DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
554: 1, 1, 0,
555: "Find all keymaps accessible via prefix characters from KEYMAP.\n\
556: Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
557: KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\
558: so that the KEYS increase in length. The first element is (\"\" . KEYMAP).")
559: (startmap)
560: Lisp_Object startmap;
561: {
562: Lisp_Object maps, tail;
563: register Lisp_Object thismap, thisseq;
564: register Lisp_Object dummy;
565: register Lisp_Object tem;
566: register Lisp_Object cmd;
567: register int i;
568:
569: maps = Fcons (Fcons (build_string (""), get_keymap (startmap)), Qnil);
570: tail = maps;
571:
572: /* For each map in the list maps,
573: look at any other maps it points to
574: and stick them at the end if they are not already in the list */
575:
576: while (!NULL (tail))
577: {
578: thisseq = Fcar (Fcar (tail));
579: thismap = Fcdr (Fcar (tail));
580: for (i = 0; i < 0200; i++)
581: {
582: cmd = get_keyelt (access_keymap (thismap, i));
583: if (NULL (cmd)) continue;
584: tem = Fkeymapp (cmd);
585: if (!NULL (tem))
586: {
587: cmd = get_keymap (cmd);
588: tem = Frassq (cmd, maps);
589: if (NULL (tem))
590: {
591: XFASTINT (dummy) = i;
592: dummy = concat2 (thisseq, Fchar_to_string (dummy));
593: nconc2 (tail, Fcons (Fcons (dummy, cmd), Qnil));
594: }
595: }
596: }
597: tail = Fcdr (tail);
598: }
599:
600: return maps;
601: }
602:
603: Lisp_Object Qsingle_key_description, Qkey_description;
604:
605: DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
606: "Return a pretty description of key-sequence KEYS.\n\
607: Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
608: spaces are put between sequence elements, etc.")
609: (keys)
610: Lisp_Object keys;
611: {
612: return Fmapconcat (Qsingle_key_description, keys, build_string (" "));
613: }
614:
615: char *
616: push_key_description (c, p)
617: register unsigned int c;
618: register char *p;
619: {
620: if (c >= 0200)
621: {
622: *p++ = 'M';
623: *p++ = '-';
624: c -= 0200;
625: }
626: if (c < 040)
627: {
628: if (c == 033)
629: {
630: *p++ = 'E';
631: *p++ = 'S';
632: *p++ = 'C';
633: }
634: else if (c == Ctl('I'))
635: {
636: *p++ = 'T';
637: *p++ = 'A';
638: *p++ = 'B';
639: }
640: else if (c == Ctl('J'))
641: {
642: *p++ = 'L';
643: *p++ = 'F';
644: *p++ = 'D';
645: }
646: else if (c == Ctl('M'))
647: {
648: *p++ = 'R';
649: *p++ = 'E';
650: *p++ = 'T';
651: }
652: else
653: {
654: *p++ = 'C';
655: *p++ = '-';
656: if (c > 0 && c <= Ctl ('Z'))
657: *p++ = c + 0140;
658: else
659: *p++ = c + 0100;
660: }
661: }
662: else if (c == 0177)
663: {
664: *p++ = 'D';
665: *p++ = 'E';
666: *p++ = 'L';
667: }
668: else if (c == ' ')
669: {
670: *p++ = 'S';
671: *p++ = 'P';
672: *p++ = 'C';
673: }
674: else
675: *p++ = c;
676: return p;
677: }
678:
679: DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0,
680: "Return a pretty description of command character KEY.\n\
681: Control characters turn into C-whatever, etc.")
682: (key)
683: Lisp_Object key;
684: {
685: register unsigned char c;
686: char tem[6];
687:
688: CHECK_NUMBER (key, 0);
689: c = XINT (key) & 0377;
690:
691: *push_key_description (c, tem) = 0;
692:
693: return build_string (tem);
694: }
695:
696: char *
697: push_text_char_description (c, p)
698: register unsigned int c;
699: register char *p;
700: {
701: if (c >= 0200)
702: {
703: *p++ = 'M';
704: *p++ = '-';
705: c -= 0200;
706: }
707: if (c < 040)
708: {
709: *p++ = '^';
710: *p++ = c + 64; /* 'A' - 1 */
711: }
712: else if (c == 0177)
713: {
714: *p++ = '^';
715: *p++ = '?';
716: }
717: else
718: *p++ = c;
719: return p;
720: }
721:
722: DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
723: "Return a pretty description of file-character CHAR.\n\
724: Control characters turn into \"^char\", etc.")
725: (chr)
726: Lisp_Object chr;
727: {
728: char tem[6];
729:
730: CHECK_NUMBER (chr, 0);
731:
732: *push_text_char_description (XINT (chr) & 0377, tem) = 0;
733:
734: return build_string (tem);
735: }
736:
737: DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 3, 0,
738: "Return list of key sequences that currently invoke command DEFINITION\n\
739: in KEYMAP or (current-global-map). If KEYMAP is nil, only search for\n\
740: keys in the global map.\n\
741: \n\
742: If FIRSTONLY is non-nil, returns a string representing the first key\n\
743: sequence found, rather than a list of all possible key sequences.")
744: (definition, local_keymap, firstonly)
745: Lisp_Object definition, local_keymap, firstonly;
746: {
747: Lisp_Object start1;
748: register Lisp_Object maps;
749: Lisp_Object found;
750:
751: XSET (start1, Lisp_Vector, global_map);
752:
753: if (!NULL (local_keymap))
754: maps = nconc2 (Faccessible_keymaps (get_keymap (local_keymap)),
755: Faccessible_keymaps (start1));
756: else
757: maps = Faccessible_keymaps (start1);
758:
759: found = Qnil;
760:
761: for (; !NULL (maps); maps = Fcdr (maps))
762: {
763: register this = Fcar (Fcar (maps)); /* Key sequence to reach map */
764: register map = Fcdr (Fcar (maps)); /* The map that it reaches */
765: register int i = 0;
766:
767: if (CONSP (map))
768: map = Fcdr (map);
769:
770: /* If the MAP is a vector, I increments and eventually reaches 0200.
771: Otherwise I remains 0; MAP is cdr'd and eventually becomes nil. */
772:
773: while (!NULL (map) && i < 0200)
774: {
775: register Lisp_Object elt, dummy;
776:
777: QUIT;
778: if (CONSP (map))
779: {
780: elt = Fcdr (Fcar (map));
781: dummy = Fcar (Fcar (map));
782: map = Fcdr (map);
783: }
784: else
785: {
786: elt = XVECTOR (map)->contents[i];
787: XFASTINT (dummy) = i;
788: i++;
789: }
790:
791: if (XTYPE (definition) != Lisp_Cons)
792: elt = get_keyelt (elt);
793:
794: /* End this iteration if this element does not match
795: the target. */
796:
797: if (XTYPE (definition) == Lisp_Cons)
798: {
799: Lisp_Object tem;
800: tem = Fequal (elt, definition);
801: if (NULL (tem))
802: continue;
803: }
804: else
805: if (!EQ (elt, definition))
806: continue;
807:
808: /* We have found a match.
809: Construct the key sequence where we found it. */
810:
811: dummy = concat2 (this, Fchar_to_string (dummy));
812:
813: /* Verify that this key binding is not shadowed
814: by another binding for the same key,
815: before we say it exists.
816: The mechanism: look for local definition of this key
817: and if it is defined and does not match what we found
818: then ignore this key.
819: Either nil or number as value from Flookup_key
820: means undefined. */
821:
822: if (!NULL (local_keymap))
823: elt = Flookup_key (local_keymap, dummy);
824: if (!NULL (elt) && XTYPE (elt) != Lisp_Int)
825: {
826: if (XTYPE (definition) == Lisp_Cons)
827: {
828: Lisp_Object tem;
829: tem = Fequal (elt, definition);
830: if (NULL (tem))
831: continue;
832: }
833: else
834: if (!EQ (elt, definition))
835: continue;
836: }
837:
838: /* It is a true unshadowed match Record it. */
839:
840: if (!NULL (firstonly))
841: return dummy;
842: found = Fcons (dummy, found);
843: }
844: }
845: return Fnreverse (found);
846: }
847:
848: DEFUN ("where-is", Fwhere_is, Swhere_is, 1, 1, "CWhere is command: ",
849: "Print message listing key sequences that invoke specified command.\n\
850: Argument is a command definition, usually a symbol with a function definition.")
851: (definition)
852: Lisp_Object definition;
853: {
854: register Lisp_Object tem;
855: CHECK_SYMBOL (definition, 0);
856: tem = Fmapconcat (Qkey_description,
857: Fwhere_is_internal (definition, current_buffer->keymap, Qnil),
858: build_string (", "));
859: if (XSTRING (tem)->size)
860: message ("%s is on %s", XSYMBOL (definition)->name->data, XSTRING (tem)->data);
861: else
862: message ("%s is not on any keys", XSYMBOL (definition)->name->data);
863: return Qnil;
864: }
865:
866: Lisp_Object describe_buffer_bindings ();
867:
868: DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 0, "",
869: "Show a list of all defined keys, and their definitions.\n\
870: The list is put in a buffer, which is displayed.")
871: ()
872: {
873: register Lisp_Object thisbuf;
874: XSET (thisbuf, Lisp_Buffer, current_buffer);
875: internal_with_output_to_temp_buffer ("*Help*", describe_buffer_bindings, thisbuf);
876: return Qnil;
877: }
878:
879: Lisp_Object
880: describe_buffer_bindings (descbuf)
881: Lisp_Object descbuf;
882: {
883: register Lisp_Object start1;
884: char *heading = "key binding\n--- -------\n";
885:
886: Fset_buffer (Vstandard_output);
887:
888: start1 = XBUFFER (descbuf)->keymap;
889: if (!NULL (start1))
890: {
891: InsStr ("Local Bindings:\n");
892: InsStr (heading);
893: heading = 0;
894: describe_map_tree (start1, 0, Qnil);
895: InsStr ("\n");
896: }
897:
898: InsStr ("Global Bindings:\n");
899: if (heading)
900: InsStr (heading);
901:
902: XSET (start1, Lisp_Vector, global_map);
903: describe_map_tree (start1, 0, XBUFFER (descbuf)->keymap);
904:
905: Fset_buffer (descbuf);
906: return Qnil;
907: }
908:
909: /* Insert a desription of the key bindings in STARTMAP,
910: followed by those of all maps reachable through STARTMAP.
911: If PARTIAL is nonzero, omit certain "uninteresting" commands
912: (such as `undefined').
913: If SHADOW is non-nil, don't mention keys which would be shadowed by it */
914:
915: describe_map_tree (startmap, partial, shadow)
916: Lisp_Object startmap, shadow;
917: int partial;
918: {
919: Lisp_Object maps;
920: register Lisp_Object elt, sh;
921: struct gcpro gcpro1;
922:
923: maps = Faccessible_keymaps (startmap);
924: GCPRO1 (maps);
925:
926: for (; !NULL (maps); maps = Fcdr (maps))
927: {
928: elt = Fcar (maps);
929: sh = Fcar (elt);
930: if (NULL (shadow))
931: sh = Qnil;
932: else if (XTYPE (sh) == Lisp_String &&
933: XSTRING (sh)->size == 0)
934: sh = shadow;
935: else
936: {
937: sh = Flookup_key (shadow, Fcar (elt));
938: if (XTYPE (sh) == Lisp_Int)
939: sh = Qnil;
940: }
941: if (NULL (sh) || !NULL (Fkeymapp (sh)))
942: describe_map (Fcdr (elt), Fcar (elt), partial, sh);
943: }
944:
945: UNGCPRO;
946: }
947:
948: describe_command (definition)
949: Lisp_Object definition;
950: {
951: register Lisp_Object tem1;
952:
953: Findent_to (make_number (16), make_number (1));
954:
955: if (XTYPE (definition) == Lisp_Symbol)
956: {
957: XSET (tem1, Lisp_String, XSYMBOL (definition)->name);
958: insert1 (tem1);
959: InsStr ("\n");
960: }
961: else
962: {
963: tem1 = Fkeymapp (definition);
964: if (!NULL (tem1))
965: InsStr ("Prefix Command\n");
966: else
967: InsStr ("??\n");
968: }
969: }
970:
971: /* Describe the contents of map MAP, assuming that this map
972: itself is reached by the sequence of prefix keys STRING (a string).
973: PARTIAL and SHADOW are the same as in `describe_map_tree' above. */
974:
975: describe_map (map, string, partial, shadow)
976: Lisp_Object map, string;
977: int partial;
978: Lisp_Object shadow;
979: {
980: register Lisp_Object keysdesc;
981:
982: if (!NULL (string) && XSTRING (string)->size > 0)
983: #ifdef NeXT
984: /* Bug fix supplied by RMS via [email protected]:
985: * Evaluate build_string() after Fkey_description() to avoid
986: * having the former's results prematurely GC'ed. (28818)
987: */
988: {
989: Lisp_Object tem;
990: /* Call Fkey_description first to avoid GC problem. */
991: tem = Fkey_description (string);
992: keysdesc = concat2 (tem, build_string (" "));
993: }
994: #else
995: keysdesc = concat2 (Fkey_description (string), build_string (" "));
996: #endif /* NOT NeXT */
997: else
998: keysdesc = Qnil;
999:
1000: if (CONSP (map))
1001: describe_alist (Fcdr (map), keysdesc, describe_command,
1002: partial, shadow);
1003: else
1004: describe_vector (map, keysdesc, describe_command,
1005: partial, shadow);
1006: }
1007:
1008: describe_alist (alist, elt_prefix, elt_describer, partial, shadow)
1009: register Lisp_Object alist;
1010: Lisp_Object elt_prefix;
1011: int (*elt_describer) ();
1012: int partial;
1013: Lisp_Object shadow;
1014: {
1015: Lisp_Object this;
1016: Lisp_Object tem1, tem2;
1017: Lisp_Object suppress;
1018: Lisp_Object kludge = Qnil;
1019: int first = 1;
1020: struct gcpro gcpro1, gcpro2;
1021:
1022: if (partial)
1023: suppress = intern ("suppress-keymap");
1024:
1025: for (; CONSP (alist); alist = Fcdr (alist))
1026: {
1027: QUIT;
1028: tem1 = Fcar (Fcar (alist));
1029: tem2 = get_keyelt (Fcdr (Fcar (alist)));
1030: if (NULL (tem2)) continue;
1031: if (XTYPE (tem2) == Lisp_Symbol && partial)
1032: {
1033: this = Fget (tem2, suppress);
1034: if (!NULL (this))
1035: continue;
1036: }
1037:
1038: if (!NULL (shadow))
1039: {
1040: Lisp_Object tem;
1041: if (NULL (kludge)) kludge = build_string ("x");
1042: XSTRING (kludge)->data[0] = XINT (tem1);
1043: tem = Flookup_key (shadow, kludge);
1044: if (!NULL (tem)) continue;
1045: }
1046:
1047: if (first)
1048: {
1049: insert ("\n", 1);
1050: first = 0;
1051: }
1052:
1053: GCPRO2 (elt_prefix, tem2);
1054: if (!NULL (elt_prefix))
1055: insert1 (elt_prefix);
1056:
1057: insert1 (Fsingle_key_description (tem1));
1058:
1059: (*elt_describer) (tem2);
1060: UNGCPRO;
1061: }
1062: }
1063:
1064: describe_vector (vector, elt_prefix, elt_describer, partial, shadow)
1065: register Lisp_Object vector;
1066: Lisp_Object elt_prefix;
1067: int (*elt_describer) ();
1068: int partial;
1069: Lisp_Object shadow;
1070: {
1071: Lisp_Object this;
1072: Lisp_Object dummy;
1073: Lisp_Object tem1, tem2;
1074: register int i, size = XVECTOR (vector)->size;
1075: Lisp_Object suppress;
1076: Lisp_Object kludge;
1077: int first = 1;
1078: struct gcpro gcpro1, gcpro2;
1079:
1080: tem1 = Qnil;
1081: kludge = Qnil;
1082: GCPRO2 (elt_prefix, tem1);
1083:
1084: if (partial)
1085: suppress = intern ("suppress-keymap");
1086:
1087: for (i = 0; i < size; i++)
1088: {
1089: QUIT;
1090: tem1 = get_keyelt (XVECTOR (vector)->contents[i]);
1091: if (NULL (tem1)) continue;
1092: if (XTYPE (tem1) == Lisp_Symbol && partial)
1093: {
1094: this = Fget (tem1, suppress);
1095: if (!NULL (this))
1096: continue;
1097: }
1098:
1099: if (!NULL (shadow))
1100: {
1101: Lisp_Object tem;
1102: if (NULL (kludge)) kludge = build_string ("x");
1103: XSTRING (kludge)->data[0] = XINT (i);
1104: tem = Flookup_key (shadow, kludge);
1105: if (!NULL (tem)) continue;
1106: }
1107:
1108: if (first)
1109: {
1110: insert ("\n", 1);
1111: first = 0;
1112: }
1113:
1114: if (!NULL (elt_prefix))
1115: insert1 (elt_prefix);
1116:
1117: XFASTINT (dummy) = i;
1118: insert1 (Fsingle_key_description (dummy));
1119:
1120: while (i + 1 < size
1121: && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1]),
1122: EQ (tem2, tem1)))
1123: i++;
1124:
1125: if (i != XINT (dummy))
1126: {
1127: insert (" .. ", 4);
1128: if (!NULL (elt_prefix))
1129: insert1 (elt_prefix);
1130:
1131: XFASTINT (dummy) = i;
1132: insert1 (Fsingle_key_description (dummy));
1133: }
1134:
1135: (*elt_describer) (tem1);
1136: }
1137:
1138: UNGCPRO;
1139: }
1140:
1141: /* Apropos */
1142: Lisp_Object apropos_predicate;
1143: Lisp_Object apropos_accumulate;
1144:
1145: static
1146: apropos_accum (symbol, string)
1147: Lisp_Object symbol, string;
1148: {
1149: register Lisp_Object tem;
1150:
1151: tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
1152: if (!NULL (tem) && !NULL (apropos_predicate))
1153: tem = call1 (apropos_predicate, symbol);
1154: if (!NULL (tem))
1155: apropos_accumulate = Fcons (symbol, apropos_accumulate);
1156: }
1157:
1158: static Lisp_Object
1159: apropos1 (list)
1160: register Lisp_Object list;
1161: {
1162: struct buffer *old = current_buffer;
1163: register Lisp_Object symbol, col, tem;
1164:
1165: while (!NULL (list))
1166: {
1167: Lisp_Object min_cols;
1168:
1169: QUIT;
1170:
1171: symbol = Fcar (list);
1172: list = Fcdr (list);
1173:
1174: tem = Fwhere_is_internal (symbol, current_buffer->keymap, Qnil);
1175: tem = Fmapconcat (Qkey_description, tem, build_string (", "));
1176: XFASTINT (col) = 30;
1177:
1178: set_buffer_internal (XBUFFER (Vstandard_output));
1179: Fprin1 (symbol, Qnil);
1180: XFASTINT (min_cols) = 1;
1181: Findent_to (col, min_cols);
1182: Fprinc (tem, Qnil);
1183: Fterpri (Qnil);
1184: tem = Ffboundp (symbol);
1185: if (!NULL (tem))
1186: tem = Fdocumentation (symbol);
1187: if (XTYPE (tem) == Lisp_String)
1188: insert_first_line (" Function: ", tem);
1189: tem = Fdocumentation_property (symbol, Qvariable_documentation);
1190: if (XTYPE (tem) == Lisp_String)
1191: insert_first_line (" Variable: ", tem);
1192: set_buffer_internal (old);
1193: }
1194: return Qnil;
1195: }
1196:
1197: static void
1198: insert_first_line (prefix, str)
1199: char *prefix;
1200: Lisp_Object str;
1201: {
1202: extern char *index ();
1203: register unsigned char *p;
1204: register unsigned char *p1;
1205: register unsigned char *p2;
1206: struct gcpro gcpro1;
1207:
1208: GCPRO1 (str);
1209: InsStr (prefix);
1210:
1211: retry:
1212: p = XSTRING (str)->data;
1213: p1 = (unsigned char *) index (p, '\n');
1214:
1215: for (p2 = p; *p2 && p2 != p1; p2++)
1216: if (p2[0] == '\\' && p2[1] == '[')
1217: {
1218: str = Fsubstitute_command_keys (str);
1219: goto retry;
1220: }
1221:
1222: insert (p, p1 ? p1 - p : strlen (p));
1223: insert ("\n", 1);
1224: UNGCPRO;
1225: }
1226:
1227: DEFUN ("apropos", Fapropos, Sapropos, 1, 3, "sApropos: ",
1228: "Show all symbols whose names contain match for REGEXP.\n\
1229: If optional arg PRED is non-nil, (funcall PRED SYM) is done\n\
1230: for each symbol and a symbol is mentioned if that returns non-nil.\n\
1231: Returns list of symbols found; if third arg NOPRINT is non-nil,\n\
1232: does not display them, just returns the list.")
1233: (string, pred, noprint)
1234: Lisp_Object string, pred, noprint;
1235: {
1236: struct gcpro gcpro1, gcpro2;
1237: CHECK_STRING (string, 0);
1238: apropos_predicate = pred;
1239: GCPRO2 (apropos_predicate, apropos_accumulate);
1240: apropos_accumulate = Qnil;
1241: map_obarray (Vobarray, apropos_accum, string);
1242: apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
1243: if (NULL (noprint))
1244: internal_with_output_to_temp_buffer ("*Help*", apropos1,
1245: apropos_accumulate);
1246: UNGCPRO;
1247: return apropos_accumulate;
1248: }
1249:
1250: syms_of_keymap ()
1251: {
1252: Lisp_Object tem;
1253:
1254: Qkeymap = intern ("keymap");
1255: staticpro (&Qkeymap);
1256:
1257: /* Initialize the keymaps standardly used.
1258: Each one is the value of a Lisp variable, and is also
1259: pointed to by a C variable */
1260:
1261: #ifdef HAVE_X_WINDOWS
1262: tem = Fmake_keymap ();
1263: MouseMap = tem;
1264: Fset (intern ("mouse-map"), tem);
1265: #endif /* HAVE_X_WINDOWS */
1266:
1267: tem = Fmake_keymap ();
1268: Vglobal_map = tem;
1269: Fset (intern ("global-map"), tem);
1270:
1271: tem = Fmake_keymap ();
1272: Vesc_map = tem;
1273: Fset (intern ("esc-map"), tem);
1274: Ffset (intern ("ESC-prefix"), tem);
1275:
1276: tem = Fmake_keymap ();
1277: Vctl_x_map = tem;
1278: Fset (intern ("ctl-x-map"), tem);
1279: Ffset (intern ("Control-X-prefix"), tem);
1280:
1281: DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
1282: "Default keymap to use when reading from the minibuffer.");
1283: Vminibuffer_local_map = Fmake_sparse_keymap ();
1284:
1285: DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
1286: "The keymap used by the minibuf for local bindings when spaces are not\n\
1287: to be allowed in input string.");
1288: Vminibuffer_local_ns_map = Fmake_sparse_keymap ();
1289:
1290: DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
1291: "Keymap to use when reading from the minibuffer with completion.");
1292: Vminibuffer_local_completion_map = Fmake_sparse_keymap ();
1293:
1294: DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
1295: "Keymap to use when reading from the minibuffer with completion and\n\
1296: an exact match of one of the completions is required.");
1297: Vminibuffer_local_must_match_map = Fmake_sparse_keymap ();
1298:
1299: global_map = Vglobal_map;
1300:
1301: Qsingle_key_description = intern ("single-key-description");
1302: staticpro (&Qsingle_key_description);
1303:
1304: Qkey_description = intern ("key-description");
1305: staticpro (&Qkey_description);
1306:
1307: Qkeymapp = intern ("keymapp");
1308: staticpro (&Qkeymapp);
1309:
1310: defsubr (&Skeymapp);
1311: defsubr (&Smake_keymap);
1312: defsubr (&Smake_sparse_keymap);
1313: defsubr (&Scopy_keymap);
1314: defsubr (&Skey_binding);
1315: defsubr (&Slocal_key_binding);
1316: defsubr (&Sglobal_key_binding);
1317: defsubr (&Sglobal_set_key);
1318: defsubr (&Slocal_set_key);
1319: defsubr (&Sdefine_key);
1320: defsubr (&Slookup_key);
1321: defsubr (&Sglobal_unset_key);
1322: defsubr (&Slocal_unset_key);
1323: defsubr (&Sdefine_prefix_command);
1324: defsubr (&Suse_global_map);
1325: defsubr (&Suse_local_map);
1326: defsubr (&Scurrent_local_map);
1327: defsubr (&Scurrent_global_map);
1328: defsubr (&Saccessible_keymaps);
1329: defsubr (&Skey_description);
1330: defsubr (&Ssingle_key_description);
1331: defsubr (&Stext_char_description);
1332: defsubr (&Swhere_is_internal);
1333: defsubr (&Swhere_is);
1334: defsubr (&Sdescribe_bindings);
1335: defsubr (&Sapropos);
1336: }
1337:
1338: keys_of_keymap ()
1339: {
1340: ndefkey (Vglobal_map, 033, "ESC-prefix");
1341: ndefkey (Vglobal_map, Ctl ('X'), "Control-X-prefix");
1342: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.