1 /* Manipulation of keymaps
2    Copyright (C) 1985-1988, 1993-1995, 1998-2021 Free Software
3    Foundation, Inc.
4 
5 This file is part of GNU Emacs.
6 
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or (at
10 your option) any later version.
11 
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 GNU General Public License for more details.
16 
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
19 
20 /* Old BUGS:
21    - [M-C-a] != [?\M-\C-a]
22    - [M-f2] != [?\e f2].
23    - (define-key map [menu-bar foo] <bla>) does not always place <bla>
24      at the head of the menu (if `foo' was already bound earlier and
25      then unbound, for example).
26    TODO:
27    - allow many more Meta -> ESC mappings (like Hyper -> C-e for Emacspeak)
28    - Think about the various defaulting that's currently hard-coded in
29      keyboard.c (uppercase->lowercase, char->charset, button-events, ...)
30      and make it more generic.  Maybe we should allow mappings of the
31      form (PREDICATE . BINDING) as generalization of the default binding,
32      tho probably a cleaner way to attack this is to allow functional
33      keymaps (i.e. keymaps that are implemented as functions that implement
34      a few different methods like `lookup', `map', ...).
35    - Make [a] equivalent to [?a].
36    BEWARE:
37    - map-keymap should work meaningfully even if entries are added/removed
38      to the keymap while iterating through it:
39        start - removed <= visited <= start + added
40  */
41 
42 #include <config.h>
43 #include <stdio.h>
44 #include <stdlib.h>
45 
46 #include "lisp.h"
47 #include "commands.h"
48 #include "character.h"
49 #include "buffer.h"
50 #include "keyboard.h"
51 #include "termhooks.h"
52 #include "blockinput.h"
53 #include "puresize.h"
54 #include "intervals.h"
55 #include "keymap.h"
56 #include "window.h"
57 
58 /* Actually allocate storage for these variables.  */
59 
60 Lisp_Object current_global_map;	/* Current global keymap.  */
61 
62 Lisp_Object global_map;		/* Default global key bindings.  */
63 
64 Lisp_Object meta_map;		/* The keymap used for globally bound
65 				   ESC-prefixed default commands.  */
66 
67 Lisp_Object control_x_map;	/* The keymap used for globally bound
68 				   C-x-prefixed default commands.  */
69 
70 				/* The keymap used by the minibuf for local
71 				   bindings when spaces are allowed in the
72 				   minibuf.  */
73 
74 				/* The keymap used by the minibuf for local
75 				   bindings when spaces are not encouraged
76 				   in the minibuf.  */
77 
78 /* Alist of elements like (DEL . "\d").  */
79 static Lisp_Object exclude_keys;
80 
81 /* Pre-allocated 2-element vector for Fcommand_remapping to use.  */
82 static Lisp_Object command_remapping_vector;
83 
84 /* Hash table used to cache a reverse-map to speed up calls to where-is.  */
85 static Lisp_Object where_is_cache;
86 /* Which keymaps are reverse-stored in the cache.  */
87 static Lisp_Object where_is_cache_keymaps;
88 
89 static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object);
90 
91 static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object);
92 static void describe_command (Lisp_Object, Lisp_Object);
93 static void describe_translation (Lisp_Object, Lisp_Object);
94 static void describe_map (Lisp_Object, Lisp_Object,
95                           void (*) (Lisp_Object, Lisp_Object),
96 			  bool, Lisp_Object, Lisp_Object *, bool, bool);
97 static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object,
98                              void (*) (Lisp_Object, Lisp_Object), bool,
99                              Lisp_Object, Lisp_Object, bool, bool);
100 static void silly_event_symbol_error (Lisp_Object);
101 static Lisp_Object get_keyelt (Lisp_Object, bool);
102 
103 static void
CHECK_VECTOR_OR_CHAR_TABLE(Lisp_Object x)104 CHECK_VECTOR_OR_CHAR_TABLE (Lisp_Object x)
105 {
106   CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x);
107 }
108 
109 /* Keymap object support - constructors and predicates.			*/
110 
111 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
112        doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
113 CHARTABLE is a char-table that holds the bindings for all characters
114 without modifiers.  All entries in it are initially nil, meaning
115 "command undefined".  ALIST is an assoc-list which holds bindings for
116 function keys, mouse events, and any other things that appear in the
117 input stream.  Initially, ALIST is nil.
118 
119 The optional arg STRING supplies a menu name for the keymap
120 in case you use it as a menu with `x-popup-menu'.  */)
121   (Lisp_Object string)
122 {
123   Lisp_Object tail = !NILP (string) ? list1 (string) : Qnil;
124   return Fcons (Qkeymap,
125 		Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
126 }
127 
128 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
129        doc: /* Construct and return a new sparse keymap.
130 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
131 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
132 which binds the function key or mouse event SYMBOL to DEFINITION.
133 Initially the alist is nil.
134 
135 The optional arg STRING supplies a menu name for the keymap
136 in case you use it as a menu with `x-popup-menu'.  */)
137   (Lisp_Object string)
138 {
139   if (!NILP (string))
140     {
141       if (!NILP (Vpurify_flag))
142 	string = Fpurecopy (string);
143       return list2 (Qkeymap, string);
144     }
145   return list1 (Qkeymap);
146 }
147 
148 /* This function is used for installing the standard key bindings
149    at initialization time.
150 
151    For example:
152 
153    initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark");  */
154 
155 void
initial_define_key(Lisp_Object keymap,int key,const char * defname)156 initial_define_key (Lisp_Object keymap, int key, const char *defname)
157 {
158   store_in_keymap (keymap, make_fixnum (key), intern_c_string (defname));
159 }
160 
161 void
initial_define_lispy_key(Lisp_Object keymap,const char * keyname,const char * defname)162 initial_define_lispy_key (Lisp_Object keymap, const char *keyname, const char *defname)
163 {
164   store_in_keymap (keymap, intern_c_string (keyname), intern_c_string (defname));
165 }
166 
167 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
168        doc: /* Return t if OBJECT is a keymap.
169 
170 A keymap is a list (keymap . ALIST),
171 or a symbol whose function definition is itself a keymap.
172 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
173 a vector of densely packed bindings for small character codes
174 is also allowed as an element.  */)
175   (Lisp_Object object)
176 {
177   return (KEYMAPP (object) ? Qt : Qnil);
178 }
179 
180 DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0,
181        doc: /* Return the prompt-string of a keymap MAP.
182 If non-nil, the prompt is shown in the echo-area
183 when reading a key-sequence to be looked-up in this keymap.  */)
184   (Lisp_Object map)
185 {
186   map = get_keymap (map, 0, 0);
187   while (CONSP (map))
188     {
189       Lisp_Object tem = XCAR (map);
190       if (STRINGP (tem))
191 	return tem;
192       else if (KEYMAPP (tem))
193 	{
194 	  tem = Fkeymap_prompt (tem);
195 	  if (!NILP (tem))
196 	    return tem;
197 	}
198       map = XCDR (map);
199     }
200   return Qnil;
201 }
202 
203 /* Check that OBJECT is a keymap (after dereferencing through any
204    symbols).  If it is, return it.
205 
206    If AUTOLOAD and if OBJECT is a symbol whose function value
207    is an autoload form, do the autoload and try again.
208    If AUTOLOAD, callers must assume GC is possible.
209 
210    ERROR_IF_NOT_KEYMAP controls how we respond if OBJECT isn't a keymap.
211    If ERROR_IF_NOT_KEYMAP, signal an error; otherwise,
212    just return Qnil.
213 
214    Note that most of the time, we don't want to pursue autoloads.
215    Functions like Faccessible_keymaps which scan entire keymap trees
216    shouldn't load every autoloaded keymap.  I'm not sure about this,
217    but it seems to me that only read_key_sequence, Flookup_key, and
218    Fdefine_key should cause keymaps to be autoloaded.
219 
220    This function can GC when AUTOLOAD is true, because it calls
221    Fautoload_do_load which can GC.  */
222 
223 Lisp_Object
get_keymap(Lisp_Object object,bool error_if_not_keymap,bool autoload)224 get_keymap (Lisp_Object object, bool error_if_not_keymap, bool autoload)
225 {
226   Lisp_Object tem;
227 
228  autoload_retry:
229   if (NILP (object))
230     goto end;
231   if (CONSP (object) && EQ (XCAR (object), Qkeymap))
232     return object;
233 
234   tem = indirect_function (object);
235   if (CONSP (tem))
236     {
237       if (EQ (XCAR (tem), Qkeymap))
238 	return tem;
239 
240       /* Should we do an autoload?  Autoload forms for keymaps have
241 	 Qkeymap as their fifth element.  */
242       if ((autoload || !error_if_not_keymap) && EQ (XCAR (tem), Qautoload)
243 	  && SYMBOLP (object))
244 	{
245 	  Lisp_Object tail;
246 
247 	  tail = Fnth (make_fixnum (4), tem);
248 	  if (EQ (tail, Qkeymap))
249 	    {
250 	      if (autoload)
251 		{
252 		  Fautoload_do_load (tem, object, Qnil);
253 		  goto autoload_retry;
254 		}
255 	      else
256 	      	return object;
257 	    }
258 	}
259     }
260 
261  end:
262   if (error_if_not_keymap)
263     wrong_type_argument (Qkeymapp, object);
264   return Qnil;
265 }
266 
267 /* Return the parent map of KEYMAP, or nil if it has none.
268    We assume that KEYMAP is a valid keymap.  */
269 
270 static Lisp_Object
keymap_parent(Lisp_Object keymap,bool autoload)271 keymap_parent (Lisp_Object keymap, bool autoload)
272 {
273   Lisp_Object list;
274 
275   keymap = get_keymap (keymap, 1, autoload);
276 
277   /* Skip past the initial element `keymap'.  */
278   list = XCDR (keymap);
279   for (; CONSP (list); list = XCDR (list))
280     {
281       /* See if there is another `keymap'.  */
282       if (KEYMAPP (list))
283 	return list;
284     }
285 
286   return get_keymap (list, 0, autoload);
287 }
288 
289 DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
290        doc: /* Return the parent keymap of KEYMAP.
291 If KEYMAP has no parent, return nil.  */)
292   (Lisp_Object keymap)
293 {
294   return keymap_parent (keymap, 1);
295 }
296 
297 /* Check whether MAP is one of MAPS parents.  */
298 static bool
keymap_memberp(Lisp_Object map,Lisp_Object maps)299 keymap_memberp (Lisp_Object map, Lisp_Object maps)
300 {
301   if (NILP (map)) return 0;
302   while (KEYMAPP (maps) && !EQ (map, maps))
303     maps = keymap_parent (maps, 0);
304   return (EQ (map, maps));
305 }
306 
307 /* Set the parent keymap of MAP to PARENT.  */
308 
309 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
310        doc: /* Modify KEYMAP to set its parent map to PARENT.
311 Return PARENT.  PARENT should be nil or another keymap.  */)
312   (Lisp_Object keymap, Lisp_Object parent)
313 {
314   Lisp_Object list, prev;
315 
316   /* Flush any reverse-map cache.  */
317   where_is_cache = Qnil; where_is_cache_keymaps = Qt;
318 
319   keymap = get_keymap (keymap, 1, 1);
320 
321   if (!NILP (parent))
322     {
323       parent = get_keymap (parent, 1, 0);
324 
325       /* Check for cycles.  */
326       if (keymap_memberp (keymap, parent))
327 	error ("Cyclic keymap inheritance");
328     }
329 
330   /* Skip past the initial element `keymap'.  */
331   prev = keymap;
332   while (1)
333     {
334       list = XCDR (prev);
335       /* If there is a parent keymap here, replace it.
336 	 If we came to the end, add the parent in PREV.  */
337       if (!CONSP (list) || KEYMAPP (list))
338 	{
339 	  CHECK_IMPURE (prev, XCONS (prev));
340 	  XSETCDR (prev, parent);
341 	  return parent;
342 	}
343       prev = list;
344     }
345 }
346 
347 
348 /* Look up IDX in MAP.  IDX may be any sort of event.
349    Note that this does only one level of lookup; IDX must be a single
350    event, not a sequence.
351 
352    MAP must be a keymap or a list of keymaps.
353 
354    If T_OK, bindings for Qt are treated as default
355    bindings; any key left unmentioned by other tables and bindings is
356    given the binding of Qt.
357 
358    If not T_OK, bindings for Qt are not treated specially.
359 
360    If NOINHERIT, don't accept a subkeymap found in an inherited keymap.
361 
362    Return Qunbound if no binding was found (and return Qnil if a nil
363    binding was found).  */
364 
365 static Lisp_Object
access_keymap_1(Lisp_Object map,Lisp_Object idx,bool t_ok,bool noinherit,bool autoload)366 access_keymap_1 (Lisp_Object map, Lisp_Object idx,
367 		 bool t_ok, bool noinherit, bool autoload)
368 {
369   /* If idx is a list (some sort of mouse click, perhaps?),
370      the index we want to use is the car of the list, which
371      ought to be a symbol.  */
372   idx = EVENT_HEAD (idx);
373 
374   /* If idx is a symbol, it might have modifiers, which need to
375      be put in the canonical order.  */
376   if (SYMBOLP (idx))
377     idx = reorder_modifiers (idx);
378   else if (FIXNUMP (idx))
379     /* Clobber the high bits that can be present on a machine
380        with more than 24 bits of integer.  */
381     XSETFASTINT (idx, XFIXNUM (idx) & (CHAR_META | (CHAR_META - 1)));
382 
383   /* Handle the special meta -> esc mapping.  */
384   if (FIXNUMP (idx) && XFIXNAT (idx) & meta_modifier)
385     {
386       /* See if there is a meta-map.  If there's none, there is
387          no binding for IDX, unless a default binding exists in MAP.  */
388       Lisp_Object event_meta_binding, event_meta_map;
389       /* A strange value in which Meta is set would cause
390 	 infinite recursion.  Protect against that.  */
391       if (XFIXNUM (meta_prefix_char) & CHAR_META)
392 	meta_prefix_char = make_fixnum (27);
393       event_meta_binding = access_keymap_1 (map, meta_prefix_char, t_ok,
394 					    noinherit, autoload);
395       event_meta_map = get_keymap (event_meta_binding, 0, autoload);
396       if (CONSP (event_meta_map))
397 	{
398 	  map = event_meta_map;
399 	  idx = make_fixnum (XFIXNAT (idx) & ~meta_modifier);
400 	}
401       else if (t_ok)
402 	/* Set IDX to t, so that we only find a default binding.  */
403 	idx = Qt;
404       else
405 	/* An explicit nil binding, or no binding at all.  */
406 	return NILP (event_meta_binding) ? Qnil : Qunbound;
407     }
408 
409   /* t_binding is where we put a default binding that applies,
410      to use in case we do not find a binding specifically
411      for this key sequence.  */
412   {
413     Lisp_Object tail;
414     Lisp_Object t_binding = Qunbound;
415     Lisp_Object retval = Qunbound;
416     Lisp_Object retval_tail = Qnil;
417 
418     for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
419 	 (CONSP (tail)
420 	  || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
421 	 tail = XCDR (tail))
422       {
423 	/* Qunbound in VAL means we have found no binding.  */
424 	Lisp_Object val = Qunbound;
425 	Lisp_Object binding = XCAR (tail);
426 	Lisp_Object submap = get_keymap (binding, 0, autoload);
427 
428 	if (EQ (binding, Qkeymap))
429 	  {
430 	    if (noinherit || NILP (retval))
431 	      /* If NOINHERIT, stop here, the rest is inherited.  */
432 	      break;
433 	    else if (!EQ (retval, Qunbound))
434 	      {
435 		Lisp_Object parent_entry;
436 		eassert (KEYMAPP (retval));
437 		parent_entry
438 		  = get_keymap (access_keymap_1 (tail, idx,
439 						 t_ok, 0, autoload),
440 				0, autoload);
441 		if (KEYMAPP (parent_entry))
442 		  {
443 		    if (CONSP (retval_tail))
444 		      XSETCDR (retval_tail, parent_entry);
445 		    else
446 		      {
447 			retval_tail = Fcons (retval, parent_entry);
448 			retval = Fcons (Qkeymap, retval_tail);
449 		      }
450 		  }
451 		break;
452 	      }
453 	  }
454 	else if (CONSP (submap))
455 	  {
456 	    val = access_keymap_1 (submap, idx, t_ok, noinherit, autoload);
457 	  }
458 	else if (CONSP (binding))
459 	  {
460 	    Lisp_Object key = XCAR (binding);
461 
462 	    if (EQ (key, idx))
463 	      val = XCDR (binding);
464 	    else if (t_ok && EQ (key, Qt))
465 	      {
466 		t_binding = XCDR (binding);
467 		t_ok = 0;
468 	      }
469 	  }
470 	else if (VECTORP (binding))
471 	  {
472 	    if (FIXNUMP (idx) && XFIXNAT (idx) < ASIZE (binding))
473 	      val = AREF (binding, XFIXNAT (idx));
474 	  }
475 	else if (CHAR_TABLE_P (binding))
476 	  {
477 	    /* Character codes with modifiers
478 	       are not included in a char-table.
479 	       All character codes without modifiers are included.  */
480 	    if (FIXNUMP (idx) && (XFIXNAT (idx) & CHAR_MODIFIER_MASK) == 0)
481 	      {
482 		val = Faref (binding, idx);
483 		/* nil has a special meaning for char-tables, so
484 		   we use something else to record an explicitly
485 		   unbound entry.  */
486 		if (NILP (val))
487 		  val = Qunbound;
488 	      }
489 	  }
490 
491 	/* If we found a binding, clean it up and return it.  */
492 	if (!EQ (val, Qunbound))
493 	  {
494 	    if (EQ (val, Qt))
495 	      /* A Qt binding is just like an explicit nil binding
496 		 (i.e. it shadows any parent binding but not bindings in
497 		 keymaps of lower precedence).  */
498 	      val = Qnil;
499 
500 	    val = get_keyelt (val, autoload);
501 
502 	    if (!KEYMAPP (val))
503 	      {
504 		if (NILP (retval) || EQ (retval, Qunbound))
505 		  retval = val;
506 		if (!NILP (val))
507 		  break;  /* Shadows everything that follows.  */
508 	      }
509 	    else if (NILP (retval) || EQ (retval, Qunbound))
510 	      retval = val;
511 	    else if (CONSP (retval_tail))
512 	      {
513 		XSETCDR (retval_tail, list1 (val));
514 		retval_tail = XCDR (retval_tail);
515 	      }
516 	    else
517 	      {
518 		retval_tail = list1 (val);
519 		retval = Fcons (Qkeymap, Fcons (retval, retval_tail));
520 	      }
521 	  }
522 	maybe_quit ();
523       }
524 
525     return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval;
526   }
527 }
528 
529 Lisp_Object
access_keymap(Lisp_Object map,Lisp_Object idx,bool t_ok,bool noinherit,bool autoload)530 access_keymap (Lisp_Object map, Lisp_Object idx,
531 	       bool t_ok, bool noinherit, bool autoload)
532 {
533   Lisp_Object val = access_keymap_1 (map, idx, t_ok, noinherit, autoload);
534   return EQ (val, Qunbound) ? Qnil : val;
535 }
536 
537 static void
map_keymap_item(map_keymap_function_t fun,Lisp_Object args,Lisp_Object key,Lisp_Object val,void * data)538 map_keymap_item (map_keymap_function_t fun, Lisp_Object args, Lisp_Object key, Lisp_Object val, void *data)
539 {
540   if (EQ (val, Qt))
541     val = Qnil;
542   (*fun) (key, val, args, data);
543 }
544 
545 union map_keymap
546 {
547   struct
548   {
549     map_keymap_function_t fun;
550     Lisp_Object args;
551     void *data;
552   } s;
553   GCALIGNED_UNION_MEMBER
554 };
555 verify (GCALIGNED (union map_keymap));
556 
557 static void
map_keymap_char_table_item(Lisp_Object args,Lisp_Object key,Lisp_Object val)558 map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val)
559 {
560   if (!NILP (val))
561     {
562       /* If the key is a range, make a copy since map_char_table modifies
563 	 it in place.  */
564       if (CONSP (key))
565 	key = Fcons (XCAR (key), XCDR (key));
566       union map_keymap *md = XFIXNUMPTR (args);
567       map_keymap_item (md->s.fun, md->s.args, key, val, md->s.data);
568     }
569 }
570 
571 /* Call FUN for every binding in MAP and stop at (and return) the parent.
572    FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).  */
573 static Lisp_Object
map_keymap_internal(Lisp_Object map,map_keymap_function_t fun,Lisp_Object args,void * data)574 map_keymap_internal (Lisp_Object map,
575 		     map_keymap_function_t fun,
576 		     Lisp_Object args,
577 		     void *data)
578 {
579   Lisp_Object tail
580     = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
581 
582   for (; CONSP (tail) && !EQ (Qkeymap, XCAR (tail)); tail = XCDR (tail))
583     {
584       Lisp_Object binding = XCAR (tail);
585 
586       if (KEYMAPP (binding))	/* An embedded parent.  */
587 	break;
588       else if (CONSP (binding))
589 	map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
590       else if (VECTORP (binding))
591 	{
592 	  /* Loop over the char values represented in the vector.  */
593 	  int len = ASIZE (binding);
594 	  int c;
595 	  for (c = 0; c < len; c++)
596 	    {
597 	      Lisp_Object character;
598 	      XSETFASTINT (character, c);
599 	      map_keymap_item (fun, args, character, AREF (binding, c), data);
600 	    }
601 	}
602       else if (CHAR_TABLE_P (binding))
603 	{
604 	  union map_keymap mapdata = {{fun, args, data}};
605 	  map_char_table (map_keymap_char_table_item, Qnil, binding,
606 			  make_pointer_integer (&mapdata));
607 	}
608     }
609 
610   return tail;
611 }
612 
613 static void
map_keymap_call(Lisp_Object key,Lisp_Object val,Lisp_Object fun,void * dummy)614 map_keymap_call (Lisp_Object key, Lisp_Object val, Lisp_Object fun, void *dummy)
615 {
616   call2 (fun, key, val);
617 }
618 
619 /* Same as map_keymap_internal, but traverses parent keymaps as well.
620    AUTOLOAD indicates that autoloaded keymaps should be loaded.  */
621 void
map_keymap(Lisp_Object map,map_keymap_function_t fun,Lisp_Object args,void * data,bool autoload)622 map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args,
623 	    void *data, bool autoload)
624 {
625   map = get_keymap (map, 1, autoload);
626   while (CONSP (map))
627     {
628       if (KEYMAPP (XCAR (map)))
629 	{
630 	  map_keymap (XCAR (map), fun, args, data, autoload);
631 	  map = XCDR (map);
632 	}
633       else
634 	map = map_keymap_internal (map, fun, args, data);
635       if (!CONSP (map))
636 	map = get_keymap (map, 0, autoload);
637     }
638 }
639 
640 /* Same as map_keymap, but does it right, properly eliminating duplicate
641    bindings due to inheritance.   */
642 void
map_keymap_canonical(Lisp_Object map,map_keymap_function_t fun,Lisp_Object args,void * data)643 map_keymap_canonical (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data)
644 {
645   /* map_keymap_canonical may be used from redisplay (e.g. when building menus)
646      so be careful to ignore errors and to inhibit redisplay.  */
647   map = safe_call1 (Qkeymap_canonicalize, map);
648   /* No need to use `map_keymap' here because canonical map has no parent.  */
649   map_keymap_internal (map, fun, args, data);
650 }
651 
652 DEFUN ("map-keymap-internal", Fmap_keymap_internal, Smap_keymap_internal, 2, 2, 0,
653        doc: /* Call FUNCTION once for each event binding in KEYMAP.
654 FUNCTION is called with two arguments: the event that is bound, and
655 the definition it is bound to.  The event may be a character range.
656 If KEYMAP has a parent, this function returns it without processing it.  */)
657   (Lisp_Object function, Lisp_Object keymap)
658 {
659   keymap = get_keymap (keymap, 1, 1);
660   keymap = map_keymap_internal (keymap, map_keymap_call, function, NULL);
661   return keymap;
662 }
663 
664 DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
665        doc: /* Call FUNCTION once for each event binding in KEYMAP.
666 FUNCTION is called with two arguments: the event that is bound, and
667 the definition it is bound to.  The event may be a character range.
668 
669 If KEYMAP has a parent, the parent's bindings are included as well.
670 This works recursively: if the parent has itself a parent, then the
671 grandparent's bindings are also included and so on.
672 usage: (map-keymap FUNCTION KEYMAP)  */)
673   (Lisp_Object function, Lisp_Object keymap, Lisp_Object sort_first)
674 {
675   if (! NILP (sort_first))
676     return call2 (intern ("map-keymap-sorted"), function, keymap);
677 
678   map_keymap (keymap, map_keymap_call, function, NULL, 1);
679   return Qnil;
680 }
681 
682 /* Given OBJECT which was found in a slot in a keymap,
683    trace indirect definitions to get the actual definition of that slot.
684    An indirect definition is a list of the form
685    (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
686    and INDEX is the object to look up in KEYMAP to yield the definition.
687 
688    Also if OBJECT has a menu string as the first element,
689    remove that.  Also remove a menu help string as second element.
690 
691    If AUTOLOAD, load autoloadable keymaps
692    that are referred to with indirection.
693 
694    This can GC because menu_item_eval_property calls Feval.  */
695 
696 static Lisp_Object
get_keyelt(Lisp_Object object,bool autoload)697 get_keyelt (Lisp_Object object, bool autoload)
698 {
699   while (1)
700     {
701       if (!(CONSP (object)))
702 	/* This is really the value.  */
703 	return object;
704 
705       /* If the keymap contents looks like (menu-item name . DEFN)
706 	 or (menu-item name DEFN ...) then use DEFN.
707 	 This is a new format menu item.  */
708       else if (EQ (XCAR (object), Qmenu_item))
709 	{
710 	  if (CONSP (XCDR (object)))
711 	    {
712 	      Lisp_Object tem;
713 
714 	      object = XCDR (XCDR (object));
715 	      tem = object;
716 	      if (CONSP (object))
717 		object = XCAR (object);
718 
719 	      /* If there's a `:filter FILTER', apply FILTER to the
720 		 menu-item's definition to get the real definition to
721 		 use.  */
722 	      for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
723 		if (EQ (XCAR (tem), QCfilter) && autoload)
724 		  {
725 		    Lisp_Object filter;
726 		    filter = XCAR (XCDR (tem));
727 		    filter = list2 (filter, list2 (Qquote, object));
728 		    object = menu_item_eval_property (filter);
729 		    break;
730 		  }
731 	    }
732 	  else
733 	    /* Invalid keymap.  */
734 	    return object;
735 	}
736 
737       /* If the keymap contents looks like (STRING . DEFN), use DEFN.
738 	 Keymap alist elements like (CHAR MENUSTRING . DEFN)
739 	 will be used by HierarKey menus.  */
740       else if (STRINGP (XCAR (object)))
741 	object = XCDR (object);
742 
743       else
744 	return object;
745     }
746 }
747 
748 static Lisp_Object
store_in_keymap(Lisp_Object keymap,register Lisp_Object idx,Lisp_Object def)749 store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
750 {
751   /* Flush any reverse-map cache.  */
752   where_is_cache = Qnil;
753   where_is_cache_keymaps = Qt;
754 
755   if (EQ (idx, Qkeymap))
756     error ("`keymap' is reserved for embedded parent maps");
757 
758   /* If we are preparing to dump, and DEF is a menu element
759      with a menu item indicator, copy it to ensure it is not pure.  */
760   if (CONSP (def) && PURE_P (XCONS (def))
761       && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
762     def = Fcons (XCAR (def), XCDR (def));
763 
764   if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
765     error ("attempt to define a key in a non-keymap");
766 
767   /* If idx is a cons, and the car part is a character, idx must be of
768      the form (FROM-CHAR . TO-CHAR).  */
769   if (CONSP (idx) && CHARACTERP (XCAR (idx)))
770     CHECK_CHARACTER_CDR (idx);
771   else
772     /* If idx is a list (some sort of mouse click, perhaps?),
773        the index we want to use is the car of the list, which
774        ought to be a symbol.  */
775     idx = EVENT_HEAD (idx);
776 
777   /* If idx is a symbol, it might have modifiers, which need to
778      be put in the canonical order.  */
779   if (SYMBOLP (idx))
780     idx = reorder_modifiers (idx);
781   else if (FIXNUMP (idx))
782     /* Clobber the high bits that can be present on a machine
783        with more than 24 bits of integer.  */
784     XSETFASTINT (idx, XFIXNUM (idx) & (CHAR_META | (CHAR_META - 1)));
785 
786   /* Scan the keymap for a binding of idx.  */
787   {
788     Lisp_Object tail;
789 
790     /* The cons after which we should insert new bindings.  If the
791        keymap has a table element, we record its position here, so new
792        bindings will go after it; this way, the table will stay
793        towards the front of the alist and character lookups in dense
794        keymaps will remain fast.  Otherwise, this just points at the
795        front of the keymap.  */
796     Lisp_Object insertion_point;
797 
798     insertion_point = keymap;
799     for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
800       {
801 	Lisp_Object elt;
802 
803 	elt = XCAR (tail);
804 	if (VECTORP (elt))
805 	  {
806 	    if (FIXNATP (idx) && XFIXNAT (idx) < ASIZE (elt))
807 	      {
808 		CHECK_IMPURE (elt, XVECTOR (elt));
809 		ASET (elt, XFIXNAT (idx), def);
810 		return def;
811 	      }
812 	    else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
813 	      {
814 		int from = XFIXNAT (XCAR (idx));
815 		int to = XFIXNAT (XCDR (idx));
816 
817 		if (to >= ASIZE (elt))
818 		  to = ASIZE (elt) - 1;
819 		for (; from <= to; from++)
820 		  ASET (elt, from, def);
821 		if (to == XFIXNAT (XCDR (idx)))
822 		  /* We have defined all keys in IDX.  */
823 		  return def;
824 	      }
825 	    insertion_point = tail;
826 	  }
827 	else if (CHAR_TABLE_P (elt))
828 	  {
829 	    /* Character codes with modifiers
830 	       are not included in a char-table.
831 	       All character codes without modifiers are included.  */
832 	    if (FIXNATP (idx) && !(XFIXNAT (idx) & CHAR_MODIFIER_MASK))
833 	      {
834 		Faset (elt, idx,
835 		       /* nil has a special meaning for char-tables, so
836 			  we use something else to record an explicitly
837 			  unbound entry.  */
838 		       NILP (def) ? Qt : def);
839 		return def;
840 	      }
841 	    else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
842 	      {
843 		Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
844 		return def;
845 	      }
846 	    insertion_point = tail;
847 	  }
848 	else if (CONSP (elt))
849 	  {
850 	    if (EQ (Qkeymap, XCAR (elt)))
851 	      { /* A sub keymap.  This might be due to a lookup that found
852 		   two matching bindings (maybe because of a sub keymap).
853 		   It almost never happens (since the second binding normally
854 		   only happens in the inherited part of the keymap), but
855 		   if it does, we want to update the sub-keymap since the
856 		   main one might be temporary (built by access_keymap).  */
857 		tail = insertion_point = elt;
858 	      }
859 	    else if (EQ (idx, XCAR (elt)))
860 	      {
861 		CHECK_IMPURE (elt, XCONS (elt));
862 		XSETCDR (elt, def);
863 		return def;
864 	      }
865 	    else if (CONSP (idx)
866 		     && CHARACTERP (XCAR (idx))
867 		     && CHARACTERP (XCAR (elt)))
868 	      {
869 		int from = XFIXNAT (XCAR (idx));
870 		int to = XFIXNAT (XCDR (idx));
871 
872 		if (from <= XFIXNAT (XCAR (elt))
873 		    && to >= XFIXNAT (XCAR (elt)))
874 		  {
875 		    XSETCDR (elt, def);
876 		    if (from == to)
877 		      return def;
878 		  }
879 	      }
880 	  }
881 	else if (EQ (elt, Qkeymap))
882 	  /* If we find a 'keymap' symbol in the spine of KEYMAP,
883 	     then we must have found the start of a second keymap
884 	     being used as the tail of KEYMAP, and a binding for IDX
885 	     should be inserted before it.  */
886 	  goto keymap_end;
887 
888 	maybe_quit ();
889       }
890 
891   keymap_end:
892     /* We have scanned the entire keymap, and not found a binding for
893        IDX.  Let's add one.  */
894     {
895       Lisp_Object elt;
896 
897       if (CONSP (idx) && CHARACTERP (XCAR (idx)))
898 	{
899 	  /* IDX specifies a range of characters, and not all of them
900 	     were handled yet, which means this keymap doesn't have a
901 	     char-table.  So, we insert a char-table now.  */
902 	  elt = Fmake_char_table (Qkeymap, Qnil);
903 	  Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
904 	}
905       else
906 	elt = Fcons (idx, def);
907       CHECK_IMPURE (insertion_point, XCONS (insertion_point));
908       XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point)));
909     }
910   }
911 
912   return def;
913 }
914 
915 static Lisp_Object copy_keymap_1 (Lisp_Object keymap, int depth);
916 
917 static Lisp_Object
copy_keymap_item(Lisp_Object elt,int depth)918 copy_keymap_item (Lisp_Object elt, int depth)
919 {
920   Lisp_Object res, tem;
921 
922   if (!CONSP (elt))
923     return elt;
924 
925   res = tem = elt;
926 
927   /* Is this a new format menu item.  */
928   if (EQ (XCAR (tem), Qmenu_item))
929     {
930       /* Copy cell with menu-item marker.  */
931       res = elt = Fcons (XCAR (tem), XCDR (tem));
932       tem = XCDR (elt);
933       if (CONSP (tem))
934 	{
935 	  /* Copy cell with menu-item name.  */
936 	  XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
937 	  elt = XCDR (elt);
938 	  tem = XCDR (elt);
939 	}
940       if (CONSP (tem))
941 	{
942 	  /* Copy cell with binding and if the binding is a keymap,
943 	     copy that.  */
944 	  XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
945 	  elt = XCDR (elt);
946 	  tem = XCAR (elt);
947 	  if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
948 	    XSETCAR (elt, copy_keymap_1 (tem, depth));
949 	  tem = XCDR (elt);
950 	}
951     }
952   else
953     {
954       /* It may be an old format menu item.
955 	 Skip the optional menu string.  */
956       if (STRINGP (XCAR (tem)))
957 	{
958 	  /* Copy the cell, since copy-alist didn't go this deep.  */
959 	  res = elt = Fcons (XCAR (tem), XCDR (tem));
960 	  tem = XCDR (elt);
961 	  /* Also skip the optional menu help string.  */
962 	  if (CONSP (tem) && STRINGP (XCAR (tem)))
963 	    {
964 	      XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
965 	      elt = XCDR (elt);
966 	      tem = XCDR (elt);
967 	    }
968 	  if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
969 	    XSETCDR (elt, copy_keymap_1 (tem, depth));
970 	}
971       else if (EQ (XCAR (tem), Qkeymap))
972 	res = copy_keymap_1 (elt, depth);
973     }
974   return res;
975 }
976 
977 static void
copy_keymap_set_char_table(Lisp_Object chartable_and_depth,Lisp_Object idx,Lisp_Object elt)978 copy_keymap_set_char_table (Lisp_Object chartable_and_depth, Lisp_Object idx,
979 			    Lisp_Object elt)
980 {
981   Fset_char_table_range
982     (XCAR (chartable_and_depth), idx,
983      copy_keymap_item (elt, XFIXNUM (XCDR (chartable_and_depth))));
984 }
985 
986 static Lisp_Object
copy_keymap_1(Lisp_Object keymap,int depth)987 copy_keymap_1 (Lisp_Object keymap, int depth)
988 {
989   Lisp_Object copy, tail;
990 
991   if (depth > 100)
992     error ("Possible infinite recursion when copying keymap");
993 
994   keymap = get_keymap (keymap, 1, 0);
995   copy = tail = list1 (Qkeymap);
996   keymap = XCDR (keymap);		/* Skip the `keymap' symbol.  */
997 
998   while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
999     {
1000       Lisp_Object elt = XCAR (keymap);
1001       if (CHAR_TABLE_P (elt))
1002 	{
1003 	  elt = Fcopy_sequence (elt);
1004 	  map_char_table (copy_keymap_set_char_table, Qnil, elt,
1005 			  Fcons (elt, make_fixnum (depth + 1)));
1006 	}
1007       else if (VECTORP (elt))
1008 	{
1009 	  int i;
1010 	  elt = Fcopy_sequence (elt);
1011 	  for (i = 0; i < ASIZE (elt); i++)
1012 	    ASET (elt, i, copy_keymap_item (AREF (elt, i), depth + 1));
1013 	}
1014       else if (CONSP (elt))
1015 	{
1016 	  if (EQ (XCAR (elt), Qkeymap))
1017 	    /* This is a sub keymap.  */
1018 	    elt = copy_keymap_1 (elt, depth + 1);
1019 	  else
1020 	    elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt), depth + 1));
1021 	}
1022       XSETCDR (tail, list1 (elt));
1023       tail = XCDR (tail);
1024       keymap = XCDR (keymap);
1025     }
1026   XSETCDR (tail, keymap);
1027   return copy;
1028 }
1029 
1030 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
1031        doc: /* Return a copy of the keymap KEYMAP.
1032 
1033 Note that this is almost never needed.  If you want a keymap that's like
1034 another yet with a few changes, you should use map inheritance rather
1035 than copying.  I.e. something like:
1036 
1037     (let ((map (make-sparse-keymap)))
1038       (set-keymap-parent map <theirmap>)
1039       (define-key map ...)
1040       ...)
1041 
1042 After performing `copy-keymap', the copy starts out with the same definitions
1043 of KEYMAP, but changing either the copy or KEYMAP does not affect the other.
1044 Any key definitions that are subkeymaps are recursively copied.
1045 However, a key definition which is a symbol whose definition is a keymap
1046 is not copied.  */)
1047   (Lisp_Object keymap)
1048 {
1049   return copy_keymap_1 (keymap, 0);
1050 }
1051 
1052 
1053 /* Simple Keymap mutators and accessors.				*/
1054 
1055 /* GC is possible in this function if it autoloads a keymap.  */
1056 
1057 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
1058        doc: /* In KEYMAP, define key sequence KEY as DEF.
1059 KEYMAP is a keymap.
1060 
1061 KEY is a string or a vector of symbols and characters, representing a
1062 sequence of keystrokes and events.  Non-ASCII characters with codes
1063 above 127 (such as ISO Latin-1) can be represented by vectors.
1064 Two types of vector have special meanings:
1065  [remap COMMAND] remaps any key binding for COMMAND.
1066  [t] creates a default definition, which applies to any event with no
1067     other definition in KEYMAP.
1068 
1069 DEF is anything that can be a key's definition:
1070  nil (means key is undefined in this keymap),
1071  a command (a Lisp function suitable for interactive calling),
1072  a string (treated as a keyboard macro),
1073  a keymap (to define a prefix key),
1074  a symbol (when the key is looked up, the symbol will stand for its
1075     function definition, which should at that time be one of the above,
1076     or another symbol whose function definition is used, etc.),
1077  a cons (STRING . DEFN), meaning that DEFN is the definition
1078     (DEFN should be a valid definition in its own right),
1079  or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP,
1080  or an extended menu item definition.
1081  (See info node `(elisp)Extended Menu Items'.)
1082 
1083 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1084 binding is altered.  If there is no binding for KEY, the new pair
1085 binding KEY to DEF is added at the front of KEYMAP.  */)
1086   (Lisp_Object keymap, Lisp_Object key, Lisp_Object def)
1087 {
1088   ptrdiff_t idx;
1089   Lisp_Object c;
1090   Lisp_Object cmd;
1091   bool metized = 0;
1092   int meta_bit;
1093   ptrdiff_t length;
1094 
1095   keymap = get_keymap (keymap, 1, 1);
1096 
1097   length = CHECK_VECTOR_OR_STRING (key);
1098   if (length == 0)
1099     return Qnil;
1100 
1101   if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1102     Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1103 
1104   meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key))
1105 	      ? meta_modifier : 0x80);
1106 
1107   if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
1108     { /* DEF is apparently an XEmacs-style keyboard macro.  */
1109       Lisp_Object tmp = make_nil_vector (ASIZE (def));
1110       ptrdiff_t i = ASIZE (def);
1111       while (--i >= 0)
1112 	{
1113 	  Lisp_Object defi = AREF (def, i);
1114 	  if (CONSP (defi) && lucid_event_type_list_p (defi))
1115 	    defi = Fevent_convert_list (defi);
1116 	  ASET (tmp, i, defi);
1117 	}
1118       def = tmp;
1119     }
1120 
1121   idx = 0;
1122   while (1)
1123     {
1124       c = Faref (key, make_fixnum (idx));
1125 
1126       if (CONSP (c))
1127 	{
1128 	  /* C may be a Lucid style event type list or a cons (FROM .
1129 	     TO) specifying a range of characters.  */
1130 	  if (lucid_event_type_list_p (c))
1131 	    c = Fevent_convert_list (c);
1132 	  else if (CHARACTERP (XCAR (c)))
1133 	    CHECK_CHARACTER_CDR (c);
1134 	}
1135 
1136       if (SYMBOLP (c))
1137 	silly_event_symbol_error (c);
1138 
1139       if (FIXNUMP (c)
1140 	  && (XFIXNUM (c) & meta_bit)
1141 	  && !metized)
1142 	{
1143 	  c = meta_prefix_char;
1144 	  metized = 1;
1145 	}
1146       else
1147 	{
1148 	  if (FIXNUMP (c))
1149 	    XSETINT (c, XFIXNUM (c) & ~meta_bit);
1150 
1151 	  metized = 0;
1152 	  idx++;
1153 	}
1154 
1155       if (!FIXNUMP (c) && !SYMBOLP (c)
1156 	  && (!CONSP (c)
1157 	      /* If C is a range, it must be a leaf.  */
1158 	      || (FIXNUMP (XCAR (c)) && idx != length)))
1159 	message_with_string ("Key sequence contains invalid event %s", c, 1);
1160 
1161       if (idx == length)
1162 	return store_in_keymap (keymap, c, def);
1163 
1164       cmd = access_keymap (keymap, c, 0, 1, 1);
1165 
1166       /* If this key is undefined, make it a prefix.  */
1167       if (NILP (cmd))
1168 	cmd = define_as_prefix (keymap, c);
1169 
1170       keymap = get_keymap (cmd, 0, 1);
1171       if (!CONSP (keymap))
1172 	{
1173 	  const char *trailing_esc = ((EQ (c, meta_prefix_char) && metized)
1174 				      ? (idx == 0 ? "ESC" : " ESC")
1175 				      : "");
1176 
1177 	  /* We must use Fkey_description rather than just passing key to
1178 	     error; key might be a vector, not a string.  */
1179 	  error ("Key sequence %s starts with non-prefix key %s%s",
1180 		 SDATA (Fkey_description (key, Qnil)),
1181 		 SDATA (Fkey_description (Fsubstring (key, make_fixnum (0),
1182 						      make_fixnum (idx)),
1183 					  Qnil)),
1184 		 trailing_esc);
1185 	}
1186     }
1187 }
1188 
1189 /* This function may GC (it calls Fkey_binding).  */
1190 
1191 DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 3, 0,
1192        doc: /* Return the remapping for command COMMAND.
1193 Returns nil if COMMAND is not remapped (or not a symbol).
1194 
1195 If the optional argument POSITION is non-nil, it specifies a mouse
1196 position as returned by `event-start' and `event-end', and the
1197 remapping occurs in the keymaps associated with it.  It can also be a
1198 number or marker, in which case the keymap properties at the specified
1199 buffer position instead of point are used.  The KEYMAPS argument is
1200 ignored if POSITION is non-nil.
1201 
1202 If the optional argument KEYMAPS is non-nil, it should be a keymap or list of
1203 keymaps to search for command remapping.  Otherwise, search for the
1204 remapping in all currently active keymaps.  */)
1205   (Lisp_Object command, Lisp_Object position, Lisp_Object keymaps)
1206 {
1207   if (!SYMBOLP (command))
1208     return Qnil;
1209 
1210   ASET (command_remapping_vector, 1, command);
1211 
1212   if (NILP (keymaps))
1213     command = Fkey_binding (command_remapping_vector, Qnil, Qt, position);
1214   else
1215     command = Flookup_key (keymaps, command_remapping_vector, Qnil);
1216   return FIXNUMP (command) ? Qnil : command;
1217 }
1218 
1219 /* Value is number if KEY is too long; nil if valid but has no definition.  */
1220 /* GC is possible in this function.  */
1221 
1222 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1223        doc: /* Look up key sequence KEY in KEYMAP.  Return the definition.
1224 A value of nil means undefined.  See doc of `define-key'
1225 for kinds of definitions.
1226 
1227 A number as value means KEY is "too long";
1228 that is, characters or symbols in it except for the last one
1229 fail to be a valid sequence of prefix characters in KEYMAP.
1230 The number is how many characters at the front of KEY
1231 it takes to reach a non-prefix key.
1232 KEYMAP can also be a list of keymaps.
1233 
1234 Normally, `lookup-key' ignores bindings for t, which act as default
1235 bindings, used when nothing else in the keymap applies; this makes it
1236 usable as a general function for probing keymaps.  However, if the
1237 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1238 recognize the default bindings, just as `read-key-sequence' does.  */)
1239   (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default)
1240 {
1241   ptrdiff_t idx;
1242   Lisp_Object cmd;
1243   Lisp_Object c;
1244   ptrdiff_t length;
1245   bool t_ok = !NILP (accept_default);
1246 
1247   if (!CONSP (keymap) && !NILP (keymap))
1248     keymap = get_keymap (keymap, true, true);
1249 
1250   length = CHECK_VECTOR_OR_STRING (key);
1251   if (length == 0)
1252     return keymap;
1253 
1254   idx = 0;
1255   while (1)
1256     {
1257       c = Faref (key, make_fixnum (idx++));
1258 
1259       if (CONSP (c) && lucid_event_type_list_p (c))
1260 	c = Fevent_convert_list (c);
1261 
1262       /* Turn the 8th bit of string chars into a meta modifier.  */
1263       if (STRINGP (key) && XFIXNUM (c) & 0x80 && !STRING_MULTIBYTE (key))
1264 	XSETINT (c, (XFIXNUM (c) | meta_modifier) & ~0x80);
1265 
1266       /* Allow string since binding for `menu-bar-select-buffer'
1267 	 includes the buffer name in the key sequence.  */
1268       if (!FIXNUMP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
1269 	message_with_string ("Key sequence contains invalid event %s", c, 1);
1270 
1271       cmd = access_keymap (keymap, c, t_ok, 0, 1);
1272       if (idx == length)
1273 	return cmd;
1274 
1275       keymap = get_keymap (cmd, 0, 1);
1276       if (!CONSP (keymap))
1277 	return make_fixnum (idx);
1278 
1279       maybe_quit ();
1280     }
1281 }
1282 
1283 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1284    Assume that currently it does not define C at all.
1285    Return the keymap.  */
1286 
1287 static Lisp_Object
define_as_prefix(Lisp_Object keymap,Lisp_Object c)1288 define_as_prefix (Lisp_Object keymap, Lisp_Object c)
1289 {
1290   Lisp_Object cmd;
1291 
1292   cmd = Fmake_sparse_keymap (Qnil);
1293   store_in_keymap (keymap, c, cmd);
1294 
1295   return cmd;
1296 }
1297 
1298 /* Append a key to the end of a key sequence.  We always make a vector.  */
1299 
1300 static Lisp_Object
append_key(Lisp_Object key_sequence,Lisp_Object key)1301 append_key (Lisp_Object key_sequence, Lisp_Object key)
1302 {
1303   AUTO_LIST1 (key_list, key);
1304   return CALLN (Fvconcat, key_sequence, key_list);
1305 }
1306 
1307 /* Given an event type C which is a symbol,
1308    signal an error if is a mistake such as RET or M-RET or C-DEL, etc.  */
1309 
1310 static void
silly_event_symbol_error(Lisp_Object c)1311 silly_event_symbol_error (Lisp_Object c)
1312 {
1313   Lisp_Object parsed, base, name, assoc;
1314   int modifiers;
1315 
1316   parsed = parse_modifiers (c);
1317   modifiers = XFIXNAT (XCAR (XCDR (parsed)));
1318   base = XCAR (parsed);
1319   name = Fsymbol_name (base);
1320   /* This alist includes elements such as ("RET" . "\\r").  */
1321   assoc = Fassoc (name, exclude_keys, Qnil);
1322 
1323   if (! NILP (assoc))
1324     {
1325       char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1326       char *p = new_mods;
1327       Lisp_Object keystring;
1328       if (modifiers & alt_modifier)
1329 	{ *p++ = '\\'; *p++ = 'A'; *p++ = '-'; }
1330       if (modifiers & ctrl_modifier)
1331 	{ *p++ = '\\'; *p++ = 'C'; *p++ = '-'; }
1332       if (modifiers & hyper_modifier)
1333 	{ *p++ = '\\'; *p++ = 'H'; *p++ = '-'; }
1334       if (modifiers & meta_modifier)
1335 	{ *p++ = '\\'; *p++ = 'M'; *p++ = '-'; }
1336       if (modifiers & shift_modifier)
1337 	{ *p++ = '\\'; *p++ = 'S'; *p++ = '-'; }
1338       if (modifiers & super_modifier)
1339 	{ *p++ = '\\'; *p++ = 's'; *p++ = '-'; }
1340       *p = 0;
1341 
1342       c = reorder_modifiers (c);
1343       AUTO_STRING_WITH_LEN (new_mods_string, new_mods, p - new_mods);
1344       keystring = concat2 (new_mods_string, XCDR (assoc));
1345 
1346       error ("To bind the key %s, use [?%s], not [%s]",
1347 	     SDATA (SYMBOL_NAME (c)), SDATA (keystring),
1348 	     SDATA (SYMBOL_NAME (c)));
1349     }
1350 }
1351 
1352 /* Global, local, and minor mode keymap stuff.				*/
1353 
1354 /* We can't put these variables inside current_minor_maps, since under
1355    some systems, static gets macro-defined to be the empty string.
1356    Ickypoo.  */
1357 static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
1358 static ptrdiff_t cmm_size = 0;
1359 
1360 /* Store a pointer to an array of the currently active minor modes in
1361    *modeptr, a pointer to an array of the keymaps of the currently
1362    active minor modes in *mapptr, and return the number of maps
1363    *mapptr contains.
1364 
1365    This function always returns a pointer to the same buffer, and may
1366    free or reallocate it, so if you want to keep it for a long time or
1367    hand it out to lisp code, copy it.  This procedure will be called
1368    for every key sequence read, so the nice lispy approach (return a
1369    new assoclist, list, what have you) for each invocation would
1370    result in a lot of consing over time.
1371 
1372    If we used xrealloc/xmalloc and ran out of memory, they would throw
1373    back to the command loop, which would try to read a key sequence,
1374    which would call this function again, resulting in an infinite
1375    loop.  Instead, we'll use realloc/malloc and silently truncate the
1376    list, let the key sequence be read, and hope some other piece of
1377    code signals the error.  */
1378 ptrdiff_t
current_minor_maps(Lisp_Object ** modeptr,Lisp_Object ** mapptr)1379 current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr)
1380 {
1381   ptrdiff_t i = 0;
1382   int list_number = 0;
1383   Lisp_Object alist, assoc, var, val;
1384   Lisp_Object emulation_alists;
1385   Lisp_Object lists[2];
1386 
1387   emulation_alists = Vemulation_mode_map_alists;
1388   lists[0] = Vminor_mode_overriding_map_alist;
1389   lists[1] = Vminor_mode_map_alist;
1390 
1391   for (list_number = 0; list_number < 2; list_number++)
1392     {
1393       if (CONSP (emulation_alists))
1394 	{
1395 	  alist = XCAR (emulation_alists);
1396 	  emulation_alists = XCDR (emulation_alists);
1397 	  if (SYMBOLP (alist))
1398 	    alist = find_symbol_value (alist);
1399 	  list_number = -1;
1400 	}
1401       else
1402 	alist = lists[list_number];
1403 
1404       for ( ; CONSP (alist); alist = XCDR (alist))
1405 	if ((assoc = XCAR (alist), CONSP (assoc))
1406 	    && (var = XCAR (assoc), SYMBOLP (var))
1407 	    && (val = find_symbol_value (var), !EQ (val, Qunbound))
1408 	    && !NILP (val))
1409 	  {
1410 	    Lisp_Object temp;
1411 
1412 	    /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1413 	       and also an entry in Vminor_mode_map_alist,
1414 	       ignore the latter.  */
1415 	    if (list_number == 1)
1416 	      {
1417 		val = assq_no_quit (var, lists[0]);
1418 		if (!NILP (val))
1419 		  continue;
1420 	      }
1421 
1422 	    if (i >= cmm_size)
1423 	      {
1424 		ptrdiff_t newsize, allocsize;
1425 		Lisp_Object *newmodes, *newmaps;
1426 
1427 		/* Check for size calculation overflow.  Other code
1428 		   (e.g., read_key_sequence) adds 3 to the count
1429 		   later, so subtract 3 from the limit here.  */
1430 		if (min (PTRDIFF_MAX, SIZE_MAX) / (2 * sizeof *newmodes) - 3
1431 		    < cmm_size)
1432 		  break;
1433 
1434 		newsize = cmm_size == 0 ? 30 : cmm_size * 2;
1435 		allocsize = newsize * sizeof *newmodes;
1436 
1437 		/* Use malloc here.  See the comment above this function.
1438 		   Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1439 		block_input ();
1440 		newmodes = malloc (allocsize);
1441 		if (newmodes)
1442 		  {
1443 		    if (cmm_modes)
1444 		      {
1445 			memcpy (newmodes, cmm_modes,
1446 				cmm_size * sizeof cmm_modes[0]);
1447 			free (cmm_modes);
1448 		      }
1449 		    cmm_modes = newmodes;
1450 		  }
1451 
1452 		newmaps = malloc (allocsize);
1453 		if (newmaps)
1454 		  {
1455 		    if (cmm_maps)
1456 		      {
1457 			memcpy (newmaps, cmm_maps,
1458 				cmm_size * sizeof cmm_maps[0]);
1459 			free (cmm_maps);
1460 		      }
1461 		    cmm_maps = newmaps;
1462 		  }
1463 		unblock_input ();
1464 
1465 		if (newmodes == NULL || newmaps == NULL)
1466 		  break;
1467 		cmm_size = newsize;
1468 	      }
1469 
1470 	    /* Get the keymap definition--or nil if it is not defined.  */
1471 	    temp = Findirect_function (XCDR (assoc), Qt);
1472 	    if (!NILP (temp))
1473 	      {
1474 		cmm_modes[i] = var;
1475 		cmm_maps [i] = temp;
1476 		i++;
1477 	      }
1478 	  }
1479     }
1480 
1481   if (modeptr) *modeptr = cmm_modes;
1482   if (mapptr)  *mapptr  = cmm_maps;
1483   return i;
1484 }
1485 
1486 /* Return the offset of POSITION, a click position, in the style of
1487    the respective argument of Fkey_binding.  */
1488 static ptrdiff_t
click_position(Lisp_Object position)1489 click_position (Lisp_Object position)
1490 {
1491   EMACS_INT pos = (FIXNUMP (position) ? XFIXNUM (position)
1492 		   : MARKERP (position) ? marker_position (position)
1493 		   : PT);
1494   if (! (BEGV <= pos && pos <= ZV))
1495     args_out_of_range (Fcurrent_buffer (), position);
1496   return pos;
1497 }
1498 
1499 DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
1500        0, 2, 0,
1501        doc: /* Return a list of the currently active keymaps.
1502 OLP if non-nil indicates that we should obey `overriding-local-map' and
1503 `overriding-terminal-local-map'.  POSITION can specify a click position
1504 like in the respective argument of `key-binding'.  */)
1505   (Lisp_Object olp, Lisp_Object position)
1506 {
1507   ptrdiff_t count = SPECPDL_INDEX ();
1508 
1509   Lisp_Object keymaps = list1 (current_global_map);
1510 
1511   /* If a mouse click position is given, our variables are based on
1512      the buffer clicked on, not the current buffer.  So we may have to
1513      switch the buffer here.  */
1514 
1515   if (CONSP (position))
1516     {
1517       Lisp_Object window;
1518 
1519       window = POSN_WINDOW (position);
1520 
1521       if (WINDOWP (window)
1522 	  && BUFFERP (XWINDOW (window)->contents)
1523 	  && XBUFFER (XWINDOW (window)->contents) != current_buffer)
1524 	{
1525 	  /* Arrange to go back to the original buffer once we're done
1526 	     processing the key sequence.  We don't use
1527 	     save_excursion_{save,restore} here, in analogy to
1528 	     `read-key-sequence' to avoid saving point.  Maybe this
1529 	     would not be a problem here, but it is easier to keep
1530 	     things the same.
1531 	  */
1532 	  record_unwind_current_buffer ();
1533 	  set_buffer_internal (XBUFFER (XWINDOW (window)->contents));
1534 	}
1535     }
1536 
1537   if (!NILP (olp)
1538       /* The doc said that overriding-terminal-local-map should
1539 	 override overriding-local-map.  The code used them both,
1540 	 but it seems clearer to use just one.  rms, jan 2005.  */
1541       && NILP (KVAR (current_kboard, Voverriding_terminal_local_map))
1542       && !NILP (Voverriding_local_map))
1543     keymaps = Fcons (Voverriding_local_map, keymaps);
1544 
1545   if (NILP (XCDR (keymaps)))
1546     {
1547       Lisp_Object *maps;
1548       int nmaps, i;
1549       ptrdiff_t pt = click_position (position);
1550       /* This usually returns the buffer's local map,
1551 	 but that can be overridden by a `local-map' property.  */
1552       Lisp_Object local_map = get_local_map (pt, current_buffer, Qlocal_map);
1553       /* This returns nil unless there is a `keymap' property.  */
1554       Lisp_Object keymap = get_local_map (pt, current_buffer, Qkeymap);
1555       Lisp_Object otlp = KVAR (current_kboard, Voverriding_terminal_local_map);
1556 
1557       if (CONSP (position))
1558 	{
1559 	  Lisp_Object string = POSN_STRING (position);
1560 
1561 	  /* For a mouse click, get the local text-property keymap
1562 	     of the place clicked on, rather than point.  */
1563 
1564 	  if (POSN_INBUFFER_P (position))
1565 	    {
1566 	      Lisp_Object pos;
1567 
1568 	      pos = POSN_BUFFER_POSN (position);
1569 	      if (FIXNUMP (pos)
1570 		  && XFIXNUM (pos) >= BEG && XFIXNUM (pos) <= Z)
1571 		{
1572 		  local_map = get_local_map (XFIXNUM (pos),
1573 					     current_buffer, Qlocal_map);
1574 
1575 		  keymap = get_local_map (XFIXNUM (pos),
1576 					  current_buffer, Qkeymap);
1577 		}
1578 	    }
1579 
1580 	  /* If on a mode line string with a local keymap,
1581 	     or for a click on a string, i.e. overlay string or a
1582 	     string displayed via the `display' property,
1583 	     consider `local-map' and `keymap' properties of
1584 	     that string.  */
1585 
1586 	  if (CONSP (string) && STRINGP (XCAR (string)))
1587 	    {
1588 	      Lisp_Object pos, map;
1589 
1590 	      pos = XCDR (string);
1591 	      string = XCAR (string);
1592 	      if (FIXNUMP (pos)
1593 		  && XFIXNUM (pos) >= 0
1594 		  && XFIXNUM (pos) < SCHARS (string))
1595 		{
1596 		  map = Fget_text_property (pos, Qlocal_map, string);
1597 		  if (!NILP (map))
1598 		    local_map = map;
1599 
1600 		  map = Fget_text_property (pos, Qkeymap, string);
1601 		  if (!NILP (map))
1602 		    keymap = map;
1603 		}
1604 	    }
1605 
1606 	}
1607 
1608       if (!NILP (local_map))
1609 	keymaps = Fcons (local_map, keymaps);
1610 
1611       /* Now put all the minor mode keymaps on the list.  */
1612       nmaps = current_minor_maps (0, &maps);
1613 
1614       for (i = --nmaps; i >= 0; i--)
1615 	if (!NILP (maps[i]))
1616 	  keymaps = Fcons (maps[i], keymaps);
1617 
1618       if (!NILP (keymap))
1619 	keymaps = Fcons (keymap, keymaps);
1620 
1621       if (!NILP (olp) && !NILP (otlp))
1622 	keymaps = Fcons (otlp, keymaps);
1623     }
1624 
1625   return unbind_to (count, keymaps);
1626 }
1627 
1628 /* GC is possible in this function if it autoloads a keymap.  */
1629 
1630 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
1631        doc: /* Return the binding for command KEY in current keymaps.
1632 KEY is a string or vector, a sequence of keystrokes.
1633 The binding is probably a symbol with a function definition.
1634 
1635 Normally, `key-binding' ignores bindings for t, which act as default
1636 bindings, used when nothing else in the keymap applies; this makes it
1637 usable as a general function for probing keymaps.  However, if the
1638 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1639 recognize the default bindings, just as `read-key-sequence' does.
1640 
1641 Like the normal command loop, `key-binding' will remap the command
1642 resulting from looking up KEY by looking up the command in the
1643 current keymaps.  However, if the optional third argument NO-REMAP
1644 is non-nil, `key-binding' returns the unmapped command.
1645 
1646 If KEY is a key sequence initiated with the mouse, the used keymaps
1647 will depend on the clicked mouse position with regard to the buffer
1648 and possible local keymaps on strings.
1649 
1650 If the optional argument POSITION is non-nil, it specifies a mouse
1651 position as returned by `event-start' and `event-end', and the lookup
1652 occurs in the keymaps associated with it instead of KEY.  It can also
1653 be a number or marker, in which case the keymap properties at the
1654 specified buffer position instead of point are used.
1655   */)
1656   (Lisp_Object key, Lisp_Object accept_default, Lisp_Object no_remap, Lisp_Object position)
1657 {
1658   Lisp_Object value;
1659 
1660   if (NILP (position) && VECTORP (key))
1661     {
1662       Lisp_Object event;
1663 
1664       if (ASIZE (key) == 0)
1665 	return Qnil;
1666 
1667       /* mouse events may have a symbolic prefix indicating the
1668 	 scrollbar or mode line */
1669       event = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
1670 
1671       /* We are not interested in locations without event data */
1672 
1673       if (EVENT_HAS_PARAMETERS (event) && CONSP (XCDR (event)))
1674 	{
1675 	  Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (event));
1676 	  if (EQ (kind, Qmouse_click))
1677 	    position = EVENT_START (event);
1678 	}
1679     }
1680 
1681   value = Flookup_key (Fcurrent_active_maps (Qt, position),
1682 		       key, accept_default);
1683 
1684   if (NILP (value) || FIXNUMP (value))
1685     return Qnil;
1686 
1687   /* If the result of the ordinary keymap lookup is an interactive
1688      command, look for a key binding (ie. remapping) for that command.  */
1689 
1690   if (NILP (no_remap) && SYMBOLP (value))
1691     {
1692       Lisp_Object value1;
1693       if (value1 = Fcommand_remapping (value, position, Qnil), !NILP (value1))
1694 	value = value1;
1695     }
1696 
1697   return value;
1698 }
1699 
1700 /* GC is possible in this function if it autoloads a keymap.  */
1701 
1702 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1703        doc: /* Return the binding for command KEYS in current local keymap only.
1704 KEYS is a string or vector, a sequence of keystrokes.
1705 The binding is probably a symbol with a function definition.
1706 
1707 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1708 bindings; see the description of `lookup-key' for more details about this.  */)
1709   (Lisp_Object keys, Lisp_Object accept_default)
1710 {
1711   register Lisp_Object map;
1712   map = BVAR (current_buffer, keymap);
1713   if (NILP (map))
1714     return Qnil;
1715   return Flookup_key (map, keys, accept_default);
1716 }
1717 
1718 /* GC is possible in this function if it autoloads a keymap.  */
1719 
1720 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1721        doc: /* Return the binding for command KEYS in current global keymap only.
1722 KEYS is a string or vector, a sequence of keystrokes.
1723 The binding is probably a symbol with a function definition.
1724 This function's return values are the same as those of `lookup-key'
1725 \(which see).
1726 
1727 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1728 bindings; see the description of `lookup-key' for more details about this.  */)
1729   (Lisp_Object keys, Lisp_Object accept_default)
1730 {
1731   return Flookup_key (current_global_map, keys, accept_default);
1732 }
1733 
1734 /* GC is possible in this function if it autoloads a keymap.  */
1735 
1736 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1737        doc: /* Find the visible minor mode bindings of KEY.
1738 Return an alist of pairs (MODENAME . BINDING), where MODENAME is
1739 the symbol which names the minor mode binding KEY, and BINDING is
1740 KEY's definition in that mode.  In particular, if KEY has no
1741 minor-mode bindings, return nil.  If the first binding is a
1742 non-prefix, all subsequent bindings will be omitted, since they would
1743 be ignored.  Similarly, the list doesn't include non-prefix bindings
1744 that come after prefix bindings.
1745 
1746 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1747 bindings; see the description of `lookup-key' for more details about this.  */)
1748   (Lisp_Object key, Lisp_Object accept_default)
1749 {
1750   Lisp_Object *modes, *maps;
1751   int nmaps;
1752   Lisp_Object binding;
1753   int i, j;
1754 
1755   nmaps = current_minor_maps (&modes, &maps);
1756 
1757   binding = Qnil;
1758 
1759   for (i = j = 0; i < nmaps; i++)
1760     if (!NILP (maps[i])
1761 	&& !NILP (binding = Flookup_key (maps[i], key, accept_default))
1762 	&& !FIXNUMP (binding))
1763       {
1764 	if (KEYMAPP (binding))
1765 	  maps[j++] = Fcons (modes[i], binding);
1766 	else if (j == 0)
1767 	  return list1 (Fcons (modes[i], binding));
1768       }
1769 
1770   return Flist (j, maps);
1771 }
1772 
1773 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
1774        doc: /* Define COMMAND as a prefix command.  COMMAND should be a symbol.
1775 A new sparse keymap is stored as COMMAND's function definition and its
1776 value.
1777 This prepares COMMAND for use as a prefix key's binding.
1778 If a second optional argument MAPVAR is given, it should be a symbol.
1779 The map is then stored as MAPVAR's value instead of as COMMAND's
1780 value; but COMMAND is still defined as a function.
1781 The third optional argument NAME, if given, supplies a menu name
1782 string for the map.  This is required to use the keymap as a menu.
1783 This function returns COMMAND.  */)
1784   (Lisp_Object command, Lisp_Object mapvar, Lisp_Object name)
1785 {
1786   Lisp_Object map;
1787   map = Fmake_sparse_keymap (name);
1788   Ffset (command, map);
1789   if (!NILP (mapvar))
1790     Fset (mapvar, map);
1791   else
1792     Fset (command, map);
1793   return command;
1794 }
1795 
1796 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1797        doc: /* Select KEYMAP as the global keymap.  */)
1798   (Lisp_Object keymap)
1799 {
1800   keymap = get_keymap (keymap, 1, 1);
1801   current_global_map = keymap;
1802 
1803   return Qnil;
1804 }
1805 
1806 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
1807        doc: /* Select KEYMAP as the local keymap.
1808 If KEYMAP is nil, that means no local keymap.  */)
1809   (Lisp_Object keymap)
1810 {
1811   if (!NILP (keymap))
1812     keymap = get_keymap (keymap, 1, 1);
1813 
1814   bset_keymap (current_buffer, keymap);
1815 
1816   return Qnil;
1817 }
1818 
1819 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1820        doc: /* Return current buffer's local keymap, or nil if it has none.
1821 Normally the local keymap is set by the major mode with `use-local-map'.  */)
1822   (void)
1823 {
1824   return BVAR (current_buffer, keymap);
1825 }
1826 
1827 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
1828        doc: /* Return the current global keymap.  */)
1829   (void)
1830 {
1831   return current_global_map;
1832 }
1833 
1834 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
1835        doc: /* Return a list of keymaps for the minor modes of the current buffer.  */)
1836   (void)
1837 {
1838   Lisp_Object *maps;
1839   int nmaps = current_minor_maps (0, &maps);
1840 
1841   return Flist (nmaps, maps);
1842 }
1843 
1844 /* Help functions for describing and documenting keymaps.		*/
1845 
1846 struct accessible_keymaps_data {
1847   Lisp_Object maps, tail, thisseq;
1848   /* Does the current sequence end in the meta-prefix-char?  */
1849   bool is_metized;
1850 };
1851 
1852 static void
accessible_keymaps_1(Lisp_Object key,Lisp_Object cmd,Lisp_Object args,void * data)1853 accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void *data)
1854 /* Use void * data to be compatible with map_keymap_function_t.  */
1855 {
1856   struct accessible_keymaps_data *d = data; /* Cast! */
1857   Lisp_Object maps = d->maps;
1858   Lisp_Object tail = d->tail;
1859   Lisp_Object thisseq = d->thisseq;
1860   bool is_metized = d->is_metized && FIXNUMP (key);
1861   Lisp_Object tem;
1862 
1863   cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
1864   if (NILP (cmd))
1865     return;
1866 
1867   /* Look for and break cycles.  */
1868   while (!NILP (tem = Frassq (cmd, maps)))
1869     {
1870       Lisp_Object prefix = XCAR (tem);
1871       ptrdiff_t lim = XFIXNUM (Flength (XCAR (tem)));
1872       if (lim <= XFIXNUM (Flength (thisseq)))
1873 	{ /* This keymap was already seen with a smaller prefix.  */
1874 	  ptrdiff_t i = 0;
1875 	  while (i < lim && EQ (Faref (prefix, make_fixnum (i)),
1876 				Faref (thisseq, make_fixnum (i))))
1877 	    i++;
1878 	  if (i >= lim)
1879 	    /* `prefix' is a prefix of `thisseq' => there's a cycle.  */
1880 	    return;
1881 	}
1882       /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
1883 	 but maybe `cmd' occurs again further down in `maps', so keep
1884 	 looking.  */
1885       maps = XCDR (Fmemq (tem, maps));
1886     }
1887 
1888   /* If the last key in thisseq is meta-prefix-char,
1889      turn it into a meta-ized keystroke.  We know
1890      that the event we're about to append is an
1891      ascii keystroke since we're processing a
1892      keymap table.  */
1893   if (is_metized)
1894     {
1895       int meta_bit = meta_modifier;
1896       Lisp_Object last = make_fixnum (XFIXNUM (Flength (thisseq)) - 1);
1897       tem = Fcopy_sequence (thisseq);
1898 
1899       Faset (tem, last, make_fixnum (XFIXNUM (key) | meta_bit));
1900 
1901       /* This new sequence is the same length as
1902 	 thisseq, so stick it in the list right
1903 	 after this one.  */
1904       XSETCDR (tail,
1905 	       Fcons (Fcons (tem, cmd), XCDR (tail)));
1906     }
1907   else
1908     {
1909       tem = append_key (thisseq, key);
1910       nconc2 (tail, list1 (Fcons (tem, cmd)));
1911     }
1912 }
1913 
1914 /* This function cannot GC.  */
1915 
1916 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
1917        1, 2, 0,
1918        doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
1919 Returns a list of elements of the form (KEYS . MAP), where the sequence
1920 KEYS starting from KEYMAP gets you to MAP.  These elements are ordered
1921 so that the KEYS increase in length.  The first element is ([] . KEYMAP).
1922 An optional argument PREFIX, if non-nil, should be a key sequence;
1923 then the value includes only maps for prefixes that start with PREFIX.  */)
1924   (Lisp_Object keymap, Lisp_Object prefix)
1925 {
1926   Lisp_Object maps, tail;
1927   EMACS_INT prefixlen = XFIXNAT (Flength (prefix));
1928 
1929   if (!NILP (prefix))
1930     {
1931       /* If a prefix was specified, start with the keymap (if any) for
1932 	 that prefix, so we don't waste time considering other prefixes.  */
1933       Lisp_Object tem;
1934       tem = Flookup_key (keymap, prefix, Qt);
1935       /* Flookup_key may give us nil, or a number,
1936 	 if the prefix is not defined in this particular map.
1937 	 It might even give us a list that isn't a keymap.  */
1938       tem = get_keymap (tem, 0, 0);
1939       /* If the keymap is autoloaded `tem' is not a cons-cell, but we still
1940 	 want to return it.  */
1941       if (!NILP (tem))
1942 	{
1943 	  /* Convert PREFIX to a vector now, so that later on
1944 	     we don't have to deal with the possibility of a string.  */
1945 	  if (STRINGP (prefix))
1946 	    {
1947 	      ptrdiff_t i_byte = 0;
1948 	      Lisp_Object copy = make_nil_vector (SCHARS (prefix));
1949 	      for (ptrdiff_t i = 0; i < SCHARS (prefix); )
1950 		{
1951 		  ptrdiff_t i_before = i;
1952 		  int c;
1953 		  FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
1954 		  if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
1955 		    c ^= 0200 | meta_modifier;
1956 		  ASET (copy, i_before, make_fixnum (c));
1957 		}
1958 	      prefix = copy;
1959 	    }
1960 	  maps = list1 (Fcons (prefix, tem));
1961 	}
1962       else
1963 	return Qnil;
1964     }
1965   else
1966     maps = list1 (Fcons (zero_vector, get_keymap (keymap, 1, 0)));
1967 
1968   /* For each map in the list maps,
1969      look at any other maps it points to,
1970      and stick them at the end if they are not already in the list.
1971 
1972      This is a breadth-first traversal, where tail is the queue of
1973      nodes, and maps accumulates a list of all nodes visited.  */
1974 
1975   for (tail = maps; CONSP (tail); tail = XCDR (tail))
1976     {
1977       struct accessible_keymaps_data data;
1978       register Lisp_Object thismap = Fcdr (XCAR (tail));
1979       Lisp_Object last;
1980 
1981       data.thisseq = Fcar (XCAR (tail));
1982       data.maps = maps;
1983       data.tail = tail;
1984       last = make_fixnum (XFIXNUM (Flength (data.thisseq)) - 1);
1985       /* Does the current sequence end in the meta-prefix-char?  */
1986       data.is_metized = (XFIXNUM (last) >= 0
1987 		    /* Don't metize the last char of PREFIX.  */
1988 		    && XFIXNUM (last) >= prefixlen
1989 		    && EQ (Faref (data.thisseq, last), meta_prefix_char));
1990 
1991       /* Since we can't run lisp code, we can't scan autoloaded maps.  */
1992       if (CONSP (thismap))
1993 	map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0);
1994     }
1995   return maps;
1996 }
1997 
1998 /* This function cannot GC.  */
1999 
2000 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
2001        doc: /* Return a pretty description of key-sequence KEYS.
2002 Optional arg PREFIX is the sequence of keys leading up to KEYS.
2003 For example, [?\C-x ?l] is converted into the string \"C-x l\".
2004 
2005 For an approximate inverse of this, see `kbd'.  */)
2006   (Lisp_Object keys, Lisp_Object prefix)
2007 {
2008   ptrdiff_t len = 0;
2009   EMACS_INT i;
2010   ptrdiff_t i_byte;
2011   Lisp_Object *args;
2012   EMACS_INT size = XFIXNUM (Flength (keys));
2013   Lisp_Object list;
2014   Lisp_Object sep = build_string (" ");
2015   Lisp_Object key;
2016   Lisp_Object result;
2017   bool add_meta = 0;
2018   USE_SAFE_ALLOCA;
2019 
2020   if (!NILP (prefix))
2021     size += XFIXNUM (Flength (prefix));
2022 
2023   /* This has one extra element at the end that we don't pass to Fconcat.  */
2024   EMACS_INT size4;
2025   if (INT_MULTIPLY_WRAPV (size, 4, &size4))
2026     memory_full (SIZE_MAX);
2027   SAFE_ALLOCA_LISP (args, size4);
2028 
2029   /* In effect, this computes
2030      (mapconcat 'single-key-description keys " ")
2031      but we shouldn't use mapconcat because it can do GC.  */
2032 
2033  next_list:
2034   if (!NILP (prefix))
2035     list = prefix, prefix = Qnil;
2036   else if (!NILP (keys))
2037     list = keys, keys = Qnil;
2038   else
2039     {
2040       if (add_meta)
2041 	{
2042 	  args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
2043 	  result = Fconcat (len + 1, args);
2044 	}
2045       else if (len == 0)
2046 	result = empty_unibyte_string;
2047       else
2048 	result = Fconcat (len - 1, args);
2049       SAFE_FREE ();
2050       return result;
2051     }
2052 
2053   if (STRINGP (list))
2054     size = SCHARS (list);
2055   else if (VECTORP (list))
2056     size = ASIZE (list);
2057   else if (CONSP (list))
2058     size = list_length (list);
2059   else
2060     wrong_type_argument (Qarrayp, list);
2061 
2062   i = i_byte = 0;
2063 
2064   while (i < size)
2065     {
2066       if (STRINGP (list))
2067 	{
2068 	  int c;
2069 	  FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
2070 	  if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2071 	    c ^= 0200 | meta_modifier;
2072 	  XSETFASTINT (key, c);
2073 	}
2074       else if (VECTORP (list))
2075 	{
2076 	  key = AREF (list, i); i++;
2077 	}
2078       else
2079 	{
2080 	  key = XCAR (list);
2081 	  list = XCDR (list);
2082 	  i++;
2083 	}
2084 
2085       if (add_meta)
2086 	{
2087 	  if (!FIXNUMP (key)
2088 	      || EQ (key, meta_prefix_char)
2089 	      || (XFIXNUM (key) & meta_modifier))
2090 	    {
2091 	      args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
2092 	      args[len++] = sep;
2093 	      if (EQ (key, meta_prefix_char))
2094 		continue;
2095 	    }
2096 	  else
2097 	    XSETINT (key, XFIXNUM (key) | meta_modifier);
2098 	  add_meta = 0;
2099 	}
2100       else if (EQ (key, meta_prefix_char))
2101 	{
2102 	  add_meta = 1;
2103 	  continue;
2104 	}
2105       args[len++] = Fsingle_key_description (key, Qnil);
2106       args[len++] = sep;
2107     }
2108   goto next_list;
2109 }
2110 
2111 
2112 char *
push_key_description(EMACS_INT ch,char * p)2113 push_key_description (EMACS_INT ch, char *p)
2114 {
2115   int c, c2;
2116   bool tab_as_ci;
2117 
2118   /* Clear all the meaningless bits above the meta bit.  */
2119   c = ch & (meta_modifier | ~ - meta_modifier);
2120   c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
2121 	     | meta_modifier | shift_modifier | super_modifier);
2122 
2123   if (! CHARACTERP (make_fixnum (c2)))
2124     {
2125       /* KEY_DESCRIPTION_SIZE is large enough for this.  */
2126       p += sprintf (p, "[%d]", c);
2127       return p;
2128     }
2129 
2130   tab_as_ci = (c2 == '\t' && (c & meta_modifier));
2131 
2132   if (c & alt_modifier)
2133     {
2134       *p++ = 'A';
2135       *p++ = '-';
2136       c -= alt_modifier;
2137     }
2138   if ((c & ctrl_modifier) != 0
2139       || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M'))
2140       || tab_as_ci)
2141     {
2142       *p++ = 'C';
2143       *p++ = '-';
2144       c &= ~ctrl_modifier;
2145     }
2146   if (c & hyper_modifier)
2147     {
2148       *p++ = 'H';
2149       *p++ = '-';
2150       c -= hyper_modifier;
2151     }
2152   if (c & meta_modifier)
2153     {
2154       *p++ = 'M';
2155       *p++ = '-';
2156       c -= meta_modifier;
2157     }
2158   if (c & shift_modifier)
2159     {
2160       *p++ = 'S';
2161       *p++ = '-';
2162       c -= shift_modifier;
2163     }
2164   if (c & super_modifier)
2165     {
2166       *p++ = 's';
2167       *p++ = '-';
2168       c -= super_modifier;
2169     }
2170   if (c < 040)
2171     {
2172       if (c == 033)
2173 	{
2174 	  *p++ = 'E';
2175 	  *p++ = 'S';
2176 	  *p++ = 'C';
2177 	}
2178       else if (tab_as_ci)
2179 	{
2180 	  *p++ = 'i';
2181 	}
2182       else if (c == '\t')
2183 	{
2184 	  *p++ = 'T';
2185 	  *p++ = 'A';
2186 	  *p++ = 'B';
2187 	}
2188       else if (c == Ctl ('M'))
2189 	{
2190 	  *p++ = 'R';
2191 	  *p++ = 'E';
2192 	  *p++ = 'T';
2193 	}
2194       else
2195 	{
2196 	  /* `C-' already added above.  */
2197 	  if (c > 0 && c <= Ctl ('Z'))
2198 	    *p++ = c + 0140;
2199 	  else
2200 	    *p++ = c + 0100;
2201 	}
2202     }
2203   else if (c == 0177)
2204     {
2205       *p++ = 'D';
2206       *p++ = 'E';
2207       *p++ = 'L';
2208     }
2209   else if (c == ' ')
2210    {
2211       *p++ = 'S';
2212       *p++ = 'P';
2213       *p++ = 'C';
2214     }
2215   else if (c < 128)
2216     *p++ = c;
2217   else
2218     {
2219       /* Now we are sure that C is a valid character code.  */
2220       p += CHAR_STRING (c, (unsigned char *) p);
2221     }
2222 
2223   return p;
2224 }
2225 
2226 /* This function cannot GC.  */
2227 
2228 DEFUN ("single-key-description", Fsingle_key_description,
2229        Ssingle_key_description, 1, 2, 0,
2230        doc: /* Return a pretty description of a character event KEY.
2231 Control characters turn into C-whatever, etc.
2232 Optional argument NO-ANGLES non-nil means don't put angle brackets
2233 around function keys and event symbols.
2234 
2235 See `text-char-description' for describing character codes.  */)
2236   (Lisp_Object key, Lisp_Object no_angles)
2237 {
2238   USE_SAFE_ALLOCA;
2239 
2240   if (CONSP (key) && lucid_event_type_list_p (key))
2241     key = Fevent_convert_list (key);
2242 
2243   if (CONSP (key) && FIXNUMP (XCAR (key)) && FIXNUMP (XCDR (key)))
2244     /* An interval from a map-char-table.  */
2245     {
2246       AUTO_STRING (dot_dot, "..");
2247       return concat3 (Fsingle_key_description (XCAR (key), no_angles),
2248 		      dot_dot,
2249 		      Fsingle_key_description (XCDR (key), no_angles));
2250     }
2251 
2252   key = EVENT_HEAD (key);
2253 
2254   if (FIXNUMP (key))		/* Normal character.  */
2255     {
2256       char tem[KEY_DESCRIPTION_SIZE];
2257       char *p = push_key_description (XFIXNUM (key), tem);
2258       *p = 0;
2259       return make_specified_string (tem, -1, p - tem, 1);
2260     }
2261   else if (SYMBOLP (key))	/* Function key or event-symbol.  */
2262     {
2263       if (NILP (no_angles))
2264 	{
2265 	  Lisp_Object result;
2266 	  char *buffer = SAFE_ALLOCA (sizeof "<>"
2267 				      + SBYTES (SYMBOL_NAME (key)));
2268 	  esprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
2269 	  result = build_string (buffer);
2270 	  SAFE_FREE ();
2271 	  return result;
2272 	}
2273       else
2274 	return Fsymbol_name (key);
2275     }
2276   else if (STRINGP (key))	/* Buffer names in the menubar.  */
2277     return Fcopy_sequence (key);
2278   else
2279     error ("KEY must be an integer, cons, symbol, or string");
2280 }
2281 
2282 static char *
push_text_char_description(register unsigned int c,register char * p)2283 push_text_char_description (register unsigned int c, register char *p)
2284 {
2285   if (c >= 0200)
2286     {
2287       *p++ = 'M';
2288       *p++ = '-';
2289       c -= 0200;
2290     }
2291   if (c < 040)
2292     {
2293       *p++ = '^';
2294       *p++ = c + 64;		/* 'A' - 1 */
2295     }
2296   else if (c == 0177)
2297     {
2298       *p++ = '^';
2299       *p++ = '?';
2300     }
2301   else
2302     *p++ = c;
2303   return p;
2304 }
2305 
2306 /* This function cannot GC.  */
2307 
2308 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2309        doc: /* Return the description of CHARACTER in standard Emacs notation.
2310 CHARACTER must be a valid character code that passes the `characterp' test.
2311 Control characters turn into "^char", and characters with Meta and other
2312 modifiers signal an error, as they are not valid character codes.
2313 This differs from `single-key-description' which accepts character events,
2314 and thus doesn't enforce the `characterp' condition, turns control
2315 characters into "C-char", and uses the 2**27 bit for Meta.
2316 See Info node `(elisp)Describing Characters' for examples.  */)
2317   (Lisp_Object character)
2318 {
2319   /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6).  */
2320   char str[6];
2321   int c;
2322 
2323   CHECK_CHARACTER (character);
2324 
2325   c = XFIXNUM (character);
2326   if (!ASCII_CHAR_P (c))
2327     {
2328       int len = CHAR_STRING (c, (unsigned char *) str);
2329 
2330       return make_multibyte_string (str, 1, len);
2331     }
2332 
2333   *push_text_char_description (c & 0377, str) = 0;
2334 
2335   return build_string (str);
2336 }
2337 
2338 static int where_is_preferred_modifier;
2339 
2340 /* Return 0 if SEQ uses non-preferred modifiers or non-char events.
2341    Else, return 2 if SEQ uses the where_is_preferred_modifier,
2342    and 1 otherwise.  */
2343 static int
preferred_sequence_p(Lisp_Object seq)2344 preferred_sequence_p (Lisp_Object seq)
2345 {
2346   EMACS_INT i;
2347   EMACS_INT len = XFIXNAT (Flength (seq));
2348   int result = 1;
2349 
2350   for (i = 0; i < len; i++)
2351     {
2352       Lisp_Object ii, elt;
2353 
2354       XSETFASTINT (ii, i);
2355       elt = Faref (seq, ii);
2356 
2357       if (!FIXNUMP (elt))
2358 	return 0;
2359       else
2360 	{
2361 	  int modifiers = XFIXNUM (elt) & (CHAR_MODIFIER_MASK & ~CHAR_META);
2362 	  if (modifiers == where_is_preferred_modifier)
2363 	    result = 2;
2364 	  else if (modifiers)
2365 	    return 0;
2366 	}
2367     }
2368 
2369   return result;
2370 }
2371 
2372 
2373 /* where-is - finding a command in a set of keymaps.			*/
2374 
2375 static void where_is_internal_1 (Lisp_Object key, Lisp_Object binding,
2376                                  Lisp_Object args, void *data);
2377 
2378 /* Like Flookup_key, but with command remapping; just returns nil
2379    if the key sequence is too long.  */
2380 
2381 static Lisp_Object
shadow_lookup(Lisp_Object keymap,Lisp_Object key,Lisp_Object accept_default,bool remap)2382 shadow_lookup (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default,
2383 	       bool remap)
2384 {
2385   Lisp_Object value = Flookup_key (keymap, key, accept_default);
2386 
2387   if (FIXNATP (value))          /* `key' is too long!  */
2388     return Qnil;
2389   else if (!NILP (value) && remap && SYMBOLP (value))
2390     {
2391       Lisp_Object remapping = Fcommand_remapping (value, Qnil, keymap);
2392       return (!NILP (remapping) ? remapping : value);
2393     }
2394   else
2395     return value;
2396 }
2397 
2398 static Lisp_Object Vmouse_events;
2399 
2400 struct where_is_internal_data {
2401   Lisp_Object definition, this, last;
2402   bool last_is_meta, noindirect;
2403   Lisp_Object sequences;
2404 };
2405 
2406 /* This function can't GC, AFAIK.  */
2407 /* Return the list of bindings found.  This list is ordered "longest
2408    to shortest".  It may include bindings that are actually shadowed
2409    by others, as well as duplicate bindings and remapping bindings.
2410    The list returned is potentially shared with where_is_cache, so
2411    be careful not to modify it via side-effects.  */
2412 
2413 static Lisp_Object
where_is_internal(Lisp_Object definition,Lisp_Object keymaps,bool noindirect,bool nomenus)2414 where_is_internal (Lisp_Object definition, Lisp_Object keymaps,
2415 		   bool noindirect, bool nomenus)
2416 {
2417   Lisp_Object maps = Qnil;
2418   Lisp_Object found;
2419   struct where_is_internal_data data;
2420 
2421   /* Only important use of caching is for the menubar
2422      (i.e. where-is-internal called with (def nil t nil nil)).  */
2423   if (nomenus && !noindirect)
2424     {
2425       /* Check heuristic-consistency of the cache.  */
2426       if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2427 	where_is_cache = Qnil;
2428 
2429       if (NILP (where_is_cache))
2430 	{
2431 	  /* We need to create the cache.  */
2432 	  where_is_cache = Fmake_hash_table (0, NULL);
2433 	  where_is_cache_keymaps = Qt;
2434 	}
2435       else
2436 	/* We can reuse the cache.  */
2437 	return Fgethash (definition, where_is_cache, Qnil);
2438     }
2439   else
2440     /* Kill the cache so that where_is_internal_1 doesn't think
2441        we're filling it up.  */
2442     where_is_cache = Qnil;
2443 
2444   found = keymaps;
2445   while (CONSP (found))
2446     {
2447       maps =
2448 	nconc2 (maps,
2449 		Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
2450       found = XCDR (found);
2451     }
2452 
2453   data.sequences = Qnil;
2454   for (; CONSP (maps); maps = XCDR (maps))
2455     {
2456       /* Key sequence to reach map, and the map that it reaches */
2457       register Lisp_Object this, map, tem;
2458 
2459       /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2460 	 [M-CHAR] sequences, check if last character of the sequence
2461 	 is the meta-prefix char.  */
2462       Lisp_Object last;
2463       bool last_is_meta;
2464 
2465       this = Fcar (XCAR (maps));
2466       map  = Fcdr (XCAR (maps));
2467       last = make_fixnum (XFIXNUM (Flength (this)) - 1);
2468       last_is_meta = (XFIXNUM (last) >= 0
2469 		      && EQ (Faref (this, last), meta_prefix_char));
2470 
2471       /* if (nomenus && !preferred_sequence_p (this)) */
2472       if (nomenus && XFIXNUM (last) >= 0
2473 	  && SYMBOLP (tem = Faref (this, make_fixnum (0)))
2474 	  && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
2475 	/* If no menu entries should be returned, skip over the
2476 	   keymaps bound to `menu-bar' and `tool-bar' and other
2477 	   non-ascii prefixes like `C-down-mouse-2'.  */
2478 	continue;
2479 
2480       maybe_quit ();
2481 
2482       data.definition = definition;
2483       data.noindirect = noindirect;
2484       data.this = this;
2485       data.last = last;
2486       data.last_is_meta = last_is_meta;
2487 
2488       if (CONSP (map))
2489 	map_keymap (map, where_is_internal_1, Qnil, &data, 0);
2490     }
2491 
2492   if (nomenus && !noindirect)
2493     { /* Remember for which keymaps this cache was built.
2494 	 We do it here (late) because we want to keep where_is_cache_keymaps
2495 	 set to t while the cache isn't fully filled.  */
2496       where_is_cache_keymaps = keymaps;
2497       /* During cache-filling, data.sequences is not filled by
2498 	 where_is_internal_1.  */
2499       return Fgethash (definition, where_is_cache, Qnil);
2500     }
2501   else
2502     return data.sequences;
2503 }
2504 
2505 /* This function can GC if Flookup_key autoloads any keymaps.  */
2506 
2507 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
2508        doc: /* Return list of keys that invoke DEFINITION.
2509 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2510 If KEYMAP is nil, search all the currently active keymaps, except
2511  for `overriding-local-map' (which is ignored).
2512 If KEYMAP is a list of keymaps, search only those keymaps.
2513 
2514 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2515 rather than a list of all possible key sequences.
2516 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2517 no matter what it is.
2518 If FIRSTONLY has another non-nil value, prefer bindings
2519 that use the modifier key specified in `where-is-preferred-modifier'
2520 \(or their meta variants) and entirely reject menu bindings.
2521 
2522 If optional 4th arg NOINDIRECT is non-nil, don't extract the commands inside
2523 menu-items.  This makes it possible to search for a menu-item itself.
2524 
2525 The optional 5th arg NO-REMAP alters how command remapping is handled:
2526 
2527 - If another command OTHER-COMMAND is remapped to DEFINITION, normally
2528   search for the bindings of OTHER-COMMAND and include them in the
2529   returned list.  But if NO-REMAP is non-nil, include the vector
2530   [remap OTHER-COMMAND] in the returned list instead, without
2531   searching for those other bindings.
2532 
2533 - If DEFINITION is remapped to OTHER-COMMAND, normally return the
2534   bindings for OTHER-COMMAND.  But if NO-REMAP is non-nil, return the
2535   bindings for DEFINITION instead, ignoring its remapping.  */)
2536   (Lisp_Object definition, Lisp_Object keymap, Lisp_Object firstonly, Lisp_Object noindirect, Lisp_Object no_remap)
2537 {
2538   /* The keymaps in which to search.  */
2539   Lisp_Object keymaps;
2540   /* Potentially relevant bindings in "shortest to longest" order.  */
2541   Lisp_Object sequences = Qnil;
2542     /* Actually relevant bindings.  */
2543   Lisp_Object found = Qnil;
2544   /* 1 means ignore all menu bindings entirely.  */
2545   bool nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2546   /* List of sequences found via remapping.  Keep them in a separate
2547      variable, so as to push them later, since we prefer
2548      non-remapped binding.  */
2549   Lisp_Object remapped_sequences = Qnil;
2550   /* Whether or not we're handling remapped sequences.  This is needed
2551      because remapping is not done recursively by Fcommand_remapping: you
2552      can't remap a remapped command.  */
2553   bool remapped = 0;
2554   Lisp_Object tem = Qnil;
2555 
2556   /* Refresh the C version of the modifier preference.  */
2557   where_is_preferred_modifier
2558     = parse_solitary_modifier (Vwhere_is_preferred_modifier);
2559 
2560   /* Find the relevant keymaps.  */
2561   if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
2562     keymaps = keymap;
2563   else if (!NILP (keymap))
2564     keymaps = list2 (keymap, current_global_map);
2565   else
2566     keymaps = Fcurrent_active_maps (Qnil, Qnil);
2567 
2568   tem = Fcommand_remapping (definition, Qnil, keymaps);
2569   /* If `definition' is remapped to `tem', then OT1H no key will run
2570      that command (since they will run `tem' instead), so we should
2571      return nil; but OTOH all keys bound to `definition' (or to `tem')
2572      will run the same command.
2573      So for menu-shortcut purposes, we want to find all the keys bound (maybe
2574      via remapping) to `tem'.  But for the purpose of finding the keys that
2575      run `definition', then we'd want to just return nil.
2576      We choose to make it work right for menu-shortcuts, since it's the most
2577      common use.
2578      Known bugs: if you remap switch-to-buffer to toto, C-h f switch-to-buffer
2579      will tell you that switch-to-buffer is bound to C-x b even though C-x b
2580      will run toto instead.  And if `toto' is itself remapped to forward-char,
2581      then C-h f toto will tell you that it's bound to C-f even though C-f does
2582      not run toto and it won't tell you that C-x b does run toto.  */
2583   if (NILP (no_remap) && !NILP (tem))
2584     definition = tem;
2585 
2586   if (SYMBOLP (definition)
2587       && !NILP (firstonly)
2588       && !NILP (tem = Fget (definition, QCadvertised_binding)))
2589     {
2590       /* We have a list of advertised bindings.  */
2591       /* FIXME: Not sure why we use false for shadow_lookup's remapping,
2592          nor why we use `EQ' here but `Fequal' in the call further down.  */
2593       while (CONSP (tem))
2594 	if (EQ (shadow_lookup (keymaps, XCAR (tem), Qnil, 0), definition))
2595 	  return XCAR (tem);
2596 	else
2597 	  tem = XCDR (tem);
2598       if (EQ (shadow_lookup (keymaps, tem, Qnil, 0), definition))
2599 	return tem;
2600     }
2601 
2602   sequences = Freverse (where_is_internal (definition, keymaps,
2603 					   !NILP (noindirect), nomenus));
2604 
2605   while (CONSP (sequences)
2606 	 /* If we're at the end of the `sequences' list and we haven't
2607 	    considered remapped sequences yet, copy them over and
2608 	    process them.  */
2609 	 || (!remapped && (sequences = remapped_sequences,
2610 			   remapped = 1,
2611 			   CONSP (sequences))))
2612     {
2613       Lisp_Object sequence, function;
2614 
2615       sequence = XCAR (sequences);
2616       sequences = XCDR (sequences);
2617 
2618       /* Verify that this key binding is not shadowed by another
2619 	 binding for the same key, before we say it exists.
2620 
2621 	 Mechanism: look for local definition of this key and if
2622 	 it is defined and does not match what we found then
2623 	 ignore this key.
2624 
2625 	 Either nil or number as value from Flookup_key
2626 	 means undefined.  */
2627       if (NILP (Fequal (shadow_lookup (keymaps, sequence, Qnil, remapped),
2628 			definition)))
2629 	continue;
2630 
2631       /* If the current sequence is a command remapping with
2632 	 format [remap COMMAND], find the key sequences
2633 	 which run COMMAND, and use those sequences instead.  */
2634       if (NILP (no_remap) && !remapped
2635 	  && VECTORP (sequence) && ASIZE (sequence) == 2
2636 	  && EQ (AREF (sequence, 0), Qremap)
2637 	  && (function = AREF (sequence, 1), SYMBOLP (function)))
2638 	{
2639 	  Lisp_Object seqs = where_is_internal (function, keymaps,
2640 						!NILP (noindirect), nomenus);
2641 	  remapped_sequences = nconc2 (Freverse (seqs), remapped_sequences);
2642 	  continue;
2643 	}
2644 
2645       /* Don't annoy user with strings from a menu such as the
2646 	 entries from the "Edit => Paste from Kill Menu".
2647 	 Change them all to "(any string)", so that there
2648 	 seems to be only one menu item to report.  */
2649       if (! NILP (sequence))
2650 	{
2651 	  Lisp_Object tem1;
2652 	  tem1 = Faref (sequence, make_fixnum (ASIZE (sequence) - 1));
2653 	  if (STRINGP (tem1))
2654 	    Faset (sequence, make_fixnum (ASIZE (sequence) - 1),
2655 		   build_string ("(any string)"));
2656 	}
2657 
2658       /* It is a true unshadowed match.  Record it, unless it's already
2659 	 been seen (as could happen when inheriting keymaps).  */
2660       if (NILP (Fmember (sequence, found)))
2661 	found = Fcons (sequence, found);
2662 
2663       /* If firstonly is Qnon_ascii, then we can return the first
2664 	 binding we find.  If firstonly is not Qnon_ascii but not
2665 	 nil, then we should return the first ascii-only binding
2666 	 we find.  */
2667       if (EQ (firstonly, Qnon_ascii))
2668 	return sequence;
2669       else if (!NILP (firstonly)
2670 	       && 2 == preferred_sequence_p (sequence))
2671 	return sequence;
2672     }
2673 
2674   found = Fnreverse (found);
2675 
2676   /* firstonly may have been t, but we may have gone all the way through
2677      the keymaps without finding an all-ASCII key sequence.  So just
2678      return the best we could find.  */
2679   if (NILP (firstonly))
2680     return found;
2681   else if (where_is_preferred_modifier == 0)
2682     return Fcar (found);
2683   else
2684     { /* Maybe we did not find a preferred_modifier binding, but we did find
2685 	 some ASCII binding.  */
2686       Lisp_Object bindings = found;
2687       while (CONSP (bindings))
2688 	if (preferred_sequence_p (XCAR (bindings)))
2689 	  return XCAR (bindings);
2690 	else
2691 	  bindings = XCDR (bindings);
2692       return Fcar (found);
2693     }
2694 }
2695 
2696 /* This function can GC because get_keyelt can.  */
2697 
2698 static void
where_is_internal_1(Lisp_Object key,Lisp_Object binding,Lisp_Object args,void * data)2699 where_is_internal_1 (Lisp_Object key, Lisp_Object binding, Lisp_Object args, void *data)
2700 {
2701   struct where_is_internal_data *d = data; /* Cast! */
2702   Lisp_Object definition = d->definition;
2703   bool noindirect = d->noindirect;
2704   Lisp_Object this = d->this;
2705   Lisp_Object last = d->last;
2706   bool last_is_meta = d->last_is_meta;
2707   Lisp_Object sequence;
2708 
2709   /* Search through indirections unless that's not wanted.  */
2710   if (!noindirect)
2711     binding = get_keyelt (binding, 0);
2712 
2713   /* End this iteration if this element does not match
2714      the target.  */
2715 
2716   if (!(!NILP (where_is_cache)	/* everything "matches" during cache-fill.  */
2717 	|| EQ (binding, definition)
2718 	|| (CONSP (definition) && !NILP (Fequal (binding, definition)))))
2719     /* Doesn't match.  */
2720     return;
2721 
2722   /* We have found a match.  Construct the key sequence where we found it.  */
2723   if (FIXNUMP (key) && last_is_meta)
2724     {
2725       sequence = Fcopy_sequence (this);
2726       Faset (sequence, last, make_fixnum (XFIXNUM (key) | meta_modifier));
2727     }
2728   else
2729     {
2730       if (CONSP (key))
2731 	key = Fcons (XCAR (key), XCDR (key));
2732       sequence = append_key (this, key);
2733     }
2734 
2735   if (!NILP (where_is_cache))
2736     {
2737       Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
2738       Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
2739     }
2740   else
2741     d->sequences = Fcons (sequence, d->sequences);
2742 }
2743 
2744 /* describe-bindings - summarizing all the bindings in a set of keymaps.  */
2745 
2746 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
2747        doc: /* Insert the list of all defined keys and their definitions.
2748 The list is inserted in the current buffer, while the bindings are
2749 looked up in BUFFER.
2750 The optional argument PREFIX, if non-nil, should be a key sequence;
2751 then we display only bindings that start with that prefix.
2752 The optional argument MENUS, if non-nil, says to mention menu bindings.
2753 \(Ordinarily these are omitted from the output.)  */)
2754   (Lisp_Object buffer, Lisp_Object prefix, Lisp_Object menus)
2755 {
2756   Lisp_Object outbuf, shadow;
2757   bool nomenu = NILP (menus);
2758   Lisp_Object start1;
2759 
2760   const char *alternate_heading
2761     = "\
2762 Keyboard translations:\n\n\
2763 You type        Translation\n\
2764 --------        -----------\n";
2765 
2766   CHECK_BUFFER (buffer);
2767 
2768   shadow = Qnil;
2769   outbuf = Fcurrent_buffer ();
2770 
2771   /* Report on alternates for keys.  */
2772   if (STRINGP (KVAR (current_kboard, Vkeyboard_translate_table)) && !NILP (prefix))
2773     {
2774       int c;
2775       const unsigned char *translate = SDATA (KVAR (current_kboard, Vkeyboard_translate_table));
2776       int translate_len = SCHARS (KVAR (current_kboard, Vkeyboard_translate_table));
2777 
2778       for (c = 0; c < translate_len; c++)
2779 	if (translate[c] != c)
2780 	  {
2781 	    char buf[KEY_DESCRIPTION_SIZE];
2782 	    char *bufend;
2783 
2784 	    if (alternate_heading)
2785 	      {
2786 		insert_string (alternate_heading);
2787 		alternate_heading = 0;
2788 	      }
2789 
2790 	    bufend = push_key_description (translate[c], buf);
2791 	    insert (buf, bufend - buf);
2792 	    Findent_to (make_fixnum (16), make_fixnum (1));
2793 	    bufend = push_key_description (c, buf);
2794 	    insert (buf, bufend - buf);
2795 
2796 	    insert ("\n", 1);
2797 
2798 	    /* Insert calls signal_after_change which may GC.  */
2799 	    translate = SDATA (KVAR (current_kboard, Vkeyboard_translate_table));
2800 	  }
2801 
2802       insert ("\n", 1);
2803     }
2804 
2805   if (!NILP (Vkey_translation_map))
2806     describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
2807 		       "Key translations", nomenu, 1, 0, 0);
2808 
2809 
2810   /* Print the (major mode) local map.  */
2811   start1 = Qnil;
2812   if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
2813     start1 = KVAR (current_kboard, Voverriding_terminal_local_map);
2814 
2815   if (!NILP (start1))
2816     {
2817       describe_map_tree (start1, 1, shadow, prefix,
2818 			 "\f\nOverriding Bindings", nomenu, 0, 0, 0);
2819       shadow = Fcons (start1, shadow);
2820       start1 = Qnil;
2821     }
2822   else if (!NILP (Voverriding_local_map))
2823     start1 = Voverriding_local_map;
2824 
2825   if (!NILP (start1))
2826     {
2827       describe_map_tree (start1, 1, shadow, prefix,
2828 			 "\f\nOverriding Bindings", nomenu, 0, 0, 0);
2829       shadow = Fcons (start1, shadow);
2830     }
2831   else
2832     {
2833       /* Print the minor mode and major mode keymaps.  */
2834       int i, nmaps;
2835       Lisp_Object *modes, *maps;
2836 
2837       /* Temporarily switch to `buffer', so that we can get that buffer's
2838 	 minor modes correctly.  */
2839       Fset_buffer (buffer);
2840 
2841       nmaps = current_minor_maps (&modes, &maps);
2842       Fset_buffer (outbuf);
2843 
2844       start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
2845 			      XBUFFER (buffer), Qkeymap);
2846       if (!NILP (start1))
2847 	{
2848 	  describe_map_tree (start1, 1, shadow, prefix,
2849 			     "\f\n`keymap' Property Bindings", nomenu,
2850 			     0, 0, 0);
2851 	  shadow = Fcons (start1, shadow);
2852 	}
2853 
2854       /* Print the minor mode maps.  */
2855       for (i = 0; i < nmaps; i++)
2856 	{
2857 	  /* The title for a minor mode keymap
2858 	     is constructed at run time.
2859 	     We let describe_map_tree do the actual insertion
2860 	     because it takes care of other features when doing so.  */
2861 	  char *title, *p;
2862 
2863 	  if (!SYMBOLP (modes[i]))
2864 	    emacs_abort ();
2865 
2866 	  USE_SAFE_ALLOCA;
2867 	  p = title = SAFE_ALLOCA (42 + SBYTES (SYMBOL_NAME (modes[i])));
2868 	  *p++ = '\f';
2869 	  *p++ = '\n';
2870 	  *p++ = '`';
2871 	  memcpy (p, SDATA (SYMBOL_NAME (modes[i])),
2872 		  SBYTES (SYMBOL_NAME (modes[i])));
2873 	  p += SBYTES (SYMBOL_NAME (modes[i]));
2874 	  *p++ = '\'';
2875 	  memcpy (p, " Minor Mode Bindings", strlen (" Minor Mode Bindings"));
2876 	  p += strlen (" Minor Mode Bindings");
2877 	  *p = 0;
2878 
2879 	  describe_map_tree (maps[i], 1, shadow, prefix,
2880 			     title, nomenu, 0, 0, 0);
2881 	  shadow = Fcons (maps[i], shadow);
2882 	  SAFE_FREE ();
2883 	}
2884 
2885       start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
2886 			      XBUFFER (buffer), Qlocal_map);
2887       if (!NILP (start1))
2888 	{
2889 	  if (EQ (start1, BVAR (XBUFFER (buffer), keymap)))
2890 	    describe_map_tree (start1, 1, shadow, prefix,
2891 			       "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
2892 	  else
2893 	    describe_map_tree (start1, 1, shadow, prefix,
2894 			       "\f\n`local-map' Property Bindings",
2895 			       nomenu, 0, 0, 0);
2896 
2897 	  shadow = Fcons (start1, shadow);
2898 	}
2899     }
2900 
2901   describe_map_tree (current_global_map, 1, shadow, prefix,
2902 		     "\f\nGlobal Bindings", nomenu, 0, 1, 0);
2903 
2904   /* Print the function-key-map translations under this prefix.  */
2905   if (!NILP (KVAR (current_kboard, Vlocal_function_key_map)))
2906     describe_map_tree (KVAR (current_kboard, Vlocal_function_key_map), 0, Qnil, prefix,
2907 		       "\f\nFunction key map translations", nomenu, 1, 0, 0);
2908 
2909   /* Print the input-decode-map translations under this prefix.  */
2910   if (!NILP (KVAR (current_kboard, Vinput_decode_map)))
2911     describe_map_tree (KVAR (current_kboard, Vinput_decode_map), 0, Qnil, prefix,
2912 		       "\f\nInput decoding map translations", nomenu, 1, 0, 0);
2913 
2914   return Qnil;
2915 }
2916 
2917 /* Insert a description of the key bindings in STARTMAP,
2918     followed by those of all maps reachable through STARTMAP.
2919    If PARTIAL, omit certain "uninteresting" commands
2920     (such as `undefined').
2921    If SHADOW is non-nil, it is a list of maps;
2922     don't mention keys which would be shadowed by any of them.
2923    PREFIX, if non-nil, says mention only keys that start with PREFIX.
2924    TITLE, if not 0, is a string to insert at the beginning.
2925    TITLE should not end with a colon or a newline; we supply that.
2926    If NOMENU, then omit menu-bar commands.
2927 
2928    If TRANSL, the definitions are actually key translations
2929    so print strings and vectors differently.
2930 
2931    If ALWAYS_TITLE, print the title even if there are no maps
2932    to look through.
2933 
2934    If MENTION_SHADOW, then when something is shadowed by SHADOW,
2935    don't omit it; instead, mention it but say it is shadowed.
2936 
2937    Any inserted text ends in two newlines (used by `help-make-xrefs').  */
2938 
2939 void
describe_map_tree(Lisp_Object startmap,bool partial,Lisp_Object shadow,Lisp_Object prefix,const char * title,bool nomenu,bool transl,bool always_title,bool mention_shadow)2940 describe_map_tree (Lisp_Object startmap, bool partial, Lisp_Object shadow,
2941 		   Lisp_Object prefix, const char *title, bool nomenu,
2942 		   bool transl, bool always_title, bool mention_shadow)
2943 {
2944   Lisp_Object maps, orig_maps, seen, sub_shadows;
2945   bool something = 0;
2946   const char *key_heading
2947     = "\
2948 key             binding\n\
2949 ---             -------\n";
2950 
2951   orig_maps = maps = Faccessible_keymaps (startmap, prefix);
2952   seen = Qnil;
2953   sub_shadows = Qnil;
2954 
2955   if (nomenu)
2956     {
2957       Lisp_Object list;
2958 
2959       /* Delete from MAPS each element that is for the menu bar.  */
2960       for (list = maps; CONSP (list); list = XCDR (list))
2961 	{
2962 	  Lisp_Object elt, elt_prefix, tem;
2963 
2964 	  elt = XCAR (list);
2965 	  elt_prefix = Fcar (elt);
2966 	  if (ASIZE (elt_prefix) >= 1)
2967 	    {
2968 	      tem = Faref (elt_prefix, make_fixnum (0));
2969 	      if (EQ (tem, Qmenu_bar))
2970 		maps = Fdelq (elt, maps);
2971 	    }
2972 	}
2973     }
2974 
2975   if (!NILP (maps) || always_title)
2976     {
2977       if (title)
2978 	{
2979 	  insert_string (title);
2980 	  if (!NILP (prefix))
2981 	    {
2982 	      insert_string (" Starting With ");
2983 	      insert1 (Fkey_description (prefix, Qnil));
2984 	    }
2985 	  insert_string (":\n");
2986 	}
2987       insert_string (key_heading);
2988       something = 1;
2989     }
2990 
2991   for (; CONSP (maps); maps = XCDR (maps))
2992     {
2993       register Lisp_Object elt, elt_prefix, tail;
2994 
2995       elt = XCAR (maps);
2996       elt_prefix = Fcar (elt);
2997 
2998       sub_shadows = Flookup_key (shadow, elt_prefix, Qt);
2999       if (FIXNATP (sub_shadows))
3000         sub_shadows = Qnil;
3001       else if (!KEYMAPP (sub_shadows)
3002                && !NILP (sub_shadows)
3003                && !(CONSP (sub_shadows)
3004                     && KEYMAPP (XCAR (sub_shadows))))
3005 	  /* If elt_prefix is bound to something that's not a keymap,
3006 	     it completely shadows this map, so don't
3007 	     describe this map at all.  */
3008         goto skip;
3009 
3010       /* Maps we have already listed in this loop shadow this map.  */
3011       for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
3012 	{
3013 	  Lisp_Object tem;
3014 	  tem = Fequal (Fcar (XCAR (tail)), elt_prefix);
3015 	  if (!NILP (tem))
3016 	    sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
3017 	}
3018 
3019       describe_map (Fcdr (elt), elt_prefix,
3020 		    transl ? describe_translation : describe_command,
3021 		    partial, sub_shadows, &seen, nomenu, mention_shadow);
3022 
3023     skip: ;
3024     }
3025 
3026   if (something)
3027     insert_string ("\n");
3028 }
3029 
3030 static int previous_description_column;
3031 
3032 static void
describe_command(Lisp_Object definition,Lisp_Object args)3033 describe_command (Lisp_Object definition, Lisp_Object args)
3034 {
3035   register Lisp_Object tem1;
3036   ptrdiff_t column = current_column ();
3037   int description_column;
3038 
3039   /* If column 16 is no good, go to col 32;
3040      but don't push beyond that--go to next line instead.  */
3041   if (column > 30)
3042     {
3043       insert_char ('\n');
3044       description_column = 32;
3045     }
3046   else if (column > 14 || (column > 10 && previous_description_column == 32))
3047     description_column = 32;
3048   else
3049     description_column = 16;
3050 
3051   Findent_to (make_fixnum (description_column), make_fixnum (1));
3052   previous_description_column = description_column;
3053 
3054   if (SYMBOLP (definition))
3055     {
3056       tem1 = SYMBOL_NAME (definition);
3057       insert1 (tem1);
3058       insert_string ("\n");
3059     }
3060   else if (STRINGP (definition) || VECTORP (definition))
3061     insert_string ("Keyboard Macro\n");
3062   else if (KEYMAPP (definition))
3063     insert_string ("Prefix Command\n");
3064   else
3065     insert_string ("??\n");
3066 }
3067 
3068 static void
describe_translation(Lisp_Object definition,Lisp_Object args)3069 describe_translation (Lisp_Object definition, Lisp_Object args)
3070 {
3071   register Lisp_Object tem1;
3072 
3073   Findent_to (make_fixnum (16), make_fixnum (1));
3074 
3075   if (SYMBOLP (definition))
3076     {
3077       tem1 = SYMBOL_NAME (definition);
3078       insert1 (tem1);
3079       insert_string ("\n");
3080     }
3081   else if (STRINGP (definition) || VECTORP (definition))
3082     {
3083       insert1 (Fkey_description (definition, Qnil));
3084       insert_string ("\n");
3085     }
3086   else if (KEYMAPP (definition))
3087     insert_string ("Prefix Command\n");
3088   else
3089     insert_string ("??\n");
3090 }
3091 
3092 /* describe_map puts all the usable elements of a sparse keymap
3093    into an array of `struct describe_map_elt',
3094    then sorts them by the events.  */
3095 
3096 struct describe_map_elt
3097 {
3098   Lisp_Object event;
3099   Lisp_Object definition;
3100   bool shadowed;
3101 };
3102 
3103 /* qsort comparison function for sorting `struct describe_map_elt' by
3104    the event field.  */
3105 
3106 static int
describe_map_compare(const void * aa,const void * bb)3107 describe_map_compare (const void *aa, const void *bb)
3108 {
3109   const struct describe_map_elt *a = aa, *b = bb;
3110   if (FIXNUMP (a->event) && FIXNUMP (b->event))
3111     return ((XFIXNUM (a->event) > XFIXNUM (b->event))
3112 	    - (XFIXNUM (a->event) < XFIXNUM (b->event)));
3113   if (!FIXNUMP (a->event) && FIXNUMP (b->event))
3114     return 1;
3115   if (FIXNUMP (a->event) && !FIXNUMP (b->event))
3116     return -1;
3117   if (SYMBOLP (a->event) && SYMBOLP (b->event))
3118     /* Sort the keystroke names in the "natural" way, with (for
3119        instance) "<f2>" coming between "<f1>" and "<f11>".  */
3120     return string_version_cmp (SYMBOL_NAME (a->event), SYMBOL_NAME (b->event));
3121   return 0;
3122 }
3123 
3124 /* Describe the contents of map MAP, assuming that this map itself is
3125    reached by the sequence of prefix keys PREFIX (a string or vector).
3126    PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above.  */
3127 
3128 static void
describe_map(Lisp_Object map,Lisp_Object prefix,void (* elt_describer)(Lisp_Object,Lisp_Object),bool partial,Lisp_Object shadow,Lisp_Object * seen,bool nomenu,bool mention_shadow)3129 describe_map (Lisp_Object map, Lisp_Object prefix,
3130 	      void (*elt_describer) (Lisp_Object, Lisp_Object),
3131 	      bool partial, Lisp_Object shadow,
3132 	      Lisp_Object *seen, bool nomenu, bool mention_shadow)
3133 {
3134   Lisp_Object tail, definition, event;
3135   Lisp_Object tem;
3136   Lisp_Object suppress;
3137   Lisp_Object kludge;
3138   bool first = 1;
3139 
3140   /* These accumulate the values from sparse keymap bindings,
3141      so we can sort them and handle them in order.  */
3142   ptrdiff_t length_needed = 0;
3143   struct describe_map_elt *vect;
3144   ptrdiff_t slots_used = 0;
3145   ptrdiff_t i;
3146 
3147   suppress = Qnil;
3148 
3149   if (partial)
3150     suppress = intern ("suppress-keymap");
3151 
3152   /* This vector gets used to present single keys to Flookup_key.  Since
3153      that is done once per keymap element, we don't want to cons up a
3154      fresh vector every time.  */
3155   kludge = make_nil_vector (1);
3156   definition = Qnil;
3157 
3158   map = call1 (Qkeymap_canonicalize, map);
3159 
3160   for (tail = map; CONSP (tail); tail = XCDR (tail))
3161     length_needed++;
3162 
3163   USE_SAFE_ALLOCA;
3164   SAFE_NALLOCA (vect, 1, length_needed);
3165 
3166   for (tail = map; CONSP (tail); tail = XCDR (tail))
3167     {
3168       maybe_quit ();
3169 
3170       if (VECTORP (XCAR (tail))
3171 	  || CHAR_TABLE_P (XCAR (tail)))
3172 	describe_vector (XCAR (tail),
3173 			 prefix, Qnil, elt_describer, partial, shadow, map,
3174 			 1, mention_shadow);
3175       else if (CONSP (XCAR (tail)))
3176 	{
3177 	  bool this_shadowed = 0;
3178 
3179 	  event = XCAR (XCAR (tail));
3180 
3181 	  /* Ignore bindings whose "prefix" are not really valid events.
3182 	     (We get these in the frames and buffers menu.)  */
3183 	  if (!(SYMBOLP (event) || FIXNUMP (event)))
3184 	    continue;
3185 
3186 	  if (nomenu && EQ (event, Qmenu_bar))
3187 	    continue;
3188 
3189 	  definition = get_keyelt (XCDR (XCAR (tail)), 0);
3190 
3191 	  /* Don't show undefined commands or suppressed commands.  */
3192 	  if (NILP (definition)) continue;
3193 	  if (SYMBOLP (definition) && partial)
3194 	    {
3195 	      tem = Fget (definition, suppress);
3196 	      if (!NILP (tem))
3197 		continue;
3198 	    }
3199 
3200 	  /* Don't show a command that isn't really visible
3201 	     because a local definition of the same key shadows it.  */
3202 
3203 	  ASET (kludge, 0, event);
3204 	  if (!NILP (shadow))
3205 	    {
3206 	      tem = shadow_lookup (shadow, kludge, Qt, 0);
3207 	      if (!NILP (tem))
3208 		{
3209 		  /* If both bindings are keymaps, this key is a prefix key,
3210 		     so don't say it is shadowed.  */
3211 		  if (KEYMAPP (definition) && KEYMAPP (tem))
3212 		    ;
3213 		  /* Avoid generating duplicate entries if the
3214 		     shadowed binding has the same definition.  */
3215 		  else if (mention_shadow && !EQ (tem, definition))
3216 		    this_shadowed = 1;
3217 		  else
3218 		    continue;
3219 		}
3220 	    }
3221 
3222 	  tem = Flookup_key (map, kludge, Qt);
3223 	  if (!EQ (tem, definition)) continue;
3224 
3225 	  vect[slots_used].event = event;
3226 	  vect[slots_used].definition = definition;
3227 	  vect[slots_used].shadowed = this_shadowed;
3228 	  slots_used++;
3229 	}
3230       else if (EQ (XCAR (tail), Qkeymap))
3231 	{
3232 	  /* The same keymap might be in the structure twice, if we're
3233 	     using an inherited keymap.  So skip anything we've already
3234 	     encountered.  */
3235 	  tem = Fassq (tail, *seen);
3236 	  if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
3237 	    break;
3238 	  *seen = Fcons (Fcons (tail, prefix), *seen);
3239 	}
3240     }
3241 
3242   /* If we found some sparse map events, sort them.  */
3243 
3244   qsort (vect, slots_used, sizeof (struct describe_map_elt),
3245 	 describe_map_compare);
3246 
3247   /* Now output them in sorted order.  */
3248 
3249   for (i = 0; i < slots_used; i++)
3250     {
3251       Lisp_Object start, end;
3252 
3253       if (first)
3254 	{
3255 	  previous_description_column = 0;
3256 	  insert ("\n", 1);
3257 	  first = 0;
3258 	}
3259 
3260       ASET (kludge, 0, vect[i].event);
3261       start = vect[i].event;
3262       end = start;
3263 
3264       definition = vect[i].definition;
3265 
3266       /* Find consecutive chars that are identically defined.  */
3267       if (FIXNUMP (vect[i].event))
3268 	{
3269 	  while (i + 1 < slots_used
3270 		 && EQ (vect[i+1].event, make_fixnum (XFIXNUM (vect[i].event) + 1))
3271 		 && !NILP (Fequal (vect[i + 1].definition, definition))
3272 		 && vect[i].shadowed == vect[i + 1].shadowed)
3273 	    i++;
3274 	  end = vect[i].event;
3275 	}
3276 
3277       /* Now START .. END is the range to describe next.  */
3278 
3279       /* Insert the string to describe the event START.  */
3280       insert1 (Fkey_description (kludge, prefix));
3281 
3282       if (!EQ (start, end))
3283 	{
3284 	  insert (" .. ", 4);
3285 
3286 	  ASET (kludge, 0, end);
3287 	  /* Insert the string to describe the character END.  */
3288 	  insert1 (Fkey_description (kludge, prefix));
3289 	}
3290 
3291       /* Print a description of the definition of this character.
3292 	 elt_describer will take care of spacing out far enough
3293 	 for alignment purposes.  */
3294       (*elt_describer) (vect[i].definition, Qnil);
3295 
3296       if (vect[i].shadowed)
3297 	{
3298 	  ptrdiff_t pt = max (PT - 1, BEG);
3299 
3300 	  SET_PT (pt);
3301 	  insert_string ("\n  (that binding is currently shadowed by another mode)");
3302 	  pt = min (PT + 1, Z);
3303 	  SET_PT (pt);
3304 	}
3305     }
3306 
3307   SAFE_FREE ();
3308 }
3309 
3310 static void
describe_vector_princ(Lisp_Object elt,Lisp_Object fun)3311 describe_vector_princ (Lisp_Object elt, Lisp_Object fun)
3312 {
3313   Findent_to (make_fixnum (16), make_fixnum (1));
3314   call1 (fun, elt);
3315   Fterpri (Qnil, Qnil);
3316 }
3317 
3318 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
3319        doc: /* Insert a description of contents of VECTOR.
3320 This is text showing the elements of vector matched against indices.
3321 DESCRIBER is the output function used; nil means use `princ'.  */)
3322   (Lisp_Object vector, Lisp_Object describer)
3323 {
3324   ptrdiff_t count = SPECPDL_INDEX ();
3325   if (NILP (describer))
3326     describer = intern ("princ");
3327   specbind (Qstandard_output, Fcurrent_buffer ());
3328   CHECK_VECTOR_OR_CHAR_TABLE (vector);
3329   describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
3330 		   Qnil, Qnil, 0, 0);
3331 
3332   return unbind_to (count, Qnil);
3333 }
3334 
3335 /* Insert in the current buffer a description of the contents of VECTOR.
3336    We call ELT_DESCRIBER to insert the description of one value found
3337    in VECTOR.
3338 
3339    ELT_PREFIX describes what "comes before" the keys or indices defined
3340    by this vector.  This is a human-readable string whose size
3341    is not necessarily related to the situation.
3342 
3343    If the vector is in a keymap, ELT_PREFIX is a prefix key which
3344    leads to this keymap.
3345 
3346    If the vector is a chartable, ELT_PREFIX is the vector
3347    of bytes that lead to the character set or portion of a character
3348    set described by this chartable.
3349 
3350    If PARTIAL, it means do not mention suppressed commands
3351    (that assumes the vector is in a keymap).
3352 
3353    SHADOW is a list of keymaps that shadow this map.
3354    If it is non-nil, then we look up the key in those maps
3355    and we don't mention it now if it is defined by any of them.
3356 
3357    ENTIRE_MAP is the keymap in which this vector appears.
3358    If the definition in effect in the whole map does not match
3359    the one in this vector, we ignore this one.
3360 
3361    ARGS is simply passed as the second argument to ELT_DESCRIBER.
3362 
3363    KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3364 
3365    ARGS is simply passed as the second argument to ELT_DESCRIBER.  */
3366 
3367 static void
describe_vector(Lisp_Object vector,Lisp_Object prefix,Lisp_Object args,void (* elt_describer)(Lisp_Object,Lisp_Object),bool partial,Lisp_Object shadow,Lisp_Object entire_map,bool keymap_p,bool mention_shadow)3368 describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
3369 		 void (*elt_describer) (Lisp_Object, Lisp_Object),
3370 		 bool partial, Lisp_Object shadow, Lisp_Object entire_map,
3371 		 bool keymap_p, bool mention_shadow)
3372 {
3373   Lisp_Object definition;
3374   Lisp_Object tem2;
3375   Lisp_Object elt_prefix = Qnil;
3376   int i;
3377   Lisp_Object suppress;
3378   Lisp_Object kludge;
3379   bool first = 1;
3380   /* Range of elements to be handled.  */
3381   int from, to, stop;
3382   Lisp_Object character;
3383   int starting_i;
3384 
3385   suppress = Qnil;
3386 
3387   definition = Qnil;
3388 
3389   if (!keymap_p)
3390     {
3391       if (!NILP (prefix) && XFIXNAT (Flength (prefix)) > 0)
3392 	{
3393 	  AUTO_STRING (space, " ");
3394 	  elt_prefix = concat2 (Fkey_description (prefix, Qnil), space);
3395 	}
3396       prefix = Qnil;
3397     }
3398 
3399   /* This vector gets used to present single keys to Flookup_key.  Since
3400      that is done once per vector element, we don't want to cons up a
3401      fresh vector every time.  */
3402   kludge = make_nil_vector (1);
3403 
3404   if (partial)
3405     suppress = intern ("suppress-keymap");
3406 
3407   from = 0;
3408   if (CHAR_TABLE_P (vector))
3409     stop = MAX_5_BYTE_CHAR + 1, to = MAX_CHAR + 1;
3410   else
3411     stop = to = ASIZE (vector);
3412 
3413   for (i = from; ; i++)
3414     {
3415       bool this_shadowed = 0;
3416       int range_beg, range_end;
3417       Lisp_Object val;
3418 
3419       maybe_quit ();
3420 
3421       if (i == stop)
3422 	{
3423 	  if (i == to)
3424 	    break;
3425 	  stop = to;
3426 	}
3427 
3428       starting_i = i;
3429 
3430       if (CHAR_TABLE_P (vector))
3431 	{
3432 	  range_beg = i;
3433 	  i = stop - 1;
3434 	  val = char_table_ref_and_range (vector, range_beg, &range_beg, &i);
3435 	}
3436       else
3437 	val = AREF (vector, i);
3438       definition = get_keyelt (val, 0);
3439 
3440       if (NILP (definition)) continue;
3441 
3442       /* Don't mention suppressed commands.  */
3443       if (SYMBOLP (definition) && partial)
3444 	{
3445 	  Lisp_Object tem;
3446 
3447 	  tem = Fget (definition, suppress);
3448 
3449 	  if (!NILP (tem)) continue;
3450 	}
3451 
3452       character = make_fixnum (starting_i);
3453       ASET (kludge, 0, character);
3454 
3455       /* If this binding is shadowed by some other map, ignore it.  */
3456       if (!NILP (shadow))
3457 	{
3458 	  Lisp_Object tem;
3459 
3460 	  tem = shadow_lookup (shadow, kludge, Qt, 0);
3461 
3462 	  if (!NILP (tem))
3463 	    {
3464 	      if (mention_shadow)
3465 		this_shadowed = 1;
3466 	      else
3467 		continue;
3468 	    }
3469 	}
3470 
3471       /* Ignore this definition if it is shadowed by an earlier
3472 	 one in the same keymap.  */
3473       if (!NILP (entire_map))
3474 	{
3475 	  Lisp_Object tem;
3476 
3477 	  tem = Flookup_key (entire_map, kludge, Qt);
3478 
3479 	  if (!EQ (tem, definition))
3480 	    continue;
3481 	}
3482 
3483       if (first)
3484 	{
3485 	  insert ("\n", 1);
3486 	  first = 0;
3487 	}
3488 
3489       /* Output the prefix that applies to every entry in this map.  */
3490       if (!NILP (elt_prefix))
3491 	insert1 (elt_prefix);
3492 
3493       insert1 (Fkey_description (kludge, prefix));
3494 
3495       /* Find all consecutive characters or rows that have the same
3496          definition.  But, VECTOR is a char-table, we had better put a
3497          boundary between normal characters (-#x3FFF7F) and 8-bit
3498          characters (#x3FFF80-).  */
3499       if (CHAR_TABLE_P (vector))
3500 	{
3501 	  while (i + 1 < stop
3502 		 && (range_beg = i + 1, range_end = stop - 1,
3503 		   val = char_table_ref_and_range (vector, range_beg,
3504 						   &range_beg, &range_end),
3505 		   tem2 = get_keyelt (val, 0),
3506 		   !NILP (tem2))
3507 		 && !NILP (Fequal (tem2, definition)))
3508 	    i = range_end;
3509 	}
3510       else
3511 	while (i + 1 < stop
3512 	       && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
3513 		   !NILP (tem2))
3514 	       && !NILP (Fequal (tem2, definition)))
3515 	  i++;
3516 
3517       /* If we have a range of more than one character,
3518 	 print where the range reaches to.  */
3519 
3520       if (i != starting_i)
3521 	{
3522 	  insert (" .. ", 4);
3523 
3524 	  ASET (kludge, 0, make_fixnum (i));
3525 
3526 	  if (!NILP (elt_prefix))
3527 	    insert1 (elt_prefix);
3528 
3529 	  insert1 (Fkey_description (kludge, prefix));
3530 	}
3531 
3532       /* Print a description of the definition of this character.
3533 	 elt_describer will take care of spacing out far enough
3534 	 for alignment purposes.  */
3535       (*elt_describer) (definition, args);
3536 
3537       if (this_shadowed)
3538 	{
3539 	  SET_PT (PT - 1);
3540 	  insert_string ("  (binding currently shadowed)");
3541 	  SET_PT (PT + 1);
3542 	}
3543     }
3544 
3545   if (CHAR_TABLE_P (vector) && ! NILP (XCHAR_TABLE (vector)->defalt))
3546     {
3547       if (!NILP (elt_prefix))
3548 	insert1 (elt_prefix);
3549       insert ("default", 7);
3550       (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
3551     }
3552 }
3553 
3554 /* Apropos - finding all symbols whose names match a regexp.		*/
3555 static Lisp_Object apropos_predicate;
3556 static Lisp_Object apropos_accumulate;
3557 
3558 static void
apropos_accum(Lisp_Object symbol,Lisp_Object string)3559 apropos_accum (Lisp_Object symbol, Lisp_Object string)
3560 {
3561   register Lisp_Object tem;
3562 
3563   tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3564   if (!NILP (tem) && !NILP (apropos_predicate))
3565     tem = call1 (apropos_predicate, symbol);
3566   if (!NILP (tem))
3567     apropos_accumulate = Fcons (symbol, apropos_accumulate);
3568 }
3569 
3570 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3571        doc: /* Show all symbols whose names contain match for REGEXP.
3572 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3573 for each symbol and a symbol is mentioned only if that returns non-nil.
3574 Return list of symbols found.  */)
3575   (Lisp_Object regexp, Lisp_Object predicate)
3576 {
3577   Lisp_Object tem;
3578   CHECK_STRING (regexp);
3579   apropos_predicate = predicate;
3580   apropos_accumulate = Qnil;
3581   map_obarray (Vobarray, apropos_accum, regexp);
3582   tem = Fsort (apropos_accumulate, Qstring_lessp);
3583   apropos_accumulate = Qnil;
3584   apropos_predicate = Qnil;
3585   return tem;
3586 }
3587 
3588 void
syms_of_keymap(void)3589 syms_of_keymap (void)
3590 {
3591   DEFSYM (Qkeymap, "keymap");
3592   staticpro (&apropos_predicate);
3593   staticpro (&apropos_accumulate);
3594   apropos_predicate = Qnil;
3595   apropos_accumulate = Qnil;
3596 
3597   DEFSYM (Qkeymap_canonicalize, "keymap-canonicalize");
3598 
3599   /* Now we are ready to set up this property, so we can
3600      create char tables.  */
3601   Fput (Qkeymap, Qchar_table_extra_slots, make_fixnum (0));
3602 
3603   /* Initialize the keymaps standardly used.
3604      Each one is the value of a Lisp variable, and is also
3605      pointed to by a C variable */
3606 
3607   global_map = Fmake_keymap (Qnil);
3608   Fset (intern_c_string ("global-map"), global_map);
3609 
3610   current_global_map = global_map;
3611   staticpro (&global_map);
3612   staticpro (&current_global_map);
3613 
3614   meta_map = Fmake_keymap (Qnil);
3615   Fset (intern_c_string ("esc-map"), meta_map);
3616   Ffset (intern_c_string ("ESC-prefix"), meta_map);
3617 
3618   control_x_map = Fmake_keymap (Qnil);
3619   Fset (intern_c_string ("ctl-x-map"), control_x_map);
3620   Ffset (intern_c_string ("Control-X-prefix"), control_x_map);
3621 
3622   exclude_keys = pure_list
3623     (pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")),
3624      pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")),
3625      pure_cons (build_pure_c_string ("RET"), build_pure_c_string ("\\r")),
3626      pure_cons (build_pure_c_string ("ESC"), build_pure_c_string ("\\e")),
3627      pure_cons (build_pure_c_string ("SPC"), build_pure_c_string (" ")));
3628   staticpro (&exclude_keys);
3629 
3630   DEFVAR_LISP ("define-key-rebound-commands", Vdefine_key_rebound_commands,
3631 	       doc: /* List of commands given new key bindings recently.
3632 This is used for internal purposes during Emacs startup;
3633 don't alter it yourself.  */);
3634   Vdefine_key_rebound_commands = Qt;
3635 
3636   DEFVAR_LISP ("minibuffer-local-map", Vminibuffer_local_map,
3637 	       doc: /* Default keymap to use when reading from the minibuffer.  */);
3638   Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
3639 
3640   DEFVAR_LISP ("minibuffer-local-ns-map", Vminibuffer_local_ns_map,
3641 	       doc: /* Local keymap for the minibuffer when spaces are not allowed.  */);
3642   Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
3643   Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
3644 
3645 
3646   DEFVAR_LISP ("minor-mode-map-alist", Vminor_mode_map_alist,
3647 	       doc: /* Alist of keymaps to use for minor modes.
3648 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
3649 key sequences and look up bindings if VARIABLE's value is non-nil.
3650 If two active keymaps bind the same key, the keymap appearing earlier
3651 in the list takes precedence.  */);
3652   Vminor_mode_map_alist = Qnil;
3653 
3654   DEFVAR_LISP ("minor-mode-overriding-map-alist", Vminor_mode_overriding_map_alist,
3655 	       doc: /* Alist of keymaps to use for minor modes, in current major mode.
3656 This variable is an alist just like `minor-mode-map-alist', and it is
3657 used the same way (and before `minor-mode-map-alist'); however,
3658 it is provided for major modes to bind locally.  */);
3659   Vminor_mode_overriding_map_alist = Qnil;
3660 
3661   DEFVAR_LISP ("emulation-mode-map-alists", Vemulation_mode_map_alists,
3662 	       doc: /* List of keymap alists to use for emulation modes.
3663 It is intended for modes or packages using multiple minor-mode keymaps.
3664 Each element is a keymap alist just like `minor-mode-map-alist', or a
3665 symbol with a variable binding which is a keymap alist, and it is used
3666 the same way.  The "active" keymaps in each alist are used before
3667 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'.  */);
3668   Vemulation_mode_map_alists = Qnil;
3669 
3670   DEFVAR_LISP ("where-is-preferred-modifier", Vwhere_is_preferred_modifier,
3671 	       doc: /* Preferred modifier key to use for `where-is'.
3672 When a single binding is requested, `where-is' will return one that
3673 uses this modifier key if possible.  If nil, or if no such binding
3674 exists, bindings using keys without modifiers (or only with meta) will
3675 be preferred.  */);
3676   Vwhere_is_preferred_modifier = Qnil;
3677   where_is_preferred_modifier = 0;
3678 
3679   DEFSYM (Qmenu_bar, "menu-bar");
3680   DEFSYM (Qmode_line, "mode-line");
3681 
3682   staticpro (&Vmouse_events);
3683   Vmouse_events = pure_list (Qmenu_bar, Qtab_bar, Qtool_bar,
3684 			     Qtab_line, Qheader_line, Qmode_line,
3685 			     intern_c_string ("mouse-1"),
3686 			     intern_c_string ("mouse-2"),
3687 			     intern_c_string ("mouse-3"),
3688 			     intern_c_string ("mouse-4"),
3689 			     intern_c_string ("mouse-5"));
3690 
3691   /* Keymap used for minibuffers when doing completion.  */
3692   /* Keymap used for minibuffers when doing completion and require a match.  */
3693   DEFSYM (Qkeymapp, "keymapp");
3694   DEFSYM (Qnon_ascii, "non-ascii");
3695   DEFSYM (Qmenu_item, "menu-item");
3696   DEFSYM (Qremap, "remap");
3697   DEFSYM (QCadvertised_binding, ":advertised-binding");
3698 
3699   command_remapping_vector = make_vector (2, Qremap);
3700   staticpro (&command_remapping_vector);
3701 
3702   where_is_cache_keymaps = Qt;
3703   where_is_cache = Qnil;
3704   staticpro (&where_is_cache);
3705   staticpro (&where_is_cache_keymaps);
3706 
3707   defsubr (&Skeymapp);
3708   defsubr (&Skeymap_parent);
3709   defsubr (&Skeymap_prompt);
3710   defsubr (&Sset_keymap_parent);
3711   defsubr (&Smake_keymap);
3712   defsubr (&Smake_sparse_keymap);
3713   defsubr (&Smap_keymap_internal);
3714   defsubr (&Smap_keymap);
3715   defsubr (&Scopy_keymap);
3716   defsubr (&Scommand_remapping);
3717   defsubr (&Skey_binding);
3718   defsubr (&Slocal_key_binding);
3719   defsubr (&Sglobal_key_binding);
3720   defsubr (&Sminor_mode_key_binding);
3721   defsubr (&Sdefine_key);
3722   defsubr (&Slookup_key);
3723   defsubr (&Sdefine_prefix_command);
3724   defsubr (&Suse_global_map);
3725   defsubr (&Suse_local_map);
3726   defsubr (&Scurrent_local_map);
3727   defsubr (&Scurrent_global_map);
3728   defsubr (&Scurrent_minor_mode_maps);
3729   defsubr (&Scurrent_active_maps);
3730   defsubr (&Saccessible_keymaps);
3731   defsubr (&Skey_description);
3732   defsubr (&Sdescribe_vector);
3733   defsubr (&Ssingle_key_description);
3734   defsubr (&Stext_char_description);
3735   defsubr (&Swhere_is_internal);
3736   defsubr (&Sdescribe_buffer_bindings);
3737   defsubr (&Sapropos_internal);
3738 }
3739 
3740 void
keys_of_keymap(void)3741 keys_of_keymap (void)
3742 {
3743   initial_define_key (global_map, 033, "ESC-prefix");
3744   initial_define_key (global_map, Ctl ('X'), "Control-X-prefix");
3745 }
3746