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