Mercurial > emacs
comparison src/keymap.c @ 81792:4ee4f467ca51
(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.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Tue, 10 Jul 2007 15:20:15 +0000 |
parents | 7e640eac2dcb |
children | c1184a3d99c9 |
comparison
equal
deleted
inserted
replaced
81791:98732c4676bc | 81792:4ee4f467ca51 |
---|---|
1154 RETURN_UNGCPRO (Qnil); | 1154 RETURN_UNGCPRO (Qnil); |
1155 | 1155 |
1156 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt)) | 1156 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt)) |
1157 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands); | 1157 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands); |
1158 | 1158 |
1159 meta_bit = (VECTORP (key) || STRINGP (key) && STRING_MULTIBYTE (key) | 1159 meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key)) |
1160 ? meta_modifier : 0x80); | 1160 ? meta_modifier : 0x80); |
1161 | 1161 |
1162 if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0))) | 1162 if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0))) |
1163 { /* DEF is apparently an XEmacs-style keyboard macro. */ | 1163 { /* DEF is apparently an XEmacs-style keyboard macro. */ |
1164 Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil); | 1164 Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil); |
2044 return Flist (nmaps, maps); | 2044 return Flist (nmaps, maps); |
2045 } | 2045 } |
2046 | 2046 |
2047 /* Help functions for describing and documenting keymaps. */ | 2047 /* Help functions for describing and documenting keymaps. */ |
2048 | 2048 |
2049 struct accessible_keymaps_data { | |
2050 Lisp_Object maps, tail, thisseq; | |
2051 /* Does the current sequence end in the meta-prefix-char? */ | |
2052 int is_metized; | |
2053 }; | |
2049 | 2054 |
2050 static void | 2055 static void |
2051 accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized) | 2056 accessible_keymaps_1 (key, cmd, args, data) |
2052 Lisp_Object maps, tail, thisseq, key, cmd; | 2057 Lisp_Object key, cmd, args; |
2053 int is_metized; /* If 1, `key' is assumed to be INTEGERP. */ | 2058 /* Use void* to be compatible with map_keymap_function_t. */ |
2054 { | 2059 void *data; |
2060 { | |
2061 struct accessible_keymaps_data *d = data; /* Cast! */ | |
2062 Lisp_Object maps = d->maps; | |
2063 Lisp_Object tail = d->tail; | |
2064 Lisp_Object thisseq = d->thisseq; | |
2065 int is_metized = d->is_metized && INTEGERP (key); | |
2055 Lisp_Object tem; | 2066 Lisp_Object tem; |
2056 | 2067 |
2057 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0); | 2068 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0); |
2058 if (NILP (cmd)) | 2069 if (NILP (cmd)) |
2059 return; | 2070 return; |
2103 tem = append_key (thisseq, key); | 2114 tem = append_key (thisseq, key); |
2104 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil)); | 2115 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil)); |
2105 } | 2116 } |
2106 } | 2117 } |
2107 | 2118 |
2108 static void | |
2109 accessible_keymaps_char_table (args, index, cmd) | |
2110 Lisp_Object args, index, cmd; | |
2111 { | |
2112 accessible_keymaps_1 (index, cmd, | |
2113 XCAR (XCAR (args)), | |
2114 XCAR (XCDR (args)), | |
2115 XCDR (XCDR (args)), | |
2116 XINT (XCDR (XCAR (args)))); | |
2117 } | |
2118 | |
2119 /* This function cannot GC. */ | 2119 /* This function cannot GC. */ |
2120 | 2120 |
2121 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, | 2121 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, |
2122 1, 2, 0, | 2122 1, 2, 0, |
2123 doc: /* Find all keymaps accessible via prefix characters from KEYMAP. | 2123 doc: /* Find all keymaps accessible via prefix characters from KEYMAP. |
2128 then the value includes only maps for prefixes that start with PREFIX. */) | 2128 then the value includes only maps for prefixes that start with PREFIX. */) |
2129 (keymap, prefix) | 2129 (keymap, prefix) |
2130 Lisp_Object keymap, prefix; | 2130 Lisp_Object keymap, prefix; |
2131 { | 2131 { |
2132 Lisp_Object maps, tail; | 2132 Lisp_Object maps, tail; |
2133 int prefixlen = 0; | 2133 int prefixlen = XINT (Flength (prefix)); |
2134 | 2134 |
2135 /* no need for gcpro because we don't autoload any keymaps. */ | 2135 /* no need for gcpro because we don't autoload any keymaps. */ |
2136 | |
2137 if (!NILP (prefix)) | |
2138 prefixlen = XINT (Flength (prefix)); | |
2139 | 2136 |
2140 if (!NILP (prefix)) | 2137 if (!NILP (prefix)) |
2141 { | 2138 { |
2142 /* If a prefix was specified, start with the keymap (if any) for | 2139 /* If a prefix was specified, start with the keymap (if any) for |
2143 that prefix, so we don't waste time considering other prefixes. */ | 2140 that prefix, so we don't waste time considering other prefixes. */ |
2145 tem = Flookup_key (keymap, prefix, Qt); | 2142 tem = Flookup_key (keymap, prefix, Qt); |
2146 /* Flookup_key may give us nil, or a number, | 2143 /* Flookup_key may give us nil, or a number, |
2147 if the prefix is not defined in this particular map. | 2144 if the prefix is not defined in this particular map. |
2148 It might even give us a list that isn't a keymap. */ | 2145 It might even give us a list that isn't a keymap. */ |
2149 tem = get_keymap (tem, 0, 0); | 2146 tem = get_keymap (tem, 0, 0); |
2150 if (CONSP (tem)) | 2147 /* If the keymap is autoloaded `tem' is not a cons-cell, but we still |
2148 want to return it. */ | |
2149 if (!NILP (tem)) | |
2151 { | 2150 { |
2152 /* Convert PREFIX to a vector now, so that later on | 2151 /* Convert PREFIX to a vector now, so that later on |
2153 we don't have to deal with the possibility of a string. */ | 2152 we don't have to deal with the possibility of a string. */ |
2154 if (STRINGP (prefix)) | 2153 if (STRINGP (prefix)) |
2155 { | 2154 { |
2185 This is a breadth-first traversal, where tail is the queue of | 2184 This is a breadth-first traversal, where tail is the queue of |
2186 nodes, and maps accumulates a list of all nodes visited. */ | 2185 nodes, and maps accumulates a list of all nodes visited. */ |
2187 | 2186 |
2188 for (tail = maps; CONSP (tail); tail = XCDR (tail)) | 2187 for (tail = maps; CONSP (tail); tail = XCDR (tail)) |
2189 { | 2188 { |
2190 register Lisp_Object thisseq, thismap; | 2189 struct accessible_keymaps_data data; |
2190 register Lisp_Object thismap = Fcdr (XCAR (tail)); | |
2191 Lisp_Object last; | 2191 Lisp_Object last; |
2192 | |
2193 data.thisseq = Fcar (XCAR (tail)); | |
2194 data.maps = maps; | |
2195 data.tail = tail; | |
2196 last = make_number (XINT (Flength (data.thisseq)) - 1); | |
2192 /* Does the current sequence end in the meta-prefix-char? */ | 2197 /* Does the current sequence end in the meta-prefix-char? */ |
2193 int is_metized; | 2198 data.is_metized = (XINT (last) >= 0 |
2194 | |
2195 thisseq = Fcar (Fcar (tail)); | |
2196 thismap = Fcdr (Fcar (tail)); | |
2197 last = make_number (XINT (Flength (thisseq)) - 1); | |
2198 is_metized = (XINT (last) >= 0 | |
2199 /* Don't metize the last char of PREFIX. */ | 2199 /* Don't metize the last char of PREFIX. */ |
2200 && XINT (last) >= prefixlen | 2200 && XINT (last) >= prefixlen |
2201 && EQ (Faref (thisseq, last), meta_prefix_char)); | 2201 && EQ (Faref (data.thisseq, last), meta_prefix_char)); |
2202 | 2202 |
2203 for (; CONSP (thismap); thismap = XCDR (thismap)) | 2203 /* Since we can't run lisp code, we can't scan autoloaded maps. */ |
2204 { | 2204 if (CONSP (thismap)) |
2205 Lisp_Object elt; | 2205 map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0); |
2206 | 2206 } |
2207 elt = XCAR (thismap); | |
2208 | |
2209 QUIT; | |
2210 | |
2211 if (CHAR_TABLE_P (elt)) | |
2212 { | |
2213 Lisp_Object indices[3]; | |
2214 | |
2215 map_char_table (accessible_keymaps_char_table, Qnil, elt, | |
2216 elt, Fcons (Fcons (maps, make_number (is_metized)), | |
2217 Fcons (tail, thisseq)), | |
2218 0, indices); | |
2219 } | |
2220 else if (VECTORP (elt)) | |
2221 { | |
2222 register int i; | |
2223 | |
2224 /* Vector keymap. Scan all the elements. */ | |
2225 for (i = 0; i < ASIZE (elt); i++) | |
2226 accessible_keymaps_1 (make_number (i), AREF (elt, i), | |
2227 maps, tail, thisseq, is_metized); | |
2228 | |
2229 } | |
2230 else if (CONSP (elt)) | |
2231 accessible_keymaps_1 (XCAR (elt), XCDR (elt), | |
2232 maps, tail, thisseq, | |
2233 is_metized && INTEGERP (XCAR (elt))); | |
2234 | |
2235 } | |
2236 } | |
2237 | |
2238 return maps; | 2207 return maps; |
2239 } | 2208 } |
2240 | |
2241 Lisp_Object Qsingle_key_description, Qkey_description; | 2209 Lisp_Object Qsingle_key_description, Qkey_description; |
2242 | 2210 |
2243 /* This function cannot GC. */ | 2211 /* This function cannot GC. */ |
2244 | 2212 |
2245 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0, | 2213 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0, |
2506 | 2474 |
2507 if (! CHAR_VALID_P (without_bits, 1)) | 2475 if (! CHAR_VALID_P (without_bits, 1)) |
2508 { | 2476 { |
2509 char buf[256]; | 2477 char buf[256]; |
2510 | 2478 |
2511 sprintf (buf, "Invalid char code %d", XINT (key)); | 2479 sprintf (buf, "Invalid char code %ld", XINT (key)); |
2512 return build_string (buf); | 2480 return build_string (buf); |
2513 } | 2481 } |
2514 else if (charset | 2482 else if (charset |
2515 && ((c1 == 0 && c2 == -1) || c2 == 0)) | 2483 && ((c1 == 0 && c2 == -1) || c2 == 0)) |
2516 { | 2484 { |
2649 | 2617 |
2650 | 2618 |
2651 /* where-is - finding a command in a set of keymaps. */ | 2619 /* where-is - finding a command in a set of keymaps. */ |
2652 | 2620 |
2653 static Lisp_Object where_is_internal (); | 2621 static Lisp_Object where_is_internal (); |
2654 static Lisp_Object where_is_internal_1 (); | 2622 static void where_is_internal_1 P_ ((Lisp_Object key, Lisp_Object binding, |
2655 static void where_is_internal_2 (); | 2623 Lisp_Object args, void *data)); |
2656 | 2624 |
2657 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map. | 2625 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map. |
2658 Returns the first non-nil binding found in any of those maps. */ | 2626 Returns the first non-nil binding found in any of those maps. */ |
2659 | 2627 |
2660 static Lisp_Object | 2628 static Lisp_Object |
2678 } | 2646 } |
2679 return Qnil; | 2647 return Qnil; |
2680 } | 2648 } |
2681 | 2649 |
2682 static Lisp_Object Vmouse_events; | 2650 static Lisp_Object Vmouse_events; |
2651 | |
2652 struct where_is_internal_data { | |
2653 Lisp_Object definition, noindirect, this, last; | |
2654 int last_is_meta; | |
2655 Lisp_Object sequences; | |
2656 }; | |
2683 | 2657 |
2684 /* This function can GC if Flookup_key autoloads any keymaps. */ | 2658 /* This function can GC if Flookup_key autoloads any keymaps. */ |
2685 | 2659 |
2686 static Lisp_Object | 2660 static Lisp_Object |
2687 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap) | 2661 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap) |
2716 | 2690 |
2717 for (; !NILP (maps); maps = Fcdr (maps)) | 2691 for (; !NILP (maps); maps = Fcdr (maps)) |
2718 { | 2692 { |
2719 /* Key sequence to reach map, and the map that it reaches */ | 2693 /* Key sequence to reach map, and the map that it reaches */ |
2720 register Lisp_Object this, map, tem; | 2694 register Lisp_Object this, map, tem; |
2695 struct where_is_internal_data data; | |
2721 | 2696 |
2722 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into | 2697 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into |
2723 [M-CHAR] sequences, check if last character of the sequence | 2698 [M-CHAR] sequences, check if last character of the sequence |
2724 is the meta-prefix char. */ | 2699 is the meta-prefix char. */ |
2725 Lisp_Object last; | 2700 Lisp_Object last; |
2740 non-ascii prefixes like `C-down-mouse-2'. */ | 2715 non-ascii prefixes like `C-down-mouse-2'. */ |
2741 continue; | 2716 continue; |
2742 | 2717 |
2743 QUIT; | 2718 QUIT; |
2744 | 2719 |
2745 while (CONSP (map)) | 2720 data.definition = definition; |
2746 { | 2721 data.noindirect = noindirect; |
2747 /* Because the code we want to run on each binding is rather | 2722 data.this = this; |
2748 large, we don't want to have two separate loop bodies for | 2723 data.last = last; |
2749 sparse keymap bindings and tables; we want to iterate one | 2724 data.last_is_meta = last_is_meta; |
2750 loop body over both keymap and vector bindings. | 2725 data.sequences = Qnil; |
2751 | 2726 |
2752 For this reason, if Fcar (map) is a vector, we don't | 2727 if (CONSP (map)) |
2753 advance map to the next element until i indicates that we | 2728 map_keymap (map, where_is_internal_1, Qnil, &data, 0); |
2754 have finished off the vector. */ | 2729 |
2755 Lisp_Object elt, key, binding; | 2730 sequences = data.sequences; |
2756 elt = XCAR (map); | 2731 |
2757 map = XCDR (map); | 2732 while (CONSP (sequences)) |
2758 | 2733 { |
2759 sequences = Qnil; | 2734 Lisp_Object sequence, remapped, function; |
2760 | 2735 |
2761 QUIT; | 2736 sequence = XCAR (sequences); |
2762 | 2737 sequences = XCDR (sequences); |
2763 /* Set key and binding to the current key and binding, and | 2738 |
2764 advance map and i to the next binding. */ | 2739 /* If the current sequence is a command remapping with |
2765 if (VECTORP (elt)) | 2740 format [remap COMMAND], find the key sequences |
2741 which run COMMAND, and use those sequences instead. */ | |
2742 remapped = Qnil; | |
2743 if (NILP (no_remap) | |
2744 && VECTORP (sequence) && XVECTOR (sequence)->size == 2 | |
2745 && EQ (AREF (sequence, 0), Qremap) | |
2746 && (function = AREF (sequence, 1), SYMBOLP (function))) | |
2766 { | 2747 { |
2767 Lisp_Object sequence; | 2748 Lisp_Object remapped1; |
2768 int i; | 2749 |
2769 /* In a vector, look at each element. */ | 2750 remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt); |
2770 for (i = 0; i < XVECTOR (elt)->size; i++) | 2751 if (CONSP (remapped1)) |
2771 { | 2752 { |
2772 binding = AREF (elt, i); | 2753 /* Verify that this key binding actually maps to the |
2773 XSETFASTINT (key, i); | 2754 remapped command (see below). */ |
2774 sequence = where_is_internal_1 (binding, key, definition, | 2755 if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function)) |
2775 noindirect, this, | 2756 continue; |
2776 last, nomenus, last_is_meta); | 2757 sequence = XCAR (remapped1); |
2777 if (!NILP (sequence)) | 2758 remapped = XCDR (remapped1); |
2778 sequences = Fcons (sequence, sequences); | 2759 goto record_sequence; |
2779 } | 2760 } |
2780 } | 2761 } |
2781 else if (CHAR_TABLE_P (elt)) | 2762 |
2763 /* Verify that this key binding is not shadowed by another | |
2764 binding for the same key, before we say it exists. | |
2765 | |
2766 Mechanism: look for local definition of this key and if | |
2767 it is defined and does not match what we found then | |
2768 ignore this key. | |
2769 | |
2770 Either nil or number as value from Flookup_key | |
2771 means undefined. */ | |
2772 if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition)) | |
2773 continue; | |
2774 | |
2775 record_sequence: | |
2776 /* Don't annoy user with strings from a menu such as | |
2777 Select Paste. Change them all to "(any string)", | |
2778 so that there seems to be only one menu item | |
2779 to report. */ | |
2780 if (! NILP (sequence)) | |
2782 { | 2781 { |
2783 Lisp_Object indices[3]; | 2782 Lisp_Object tem; |
2784 Lisp_Object args; | 2783 tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1)); |
2785 | 2784 if (STRINGP (tem)) |
2786 args = Fcons (Fcons (Fcons (definition, noindirect), | 2785 Faset (sequence, make_number (XVECTOR (sequence)->size - 1), |
2787 Qnil), /* Result accumulator. */ | 2786 build_string ("(any string)")); |
2788 Fcons (Fcons (this, last), | |
2789 Fcons (make_number (nomenus), | |
2790 make_number (last_is_meta)))); | |
2791 map_char_table (where_is_internal_2, Qnil, elt, elt, args, | |
2792 0, indices); | |
2793 sequences = XCDR (XCAR (args)); | |
2794 } | 2787 } |
2795 else if (CONSP (elt)) | 2788 |
2789 /* It is a true unshadowed match. Record it, unless it's already | |
2790 been seen (as could happen when inheriting keymaps). */ | |
2791 if (NILP (Fmember (sequence, found))) | |
2792 found = Fcons (sequence, found); | |
2793 | |
2794 /* If firstonly is Qnon_ascii, then we can return the first | |
2795 binding we find. If firstonly is not Qnon_ascii but not | |
2796 nil, then we should return the first ascii-only binding | |
2797 we find. */ | |
2798 if (EQ (firstonly, Qnon_ascii)) | |
2799 RETURN_UNGCPRO (sequence); | |
2800 else if (!NILP (firstonly) && ascii_sequence_p (sequence)) | |
2801 RETURN_UNGCPRO (sequence); | |
2802 | |
2803 if (CONSP (remapped)) | |
2796 { | 2804 { |
2797 Lisp_Object sequence; | 2805 sequence = XCAR (remapped); |
2798 | 2806 remapped = XCDR (remapped); |
2799 key = XCAR (elt); | 2807 goto record_sequence; |
2800 binding = XCDR (elt); | |
2801 | |
2802 sequence = where_is_internal_1 (binding, key, definition, | |
2803 noindirect, this, | |
2804 last, nomenus, last_is_meta); | |
2805 if (!NILP (sequence)) | |
2806 sequences = Fcons (sequence, sequences); | |
2807 } | |
2808 | |
2809 | |
2810 while (!NILP (sequences)) | |
2811 { | |
2812 Lisp_Object sequence, remapped, function; | |
2813 | |
2814 sequence = XCAR (sequences); | |
2815 sequences = XCDR (sequences); | |
2816 | |
2817 /* If the current sequence is a command remapping with | |
2818 format [remap COMMAND], find the key sequences | |
2819 which run COMMAND, and use those sequences instead. */ | |
2820 remapped = Qnil; | |
2821 if (NILP (no_remap) | |
2822 && VECTORP (sequence) && XVECTOR (sequence)->size == 2 | |
2823 && EQ (AREF (sequence, 0), Qremap) | |
2824 && (function = AREF (sequence, 1), SYMBOLP (function))) | |
2825 { | |
2826 Lisp_Object remapped1; | |
2827 | |
2828 remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt); | |
2829 if (CONSP (remapped1)) | |
2830 { | |
2831 /* Verify that this key binding actually maps to the | |
2832 remapped command (see below). */ | |
2833 if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function)) | |
2834 continue; | |
2835 sequence = XCAR (remapped1); | |
2836 remapped = XCDR (remapped1); | |
2837 goto record_sequence; | |
2838 } | |
2839 } | |
2840 | |
2841 /* Verify that this key binding is not shadowed by another | |
2842 binding for the same key, before we say it exists. | |
2843 | |
2844 Mechanism: look for local definition of this key and if | |
2845 it is defined and does not match what we found then | |
2846 ignore this key. | |
2847 | |
2848 Either nil or number as value from Flookup_key | |
2849 means undefined. */ | |
2850 if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition)) | |
2851 continue; | |
2852 | |
2853 record_sequence: | |
2854 /* Don't annoy user with strings from a menu such as | |
2855 Select Paste. Change them all to "(any string)", | |
2856 so that there seems to be only one menu item | |
2857 to report. */ | |
2858 if (! NILP (sequence)) | |
2859 { | |
2860 Lisp_Object tem; | |
2861 tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1)); | |
2862 if (STRINGP (tem)) | |
2863 Faset (sequence, make_number (XVECTOR (sequence)->size - 1), | |
2864 build_string ("(any string)")); | |
2865 } | |
2866 | |
2867 /* It is a true unshadowed match. Record it, unless it's already | |
2868 been seen (as could happen when inheriting keymaps). */ | |
2869 if (NILP (Fmember (sequence, found))) | |
2870 found = Fcons (sequence, found); | |
2871 | |
2872 /* If firstonly is Qnon_ascii, then we can return the first | |
2873 binding we find. If firstonly is not Qnon_ascii but not | |
2874 nil, then we should return the first ascii-only binding | |
2875 we find. */ | |
2876 if (EQ (firstonly, Qnon_ascii)) | |
2877 RETURN_UNGCPRO (sequence); | |
2878 else if (!NILP (firstonly) && ascii_sequence_p (sequence)) | |
2879 RETURN_UNGCPRO (sequence); | |
2880 | |
2881 if (CONSP (remapped)) | |
2882 { | |
2883 sequence = XCAR (remapped); | |
2884 remapped = XCDR (remapped); | |
2885 goto record_sequence; | |
2886 } | |
2887 } | 2808 } |
2888 } | 2809 } |
2889 } | 2810 } |
2890 | 2811 |
2891 UNGCPRO; | 2812 UNGCPRO; |
3000 } | 2921 } |
3001 | 2922 |
3002 return result; | 2923 return result; |
3003 } | 2924 } |
3004 | 2925 |
3005 /* This is the function that Fwhere_is_internal calls using map_char_table. | 2926 /* This function can GC because get_keyelt can. */ |
3006 ARGS has the form | |
3007 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT)) | |
3008 . | |
3009 ((THIS . LAST) . (NOMENUS . LAST_IS_META))) | |
3010 Since map_char_table doesn't really use the return value from this function, | |
3011 we the result append to RESULT, the slot in ARGS. | |
3012 | |
3013 This function can GC because it calls where_is_internal_1 which can | |
3014 GC. */ | |
3015 | 2927 |
3016 static void | 2928 static void |
3017 where_is_internal_2 (args, key, binding) | 2929 where_is_internal_1 (key, binding, args, data) |
3018 Lisp_Object args, key, binding; | 2930 Lisp_Object key, binding, args; |
3019 { | 2931 void *data; |
3020 Lisp_Object definition, noindirect, this, last; | 2932 { |
3021 Lisp_Object result, sequence; | 2933 struct where_is_internal_data *d = data; /* Cast! */ |
3022 int nomenus, last_is_meta; | 2934 Lisp_Object definition = d->definition; |
3023 struct gcpro gcpro1, gcpro2, gcpro3; | 2935 Lisp_Object noindirect = d->noindirect; |
3024 | 2936 Lisp_Object this = d->this; |
3025 GCPRO3 (args, key, binding); | 2937 Lisp_Object last = d->last; |
3026 result = XCDR (XCAR (args)); | 2938 int last_is_meta = d->last_is_meta; |
3027 definition = XCAR (XCAR (XCAR (args))); | |
3028 noindirect = XCDR (XCAR (XCAR (args))); | |
3029 this = XCAR (XCAR (XCDR (args))); | |
3030 last = XCDR (XCAR (XCDR (args))); | |
3031 nomenus = XFASTINT (XCAR (XCDR (XCDR (args)))); | |
3032 last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args)))); | |
3033 | |
3034 sequence = where_is_internal_1 (binding, key, definition, noindirect, | |
3035 this, last, nomenus, last_is_meta); | |
3036 | |
3037 if (!NILP (sequence)) | |
3038 XSETCDR (XCAR (args), Fcons (sequence, result)); | |
3039 | |
3040 UNGCPRO; | |
3041 } | |
3042 | |
3043 | |
3044 /* This function can GC because get_keyelt can. */ | |
3045 | |
3046 static Lisp_Object | |
3047 where_is_internal_1 (binding, key, definition, noindirect, this, last, | |
3048 nomenus, last_is_meta) | |
3049 Lisp_Object binding, key, definition, noindirect, this, last; | |
3050 int nomenus, last_is_meta; | |
3051 { | |
3052 Lisp_Object sequence; | 2939 Lisp_Object sequence; |
3053 | 2940 |
3054 /* Search through indirections unless that's not wanted. */ | 2941 /* Search through indirections unless that's not wanted. */ |
3055 if (NILP (noindirect)) | 2942 if (NILP (noindirect)) |
3056 binding = get_keyelt (binding, 0); | 2943 binding = get_keyelt (binding, 0); |
3060 | 2947 |
3061 if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */ | 2948 if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */ |
3062 || EQ (binding, definition) | 2949 || EQ (binding, definition) |
3063 || (CONSP (definition) && !NILP (Fequal (binding, definition))))) | 2950 || (CONSP (definition) && !NILP (Fequal (binding, definition))))) |
3064 /* Doesn't match. */ | 2951 /* Doesn't match. */ |
3065 return Qnil; | 2952 return; |
3066 | 2953 |
3067 /* We have found a match. Construct the key sequence where we found it. */ | 2954 /* We have found a match. Construct the key sequence where we found it. */ |
3068 if (INTEGERP (key) && last_is_meta) | 2955 if (INTEGERP (key) && last_is_meta) |
3069 { | 2956 { |
3070 sequence = Fcopy_sequence (this); | 2957 sequence = Fcopy_sequence (this); |
3075 | 2962 |
3076 if (!NILP (where_is_cache)) | 2963 if (!NILP (where_is_cache)) |
3077 { | 2964 { |
3078 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil); | 2965 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil); |
3079 Fputhash (binding, Fcons (sequence, sequences), where_is_cache); | 2966 Fputhash (binding, Fcons (sequence, sequences), where_is_cache); |
3080 return Qnil; | |
3081 } | 2967 } |
3082 else | 2968 else |
3083 return sequence; | 2969 d->sequences = Fcons (sequence, d->sequences); |
3084 } | 2970 } |
3085 | 2971 |
3086 /* describe-bindings - summarizing all the bindings in a set of keymaps. */ | 2972 /* describe-bindings - summarizing all the bindings in a set of keymaps. */ |
3087 | 2973 |
3088 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0, | 2974 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0, |