/* Manipulation of keymaps
Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include "character.h"
#include "charset.h"
#include "keyboard.h"
+#include "frame.h"
#include "termhooks.h"
#include "blockinput.h"
#include "puresize.h"
/* keymap used for minibuffers when doing completion in filenames
with require-match*/
-Lisp_Object Vminibuffer_local_must_match_filename_map;
+Lisp_Object Vminibuffer_local_filename_must_match_map;
/* keymap used for minibuffers when doing completion and require a match */
/* was MinibufLocalMustMatchMap */
/* List of emulation mode keymap alists. */
Lisp_Object Vemulation_mode_map_alists;
-/* Keymap mapping ASCII function key sequences onto their preferred forms.
- Initialized by the terminal-specific lisp files. See DEFVAR for more
- documentation. */
-Lisp_Object Vfunction_key_map;
-
-/* Keymap mapping ASCII function key sequences onto their preferred forms. */
-Lisp_Object Vkey_translation_map;
-
/* A list of all commands given new bindings since a certain time
when nil was stored here.
This is used to speed up recomputation of menu key equivalents
GCPRO4 (map, tail, idx, t_binding);
- /* If `t_ok' is 2, both `t' is accepted. */
- t_ok = t_ok ? 2 : 0;
-
for (tail = XCDR (map);
(CONSP (tail)
|| (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
if (EQ (key, idx))
val = XCDR (binding);
- else if (t_ok > 1 && EQ (key, Qt))
+ else if (t_ok && EQ (key, Qt))
{
t_binding = XCDR (binding);
- t_ok = 1;
+ t_ok = 0;
}
}
else if (VECTORP (binding))
}
}
-/* Call FUN for every binding in MAP.
- FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
- AUTOLOAD if non-zero means that we can autoload keymaps if necessary. */
-void
-map_keymap (map, fun, args, data, autoload)
- map_keymap_function_t fun;
- Lisp_Object map, args;
- void *data;
- int autoload;
+/* Call FUN for every binding in MAP and stop at (and return) the parent.
+ FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA). */
+Lisp_Object
+map_keymap_internal (Lisp_Object map,
+ map_keymap_function_t fun,
+ Lisp_Object args,
+ void *data)
{
struct gcpro gcpro1, gcpro2, gcpro3;
- Lisp_Object tail;
+ Lisp_Object tail
+ = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
- tail = Qnil;
GCPRO3 (map, args, tail);
- map = get_keymap (map, 1, autoload);
- for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
- CONSP (tail) || (tail = get_keymap (tail, 0, autoload), CONSP (tail));
- tail = XCDR (tail))
+ for (; CONSP (tail) && !EQ (Qkeymap, XCAR (tail)); tail = XCDR (tail))
{
Lisp_Object binding = XCAR (tail);
}
}
UNGCPRO;
+ return tail;
}
static void
call2 (fun, key, val);
}
+/* Same as map_keymap_internal, but doesn't traverses parent keymaps as well.
+ A non-zero AUTOLOAD indicates that autoloaded keymaps should be loaded. */
+void
+map_keymap (map, fun, args, data, autoload)
+ map_keymap_function_t fun;
+ Lisp_Object map, args;
+ void *data;
+ int autoload;
+{
+ struct gcpro gcpro1;
+ GCPRO1 (args);
+ map = get_keymap (map, 1, autoload);
+ while (CONSP (map))
+ {
+ map = map_keymap_internal (map, fun, args, data);
+ map = get_keymap (map, 0, autoload);
+ }
+ UNGCPRO;
+}
+
+Lisp_Object Qkeymap_canonicalize;
+
+/* Same as map_keymap, but does it right, properly eliminating duplicate
+ bindings due to inheritance. */
+void
+map_keymap_canonical (map, fun, args, data)
+ map_keymap_function_t fun;
+ Lisp_Object map, args;
+ void *data;
+{
+ struct gcpro gcpro1;
+ GCPRO1 (args);
+ /* map_keymap_canonical may be used from redisplay (e.g. when building menus)
+ so be careful to ignore errors and to inhibit redisplay. */
+ map = safe_call1 (Qkeymap_canonicalize, map);
+ /* No need to use `map_keymap' here because canonical map has no parent. */
+ map_keymap_internal (map, fun, args, data);
+ UNGCPRO;
+}
+
+DEFUN ("map-keymap-internal", Fmap_keymap_internal, Smap_keymap_internal, 2, 2, 0,
+ doc: /* Call FUNCTION once for each event binding in KEYMAP.
+FUNCTION is called with two arguments: the event that is bound, and
+the definition it is bound to. The event may be a character range.
+If KEYMAP has a parent, this function returns it without processing it. */)
+ (function, keymap)
+ Lisp_Object function, keymap;
+{
+ struct gcpro gcpro1;
+ GCPRO1 (function);
+ keymap = get_keymap (keymap, 1, 1);
+ keymap = map_keymap_internal (keymap, map_keymap_call, function, NULL);
+ UNGCPRO;
+ return keymap;
+}
+
DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
doc: /* Call FUNCTION once for each event binding in KEYMAP.
FUNCTION is called with two arguments: the event that is bound, and
-the definition it is bound to. If the event is an integer, it may be
-a generic character (see Info node `(elisp)Splitting Characters'), and
-that means that all actual character events belonging to that generic
-character are bound to the definition.
+the definition it is bound to. The event may be a character range.
If KEYMAP has a parent, the parent's bindings are included as well.
This works recursively: if the parent has itself a parent, then the
(function, keymap, sort_first)
Lisp_Object function, keymap, sort_first;
{
- if (INTEGERP (function))
- /* We have to stop integers early since map_keymap gives them special
- significance. */
- xsignal1 (Qinvalid_function, function);
if (! NILP (sort_first))
- return call3 (intern ("map-keymap-internal"), function, keymap, Qt);
+ return call2 (intern ("map-keymap-sorted"), function, keymap);
map_keymap (keymap, map_keymap_call, function, NULL, 1);
return Qnil;
{
Lisp_Object maps, binding;
- for (maps = keymaps; !NILP (maps); maps = Fcdr (maps))
+ for (maps = keymaps; CONSP (maps); maps = XCDR (maps))
{
- binding = Flookup_key (Fcar (maps), command_remapping_vector, Qnil);
+ binding = Flookup_key (XCAR (maps), command_remapping_vector, Qnil);
if (!NILP (binding) && !INTEGERP (binding))
return binding;
}
}
DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
- doc: /* Return current buffer's local keymap, or nil if it has none. */)
+ doc: /* Return current buffer's local keymap, or nil if it has none.
+Normally the local keymap is set by the major mode with `use-local-map'. */)
()
{
return current_buffer->keymap;
}
else if (VECTORP (list))
{
- key = AREF (list, i++);
+ key = AREF (list, i); i++;
}
else
{
return build_string (str);
}
-/* Return non-zero if SEQ contains only ASCII characters, perhaps with
- a meta bit. */
+static int where_is_preferred_modifier;
+
+/* Return 0 if SEQ uses non-preferred modifiers or non-char events.
+ Else, return 2 if SEQ uses the where_is_preferred_modifier,
+ and 1 otherwise. */
static int
-ascii_sequence_p (seq)
+preferred_sequence_p (seq)
Lisp_Object seq;
{
int i;
int len = XINT (Flength (seq));
+ int result = 1;
for (i = 0; i < len; i++)
{
XSETFASTINT (ii, i);
elt = Faref (seq, ii);
- if (!INTEGERP (elt)
- || (XUINT (elt) & ~CHAR_META) >= 0x80)
+ if (!INTEGERP (elt))
return 0;
+ else
+ {
+ int modifiers = XUINT (elt) & (CHAR_MODIFIER_MASK & ~CHAR_META);
+ if (modifiers == where_is_preferred_modifier)
+ result = 2;
+ else if (modifiers)
+ return 0;
+ }
}
- return 1;
+ return result;
}
\f
&& !NILP (Fcommand_remapping (definition, Qnil, keymaps)))
RETURN_UNGCPRO (Qnil);
- for (; !NILP (maps); maps = Fcdr (maps))
+ for (; CONSP (maps); maps = XCDR (maps))
{
/* Key sequence to reach map, and the map that it reaches */
register Lisp_Object this, map, tem;
Lisp_Object last;
int last_is_meta;
- this = Fcar (Fcar (maps));
- map = Fcdr (Fcar (maps));
+ this = Fcar (XCAR (maps));
+ map = Fcdr (XCAR (maps));
last = make_number (XINT (Flength (this)) - 1);
last_is_meta = (XINT (last) >= 0
&& EQ (Faref (this, last), meta_prefix_char));
- /* if (nomenus && !ascii_sequence_p (this)) */
+ /* if (nomenus && !preferred_sequence_p (this)) */
if (nomenus && XINT (last) >= 0
&& SYMBOLP (tem = Faref (this, make_number (0)))
&& !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
we find. */
if (EQ (firstonly, Qnon_ascii))
RETURN_UNGCPRO (sequence);
- else if (!NILP (firstonly) && ascii_sequence_p (sequence))
+ else if (!NILP (firstonly) && 2 == preferred_sequence_p (sequence))
RETURN_UNGCPRO (sequence);
if (CONSP (remapped))
/* firstonly may have been t, but we may have gone all the way through
the keymaps without finding an all-ASCII key sequence. So just
return the best we could find. */
- if (!NILP (firstonly))
+ if (NILP (firstonly))
+ return found;
+ else if (where_is_preferred_modifier == 0)
return Fcar (found);
-
- return found;
+ else
+ { /* Maybe we did not find a preferred_modifier binding, but we did find
+ some ASCII binding. */
+ Lisp_Object bindings = found;
+ while (CONSP (bindings))
+ if (preferred_sequence_p (XCAR (bindings)))
+ return XCAR (bindings);
+ else
+ bindings = XCDR (bindings);
+ return Fcar (found);
+ }
}
+static Lisp_Object Vwhere_is_preferred_modifier;
+
DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
doc: /* Return list of keys that invoke DEFINITION.
If KEYMAP is a keymap, search only KEYMAP and the global keymap.
rather than a list of all possible key sequences.
If FIRSTONLY is the symbol `non-ascii', return the first binding found,
no matter what it is.
-If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters
+If FIRSTONLY has another non-nil value, prefer bindings
+that use the modifier key specified in `where-is-preferred-modifier'
\(or their meta variants) and entirely reject menu bindings.
If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
Lisp_Object result;
+ /* Refresh the C version of the modifier preference. */
+ where_is_preferred_modifier
+ = parse_solitary_modifier (Vwhere_is_preferred_modifier);
+
/* Find the relevant keymaps. */
if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
keymaps = keymap;
if (nomenus && NILP (noindirect) && NILP (keymap))
{
Lisp_Object *defns;
- int i, j, n;
+ int i, n;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
/* Check heuristic-consistency of the cache. */
the following can GC. */
GCPRO2 (definition, keymaps);
result = Qnil;
- j = -1;
- for (i = n - 1; i >= 0; --i)
- if (EQ (shadow_lookup (keymaps, defns[i], Qnil), definition))
+ {
+ int best_pref = -1;
+ int j = -1;
+ for (i = n - 1; i >= 0; --i)
{
- if (ascii_sequence_p (defns[i]))
- break;
- else if (j < 0)
- j = i;
+ int pref = preferred_sequence_p (defns[i]);
+ if (pref > best_pref
+ && EQ (shadow_lookup (keymaps, defns[i], Qnil), definition))
+ {
+ j = i;
+ best_pref = pref;
+ if (best_pref == 2)
+ break;
+ }
}
-
- result = i >= 0 ? defns[i] : (j >= 0 ? defns[j] : Qnil);
+ result = j >= 0 ? defns[j] : Qnil;
+ }
UNGCPRO;
}
else
Faset (sequence, last, make_number (XINT (key) | meta_modifier));
}
else
- sequence = append_key (this, key);
+ {
+ if (CONSP (key))
+ key = Fcons (XCAR (key), XCDR (key));
+ sequence = append_key (this, key);
+ }
if (!NILP (where_is_cache))
{
outbuf = Fcurrent_buffer ();
/* Report on alternates for keys. */
- if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
+ if (STRINGP (current_kboard->Vkeyboard_translate_table) && !NILP (prefix))
{
int c;
- const unsigned char *translate = SDATA (Vkeyboard_translate_table);
- int translate_len = SCHARS (Vkeyboard_translate_table);
+ const unsigned char *translate = SDATA (current_kboard->Vkeyboard_translate_table);
+ int translate_len = SCHARS (current_kboard->Vkeyboard_translate_table);
for (c = 0; c < translate_len; c++)
if (translate[c] != c)
insert ("\n", 1);
/* Insert calls signal_after_change which may GC. */
- translate = SDATA (Vkeyboard_translate_table);
+ translate = SDATA (current_kboard->Vkeyboard_translate_table);
}
insert ("\n", 1);
char *title, *p;
if (!SYMBOLP (modes[i]))
- abort();
+ abort ();
p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
*p++ = '\f';
"\f\nGlobal Bindings", nomenu, 0, 1, 0);
/* Print the function-key-map translations under this prefix. */
- if (!NILP (Vfunction_key_map))
- describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
+ if (!NILP (current_kboard->Vlocal_function_key_map))
+ describe_map_tree (current_kboard->Vlocal_function_key_map, 0, Qnil, prefix,
"\f\nFunction key map translations", nomenu, 1, 0, 0);
+ /* Print the input-decode-map translations under this prefix. */
+ if (!NILP (current_kboard->Vinput_decode_map))
+ describe_map_tree (current_kboard->Vinput_decode_map, 0, Qnil, prefix,
+ "\f\nInput decoding map translations", nomenu, 1, 0, 0);
+
UNGCPRO;
return Qnil;
}
Lisp_Object list;
/* Delete from MAPS each element that is for the menu bar. */
- for (list = maps; !NILP (list); list = XCDR (list))
+ for (list = maps; CONSP (list); list = XCDR (list))
{
Lisp_Object elt, prefix, tem;
- elt = Fcar (list);
+ elt = XCAR (list);
prefix = Fcar (elt);
if (XVECTOR (prefix)->size >= 1)
{
something = 1;
}
- for (; !NILP (maps); maps = Fcdr (maps))
+ for (; CONSP (maps); maps = XCDR (maps))
{
register Lisp_Object elt, prefix, tail;
- elt = Fcar (maps);
+ elt = XCAR (maps);
prefix = Fcar (elt);
sub_shadows = Qnil;
kludge = Fmake_vector (make_number (1), Qnil);
definition = Qnil;
+ GCPRO3 (prefix, definition, kludge);
+
+ map = call1 (Qkeymap_canonicalize, map);
+
for (tail = map; CONSP (tail); tail = XCDR (tail))
length_needed++;
vect = ((struct describe_map_elt *)
alloca (sizeof (struct describe_map_elt) * length_needed));
- GCPRO3 (prefix, definition, kludge);
-
for (tail = map; CONSP (tail); tail = XCDR (tail))
{
QUIT;
apropos_predicate = Qnil;
apropos_accumulate = Qnil;
+ Qkeymap_canonicalize = intern ("keymap-canonicalize");
+ staticpro (&Qkeymap_canonicalize);
+
/* Now we are ready to set up this property, so we can
create char tables. */
Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
Fset_keymap_parent (Vminibuffer_local_must_match_map,
Vminibuffer_local_completion_map);
- DEFVAR_LISP ("minibuffer-local-must-match-filename-map",
- &Vminibuffer_local_must_match_filename_map,
+ DEFVAR_LISP ("minibuffer-local-filename-must-match-map",
+ &Vminibuffer_local_filename_must_match_map,
doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */);
- Vminibuffer_local_must_match_filename_map = Fmake_sparse_keymap (Qnil);
- Fset_keymap_parent (Vminibuffer_local_must_match_filename_map,
+ Vminibuffer_local_filename_must_match_map = Fmake_sparse_keymap (Qnil);
+ Fset_keymap_parent (Vminibuffer_local_filename_must_match_map,
Vminibuffer_local_must_match_map);
DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
doc: /* Alist of keymaps to use for minor modes.
Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
-key sequences and look up bindings iff VARIABLE's value is non-nil.
+key sequences and look up bindings if VARIABLE's value is non-nil.
If two active keymaps bind the same key, the keymap appearing earlier
in the list takes precedence. */);
Vminor_mode_map_alist = Qnil;
`minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
Vemulation_mode_map_alists = Qnil;
-
- DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
- doc: /* Keymap that translates key sequences to key sequences during input.
-This is used mainly for mapping ASCII function key sequences into
-real Emacs function key events (symbols).
-
-The `read-key-sequence' function replaces any subsequence bound by
-`function-key-map' with its binding. More precisely, when the active
-keymaps have no binding for the current key sequence but
-`function-key-map' binds a suffix of the sequence to a vector or string,
-`read-key-sequence' replaces the matching suffix with its binding, and
-continues with the new sequence.
-
-If the binding is a function, it is called with one argument (the prompt)
-and its return value (a key sequence) is used.
-
-The events that come from bindings in `function-key-map' are not
-themselves looked up in `function-key-map'.
-
-For example, suppose `function-key-map' binds `ESC O P' to [f1].
-Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
-`C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix
-key, typing `ESC O P x' would return [f1 x]. */);
- Vfunction_key_map = Fmake_sparse_keymap (Qnil);
-
- DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
- doc: /* Keymap of key translations that can override keymaps.
-This keymap works like `function-key-map', but comes after that,
-and its non-prefix bindings override ordinary bindings. */);
- Vkey_translation_map = Qnil;
+ DEFVAR_LISP ("where-is-preferred-modifier", &Vwhere_is_preferred_modifier,
+ doc: /* Preferred modifier to use for `where-is'.
+When a single binding is requested, `where-is' will return one that
+uses this modifier if possible. If nil, or if no such binding exists,
+bindings using keys without modifiers (or only with meta) will be
+preferred. */);
+ Vwhere_is_preferred_modifier = Qnil;
+ where_is_preferred_modifier = 0;
staticpro (&Vmouse_events);
Vmouse_events = Fcons (intern ("menu-bar"),
defsubr (&Sset_keymap_parent);
defsubr (&Smake_keymap);
defsubr (&Smake_sparse_keymap);
+ defsubr (&Smap_keymap_internal);
defsubr (&Smap_keymap);
defsubr (&Scopy_keymap);
defsubr (&Scommand_remapping);
keys_of_keymap ()
{
initial_define_key (global_map, 033, "ESC-prefix");
- initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
+ initial_define_key (global_map, Ctl ('X'), "Control-X-prefix");
}
/* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463