From fab84e3cfb291680f863074023e29b8daea0ed82 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jul 2007 15:20:15 +0000 Subject: [PATCH] (struct accessible_keymaps_data, struct where_is_internal_data): New structs. (accessible_keymaps_1, where_is_internal_1): Use them to change interface to adhere to the one used by map_keymap. (Faccessible_keymaps, where_is_internal): Use map_keymap. (accessible_keymaps_char_table, where_is_internal_2): Remove. --- src/ChangeLog | 7 + src/keymap.c | 370 +++++++++++++++++--------------------------------- 2 files changed, 135 insertions(+), 242 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 5c8a1db1dc5..8c4cbe1c214 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,12 @@ 2007-07-10 Stefan Monnier + * keymap.c (struct accessible_keymaps_data) + (struct where_is_internal_data): New structures. + (accessible_keymaps_1, where_is_internal_1): Use them to change + interface to adhere to the one used by map_keymap. + (Faccessible_keymaps, where_is_internal): Use map_keymap. + (accessible_keymaps_char_table, where_is_internal_2): Remove. + * keymap.h (map_keymap_function_t): More informative prototype. 2007-07-10 Guanpeng Xu diff --git a/src/keymap.c b/src/keymap.c index f9071f9c633..e008fceed99 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1156,7 +1156,7 @@ binding KEY to DEF is added at the front of KEYMAP. */) if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt)) Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands); - meta_bit = (VECTORP (key) || STRINGP (key) && STRING_MULTIBYTE (key) + meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key)) ? meta_modifier : 0x80); if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0))) @@ -2046,12 +2046,23 @@ DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_ /* Help functions for describing and documenting keymaps. */ +struct accessible_keymaps_data { + Lisp_Object maps, tail, thisseq; + /* Does the current sequence end in the meta-prefix-char? */ + int is_metized; +}; static void -accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized) - Lisp_Object maps, tail, thisseq, key, cmd; - int is_metized; /* If 1, `key' is assumed to be INTEGERP. */ +accessible_keymaps_1 (key, cmd, args, data) + Lisp_Object key, cmd, args; + /* Use void* to be compatible with map_keymap_function_t. */ + void *data; { + struct accessible_keymaps_data *d = data; /* Cast! */ + Lisp_Object maps = d->maps; + Lisp_Object tail = d->tail; + Lisp_Object thisseq = d->thisseq; + int is_metized = d->is_metized && INTEGERP (key); Lisp_Object tem; cmd = get_keymap (get_keyelt (cmd, 0), 0, 0); @@ -2105,17 +2116,6 @@ accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized) } } -static void -accessible_keymaps_char_table (args, index, cmd) - Lisp_Object args, index, cmd; -{ - accessible_keymaps_1 (index, cmd, - XCAR (XCAR (args)), - XCAR (XCDR (args)), - XCDR (XCDR (args)), - XINT (XCDR (XCAR (args)))); -} - /* This function cannot GC. */ DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, @@ -2130,13 +2130,10 @@ then the value includes only maps for prefixes that start with PREFIX. */) Lisp_Object keymap, prefix; { Lisp_Object maps, tail; - int prefixlen = 0; + int prefixlen = XINT (Flength (prefix)); /* no need for gcpro because we don't autoload any keymaps. */ - if (!NILP (prefix)) - prefixlen = XINT (Flength (prefix)); - if (!NILP (prefix)) { /* If a prefix was specified, start with the keymap (if any) for @@ -2147,7 +2144,9 @@ then the value includes only maps for prefixes that start with PREFIX. */) if the prefix is not defined in this particular map. It might even give us a list that isn't a keymap. */ tem = get_keymap (tem, 0, 0); - if (CONSP (tem)) + /* If the keymap is autoloaded `tem' is not a cons-cell, but we still + want to return it. */ + if (!NILP (tem)) { /* Convert PREFIX to a vector now, so that later on we don't have to deal with the possibility of a string. */ @@ -2187,57 +2186,26 @@ then the value includes only maps for prefixes that start with PREFIX. */) for (tail = maps; CONSP (tail); tail = XCDR (tail)) { - register Lisp_Object thisseq, thismap; + struct accessible_keymaps_data data; + register Lisp_Object thismap = Fcdr (XCAR (tail)); Lisp_Object last; - /* Does the current sequence end in the meta-prefix-char? */ - int is_metized; - thisseq = Fcar (Fcar (tail)); - thismap = Fcdr (Fcar (tail)); - last = make_number (XINT (Flength (thisseq)) - 1); - is_metized = (XINT (last) >= 0 + data.thisseq = Fcar (XCAR (tail)); + data.maps = maps; + data.tail = tail; + last = make_number (XINT (Flength (data.thisseq)) - 1); + /* Does the current sequence end in the meta-prefix-char? */ + data.is_metized = (XINT (last) >= 0 /* Don't metize the last char of PREFIX. */ && XINT (last) >= prefixlen - && EQ (Faref (thisseq, last), meta_prefix_char)); - - for (; CONSP (thismap); thismap = XCDR (thismap)) - { - Lisp_Object elt; - - elt = XCAR (thismap); - - QUIT; - - if (CHAR_TABLE_P (elt)) - { - Lisp_Object indices[3]; - - map_char_table (accessible_keymaps_char_table, Qnil, elt, - elt, Fcons (Fcons (maps, make_number (is_metized)), - Fcons (tail, thisseq)), - 0, indices); - } - else if (VECTORP (elt)) - { - register int i; + && EQ (Faref (data.thisseq, last), meta_prefix_char)); - /* Vector keymap. Scan all the elements. */ - for (i = 0; i < ASIZE (elt); i++) - accessible_keymaps_1 (make_number (i), AREF (elt, i), - maps, tail, thisseq, is_metized); - - } - else if (CONSP (elt)) - accessible_keymaps_1 (XCAR (elt), XCDR (elt), - maps, tail, thisseq, - is_metized && INTEGERP (XCAR (elt))); - - } + /* Since we can't run lisp code, we can't scan autoloaded maps. */ + if (CONSP (thismap)) + map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0); } - return maps; } - Lisp_Object Qsingle_key_description, Qkey_description; /* This function cannot GC. */ @@ -2508,7 +2476,7 @@ around function keys and event symbols. */) { char buf[256]; - sprintf (buf, "Invalid char code %d", XINT (key)); + sprintf (buf, "Invalid char code %ld", XINT (key)); return build_string (buf); } else if (charset @@ -2651,8 +2619,8 @@ ascii_sequence_p (seq) /* where-is - finding a command in a set of keymaps. */ static Lisp_Object where_is_internal (); -static Lisp_Object where_is_internal_1 (); -static void where_is_internal_2 (); +static void where_is_internal_1 P_ ((Lisp_Object key, Lisp_Object binding, + Lisp_Object args, void *data)); /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map. Returns the first non-nil binding found in any of those maps. */ @@ -2681,6 +2649,12 @@ shadow_lookup (shadow, key, flag) static Lisp_Object Vmouse_events; +struct where_is_internal_data { + Lisp_Object definition, noindirect, this, last; + int last_is_meta; + Lisp_Object sequences; +}; + /* This function can GC if Flookup_key autoloads any keymaps. */ static Lisp_Object @@ -2718,6 +2692,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap) { /* Key sequence to reach map, and the map that it reaches */ register Lisp_Object this, map, tem; + struct where_is_internal_data data; /* In order to fold [META-PREFIX-CHAR CHAR] sequences into [M-CHAR] sequences, check if last character of the sequence @@ -2742,148 +2717,94 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap) QUIT; - while (CONSP (map)) - { - /* Because the code we want to run on each binding is rather - large, we don't want to have two separate loop bodies for - sparse keymap bindings and tables; we want to iterate one - loop body over both keymap and vector bindings. - - For this reason, if Fcar (map) is a vector, we don't - advance map to the next element until i indicates that we - have finished off the vector. */ - Lisp_Object elt, key, binding; - elt = XCAR (map); - map = XCDR (map); + data.definition = definition; + data.noindirect = noindirect; + data.this = this; + data.last = last; + data.last_is_meta = last_is_meta; + data.sequences = Qnil; - sequences = Qnil; + if (CONSP (map)) + map_keymap (map, where_is_internal_1, Qnil, &data, 0); - QUIT; + sequences = data.sequences; - /* Set key and binding to the current key and binding, and - advance map and i to the next binding. */ - if (VECTORP (elt)) + while (CONSP (sequences)) + { + Lisp_Object sequence, remapped, function; + + sequence = XCAR (sequences); + sequences = XCDR (sequences); + + /* If the current sequence is a command remapping with + format [remap COMMAND], find the key sequences + which run COMMAND, and use those sequences instead. */ + remapped = Qnil; + if (NILP (no_remap) + && VECTORP (sequence) && XVECTOR (sequence)->size == 2 + && EQ (AREF (sequence, 0), Qremap) + && (function = AREF (sequence, 1), SYMBOLP (function))) { - Lisp_Object sequence; - int i; - /* In a vector, look at each element. */ - for (i = 0; i < XVECTOR (elt)->size; i++) + Lisp_Object remapped1; + + remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt); + if (CONSP (remapped1)) { - binding = AREF (elt, i); - XSETFASTINT (key, i); - sequence = where_is_internal_1 (binding, key, definition, - noindirect, this, - last, nomenus, last_is_meta); - if (!NILP (sequence)) - sequences = Fcons (sequence, sequences); + /* Verify that this key binding actually maps to the + remapped command (see below). */ + if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function)) + continue; + sequence = XCAR (remapped1); + remapped = XCDR (remapped1); + goto record_sequence; } } - else if (CHAR_TABLE_P (elt)) - { - Lisp_Object indices[3]; - Lisp_Object args; - - args = Fcons (Fcons (Fcons (definition, noindirect), - Qnil), /* Result accumulator. */ - Fcons (Fcons (this, last), - Fcons (make_number (nomenus), - make_number (last_is_meta)))); - map_char_table (where_is_internal_2, Qnil, elt, elt, args, - 0, indices); - sequences = XCDR (XCAR (args)); - } - else if (CONSP (elt)) - { - Lisp_Object sequence; - key = XCAR (elt); - binding = XCDR (elt); + /* Verify that this key binding is not shadowed by another + binding for the same key, before we say it exists. - sequence = where_is_internal_1 (binding, key, definition, - noindirect, this, - last, nomenus, last_is_meta); - if (!NILP (sequence)) - sequences = Fcons (sequence, sequences); - } + Mechanism: look for local definition of this key and if + it is defined and does not match what we found then + ignore this key. + Either nil or number as value from Flookup_key + means undefined. */ + if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition)) + continue; - while (!NILP (sequences)) + record_sequence: + /* Don't annoy user with strings from a menu such as + Select Paste. Change them all to "(any string)", + so that there seems to be only one menu item + to report. */ + if (! NILP (sequence)) { - Lisp_Object sequence, remapped, function; - - sequence = XCAR (sequences); - sequences = XCDR (sequences); - - /* If the current sequence is a command remapping with - format [remap COMMAND], find the key sequences - which run COMMAND, and use those sequences instead. */ - remapped = Qnil; - if (NILP (no_remap) - && VECTORP (sequence) && XVECTOR (sequence)->size == 2 - && EQ (AREF (sequence, 0), Qremap) - && (function = AREF (sequence, 1), SYMBOLP (function))) - { - Lisp_Object remapped1; - - remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt); - if (CONSP (remapped1)) - { - /* Verify that this key binding actually maps to the - remapped command (see below). */ - if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function)) - continue; - sequence = XCAR (remapped1); - remapped = XCDR (remapped1); - goto record_sequence; - } - } - - /* Verify that this key binding is not shadowed by another - binding for the same key, before we say it exists. - - Mechanism: look for local definition of this key and if - it is defined and does not match what we found then - ignore this key. - - Either nil or number as value from Flookup_key - means undefined. */ - if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition)) - continue; - - record_sequence: - /* Don't annoy user with strings from a menu such as - Select Paste. Change them all to "(any string)", - so that there seems to be only one menu item - to report. */ - if (! NILP (sequence)) - { - Lisp_Object tem; - tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1)); - if (STRINGP (tem)) - Faset (sequence, make_number (XVECTOR (sequence)->size - 1), - build_string ("(any string)")); - } + Lisp_Object tem; + tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1)); + if (STRINGP (tem)) + Faset (sequence, make_number (XVECTOR (sequence)->size - 1), + build_string ("(any string)")); + } - /* It is a true unshadowed match. Record it, unless it's already - been seen (as could happen when inheriting keymaps). */ - if (NILP (Fmember (sequence, found))) - found = Fcons (sequence, found); - - /* If firstonly is Qnon_ascii, then we can return the first - binding we find. If firstonly is not Qnon_ascii but not - nil, then we should return the first ascii-only binding - we find. */ - if (EQ (firstonly, Qnon_ascii)) - RETURN_UNGCPRO (sequence); - else if (!NILP (firstonly) && ascii_sequence_p (sequence)) - RETURN_UNGCPRO (sequence); - - if (CONSP (remapped)) - { - sequence = XCAR (remapped); - remapped = XCDR (remapped); - goto record_sequence; - } + /* It is a true unshadowed match. Record it, unless it's already + been seen (as could happen when inheriting keymaps). */ + if (NILP (Fmember (sequence, found))) + found = Fcons (sequence, found); + + /* If firstonly is Qnon_ascii, then we can return the first + binding we find. If firstonly is not Qnon_ascii but not + nil, then we should return the first ascii-only binding + we find. */ + if (EQ (firstonly, Qnon_ascii)) + RETURN_UNGCPRO (sequence); + else if (!NILP (firstonly) && ascii_sequence_p (sequence)) + RETURN_UNGCPRO (sequence); + + if (CONSP (remapped)) + { + sequence = XCAR (remapped); + remapped = XCDR (remapped); + goto record_sequence; } } } @@ -3002,53 +2923,19 @@ remapped command in the returned list. */) return result; } -/* This is the function that Fwhere_is_internal calls using map_char_table. - ARGS has the form - (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT)) - . - ((THIS . LAST) . (NOMENUS . LAST_IS_META))) - Since map_char_table doesn't really use the return value from this function, - we the result append to RESULT, the slot in ARGS. - - This function can GC because it calls where_is_internal_1 which can - GC. */ - -static void -where_is_internal_2 (args, key, binding) - Lisp_Object args, key, binding; -{ - Lisp_Object definition, noindirect, this, last; - Lisp_Object result, sequence; - int nomenus, last_is_meta; - struct gcpro gcpro1, gcpro2, gcpro3; - - GCPRO3 (args, key, binding); - result = XCDR (XCAR (args)); - definition = XCAR (XCAR (XCAR (args))); - noindirect = XCDR (XCAR (XCAR (args))); - this = XCAR (XCAR (XCDR (args))); - last = XCDR (XCAR (XCDR (args))); - nomenus = XFASTINT (XCAR (XCDR (XCDR (args)))); - last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args)))); - - sequence = where_is_internal_1 (binding, key, definition, noindirect, - this, last, nomenus, last_is_meta); - - if (!NILP (sequence)) - XSETCDR (XCAR (args), Fcons (sequence, result)); - - UNGCPRO; -} - - /* This function can GC because get_keyelt can. */ -static Lisp_Object -where_is_internal_1 (binding, key, definition, noindirect, this, last, - nomenus, last_is_meta) - Lisp_Object binding, key, definition, noindirect, this, last; - int nomenus, last_is_meta; +static void +where_is_internal_1 (key, binding, args, data) + Lisp_Object key, binding, args; + void *data; { + struct where_is_internal_data *d = data; /* Cast! */ + Lisp_Object definition = d->definition; + Lisp_Object noindirect = d->noindirect; + Lisp_Object this = d->this; + Lisp_Object last = d->last; + int last_is_meta = d->last_is_meta; Lisp_Object sequence; /* Search through indirections unless that's not wanted. */ @@ -3062,7 +2949,7 @@ where_is_internal_1 (binding, key, definition, noindirect, this, last, || EQ (binding, definition) || (CONSP (definition) && !NILP (Fequal (binding, definition))))) /* Doesn't match. */ - return Qnil; + return; /* We have found a match. Construct the key sequence where we found it. */ if (INTEGERP (key) && last_is_meta) @@ -3077,10 +2964,9 @@ where_is_internal_1 (binding, key, definition, noindirect, this, last, { Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil); Fputhash (binding, Fcons (sequence, sequences), where_is_cache); - return Qnil; } else - return sequence; + d->sequences = Fcons (sequence, d->sequences); } /* describe-bindings - summarizing all the bindings in a set of keymaps. */ -- 2.39.2