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