Mercurial > hg > xemacs-beta
annotate src/keymap.c @ 5050:6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
-------------------- ChangeLog entries follow: --------------------
ChangeLog addition:
2010-02-20 Ben Wing <ben@xemacs.org>
* configure.ac (XE_COMPLEX_ARG):
Correct doc of --quick-build: It also doesn't check for Lisp shadows.
src/ChangeLog addition:
2010-02-20 Ben Wing <ben@xemacs.org>
* EmacsFrame.c:
* EmacsFrame.c (EmacsFrameRecomputeCellSize):
* alloca.c (i00afunc):
* buffer.c:
* buffer.c (MARKED_SLOT):
* buffer.c (complex_vars_of_buffer):
* cm.c:
* cm.c (cmcheckmagic):
* console.c:
* console.c (MARKED_SLOT):
* device-x.c:
* device-x.c (x_get_visual_depth):
* emacs.c (sort_args):
* eval.c (throw_or_bomb_out):
* event-stream.c:
* event-stream.c (Fadd_timeout):
* event-stream.c (Fadd_async_timeout):
* event-stream.c (Frecent_keys):
* events.c:
* events.c (Fdeallocate_event):
* events.c (event_pixel_translation):
* extents.c:
* extents.c (process_extents_for_insertion_mapper):
* fns.c (Fbase64_encode_region):
* fns.c (Fbase64_encode_string):
* fns.c (Fbase64_decode_region):
* fns.c (Fbase64_decode_string):
* font-lock.c:
* font-lock.c (find_context):
* frame-x.c:
* frame-x.c (x_wm_mark_shell_size_user_specified):
* frame-x.c (x_wm_mark_shell_position_user_specified):
* frame-x.c (x_wm_set_shell_iconic_p):
* frame-x.c (x_wm_set_cell_size):
* frame-x.c (x_wm_set_variable_size):
* frame-x.c (x_wm_store_class_hints):
* frame-x.c (x_wm_maybe_store_wm_command):
* frame-x.c (x_initialize_frame_size):
* frame.c (delete_frame_internal):
* frame.c (change_frame_size_1):
* free-hook.c (check_free):
* free-hook.c (note_block_input):
* free-hook.c (log_gcpro):
* gccache-gtk.c (gc_cache_lookup):
* gccache-x.c:
* gccache-x.c (gc_cache_lookup):
* glyphs-gtk.c:
* glyphs-gtk.c (init_image_instance_from_gdk_pixmap):
* glyphs-x.c:
* glyphs-x.c (extract_xpm_color_names):
* insdel.c:
* insdel.c (move_gap):
* keymap.c:
* keymap.c (keymap_lookup_directly):
* keymap.c (keymap_delete_inverse_internal):
* keymap.c (accessible_keymaps_mapper_1):
* keymap.c (where_is_recursive_mapper):
* lisp.h:
* lstream.c (make_lisp_buffer_stream_1):
* macros.c:
* macros.c (pop_kbd_macro_event):
* mc-alloc.c (remove_page_from_used_list):
* menubar-x.c:
* menubar-x.c (set_frame_menubar):
* ralloc.c:
* ralloc.c (obtain):
* ralloc.c (relinquish):
* ralloc.c (relocate_blocs):
* ralloc.c (resize_bloc):
* ralloc.c (r_alloc_free):
* ralloc.c (r_re_alloc):
* ralloc.c (r_alloc_thaw):
* ralloc.c (init_ralloc):
* ralloc.c (Free_Addr_Block):
* scrollbar-x.c:
* scrollbar-x.c (x_update_scrollbar_instance_status):
* sunplay.c (init_device):
* unexnt.c:
* unexnt.c (read_in_bss):
* unexnt.c (map_in_heap):
* window.c:
* window.c (real_window):
* window.c (window_display_lines):
* window.c (window_display_buffer):
* window.c (set_window_display_buffer):
* window.c (unshow_buffer):
* window.c (Fget_lru_window):
if (...) ABORT(); ---> assert();
More specifically:
if (x == y) ABORT (); --> assert (x != y);
if (x != y) ABORT (); --> assert (x == y);
if (x > y) ABORT (); --> assert (x <= y);
etc.
if (!x) ABORT (); --> assert (x);
if (x) ABORT (); --> assert (!x);
DeMorgan's Law's applied and manually simplified:
if (x && !y) ABORT (); --> assert (!x || y);
if (!x || y >= z) ABORT (); --> assert (x && y < z);
Checked to make sure that assert() of an expression with side
effects ensures that the side effects get executed even when
asserts are disabled, and add a comment about this being a
requirement of any "disabled assert" expression.
* depend:
* make-src-depend:
* make-src-depend (PrintDeps):
Fix broken code in make-src-depend so it does what it was always
supposed to do, which was separate out config.h and lisp.h and
all the files they include into separate variables in the
depend part of Makefile so that quick-build can turn off the
lisp.h/config.h/text.h/etc. dependencies of the source files, to
speed up recompilation.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Sat, 20 Feb 2010 05:05:54 -0600 |
| parents | ae48681c47fa |
| children | 99f8ebc082d9 2a462149bd6a |
| rev | line source |
|---|---|
| 428 | 1 /* Manipulation of keymaps |
| 2 Copyright (C) 1985, 1991-1995 Free Software Foundation, Inc. | |
| 3 Copyright (C) 1995 Board of Trustees, University of Illinois. | |
| 4 Copyright (C) 1995 Sun Microsystems, Inc. | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
5 Copyright (C) 2001, 2002, 2010 Ben Wing. |
| 428 | 6 Totally redesigned by jwz in 1991. |
| 7 | |
| 8 This file is part of XEmacs. | |
| 9 | |
| 10 XEmacs is free software; you can redistribute it and/or modify it | |
| 11 under the terms of the GNU General Public License as published by the | |
| 12 Free Software Foundation; either version 2, or (at your option) any | |
| 13 later version. | |
| 14 | |
| 15 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 16 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 18 for more details. | |
| 19 | |
| 20 You should have received a copy of the GNU General Public License | |
| 21 along with XEmacs; see the file COPYING. If not, write to | |
| 22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 23 Boston, MA 02111-1307, USA. */ | |
| 24 | |
| 25 /* Synched up with: Mule 2.0. Not synched with FSF. Substantially | |
| 26 different from FSF. */ | |
| 27 | |
| 28 | |
| 29 #include <config.h> | |
| 30 #include "lisp.h" | |
| 31 | |
| 32 #include "buffer.h" | |
| 33 #include "bytecode.h" | |
| 872 | 34 #include "console-impl.h" |
| 428 | 35 #include "elhash.h" |
| 36 #include "events.h" | |
| 872 | 37 #include "extents.h" |
| 428 | 38 #include "frame.h" |
| 39 #include "insdel.h" | |
| 40 #include "keymap.h" | |
| 41 #include "window.h" | |
| 42 | |
| 43 | |
| 44 /* A keymap contains six slots: | |
| 45 | |
| 46 parents Ordered list of keymaps to search after | |
| 47 this one if no match is found. | |
| 48 Keymaps can thus be arranged in a hierarchy. | |
| 49 | |
| 50 table A hash table, hashing keysyms to their bindings. | |
| 51 It will be one of the following: | |
| 52 | |
| 3025 | 53 -- a symbol, e.g. `home' |
| 428 | 54 -- a character, representing something printable |
| 55 (not ?\C-c meaning C-c, for instance) | |
| 56 -- an integer representing a modifier combination | |
| 57 | |
| 58 inverse_table A hash table, hashing bindings to the list of keysyms | |
| 59 in this keymap which are bound to them. This is to make | |
| 60 the Fwhere_is_internal() function be fast. It needs to be | |
| 61 fast because we want to be able to call it in realtime to | |
| 62 update the keyboard-equivalents on the pulldown menus. | |
| 63 Values of the table are either atoms (keysyms) | |
| 64 or a dotted list of keysyms. | |
| 65 | |
| 66 sub_maps_cache An alist; for each entry in this keymap whose binding is | |
| 67 a keymap (that is, Fkeymapp()) this alist associates that | |
| 68 keysym with that binding. This is used to optimize both | |
| 69 Fwhere_is_internal() and Faccessible_keymaps(). This slot | |
| 70 gets set to the symbol `t' every time a change is made to | |
| 71 this keymap, causing it to be recomputed when next needed. | |
| 72 | |
| 73 prompt See `set-keymap-prompt'. | |
| 74 | |
| 75 default_binding See `set-keymap-default-binding'. | |
| 76 | |
| 77 Sequences of keys are stored in the obvious way: if the sequence of keys | |
| 78 "abc" was bound to some command `foo', the hierarchy would look like | |
| 79 | |
| 80 keymap-1: associates "a" with keymap-2 | |
| 81 keymap-2: associates "b" with keymap-3 | |
| 82 keymap-3: associates "c" with foo | |
| 83 | |
| 84 However, bucky bits ("modifiers" to the X-minded) are represented in the | |
| 85 keymap hierarchy as well. (This lets us use EQable objects as hash keys.) | |
| 86 Each combination of modifiers (e.g. control-hyper) gets its own submap | |
| 87 off of the main map. The hash key for a modifier combination is | |
| 88 an integer, computed by MAKE_MODIFIER_HASH_KEY(). | |
| 89 | |
| 90 If the key `C-a' was bound to some command, the hierarchy would look like | |
| 91 | |
| 442 | 92 keymap-1: associates the integer XEMACS_MOD_CONTROL with keymap-2 |
| 428 | 93 keymap-2: associates "a" with the command |
| 94 | |
| 95 Similarly, if the key `C-H-a' was bound to some command, the hierarchy | |
| 96 would look like | |
| 97 | |
| 442 | 98 keymap-1: associates the integer (XEMACS_MOD_CONTROL | XEMACS_MOD_HYPER) |
| 428 | 99 with keymap-2 |
| 100 keymap-2: associates "a" with the command | |
| 101 | |
| 102 Note that a special exception is made for the meta modifier, in order | |
| 103 to deal with ESC/meta lossage. Any key combination containing the | |
| 104 meta modifier is first indexed off of the main map into the meta | |
| 442 | 105 submap (with hash key XEMACS_MOD_META) and then indexed off of the |
| 428 | 106 meta submap with the meta modifier removed from the key combination. |
| 107 For example, when associating a command with C-M-H-a, we'd have | |
| 108 | |
| 442 | 109 keymap-1: associates the integer XEMACS_MOD_META with keymap-2 |
| 110 keymap-2: associates the integer (XEMACS_MOD_CONTROL | XEMACS_MOD_HYPER) | |
| 428 | 111 with keymap-3 |
| 112 keymap-3: associates "a" with the command | |
| 113 | |
| 114 Note that keymap-2 might have normal bindings in it; these would be | |
| 115 for key combinations containing only the meta modifier, such as | |
| 116 M-y or meta-backspace. | |
| 117 | |
| 118 If the command that "a" was bound to in keymap-3 was itself a keymap, | |
| 119 then that would make the key "C-M-H-a" be a prefix character. | |
| 120 | |
| 121 Note that this new model of keymaps takes much of the magic away from | |
| 122 the Escape key: the value of the variable `esc-map' is no longer indexed | |
| 123 in the `global-map' under the ESC key. It's indexed under the integer | |
| 442 | 124 XEMACS_MOD_META. This is not user-visible, however; none of the "bucky" |
| 428 | 125 maps are. |
| 126 | |
| 127 There is a hack in Flookup_key() that makes (lookup-key global-map "\^[") | |
| 128 and (define-key some-random-map "\^[" my-esc-map) work as before, for | |
| 129 compatibility. | |
| 130 | |
| 131 Since keymaps are opaque, the only way to extract information from them | |
| 132 is with the functions lookup-key, key-binding, local-key-binding, and | |
| 133 global-key-binding, which work just as before, and the new function | |
| 440 | 134 map-keymap, which is roughly analogous to maphash. |
| 428 | 135 |
| 136 Note that map-keymap perpetuates the illusion that the "bucky" submaps | |
| 137 don't exist: if you map over a keymap with bucky submaps, it will also | |
| 138 map over those submaps. It does not, however, map over other random | |
| 139 submaps of the keymap, just the bucky ones. | |
| 140 | |
| 141 One implication of this is that when you map over `global-map', you will | |
| 142 also map over `esc-map'. It is merely for compatibility that the esc-map | |
| 143 is accessible at all; I think that's a bad thing, since it blurs the | |
| 144 distinction between ESC and "meta" even more. "M-x" is no more a two- | |
| 145 key sequence than "C-x" is. | |
| 146 | |
| 147 */ | |
| 148 | |
| 440 | 149 struct Lisp_Keymap |
| 428 | 150 { |
| 3017 | 151 struct LCRECORD_HEADER header; |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
152 #define MARKED_SLOT(x) Lisp_Object x; |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
153 #include "keymap-slots.h" |
| 440 | 154 }; |
| 428 | 155 |
| 156 #define MAKE_MODIFIER_HASH_KEY(modifier) make_int (modifier) | |
| 157 #define MODIFIER_HASH_KEY_BITS(x) (INTP (x) ? XINT (x) : 0) | |
| 158 | |
| 159 | |
| 160 | |
| 161 /* Actually allocate storage for these variables */ | |
| 162 | |
| 440 | 163 Lisp_Object Vcurrent_global_map; /* Always a keymap */ |
| 428 | 164 |
| 771 | 165 static Lisp_Object Vglobal_tty_map, Vglobal_window_system_map; |
| 166 | |
| 428 | 167 static Lisp_Object Vmouse_grabbed_buffer; |
| 168 | |
| 169 /* Alist of minor mode variables and keymaps. */ | |
| 170 static Lisp_Object Qminor_mode_map_alist; | |
| 171 | |
| 172 static Lisp_Object Voverriding_local_map; | |
| 173 | |
| 174 static Lisp_Object Vkey_translation_map; | |
| 175 | |
| 176 static Lisp_Object Vvertical_divider_map; | |
| 177 | |
| 178 /* This is incremented whenever a change is made to a keymap. This is | |
| 179 so that things which care (such as the menubar code) can recompute | |
| 180 privately-cached data when the user has changed keybindings. | |
| 181 */ | |
| 458 | 182 Fixnum keymap_tick; |
| 428 | 183 |
| 184 /* Prefixing a key with this character is the same as sending a meta bit. */ | |
| 185 Lisp_Object Vmeta_prefix_char; | |
| 186 | |
| 187 Lisp_Object Qkeymapp; | |
| 188 Lisp_Object Vsingle_space_string; | |
| 189 Lisp_Object Qsuppress_keymap; | |
| 190 Lisp_Object Qmodeline_map; | |
| 191 Lisp_Object Qtoolbar_map; | |
| 192 | |
| 193 EXFUN (Fkeymap_fullness, 1); | |
| 194 EXFUN (Fset_keymap_name, 2); | |
| 195 EXFUN (Fsingle_key_description, 1); | |
| 196 | |
| 197 static void describe_command (Lisp_Object definition, Lisp_Object buffer); | |
| 198 static void describe_map (Lisp_Object keymap, Lisp_Object elt_prefix, | |
| 199 void (*elt_describer) (Lisp_Object, Lisp_Object), | |
| 200 int partial, | |
| 201 Lisp_Object shadow, | |
| 202 int mice_only_p, | |
| 203 Lisp_Object buffer); | |
| 440 | 204 static Lisp_Object keymap_submaps (Lisp_Object keymap); |
| 428 | 205 |
| 206 Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift; | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
207 |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
208 #define INCLUDE_BUTTON_ZERO |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
209 #define FROB(num) \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
210 Lisp_Object Qbutton##num; \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
211 Lisp_Object Qbutton##num##up; |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
212 #include "keymap-buttons.h" |
| 428 | 213 |
| 214 Lisp_Object Qmenu_selection; | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
215 |
| 428 | 216 /* Emacs compatibility */ |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
217 #define FROB(num) \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
218 Lisp_Object Qmouse_##num; \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
219 Lisp_Object Qdown_mouse_##num; |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
220 #include "keymap-buttons.h" |
| 428 | 221 |
| 222 /* Kludge kludge kludge */ | |
| 223 Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS; | |
| 224 | |
| 225 | |
| 226 /************************************************************************/ | |
| 227 /* The keymap Lisp object */ | |
| 228 /************************************************************************/ | |
| 229 | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
230 /* Keymaps are equal if Faces are equal if all of their display attributes are equal. We |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
231 don't compare names or doc-strings, because that would make equal |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
232 be eq. |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
233 |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
234 This isn't concerned with "unspecified" attributes, that's what |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
235 #'face-differs-from-default-p is for. */ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
236 static int |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
237 keymap_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
238 int UNUSED (foldcase)) |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
239 { |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
240 Lisp_Keymap *k1 = XKEYMAP (obj1); |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
241 Lisp_Keymap *k2 = XKEYMAP (obj2); |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
242 |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
243 depth++; |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
244 |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
245 return |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
246 ( |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
247 #define MARKED_SLOT(x) \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
248 internal_equal (k1->x, k2->x, depth) && |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
249 #define MARKED_SLOT_NOCOMPARE(x) |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
250 #include "keymap-slots.h" |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
251 1 |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
252 ); |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
253 } |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
254 |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
255 static Hashcode |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
256 keymap_hash (Lisp_Object obj, int depth) |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
257 { |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
258 Lisp_Keymap *k = XKEYMAP (obj); |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
259 Hashcode hash = 0xCAFEBABE; /* why not? */ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
260 |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
261 depth++; |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
262 |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
263 #define MARKED_SLOT(x) \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
264 hash = HASH2 (hash, internal_hash (k->x, depth)); |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
265 #define MARKED_SLOT_NOCOMPARE(x) |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
266 #include "keymap-slots.h" |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
267 |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
268 return hash; |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
269 } |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
270 |
| 428 | 271 static Lisp_Object |
| 272 mark_keymap (Lisp_Object obj) | |
| 273 { | |
| 274 Lisp_Keymap *keymap = XKEYMAP (obj); | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
275 #define MARKED_SLOT(x) mark_object (keymap->x); |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
276 #include "keymap-slots.h" |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
277 return Qnil; |
| 428 | 278 } |
| 279 | |
| 280 static void | |
| 2286 | 281 print_keymap (Lisp_Object obj, Lisp_Object printcharfun, |
| 282 int UNUSED (escapeflag)) | |
| 428 | 283 { |
| 284 /* This function can GC */ | |
| 285 Lisp_Keymap *keymap = XKEYMAP (obj); | |
| 286 if (print_readably) | |
| 4846 | 287 printing_unreadable_lcrecord (obj, 0); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
288 write_ascstring (printcharfun, "#<keymap "); |
| 428 | 289 if (!NILP (keymap->name)) |
| 440 | 290 { |
| 800 | 291 write_fmt_string_lisp (printcharfun, "%S ", 1, keymap->name); |
| 440 | 292 } |
| 800 | 293 write_fmt_string (printcharfun, "size %ld 0x%x>", |
| 294 (long) XINT (Fkeymap_fullness (obj)), keymap->header.uid); | |
| 428 | 295 } |
| 296 | |
| 1204 | 297 static const struct memory_description keymap_description[] = { |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
298 #define MARKED_SLOT(x) { XD_LISP_OBJECT, offsetof (Lisp_Keymap, x) }, |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
299 #include "keymap-slots.h" |
| 428 | 300 { XD_END } |
| 301 }; | |
| 302 | |
| 934 | 303 DEFINE_LRECORD_IMPLEMENTATION ("keymap", keymap, |
| 304 1, /*dumpable-flag*/ | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
305 mark_keymap, print_keymap, 0, |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
306 keymap_equal, keymap_hash, |
| 934 | 307 keymap_description, |
| 308 Lisp_Keymap); | |
| 428 | 309 |
| 310 /************************************************************************/ | |
| 311 /* Traversing keymaps and their parents */ | |
| 312 /************************************************************************/ | |
| 313 | |
| 314 static Lisp_Object | |
| 315 traverse_keymaps (Lisp_Object start_keymap, Lisp_Object start_parents, | |
| 316 Lisp_Object (*mapper) (Lisp_Object keymap, void *mapper_arg), | |
| 317 void *mapper_arg) | |
| 318 { | |
| 319 /* This function can GC */ | |
| 320 Lisp_Object keymap; | |
| 321 Lisp_Object tail = start_parents; | |
| 322 Lisp_Object malloc_sucks[10]; | |
| 323 Lisp_Object malloc_bites = Qnil; | |
| 324 int stack_depth = 0; | |
| 325 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
| 326 GCPRO4 (*malloc_sucks, malloc_bites, start_keymap, tail); | |
| 327 gcpro1.nvars = 0; | |
| 328 | |
| 329 start_keymap = get_keymap (start_keymap, 1, 1); | |
| 330 keymap = start_keymap; | |
| 331 /* Hack special-case parents at top-level */ | |
| 440 | 332 tail = !NILP (tail) ? tail : XKEYMAP (keymap)->parents; |
| 428 | 333 |
| 334 for (;;) | |
| 335 { | |
| 336 Lisp_Object result; | |
| 337 | |
| 338 QUIT; | |
| 440 | 339 result = mapper (keymap, mapper_arg); |
| 428 | 340 if (!NILP (result)) |
| 341 { | |
| 342 while (CONSP (malloc_bites)) | |
| 343 { | |
| 853 | 344 Lisp_Object victim = malloc_bites; |
| 345 malloc_bites = XCDR (victim); | |
| 428 | 346 free_cons (victim); |
| 347 } | |
| 348 UNGCPRO; | |
| 349 return result; | |
| 350 } | |
| 351 if (NILP (tail)) | |
| 352 { | |
| 353 if (stack_depth == 0) | |
| 354 { | |
| 355 UNGCPRO; | |
| 356 return Qnil; /* Nothing found */ | |
| 357 } | |
| 358 stack_depth--; | |
| 359 if (CONSP (malloc_bites)) | |
| 360 { | |
| 853 | 361 Lisp_Object victim = malloc_bites; |
| 362 tail = XCAR (victim); | |
| 363 malloc_bites = XCDR (victim); | |
| 428 | 364 free_cons (victim); |
| 365 } | |
| 366 else | |
| 367 { | |
| 368 tail = malloc_sucks[stack_depth]; | |
| 369 gcpro1.nvars = stack_depth; | |
| 370 } | |
| 371 keymap = XCAR (tail); | |
| 372 tail = XCDR (tail); | |
| 373 } | |
| 374 else | |
| 375 { | |
| 376 Lisp_Object parents; | |
| 377 | |
| 378 keymap = XCAR (tail); | |
| 379 tail = XCDR (tail); | |
| 380 parents = XKEYMAP (keymap)->parents; | |
| 381 if (!CONSP (parents)) | |
| 382 ; | |
| 383 else if (NILP (tail)) | |
| 384 /* Tail-recurse */ | |
| 385 tail = parents; | |
| 386 else | |
| 387 { | |
| 388 if (CONSP (malloc_bites)) | |
| 389 malloc_bites = noseeum_cons (tail, malloc_bites); | |
| 390 else if (stack_depth < countof (malloc_sucks)) | |
| 391 { | |
| 392 malloc_sucks[stack_depth++] = tail; | |
| 393 gcpro1.nvars = stack_depth; | |
| 394 } | |
| 395 else | |
| 396 { | |
| 397 /* *&@##[*&^$ C. @#[$*&@# Unix. Losers all. */ | |
| 398 int i; | |
| 399 for (i = 0, malloc_bites = Qnil; | |
| 400 i < countof (malloc_sucks); | |
| 401 i++) | |
| 402 malloc_bites = noseeum_cons (malloc_sucks[i], | |
| 403 malloc_bites); | |
| 404 gcpro1.nvars = 0; | |
| 405 } | |
| 406 tail = parents; | |
| 407 } | |
| 408 } | |
| 409 keymap = get_keymap (keymap, 1, 1); | |
| 410 if (EQ (keymap, start_keymap)) | |
| 411 { | |
| 563 | 412 invalid_argument ("Cyclic keymap indirection", start_keymap); |
| 428 | 413 } |
| 414 } | |
| 415 } | |
| 416 | |
| 417 | |
| 418 /************************************************************************/ | |
| 419 /* Some low-level functions */ | |
| 420 /************************************************************************/ | |
| 421 | |
| 442 | 422 static int |
| 428 | 423 bucky_sym_to_bucky_bit (Lisp_Object sym) |
| 424 { | |
| 442 | 425 if (EQ (sym, Qcontrol)) return XEMACS_MOD_CONTROL; |
| 426 if (EQ (sym, Qmeta)) return XEMACS_MOD_META; | |
| 427 if (EQ (sym, Qsuper)) return XEMACS_MOD_SUPER; | |
| 428 if (EQ (sym, Qhyper)) return XEMACS_MOD_HYPER; | |
| 429 if (EQ (sym, Qalt)) return XEMACS_MOD_ALT; | |
| 430 if (EQ (sym, Qsymbol)) return XEMACS_MOD_ALT; /* #### - reverse compat */ | |
| 431 if (EQ (sym, Qshift)) return XEMACS_MOD_SHIFT; | |
| 428 | 432 |
| 433 return 0; | |
| 434 } | |
| 435 | |
| 436 static Lisp_Object | |
| 442 | 437 control_meta_superify (Lisp_Object frob, int modifiers) |
| 428 | 438 { |
| 439 if (modifiers == 0) | |
| 440 return frob; | |
| 441 frob = Fcons (frob, Qnil); | |
| 442 | 442 if (modifiers & XEMACS_MOD_SHIFT) frob = Fcons (Qshift, frob); |
| 443 if (modifiers & XEMACS_MOD_ALT) frob = Fcons (Qalt, frob); | |
| 444 if (modifiers & XEMACS_MOD_HYPER) frob = Fcons (Qhyper, frob); | |
| 445 if (modifiers & XEMACS_MOD_SUPER) frob = Fcons (Qsuper, frob); | |
| 446 if (modifiers & XEMACS_MOD_CONTROL) frob = Fcons (Qcontrol, frob); | |
| 447 if (modifiers & XEMACS_MOD_META) frob = Fcons (Qmeta, frob); | |
| 428 | 448 return frob; |
| 449 } | |
| 450 | |
| 451 static Lisp_Object | |
| 934 | 452 make_key_description (const Lisp_Key_Data *key, int prettify) |
| 453 { | |
| 1204 | 454 Lisp_Object keysym = KEY_DATA_KEYSYM (key); |
| 934 | 455 int modifiers = KEY_DATA_MODIFIERS (key); |
| 428 | 456 if (prettify && CHARP (keysym)) |
| 457 { | |
| 458 /* This is a little slow, but (control a) is prettier than (control 65). | |
| 459 It's now ok to do this for digit-chars too, since we've fixed the | |
| 460 bug where \9 read as the integer 9 instead of as the symbol with | |
| 461 "9" as its name. | |
| 462 */ | |
| 463 /* !!#### I'm not sure how correct this is. */ | |
| 867 | 464 Ibyte str [1 + MAX_ICHAR_LEN]; |
| 465 Bytecount count = set_itext_ichar (str, XCHAR (keysym)); | |
| 428 | 466 str[count] = 0; |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
467 keysym = intern_istring (str); |
| 428 | 468 } |
| 469 return control_meta_superify (keysym, modifiers); | |
| 470 } | |
| 471 | |
| 472 | |
| 473 /************************************************************************/ | |
| 474 /* Low-level keymap-store functions */ | |
| 475 /************************************************************************/ | |
| 476 | |
| 477 static Lisp_Object | |
| 478 raw_lookup_key (Lisp_Object keymap, | |
| 934 | 479 const Lisp_Key_Data *raw_keys, int raw_keys_count, |
| 428 | 480 int keys_so_far, int accept_default); |
| 481 | |
| 482 /* Relies on caller to gc-protect args */ | |
| 483 static Lisp_Object | |
| 484 keymap_lookup_directly (Lisp_Object keymap, | |
| 442 | 485 Lisp_Object keysym, int modifiers) |
| 428 | 486 { |
| 487 Lisp_Keymap *k; | |
| 488 | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
489 modifiers &= ~( |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
490 #define FROB(num) XEMACS_MOD_BUTTON##num | |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
491 #include "keymap-buttons.h" |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
492 0); |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
493 assert ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META | |
|
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
494 XEMACS_MOD_SUPER | XEMACS_MOD_HYPER | |
|
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
495 XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) |
|
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
496 == 0); |
| 428 | 497 |
| 498 k = XKEYMAP (keymap); | |
| 499 | |
| 500 /* If the keysym is a one-character symbol, use the char code instead. */ | |
| 826 | 501 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1) |
| 428 | 502 { |
| 503 Lisp_Object i_fart_on_gcc = | |
| 867 | 504 make_char (string_ichar (XSYMBOL (keysym)->name, 0)); |
| 428 | 505 keysym = i_fart_on_gcc; |
| 506 } | |
| 507 | |
| 442 | 508 if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */ |
| 428 | 509 { |
| 442 | 510 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META), |
| 428 | 511 k->table, Qnil); |
| 512 if (NILP (submap)) | |
| 513 return Qnil; | |
| 514 k = XKEYMAP (submap); | |
| 442 | 515 modifiers &= ~XEMACS_MOD_META; |
| 428 | 516 } |
| 517 | |
| 518 if (modifiers != 0) | |
| 519 { | |
| 520 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers), | |
| 521 k->table, Qnil); | |
| 522 if (NILP (submap)) | |
| 523 return Qnil; | |
| 524 k = XKEYMAP (submap); | |
| 525 } | |
| 526 return Fgethash (keysym, k->table, Qnil); | |
| 527 } | |
| 528 | |
| 529 static void | |
| 530 keymap_store_inverse_internal (Lisp_Object inverse_table, | |
| 531 Lisp_Object keysym, | |
| 532 Lisp_Object value) | |
| 533 { | |
| 534 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound); | |
| 535 | |
| 536 if (UNBOUNDP (keys)) | |
| 537 { | |
| 538 keys = keysym; | |
| 539 /* Don't cons this unless necessary */ | |
| 540 /* keys = Fcons (keysym, Qnil); */ | |
| 541 Fputhash (value, keys, inverse_table); | |
| 542 } | |
| 543 else if (!CONSP (keys)) | |
| 544 { | |
| 545 /* Now it's necessary to cons */ | |
| 546 keys = Fcons (keys, keysym); | |
| 547 Fputhash (value, keys, inverse_table); | |
| 548 } | |
| 549 else | |
| 550 { | |
| 551 while (CONSP (XCDR (keys))) | |
| 552 keys = XCDR (keys); | |
| 553 XCDR (keys) = Fcons (XCDR (keys), keysym); | |
| 554 /* No need to call puthash because we've destructively | |
| 555 modified the list tail in place */ | |
| 556 } | |
| 557 } | |
| 558 | |
| 559 | |
| 560 static void | |
| 561 keymap_delete_inverse_internal (Lisp_Object inverse_table, | |
| 562 Lisp_Object keysym, | |
| 563 Lisp_Object value) | |
| 564 { | |
| 565 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound); | |
| 566 Lisp_Object new_keys = keys; | |
| 567 Lisp_Object tail; | |
| 568 Lisp_Object *prev; | |
| 569 | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
570 assert (!UNBOUNDP (keys)); |
| 428 | 571 |
| 572 for (prev = &new_keys, tail = new_keys; | |
| 573 ; | |
| 574 prev = &(XCDR (tail)), tail = XCDR (tail)) | |
| 575 { | |
| 576 if (EQ (tail, keysym)) | |
| 577 { | |
| 578 *prev = Qnil; | |
| 579 break; | |
| 580 } | |
| 581 else if (EQ (keysym, XCAR (tail))) | |
| 582 { | |
| 583 *prev = XCDR (tail); | |
| 584 break; | |
| 585 } | |
| 586 } | |
| 587 | |
| 588 if (NILP (new_keys)) | |
| 589 Fremhash (value, inverse_table); | |
| 590 else if (!EQ (keys, new_keys)) | |
| 591 /* Removed the first elt */ | |
| 592 Fputhash (value, new_keys, inverse_table); | |
| 593 /* else the list's tail has been modified, so we don't need to | |
| 594 touch the hash table again (the pointer in there is ok). | |
| 595 */ | |
| 596 } | |
| 597 | |
| 440 | 598 /* Prevent luser from shooting herself in the foot using something like |
| 599 (define-key ctl-x-4-map "p" global-map) */ | |
| 600 static void | |
| 601 check_keymap_definition_loop (Lisp_Object def, Lisp_Keymap *to_keymap) | |
| 602 { | |
| 603 def = get_keymap (def, 0, 0); | |
| 604 | |
| 605 if (KEYMAPP (def)) | |
| 606 { | |
| 607 Lisp_Object maps; | |
| 608 | |
| 609 if (XKEYMAP (def) == to_keymap) | |
| 563 | 610 invalid_argument ("Cyclic keymap definition", def); |
| 440 | 611 |
| 612 for (maps = keymap_submaps (def); | |
| 613 CONSP (maps); | |
| 614 maps = XCDR (maps)) | |
| 615 check_keymap_definition_loop (XCDR (XCAR (maps)), to_keymap); | |
| 616 } | |
| 617 } | |
| 428 | 618 |
| 619 static void | |
| 620 keymap_store_internal (Lisp_Object keysym, Lisp_Keymap *keymap, | |
| 440 | 621 Lisp_Object def) |
| 428 | 622 { |
| 440 | 623 Lisp_Object prev_def = Fgethash (keysym, keymap->table, Qnil); |
| 624 | |
| 625 if (EQ (prev_def, def)) | |
| 428 | 626 return; |
| 440 | 627 |
| 628 check_keymap_definition_loop (def, keymap); | |
| 629 | |
| 630 if (!NILP (prev_def)) | |
| 428 | 631 keymap_delete_inverse_internal (keymap->inverse_table, |
| 440 | 632 keysym, prev_def); |
| 633 if (NILP (def)) | |
| 428 | 634 { |
| 635 Fremhash (keysym, keymap->table); | |
| 636 } | |
| 637 else | |
| 638 { | |
| 440 | 639 Fputhash (keysym, def, keymap->table); |
| 428 | 640 keymap_store_inverse_internal (keymap->inverse_table, |
| 440 | 641 keysym, def); |
| 428 | 642 } |
| 643 keymap_tick++; | |
| 644 } | |
| 645 | |
| 646 | |
| 647 static Lisp_Object | |
| 442 | 648 create_bucky_submap (Lisp_Keymap *k, int modifiers, |
| 428 | 649 Lisp_Object parent_for_debugging_info) |
| 650 { | |
| 651 Lisp_Object submap = Fmake_sparse_keymap (Qnil); | |
| 652 /* User won't see this, but it is nice for debugging Emacs */ | |
| 653 XKEYMAP (submap)->name | |
| 654 = control_meta_superify (parent_for_debugging_info, modifiers); | |
| 655 /* Invalidate cache */ | |
| 656 k->sub_maps_cache = Qt; | |
| 657 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (modifiers), k, submap); | |
| 658 return submap; | |
| 659 } | |
| 660 | |
| 661 | |
| 662 /* Relies on caller to gc-protect keymap, keysym, value */ | |
| 663 static void | |
| 934 | 664 keymap_store (Lisp_Object keymap, const Lisp_Key_Data *key, |
| 428 | 665 Lisp_Object value) |
| 666 { | |
| 934 | 667 Lisp_Object keysym = KEY_DATA_KEYSYM (key); |
| 668 int modifiers = KEY_DATA_MODIFIERS (key); | |
| 440 | 669 Lisp_Keymap *k = XKEYMAP (keymap); |
| 670 | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
671 modifiers &= ~( |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
672 #define FROB(num) XEMACS_MOD_BUTTON##num | |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
673 #include "keymap-buttons.h" |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
674 0); |
| 442 | 675 assert ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META |
| 676 | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER | |
| 677 | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) == 0); | |
| 428 | 678 |
| 679 /* If the keysym is a one-character symbol, use the char code instead. */ | |
| 826 | 680 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1) |
| 867 | 681 keysym = make_char (string_ichar (XSYMBOL (keysym)->name, 0)); |
| 428 | 682 |
| 442 | 683 if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */ |
| 428 | 684 { |
| 442 | 685 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META), |
| 428 | 686 k->table, Qnil); |
| 687 if (NILP (submap)) | |
| 442 | 688 submap = create_bucky_submap (k, XEMACS_MOD_META, keymap); |
| 428 | 689 k = XKEYMAP (submap); |
| 442 | 690 modifiers &= ~XEMACS_MOD_META; |
| 428 | 691 } |
| 692 | |
| 693 if (modifiers != 0) | |
| 694 { | |
| 695 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers), | |
| 696 k->table, Qnil); | |
| 697 if (NILP (submap)) | |
| 698 submap = create_bucky_submap (k, modifiers, keymap); | |
| 699 k = XKEYMAP (submap); | |
| 700 } | |
| 701 k->sub_maps_cache = Qt; /* Invalidate cache */ | |
| 702 keymap_store_internal (keysym, k, value); | |
| 703 } | |
| 704 | |
| 705 | |
| 706 /************************************************************************/ | |
| 707 /* Listing the submaps of a keymap */ | |
| 708 /************************************************************************/ | |
| 709 | |
| 710 struct keymap_submaps_closure | |
| 711 { | |
| 712 Lisp_Object *result_locative; | |
| 713 }; | |
| 714 | |
| 715 static int | |
| 2286 | 716 keymap_submaps_mapper_0 (Lisp_Object UNUSED (key), Lisp_Object value, |
| 717 void *UNUSED (keymap_submaps_closure)) | |
| 428 | 718 { |
| 719 /* This function can GC */ | |
| 720 /* Perform any autoloads, etc */ | |
| 721 Fkeymapp (value); | |
| 722 return 0; | |
| 723 } | |
| 724 | |
| 725 static int | |
| 726 keymap_submaps_mapper (Lisp_Object key, Lisp_Object value, | |
| 727 void *keymap_submaps_closure) | |
| 728 { | |
| 729 /* This function can GC */ | |
| 730 Lisp_Object *result_locative; | |
| 731 struct keymap_submaps_closure *cl = | |
| 732 (struct keymap_submaps_closure *) keymap_submaps_closure; | |
| 733 result_locative = cl->result_locative; | |
| 734 | |
| 735 if (!NILP (Fkeymapp (value))) | |
| 736 *result_locative = Fcons (Fcons (key, value), *result_locative); | |
| 737 return 0; | |
| 738 } | |
| 739 | |
| 740 static int map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, | |
| 741 Lisp_Object pred); | |
| 742 | |
| 743 static Lisp_Object | |
| 744 keymap_submaps (Lisp_Object keymap) | |
| 745 { | |
| 746 /* This function can GC */ | |
| 747 Lisp_Keymap *k = XKEYMAP (keymap); | |
| 748 | |
| 749 if (EQ (k->sub_maps_cache, Qt)) /* Unknown */ | |
| 750 { | |
| 751 Lisp_Object result = Qnil; | |
| 752 struct gcpro gcpro1, gcpro2; | |
| 753 struct keymap_submaps_closure keymap_submaps_closure; | |
| 754 | |
| 755 GCPRO2 (keymap, result); | |
| 756 keymap_submaps_closure.result_locative = &result; | |
| 757 /* Do this first pass to touch (and load) any autoloaded maps */ | |
| 758 elisp_maphash (keymap_submaps_mapper_0, k->table, | |
| 759 &keymap_submaps_closure); | |
| 760 result = Qnil; | |
| 761 elisp_maphash (keymap_submaps_mapper, k->table, | |
| 762 &keymap_submaps_closure); | |
| 763 /* keep it sorted so that the result of accessible-keymaps is ordered */ | |
| 764 k->sub_maps_cache = list_sort (result, | |
| 765 Qnil, | |
| 766 map_keymap_sort_predicate); | |
| 767 UNGCPRO; | |
| 768 } | |
| 769 return k->sub_maps_cache; | |
| 770 } | |
| 771 | |
| 772 | |
| 773 /************************************************************************/ | |
| 774 /* Basic operations on keymaps */ | |
| 775 /************************************************************************/ | |
| 776 | |
| 777 static Lisp_Object | |
| 665 | 778 make_keymap (Elemcount size) |
| 428 | 779 { |
| 780 Lisp_Object result; | |
| 3017 | 781 Lisp_Keymap *keymap = ALLOC_LCRECORD_TYPE (Lisp_Keymap, &lrecord_keymap); |
| 428 | 782 |
| 793 | 783 result = wrap_keymap (keymap); |
| 428 | 784 |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
785 #define MARKED_SLOT(x) keymap->x = Qnil; |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
786 #include "keymap-slots.h" |
| 428 | 787 |
| 788 if (size != 0) /* hack for copy-keymap */ | |
| 789 { | |
| 790 keymap->table = | |
| 791 make_lisp_hash_table (size, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); | |
| 792 /* Inverse table is often less dense because of duplicate key-bindings. | |
| 793 If not, it will grow anyway. */ | |
| 794 keymap->inverse_table = | |
| 647 | 795 make_lisp_hash_table (size * 3 / 4, HASH_TABLE_NON_WEAK, |
| 796 HASH_TABLE_EQ); | |
| 428 | 797 } |
| 798 return result; | |
| 799 } | |
| 800 | |
| 801 DEFUN ("make-keymap", Fmake_keymap, 0, 1, 0, /* | |
| 802 Construct and return a new keymap object. | |
| 803 All entries in it are nil, meaning "command undefined". | |
| 804 | |
| 805 Optional argument NAME specifies a name to assign to the keymap, | |
| 806 as in `set-keymap-name'. This name is only a debugging convenience; | |
| 807 it is not used except when printing the keymap. | |
| 808 */ | |
| 809 (name)) | |
| 810 { | |
| 811 Lisp_Object keymap = make_keymap (60); | |
| 812 if (!NILP (name)) | |
| 813 Fset_keymap_name (keymap, name); | |
| 814 return keymap; | |
| 815 } | |
| 816 | |
| 817 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, 0, 1, 0, /* | |
| 818 Construct and return a new keymap object. | |
| 819 All entries in it are nil, meaning "command undefined". The only | |
| 444 | 820 difference between this function and `make-keymap' is that this function |
| 428 | 821 returns a "smaller" keymap (one that is expected to contain fewer |
| 444 | 822 entries). As keymaps dynamically resize, this distinction is not great. |
| 428 | 823 |
| 824 Optional argument NAME specifies a name to assign to the keymap, | |
| 825 as in `set-keymap-name'. This name is only a debugging convenience; | |
| 826 it is not used except when printing the keymap. | |
| 827 */ | |
| 828 (name)) | |
| 829 { | |
| 830 Lisp_Object keymap = make_keymap (8); | |
| 831 if (!NILP (name)) | |
| 832 Fset_keymap_name (keymap, name); | |
| 833 return keymap; | |
| 834 } | |
| 835 | |
| 836 DEFUN ("keymap-parents", Fkeymap_parents, 1, 1, 0, /* | |
| 837 Return the `parent' keymaps of KEYMAP, or nil. | |
| 838 The parents of a keymap are searched for keybindings when a key sequence | |
| 839 isn't bound in this one. `(current-global-map)' is the default parent | |
| 840 of all keymaps. | |
| 841 */ | |
| 842 (keymap)) | |
| 843 { | |
| 844 keymap = get_keymap (keymap, 1, 1); | |
| 845 return Fcopy_sequence (XKEYMAP (keymap)->parents); | |
| 846 } | |
| 847 | |
| 848 | |
| 849 | |
| 850 static Lisp_Object | |
| 2286 | 851 traverse_keymaps_noop (Lisp_Object UNUSED (keymap), void *UNUSED (arg)) |
| 428 | 852 { |
| 853 return Qnil; | |
| 854 } | |
| 855 | |
| 856 DEFUN ("set-keymap-parents", Fset_keymap_parents, 2, 2, 0, /* | |
| 857 Set the `parent' keymaps of KEYMAP to PARENTS. | |
| 858 The parents of a keymap are searched for keybindings when a key sequence | |
| 859 isn't bound in this one. `(current-global-map)' is the default parent | |
| 860 of all keymaps. | |
| 861 */ | |
| 862 (keymap, parents)) | |
| 863 { | |
| 864 /* This function can GC */ | |
| 865 Lisp_Object k; | |
| 866 struct gcpro gcpro1, gcpro2; | |
| 867 | |
| 868 GCPRO2 (keymap, parents); | |
| 869 keymap = get_keymap (keymap, 1, 1); | |
| 870 | |
| 871 if (KEYMAPP (parents)) /* backwards-compatibility */ | |
| 872 parents = list1 (parents); | |
| 873 if (!NILP (parents)) | |
| 874 { | |
| 875 Lisp_Object tail = parents; | |
| 876 while (!NILP (tail)) | |
| 877 { | |
| 878 QUIT; | |
| 879 CHECK_CONS (tail); | |
| 880 k = XCAR (tail); | |
| 881 /* Require that it be an actual keymap object, rather than a symbol | |
| 882 with a (crockish) symbol-function which is a keymap */ | |
| 883 CHECK_KEYMAP (k); /* get_keymap (k, 1, 1); */ | |
| 884 tail = XCDR (tail); | |
| 885 } | |
| 886 } | |
| 887 | |
| 888 /* Check for circularities */ | |
| 889 traverse_keymaps (keymap, parents, traverse_keymaps_noop, 0); | |
| 890 keymap_tick++; | |
| 891 XKEYMAP (keymap)->parents = Fcopy_sequence (parents); | |
| 892 UNGCPRO; | |
| 893 return parents; | |
| 894 } | |
| 895 | |
| 896 DEFUN ("set-keymap-name", Fset_keymap_name, 2, 2, 0, /* | |
| 897 Set the `name' of the KEYMAP to NEW-NAME. | |
| 898 The name is only a debugging convenience; it is not used except | |
| 899 when printing the keymap. | |
| 900 */ | |
| 901 (keymap, new_name)) | |
| 902 { | |
| 903 keymap = get_keymap (keymap, 1, 1); | |
| 904 | |
| 905 XKEYMAP (keymap)->name = new_name; | |
| 906 return new_name; | |
| 907 } | |
| 908 | |
| 909 DEFUN ("keymap-name", Fkeymap_name, 1, 1, 0, /* | |
| 910 Return the `name' of KEYMAP. | |
| 911 The name is only a debugging convenience; it is not used except | |
| 912 when printing the keymap. | |
| 913 */ | |
| 914 (keymap)) | |
| 915 { | |
| 916 keymap = get_keymap (keymap, 1, 1); | |
| 917 | |
| 918 return XKEYMAP (keymap)->name; | |
| 919 } | |
| 920 | |
| 921 DEFUN ("set-keymap-prompt", Fset_keymap_prompt, 2, 2, 0, /* | |
| 922 Set the `prompt' of KEYMAP to string NEW-PROMPT, or `nil' | |
| 923 if no prompt is desired. The prompt is shown in the echo-area | |
| 924 when reading a key-sequence to be looked-up in this keymap. | |
| 925 */ | |
| 926 (keymap, new_prompt)) | |
| 927 { | |
| 928 keymap = get_keymap (keymap, 1, 1); | |
| 929 | |
| 930 if (!NILP (new_prompt)) | |
| 931 CHECK_STRING (new_prompt); | |
| 932 | |
| 933 XKEYMAP (keymap)->prompt = new_prompt; | |
| 934 return new_prompt; | |
| 935 } | |
| 936 | |
| 937 static Lisp_Object | |
| 2286 | 938 keymap_prompt_mapper (Lisp_Object keymap, void *UNUSED (arg)) |
| 428 | 939 { |
| 940 return XKEYMAP (keymap)->prompt; | |
| 941 } | |
| 942 | |
| 943 | |
| 944 DEFUN ("keymap-prompt", Fkeymap_prompt, 1, 2, 0, /* | |
| 945 Return the `prompt' of KEYMAP. | |
| 946 If non-nil, the prompt is shown in the echo-area | |
| 947 when reading a key-sequence to be looked-up in this keymap. | |
| 948 */ | |
| 949 (keymap, use_inherited)) | |
| 950 { | |
| 951 /* This function can GC */ | |
| 952 Lisp_Object prompt; | |
| 953 | |
| 954 keymap = get_keymap (keymap, 1, 1); | |
| 955 prompt = XKEYMAP (keymap)->prompt; | |
| 956 if (!NILP (prompt) || NILP (use_inherited)) | |
| 957 return prompt; | |
| 958 else | |
| 959 return traverse_keymaps (keymap, Qnil, keymap_prompt_mapper, 0); | |
| 960 } | |
| 961 | |
| 962 DEFUN ("set-keymap-default-binding", Fset_keymap_default_binding, 2, 2, 0, /* | |
| 963 Sets the default binding of KEYMAP to COMMAND, or `nil' | |
| 964 if no default is desired. The default-binding is returned when | |
| 965 no other binding for a key-sequence is found in the keymap. | |
| 966 If a keymap has a non-nil default-binding, neither the keymap's | |
| 967 parents nor the current global map are searched for key bindings. | |
| 968 */ | |
| 969 (keymap, command)) | |
| 970 { | |
| 971 /* This function can GC */ | |
| 972 keymap = get_keymap (keymap, 1, 1); | |
| 973 | |
| 974 XKEYMAP (keymap)->default_binding = command; | |
| 975 return command; | |
| 976 } | |
| 977 | |
| 978 DEFUN ("keymap-default-binding", Fkeymap_default_binding, 1, 1, 0, /* | |
| 979 Return the default binding of KEYMAP, or `nil' if it has none. | |
| 980 The default-binding is returned when no other binding for a key-sequence | |
| 981 is found in the keymap. | |
| 982 If a keymap has a non-nil default-binding, neither the keymap's | |
| 983 parents nor the current global map are searched for key bindings. | |
| 984 */ | |
| 985 (keymap)) | |
| 986 { | |
| 987 /* This function can GC */ | |
| 988 keymap = get_keymap (keymap, 1, 1); | |
| 989 return XKEYMAP (keymap)->default_binding; | |
| 990 } | |
| 991 | |
| 992 DEFUN ("keymapp", Fkeymapp, 1, 1, 0, /* | |
| 444 | 993 Return t if OBJECT is a keymap object. |
| 428 | 994 The keymap may be autoloaded first if necessary. |
| 995 */ | |
| 996 (object)) | |
| 997 { | |
| 998 /* This function can GC */ | |
| 999 return KEYMAPP (get_keymap (object, 0, 0)) ? Qt : Qnil; | |
| 1000 } | |
| 1001 | |
| 1002 /* Check that OBJECT is a keymap (after dereferencing through any | |
| 1003 symbols). If it is, return it. | |
| 1004 | |
| 1005 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value | |
| 1006 is an autoload form, do the autoload and try again. | |
| 1007 If AUTOLOAD is nonzero, callers must assume GC is possible. | |
| 1008 | |
| 1009 ERRORP controls how we respond if OBJECT isn't a keymap. | |
| 1010 If ERRORP is non-zero, signal an error; otherwise, just return Qnil. | |
| 1011 | |
| 1012 Note that most of the time, we don't want to pursue autoloads. | |
| 1013 Functions like Faccessible_keymaps which scan entire keymap trees | |
| 1014 shouldn't load every autoloaded keymap. I'm not sure about this, | |
| 1015 but it seems to me that only read_key_sequence, Flookup_key, and | |
| 1016 Fdefine_key should cause keymaps to be autoloaded. */ | |
| 1017 | |
| 1018 Lisp_Object | |
| 1019 get_keymap (Lisp_Object object, int errorp, int autoload) | |
| 1020 { | |
| 1021 /* This function can GC */ | |
| 1022 while (1) | |
| 1023 { | |
| 1024 Lisp_Object tem = indirect_function (object, 0); | |
| 1025 | |
| 1026 if (KEYMAPP (tem)) | |
| 1027 return tem; | |
| 1028 /* Should we do an autoload? */ | |
| 1029 else if (autoload | |
| 1030 /* (autoload "filename" doc nil keymap) */ | |
| 1031 && SYMBOLP (object) | |
| 1032 && CONSP (tem) | |
| 1033 && EQ (XCAR (tem), Qautoload) | |
| 1034 && EQ (Fcar (Fcdr (Fcdr (Fcdr (Fcdr (tem))))), Qkeymap)) | |
| 1035 { | |
| 970 | 1036 /* do_autoload GCPROs both arguments */ |
| 428 | 1037 do_autoload (tem, object); |
| 1038 } | |
| 1039 else if (errorp) | |
| 1040 object = wrong_type_argument (Qkeymapp, object); | |
| 1041 else | |
| 1042 return Qnil; | |
| 1043 } | |
| 1044 } | |
| 1045 | |
| 1046 /* Given OBJECT which was found in a slot in a keymap, | |
| 1047 trace indirect definitions to get the actual definition of that slot. | |
| 1048 An indirect definition is a list of the form | |
| 1049 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one | |
| 1050 and INDEX is an ASCII code, or a cons of (KEYSYM . MODIFIERS). | |
| 1051 */ | |
| 1052 static Lisp_Object | |
| 1053 get_keyelt (Lisp_Object object, int accept_default) | |
| 1054 { | |
| 1055 /* This function can GC */ | |
| 1056 Lisp_Object map; | |
| 1057 | |
| 1058 tail_recurse: | |
| 1059 if (!CONSP (object)) | |
| 1060 return object; | |
| 1061 | |
| 1062 { | |
| 1063 struct gcpro gcpro1; | |
| 1064 GCPRO1 (object); | |
| 1065 map = XCAR (object); | |
| 1066 map = get_keymap (map, 0, 1); | |
| 1067 UNGCPRO; | |
| 1068 } | |
| 1069 /* If the contents are (KEYMAP . ELEMENT), go indirect. */ | |
| 1070 if (!NILP (map)) | |
| 1071 { | |
| 1072 Lisp_Object idx = Fcdr (object); | |
| 934 | 1073 Lisp_Key_Data indirection; |
| 428 | 1074 if (CHARP (idx)) |
| 1075 { | |
| 934 | 1076 Lisp_Object event = Fmake_event (Qnil, Qnil); |
| 1077 struct gcpro gcpro1; | |
| 1078 GCPRO1 (event); | |
| 1079 character_to_event (XCHAR (idx), XEVENT (event), | |
|
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
1080 XCONSOLE (Vselected_console), |
|
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
1081 high_bit_is_meta, 0); |
| 1204 | 1082 indirection.keysym = XEVENT_KEY_KEYSYM (event); |
| 1083 indirection.modifiers = XEVENT_KEY_MODIFIERS (event); | |
| 1084 UNGCPRO; | |
| 428 | 1085 } |
| 1086 else if (CONSP (idx)) | |
| 1087 { | |
| 1088 if (!INTP (XCDR (idx))) | |
| 1089 return Qnil; | |
| 1090 indirection.keysym = XCAR (idx); | |
| 442 | 1091 indirection.modifiers = (unsigned char) XINT (XCDR (idx)); |
| 428 | 1092 } |
| 1093 else if (SYMBOLP (idx)) | |
| 1094 { | |
| 1095 indirection.keysym = idx; | |
| 934 | 1096 SET_KEY_DATA_MODIFIERS (&indirection, XINT (XCDR (idx))); |
| 428 | 1097 } |
| 1098 else | |
| 1099 { | |
| 1100 /* Random junk */ | |
| 1101 return Qnil; | |
| 1102 } | |
| 1103 return raw_lookup_key (map, &indirection, 1, 0, accept_default); | |
| 1104 } | |
| 1105 else if (STRINGP (XCAR (object))) | |
| 1106 { | |
| 1107 /* If the keymap contents looks like (STRING . DEFN), | |
| 1108 use DEFN. | |
| 1109 Keymap alist elements like (CHAR MENUSTRING . DEFN) | |
| 1110 will be used by HierarKey menus. */ | |
| 1111 object = XCDR (object); | |
| 1112 goto tail_recurse; | |
| 1113 } | |
| 1114 else | |
| 1115 { | |
| 1116 /* Anything else is really the value. */ | |
| 1117 return object; | |
| 1118 } | |
| 1119 } | |
| 1120 | |
| 1121 static Lisp_Object | |
| 934 | 1122 keymap_lookup_1 (Lisp_Object keymap, const Lisp_Key_Data *key, |
| 428 | 1123 int accept_default) |
| 1124 { | |
| 1125 /* This function can GC */ | |
| 934 | 1126 return get_keyelt (keymap_lookup_directly (keymap, |
| 1127 KEY_DATA_KEYSYM (key), | |
| 1128 KEY_DATA_MODIFIERS (key)), | |
| 1129 accept_default); | |
| 428 | 1130 } |
| 1131 | |
| 1132 | |
| 1133 /************************************************************************/ | |
| 1134 /* Copying keymaps */ | |
| 1135 /************************************************************************/ | |
| 1136 | |
| 1137 struct copy_keymap_inverse_closure | |
| 1138 { | |
| 1139 Lisp_Object inverse_table; | |
| 1140 }; | |
| 1141 | |
| 1142 static int | |
| 1143 copy_keymap_inverse_mapper (Lisp_Object key, Lisp_Object value, | |
| 1144 void *copy_keymap_inverse_closure) | |
| 1145 { | |
| 1146 struct copy_keymap_inverse_closure *closure = | |
| 1147 (struct copy_keymap_inverse_closure *) copy_keymap_inverse_closure; | |
| 1148 | |
| 1149 /* copy-sequence deals with dotted lists. */ | |
| 1150 if (CONSP (value)) | |
| 1151 value = Fcopy_list (value); | |
| 1152 Fputhash (key, value, closure->inverse_table); | |
| 1153 | |
| 1154 return 0; | |
| 1155 } | |
| 1156 | |
| 1157 | |
| 1158 static Lisp_Object | |
| 1159 copy_keymap_internal (Lisp_Keymap *keymap) | |
| 1160 { | |
| 1161 Lisp_Object nkm = make_keymap (0); | |
| 1162 Lisp_Keymap *new_keymap = XKEYMAP (nkm); | |
| 1163 struct copy_keymap_inverse_closure copy_keymap_inverse_closure; | |
| 1164 copy_keymap_inverse_closure.inverse_table = keymap->inverse_table; | |
| 1165 | |
| 1166 new_keymap->parents = Fcopy_sequence (keymap->parents); | |
| 1167 new_keymap->sub_maps_cache = Qnil; /* No submaps */ | |
| 1168 new_keymap->table = Fcopy_hash_table (keymap->table); | |
| 1169 new_keymap->inverse_table = Fcopy_hash_table (keymap->inverse_table); | |
| 1170 new_keymap->default_binding = keymap->default_binding; | |
| 1171 /* After copying the inverse map, we need to copy the conses which | |
| 1172 are its values, lest they be shared by the copy, and mangled. | |
| 1173 */ | |
| 1174 elisp_maphash (copy_keymap_inverse_mapper, keymap->inverse_table, | |
| 1175 ©_keymap_inverse_closure); | |
| 1176 return nkm; | |
| 1177 } | |
| 1178 | |
| 1179 | |
| 1180 static Lisp_Object copy_keymap (Lisp_Object keymap); | |
| 1181 | |
| 1182 struct copy_keymap_closure | |
| 1183 { | |
| 1184 Lisp_Keymap *self; | |
| 1185 }; | |
| 1186 | |
| 1187 static int | |
| 1188 copy_keymap_mapper (Lisp_Object key, Lisp_Object value, | |
| 1189 void *copy_keymap_closure) | |
| 1190 { | |
| 1191 /* This function can GC */ | |
| 1192 struct copy_keymap_closure *closure = | |
| 1193 (struct copy_keymap_closure *) copy_keymap_closure; | |
| 1194 | |
| 1195 /* When we encounter a keymap which is indirected through a | |
| 1196 symbol, we need to copy the sub-map. In v18, the form | |
| 1197 (lookup-key (copy-keymap global-map) "\C-x") | |
| 3025 | 1198 returned a new keymap, not the symbol `Control-X-prefix'. |
| 428 | 1199 */ |
| 1200 value = get_keymap (value, 0, 1); /* #### autoload GC-safe here? */ | |
| 1201 if (KEYMAPP (value)) | |
| 1202 keymap_store_internal (key, closure->self, | |
| 1203 copy_keymap (value)); | |
| 1204 return 0; | |
| 1205 } | |
| 1206 | |
| 1207 static Lisp_Object | |
| 1208 copy_keymap (Lisp_Object keymap) | |
| 1209 { | |
| 1210 /* This function can GC */ | |
| 1211 struct copy_keymap_closure copy_keymap_closure; | |
| 1212 | |
| 1213 keymap = copy_keymap_internal (XKEYMAP (keymap)); | |
| 1214 copy_keymap_closure.self = XKEYMAP (keymap); | |
| 1215 elisp_maphash (copy_keymap_mapper, | |
| 1216 XKEYMAP (keymap)->table, | |
| 1217 ©_keymap_closure); | |
| 1218 return keymap; | |
| 1219 } | |
| 1220 | |
| 1221 DEFUN ("copy-keymap", Fcopy_keymap, 1, 1, 0, /* | |
| 1222 Return a copy of the keymap KEYMAP. | |
| 1223 The copy starts out with the same definitions of KEYMAP, | |
| 1224 but changing either the copy or KEYMAP does not affect the other. | |
| 1225 Any key definitions that are subkeymaps are recursively copied. | |
| 1226 */ | |
| 1227 (keymap)) | |
| 1228 { | |
| 1229 /* This function can GC */ | |
| 1230 keymap = get_keymap (keymap, 1, 1); | |
| 1231 return copy_keymap (keymap); | |
| 1232 } | |
| 1233 | |
| 1234 | |
| 1235 static int | |
| 1236 keymap_fullness (Lisp_Object keymap) | |
| 1237 { | |
| 1238 /* This function can GC */ | |
| 1239 int fullness; | |
| 1240 Lisp_Object sub_maps; | |
| 1241 struct gcpro gcpro1, gcpro2; | |
| 1242 | |
| 1243 keymap = get_keymap (keymap, 1, 1); | |
| 440 | 1244 fullness = XINT (Fhash_table_count (XKEYMAP (keymap)->table)); |
| 428 | 1245 GCPRO2 (keymap, sub_maps); |
| 440 | 1246 for (sub_maps = keymap_submaps (keymap); |
| 1247 !NILP (sub_maps); | |
| 1248 sub_maps = XCDR (sub_maps)) | |
| 428 | 1249 { |
| 1250 if (MODIFIER_HASH_KEY_BITS (XCAR (XCAR (sub_maps))) != 0) | |
| 1251 { | |
| 440 | 1252 Lisp_Object bucky_map = XCDR (XCAR (sub_maps)); |
| 1253 fullness--; /* don't count bucky maps themselves. */ | |
| 1254 fullness += keymap_fullness (bucky_map); | |
| 428 | 1255 } |
| 1256 } | |
| 1257 UNGCPRO; | |
| 1258 return fullness; | |
| 1259 } | |
| 1260 | |
| 1261 DEFUN ("keymap-fullness", Fkeymap_fullness, 1, 1, 0, /* | |
| 1262 Return the number of bindings in the keymap. | |
| 1263 */ | |
| 1264 (keymap)) | |
| 1265 { | |
| 1266 /* This function can GC */ | |
| 1267 return make_int (keymap_fullness (get_keymap (keymap, 1, 1))); | |
| 1268 } | |
| 1269 | |
| 1270 | |
| 1271 /************************************************************************/ | |
| 1272 /* Defining keys in keymaps */ | |
| 1273 /************************************************************************/ | |
| 1274 | |
| 1275 /* Given a keysym (should be a symbol, int, char), make sure it's valid | |
| 1276 and perform any necessary canonicalization. */ | |
| 1277 | |
| 1278 static void | |
| 1279 define_key_check_and_coerce_keysym (Lisp_Object spec, | |
| 1280 Lisp_Object *keysym, | |
| 442 | 1281 int modifiers) |
| 428 | 1282 { |
| 1283 /* Now, check and massage the trailing keysym specifier. */ | |
| 1284 if (SYMBOLP (*keysym)) | |
| 1285 { | |
| 826 | 1286 if (string_char_length (XSYMBOL (*keysym)->name) == 1) |
| 428 | 1287 { |
| 1288 Lisp_Object ream_gcc_up_the_ass = | |
| 867 | 1289 make_char (string_ichar (XSYMBOL (*keysym)->name, 0)); |
| 428 | 1290 *keysym = ream_gcc_up_the_ass; |
| 1291 goto fixnum_keysym; | |
| 1292 } | |
| 1293 } | |
| 1294 else if (CHAR_OR_CHAR_INTP (*keysym)) | |
| 1295 { | |
| 1296 CHECK_CHAR_COERCE_INT (*keysym); | |
| 1297 fixnum_keysym: | |
| 1298 if (XCHAR (*keysym) < ' ' | |
| 1299 /* || (XCHAR (*keysym) >= 128 && XCHAR (*keysym) < 160) */) | |
| 1300 /* yuck! Can't make the above restriction; too many compatibility | |
| 1301 problems ... */ | |
| 563 | 1302 invalid_argument ("keysym char must be printable", *keysym); |
| 428 | 1303 /* #### This bites! I want to be able to write (control shift a) */ |
| 442 | 1304 if (modifiers & XEMACS_MOD_SHIFT) |
| 563 | 1305 invalid_argument |
| 428 | 1306 ("The `shift' modifier may not be applied to ASCII keysyms", |
| 1307 spec); | |
| 1308 } | |
| 1309 else | |
| 1310 { | |
| 563 | 1311 invalid_argument ("Unknown keysym specifier", *keysym); |
| 428 | 1312 } |
| 1313 | |
| 1314 if (SYMBOLP (*keysym)) | |
| 1315 { | |
| 867 | 1316 Ibyte *name = XSTRING_DATA (XSYMBOL (*keysym)->name); |
| 428 | 1317 |
| 3025 | 1318 /* GNU Emacs uses symbols with the printed representation of keysyms in |
| 1319 their names, like `M-x', and we use the syntax '(meta x). So, to | |
| 1320 avoid confusion, notice the M-x syntax and signal an error - | |
| 1321 because otherwise it would be interpreted as a regular keysym, and | |
| 1322 would even show up in the list-buffers output, causing confusion | |
| 1323 to the naive. | |
| 428 | 1324 |
| 1325 We can get away with this because none of the X keysym names contain | |
| 1326 a hyphen (some contain underscore, however). | |
| 1327 | |
| 1328 It might be useful to reject keysyms which are not x-valid-keysym- | |
| 1329 name-p, but that would interfere with various tricks we do to | |
| 1330 sanitize the Sun keyboards, and would make it trickier to | |
| 1331 conditionalize a .emacs file for multiple X servers. | |
| 1332 */ | |
| 793 | 1333 if (((int) qxestrlen (name) >= 2 && name[1] == '-') |
| 428 | 1334 #if 1 |
| 1335 || | |
| 1336 /* Ok, this is a bit more dubious - prevent people from doing things | |
| 1337 like (global-set-key 'RET 'something) because that will have the | |
| 1338 same problem as above. (Gag!) Maybe we should just silently | |
| 1339 accept these as aliases for the "real" names? | |
| 1340 */ | |
| 793 | 1341 (XSTRING_LENGTH (XSYMBOL (*keysym)->name) <= 3 && |
| 2367 | 1342 (!qxestrcmp_ascii (name, "LFD") || |
| 1343 !qxestrcmp_ascii (name, "TAB") || | |
| 1344 !qxestrcmp_ascii (name, "RET") || | |
| 1345 !qxestrcmp_ascii (name, "ESC") || | |
| 1346 !qxestrcmp_ascii (name, "DEL") || | |
| 1347 !qxestrcmp_ascii (name, "SPC") || | |
| 1348 !qxestrcmp_ascii (name, "BS"))) | |
| 428 | 1349 #endif /* unused */ |
| 1350 ) | |
| 563 | 1351 invalid_argument |
| 3086 | 1352 ("Invalid (GNU Emacs) key format (see doc of define-key)", |
| 428 | 1353 *keysym); |
| 1354 | |
| 1355 /* #### Ok, this is a bit more dubious - make people not lose if they | |
| 1356 do things like (global-set-key 'RET 'something) because that would | |
| 1357 otherwise have the same problem as above. (Gag!) We silently | |
| 1358 accept these as aliases for the "real" names. | |
| 1359 */ | |
| 2367 | 1360 else if (!qxestrncmp_ascii (name, "kp_", 3)) |
| 793 | 1361 { |
| 1362 /* Likewise, the obsolete keysym binding of kp_.* should not lose. */ | |
| 1363 DECLARE_EISTRING (temp); | |
| 1364 eicpy_raw (temp, name, qxestrlen (name)); | |
| 1365 eisetch_char (temp, 2, '-'); | |
|
4355
a2af1ff1761f
Provide a DEFAULT argument in #'intern-soft.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4272
diff
changeset
|
1366 *keysym = Fintern_soft (eimake_string (temp), Qnil, Qnil); |
| 793 | 1367 } |
| 1368 else if (EQ (*keysym, QLFD)) | |
| 428 | 1369 *keysym = QKlinefeed; |
| 1370 else if (EQ (*keysym, QTAB)) | |
| 1371 *keysym = QKtab; | |
| 1372 else if (EQ (*keysym, QRET)) | |
| 1373 *keysym = QKreturn; | |
| 1374 else if (EQ (*keysym, QESC)) | |
| 1375 *keysym = QKescape; | |
| 1376 else if (EQ (*keysym, QDEL)) | |
| 1377 *keysym = QKdelete; | |
| 1378 else if (EQ (*keysym, QSPC)) | |
| 1379 *keysym = QKspace; | |
| 1380 else if (EQ (*keysym, QBS)) | |
| 1381 *keysym = QKbackspace; | |
| 1382 /* Emacs compatibility */ | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1383 #define FROB(num) \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1384 else if (EQ(*keysym, Qdown_mouse_##num)) \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1385 *keysym = Qbutton##num; \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1386 else if (EQ(*keysym, Qmouse_##num)) \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1387 *keysym = Qbutton##num##up; |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1388 #include "keymap-buttons.h" |
| 428 | 1389 } |
| 1390 } | |
| 1391 | |
| 1392 | |
| 1393 /* Given any kind of key-specifier, return a keysym and modifier mask. | |
| 1394 Proper canonicalization is performed: | |
| 1395 | |
| 1396 -- integers are converted into the equivalent characters. | |
| 1397 -- one-character strings are converted into the equivalent characters. | |
| 1398 */ | |
| 1399 | |
| 1400 static void | |
| 934 | 1401 define_key_parser (Lisp_Object spec, Lisp_Key_Data *returned_value) |
| 428 | 1402 { |
| 1403 if (CHAR_OR_CHAR_INTP (spec)) | |
| 1404 { | |
| 934 | 1405 Lisp_Object event = Fmake_event (Qnil, Qnil); |
| 1406 struct gcpro gcpro1; | |
| 1407 GCPRO1 (event); | |
| 1408 character_to_event (XCHAR_OR_CHAR_INT (spec), XEVENT (event), | |
|
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
1409 XCONSOLE (Vselected_console), high_bit_is_meta, 0); |
| 1204 | 1410 SET_KEY_DATA_KEYSYM (returned_value, XEVENT_KEY_KEYSYM (event)); |
| 934 | 1411 SET_KEY_DATA_MODIFIERS (returned_value, |
| 1204 | 1412 XEVENT_KEY_MODIFIERS (event)); |
| 1413 UNGCPRO; | |
| 428 | 1414 } |
| 1415 else if (EVENTP (spec)) | |
| 1416 { | |
| 934 | 1417 switch (XEVENT_TYPE (spec)) |
| 428 | 1418 { |
| 1419 case key_press_event: | |
| 1420 { | |
| 1204 | 1421 SET_KEY_DATA_KEYSYM (returned_value, XEVENT_KEY_KEYSYM (spec)); |
| 1422 SET_KEY_DATA_MODIFIERS (returned_value, XEVENT_KEY_MODIFIERS (spec)); | |
| 428 | 1423 break; |
| 1424 } | |
| 1425 case button_press_event: | |
| 1426 case button_release_event: | |
| 1427 { | |
| 934 | 1428 int down = (XEVENT_TYPE (spec) == button_press_event); |
| 1204 | 1429 switch (XEVENT_BUTTON_BUTTON (spec)) |
| 934 | 1430 { |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1431 #define FROB(num) \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1432 case num: \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1433 SET_KEY_DATA_KEYSYM (returned_value, \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1434 (down ? Qbutton##num : \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1435 Qbutton##num##up)); \ |
| 934 | 1436 break; |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1437 #include "keymap-buttons.h" |
| 934 | 1438 default: |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1439 SET_KEY_DATA_KEYSYM (returned_value, (down ? Qbutton0 : |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1440 Qbutton0up)); |
| 934 | 1441 break; |
| 1442 } | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1443 SET_KEY_DATA_MODIFIERS (returned_value, |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1444 XEVENT_BUTTON_MODIFIERS (spec)); |
| 428 | 1445 break; |
| 1446 } | |
| 1447 default: | |
| 563 | 1448 wtaerror ("unable to bind this type of event", spec); |
| 428 | 1449 } |
| 1450 } | |
| 1451 else if (SYMBOLP (spec)) | |
| 1452 { | |
| 1453 /* Be nice, allow = to mean (=) */ | |
| 1454 if (bucky_sym_to_bucky_bit (spec) != 0) | |
| 563 | 1455 invalid_argument ("Key is a modifier name", spec); |
| 428 | 1456 define_key_check_and_coerce_keysym (spec, &spec, 0); |
| 934 | 1457 SET_KEY_DATA_KEYSYM (returned_value, spec); |
| 1458 SET_KEY_DATA_MODIFIERS (returned_value, 0); | |
| 428 | 1459 } |
| 1460 else if (CONSP (spec)) | |
| 1461 { | |
| 442 | 1462 int modifiers = 0; |
| 428 | 1463 Lisp_Object keysym = Qnil; |
| 1464 Lisp_Object rest = spec; | |
| 1465 | |
| 1466 /* First, parse out the leading modifier symbols. */ | |
| 1467 while (CONSP (rest)) | |
| 1468 { | |
| 442 | 1469 int modifier; |
| 428 | 1470 |
| 1471 keysym = XCAR (rest); | |
| 1472 modifier = bucky_sym_to_bucky_bit (keysym); | |
| 1473 modifiers |= modifier; | |
| 1474 if (!NILP (XCDR (rest))) | |
| 1475 { | |
| 1476 if (! modifier) | |
| 563 | 1477 invalid_argument ("Unknown modifier", keysym); |
| 428 | 1478 } |
| 1479 else | |
| 1480 { | |
| 1481 if (modifier) | |
| 563 | 1482 sferror ("Nothing but modifiers here", |
| 428 | 1483 spec); |
| 1484 } | |
| 1485 rest = XCDR (rest); | |
| 1486 QUIT; | |
| 1487 } | |
| 1488 if (!NILP (rest)) | |
| 563 | 1489 signal_error (Qlist_formation_error, |
| 1490 "List must be nil-terminated", spec); | |
| 428 | 1491 |
| 1492 define_key_check_and_coerce_keysym (spec, &keysym, modifiers); | |
| 934 | 1493 SET_KEY_DATA_KEYSYM(returned_value, keysym); |
| 1494 SET_KEY_DATA_MODIFIERS (returned_value, modifiers); | |
| 428 | 1495 } |
| 1496 else | |
| 1497 { | |
| 563 | 1498 invalid_argument ("Unknown key-sequence specifier", |
| 428 | 1499 spec); |
| 1500 } | |
| 1501 } | |
| 1502 | |
| 1503 /* Used by character-to-event */ | |
| 1504 void | |
| 1505 key_desc_list_to_event (Lisp_Object list, Lisp_Object event, | |
| 1506 int allow_menu_events) | |
| 1507 { | |
| 934 | 1508 Lisp_Key_Data raw_key; |
| 428 | 1509 |
| 1510 if (allow_menu_events && | |
| 1511 CONSP (list) && | |
| 1512 /* #### where the hell does this come from? */ | |
| 1513 EQ (XCAR (list), Qmenu_selection)) | |
| 1514 { | |
| 1515 Lisp_Object fn, arg; | |
| 1516 if (! NILP (Fcdr (Fcdr (list)))) | |
| 563 | 1517 invalid_argument ("Invalid menu event desc", list); |
| 428 | 1518 arg = Fcar (Fcdr (list)); |
| 1519 if (SYMBOLP (arg)) | |
| 1520 fn = Qcall_interactively; | |
| 1521 else | |
| 1522 fn = Qeval; | |
| 934 | 1523 XSET_EVENT_TYPE (event, misc_user_event); |
| 1204 | 1524 XSET_EVENT_CHANNEL (event, wrap_frame (selected_frame ())); |
| 1525 XSET_EVENT_MISC_USER_FUNCTION (event, fn); | |
| 1526 XSET_EVENT_MISC_USER_OBJECT (event, arg); | |
| 428 | 1527 return; |
| 1528 } | |
| 1529 | |
| 1530 define_key_parser (list, &raw_key); | |
| 1531 | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1532 if ( |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1533 #define INCLUDE_BUTTON_ZERO |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1534 #define FROB(num) \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1535 EQ (raw_key.keysym, Qbutton##num) || \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1536 EQ (raw_key.keysym, Qbutton##num##up) || |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1537 #include "keymap-buttons.h" |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1538 0) |
| 563 | 1539 invalid_operation ("Mouse-clicks can't appear in saved keyboard macros", |
| 1540 Qunbound); | |
| 428 | 1541 |
| 934 | 1542 XSET_EVENT_CHANNEL (event, Vselected_console); |
| 1543 XSET_EVENT_TYPE (event, key_press_event); | |
| 1204 | 1544 XSET_EVENT_KEY_KEYSYM (event, raw_key.keysym); |
| 1545 XSET_EVENT_KEY_MODIFIERS (event, KEY_DATA_MODIFIERS (&raw_key)); | |
| 428 | 1546 } |
| 1547 | |
| 1548 | |
| 1549 int | |
| 1204 | 1550 event_matches_key_specifier_p (Lisp_Object event, Lisp_Object key_specifier) |
| 428 | 1551 { |
| 446 | 1552 Lisp_Object event2 = Qnil; |
| 428 | 1553 int retval; |
| 1554 struct gcpro gcpro1; | |
| 1555 | |
| 1204 | 1556 if (XEVENT_TYPE (event) != key_press_event || NILP (key_specifier) || |
| 428 | 1557 (INTP (key_specifier) && !CHAR_INTP (key_specifier))) |
| 1558 return 0; | |
| 1559 | |
| 1560 /* if the specifier is an integer such as 27, then it should match | |
| 3025 | 1561 both of the events `escape' and `control ['. Calling |
| 1562 Fcharacter_to_event() will only match `escape'. */ | |
| 428 | 1563 if (CHAR_OR_CHAR_INTP (key_specifier)) |
| 1564 return (XCHAR_OR_CHAR_INT (key_specifier) | |
| 2828 | 1565 == event_to_character (event, 0, 0)); |
| 428 | 1566 |
| 1567 /* Otherwise, we cannot call event_to_character() because we may | |
| 1568 be dealing with non-ASCII keystrokes. In any case, if I ask | |
| 3025 | 1569 for `control [' then I should get exactly that, and not |
| 1570 `escape'. | |
| 1571 | |
| 1572 However, we have to behave differently on TTY's, where `control [' | |
| 1573 is silently converted into `escape' by the keyboard driver. | |
| 428 | 1574 In this case, ASCII is the only thing we know about, so we have |
| 1575 to compare the ASCII values. */ | |
| 1576 | |
| 1577 GCPRO1 (event2); | |
| 1204 | 1578 if (EVENTP (key_specifier)) |
| 1579 event2 = Fcopy_event (key_specifier, Qnil); | |
| 1580 else | |
| 1581 event2 = Fcharacter_to_event (key_specifier, Qnil, Qnil, Qnil); | |
| 428 | 1582 if (XEVENT (event2)->event_type != key_press_event) |
| 1583 retval = 0; | |
| 1204 | 1584 else if (CONSOLE_TTY_P (XCONSOLE (XEVENT_CHANNEL (event)))) |
| 428 | 1585 { |
| 1586 int ch1, ch2; | |
| 1587 | |
| 2828 | 1588 ch1 = event_to_character (event, 0, 0); |
| 1589 ch2 = event_to_character (event2, 0, 0); | |
| 428 | 1590 retval = (ch1 >= 0 && ch2 >= 0 && ch1 == ch2); |
| 1591 } | |
| 1204 | 1592 else if (EQ (XEVENT_KEY_KEYSYM (event), XEVENT_KEY_KEYSYM (event2)) && |
| 1593 XEVENT_KEY_MODIFIERS (event) == XEVENT_KEY_MODIFIERS (event2)) | |
| 428 | 1594 retval = 1; |
| 1595 else | |
| 1596 retval = 0; | |
| 1597 Fdeallocate_event (event2); | |
| 1598 UNGCPRO; | |
| 1599 return retval; | |
| 1600 } | |
| 1601 | |
| 1602 static int | |
| 934 | 1603 meta_prefix_char_p (const Lisp_Key_Data *key) |
| 428 | 1604 { |
| 934 | 1605 Lisp_Object event = Fmake_event (Qnil, Qnil); |
| 1606 struct gcpro gcpro1; | |
| 1204 | 1607 int retval; |
| 1608 | |
| 934 | 1609 GCPRO1 (event); |
| 1610 | |
| 1611 XSET_EVENT_TYPE (event, key_press_event); | |
| 1612 XSET_EVENT_CHANNEL (event, Vselected_console); | |
| 1204 | 1613 XSET_EVENT_KEY_KEYSYM (event, KEY_DATA_KEYSYM (key)); |
| 1614 XSET_EVENT_KEY_MODIFIERS (event, KEY_DATA_MODIFIERS (key)); | |
| 1615 retval = event_matches_key_specifier_p (event, Vmeta_prefix_char); | |
| 1616 UNGCPRO; | |
| 1617 return retval; | |
| 428 | 1618 } |
| 1619 | |
| 1620 DEFUN ("event-matches-key-specifier-p", Fevent_matches_key_specifier_p, 2, 2, 0, /* | |
| 1621 Return non-nil if EVENT matches KEY-SPECIFIER. | |
| 1622 This can be useful, e.g., to determine if the user pressed `help-char' or | |
| 1623 `quit-char'. | |
| 1204 | 1624 |
| 1625 KEY-SPECIFIER can be a character, integer, a symbol, a list of modifiers | |
| 1626 and symbols, or an event. | |
| 1627 | |
| 1628 What this actually happens is this: | |
| 1629 | |
| 1630 \(1) Return no, if EVENT is not a key press event or if KEY-SPECIFIER is nil | |
| 1631 or an integer that cannot be converted to a character. | |
| 1632 | |
| 1633 \(2) If KEY-SPECIFIER is a character or integer, | |
| 1634 (event-to-character EVENT nil nil nil) is called, and the characters are | |
| 1635 compared to get the result. The reason for special-casing this and doing | |
| 1636 it this way is to ensure that, e.g., a KEY-SPECIFIER of 27 matches both | |
| 1637 a key-press `escape' and a key-press `control ['. #### Think about META | |
| 1638 argument to event-to-character. | |
| 1639 | |
| 1640 \(3) If KEY-SPECIFIER is an event, fine; else, convert to an event using | |
| 1641 \(character-to-event KEY-SPECIFIER nil nil nil). If EVENT is not on a TTY, | |
| 1642 we just compare keysyms and modifiers and return yes if both are equal. | |
| 1643 For TTY, we do character-level comparison by converting both to a character | |
| 1644 with (event-to-character ... nil nil nil) and comparing the characters. | |
| 1645 | |
| 428 | 1646 */ |
| 1647 (event, key_specifier)) | |
| 1648 { | |
| 1649 CHECK_LIVE_EVENT (event); | |
| 1204 | 1650 return (event_matches_key_specifier_p (event, key_specifier) ? Qt : Qnil); |
| 428 | 1651 } |
| 1204 | 1652 #define MACROLET(k, m) do { \ |
| 1653 SET_KEY_DATA_KEYSYM (returned_value, k); \ | |
| 1654 SET_KEY_DATA_MODIFIERS (returned_value, m); \ | |
| 1655 RETURN_SANS_WARNINGS; \ | |
| 934 | 1656 } while (0) |
| 428 | 1657 /* ASCII grunge. |
| 1658 Given a keysym, return another keysym/modifier pair which could be | |
| 1659 considered the same key in an ASCII world. Backspace returns ^H, for | |
| 1660 example. | |
| 1661 */ | |
| 1662 static void | |
| 934 | 1663 define_key_alternate_name (Lisp_Key_Data *key, |
| 1664 Lisp_Key_Data *returned_value) | |
| 428 | 1665 { |
| 934 | 1666 Lisp_Object keysym = KEY_DATA_KEYSYM (key); |
| 1667 int modifiers = KEY_DATA_MODIFIERS (key); | |
| 442 | 1668 int modifiers_sans_control = (modifiers & (~XEMACS_MOD_CONTROL)); |
| 1669 int modifiers_sans_meta = (modifiers & (~XEMACS_MOD_META)); | |
| 934 | 1670 SET_KEY_DATA_KEYSYM (returned_value, Qnil); /* By default, no "alternate" key */ |
| 1671 SET_KEY_DATA_MODIFIERS (returned_value, 0); | |
| 442 | 1672 if (modifiers_sans_meta == XEMACS_MOD_CONTROL) |
| 428 | 1673 { |
| 722 | 1674 if (EQ (keysym, QKspace)) |
| 428 | 1675 MACROLET (make_char ('@'), modifiers); |
| 1676 else if (!CHARP (keysym)) | |
| 1677 return; | |
| 1678 else switch (XCHAR (keysym)) | |
| 1679 { | |
| 1680 case '@': /* c-@ => c-space */ | |
| 1681 MACROLET (QKspace, modifiers); | |
| 1682 case 'h': /* c-h => backspace */ | |
| 1683 MACROLET (QKbackspace, modifiers_sans_control); | |
| 1684 case 'i': /* c-i => tab */ | |
| 1685 MACROLET (QKtab, modifiers_sans_control); | |
| 1686 case 'j': /* c-j => linefeed */ | |
| 1687 MACROLET (QKlinefeed, modifiers_sans_control); | |
| 1688 case 'm': /* c-m => return */ | |
| 1689 MACROLET (QKreturn, modifiers_sans_control); | |
| 1690 case '[': /* c-[ => escape */ | |
| 1691 MACROLET (QKescape, modifiers_sans_control); | |
| 1692 default: | |
| 1693 return; | |
| 1694 } | |
| 1695 } | |
| 1696 else if (modifiers_sans_meta != 0) | |
| 1697 return; | |
| 1698 else if (EQ (keysym, QKbackspace)) /* backspace => c-h */ | |
| 442 | 1699 MACROLET (make_char ('h'), (modifiers | XEMACS_MOD_CONTROL)); |
| 428 | 1700 else if (EQ (keysym, QKtab)) /* tab => c-i */ |
| 442 | 1701 MACROLET (make_char ('i'), (modifiers | XEMACS_MOD_CONTROL)); |
| 428 | 1702 else if (EQ (keysym, QKlinefeed)) /* linefeed => c-j */ |
| 442 | 1703 MACROLET (make_char ('j'), (modifiers | XEMACS_MOD_CONTROL)); |
| 428 | 1704 else if (EQ (keysym, QKreturn)) /* return => c-m */ |
| 442 | 1705 MACROLET (make_char ('m'), (modifiers | XEMACS_MOD_CONTROL)); |
| 428 | 1706 else if (EQ (keysym, QKescape)) /* escape => c-[ */ |
| 442 | 1707 MACROLET (make_char ('['), (modifiers | XEMACS_MOD_CONTROL)); |
| 428 | 1708 else |
| 1709 return; | |
| 1710 #undef MACROLET | |
| 1711 } | |
| 1712 | |
| 1713 static void | |
| 1714 ensure_meta_prefix_char_keymapp (Lisp_Object keys, int indx, | |
| 1715 Lisp_Object keymap) | |
| 1716 { | |
| 1717 /* This function can GC */ | |
| 1718 Lisp_Object new_keys; | |
| 1719 int i; | |
| 1720 Lisp_Object mpc_binding; | |
| 934 | 1721 Lisp_Key_Data meta_key; |
| 428 | 1722 if (NILP (Vmeta_prefix_char) || |
| 1723 (INTP (Vmeta_prefix_char) && !CHAR_INTP (Vmeta_prefix_char))) | |
| 1724 return; | |
| 1725 | |
| 1726 define_key_parser (Vmeta_prefix_char, &meta_key); | |
| 1727 mpc_binding = keymap_lookup_1 (keymap, &meta_key, 0); | |
| 1728 if (NILP (mpc_binding) || !NILP (Fkeymapp (mpc_binding))) | |
| 1729 return; | |
| 1730 | |
| 1731 if (indx == 0) | |
| 1732 new_keys = keys; | |
| 1733 else if (STRINGP (keys)) | |
| 1734 new_keys = Fsubstring (keys, Qzero, make_int (indx)); | |
| 1735 else if (VECTORP (keys)) | |
| 1736 { | |
| 1737 new_keys = make_vector (indx, Qnil); | |
| 1738 for (i = 0; i < indx; i++) | |
| 1739 XVECTOR_DATA (new_keys) [i] = XVECTOR_DATA (keys) [i]; | |
| 1740 } | |
| 1741 else | |
| 442 | 1742 { |
| 1743 new_keys = Qnil; | |
| 2500 | 1744 ABORT (); |
| 442 | 1745 } |
| 428 | 1746 |
| 1747 if (EQ (keys, new_keys)) | |
| 563 | 1748 signal_ferror_with_frob (Qinvalid_operation, mpc_binding, |
| 1749 "can't bind %s: %s has a non-keymap binding", | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1750 (CIbyte *) XSTRING_DATA (Fkey_description (keys)), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1751 (CIbyte *) XSTRING_DATA (Fsingle_key_description |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1752 (Vmeta_prefix_char))); |
| 428 | 1753 else |
| 563 | 1754 signal_ferror_with_frob (Qinvalid_operation, mpc_binding, |
| 1755 "can't bind %s: %s %s has a non-keymap binding", | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1756 (CIbyte *) XSTRING_DATA (Fkey_description (keys)), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1757 (CIbyte *) XSTRING_DATA (Fkey_description |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1758 (new_keys)), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1759 (CIbyte *) XSTRING_DATA (Fsingle_key_description |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1760 (Vmeta_prefix_char))); |
| 428 | 1761 } |
| 1762 | |
| 1763 DEFUN ("define-key", Fdefine_key, 3, 3, 0, /* | |
| 1764 Define key sequence KEYS, in KEYMAP, as DEF. | |
| 1765 KEYMAP is a keymap object. | |
| 3086 | 1766 KEYS is the key sequence to bind, described below. |
| 428 | 1767 DEF is anything that can be a key's definition: |
| 1768 nil (means key is undefined in this keymap); | |
| 1769 a command (a Lisp function suitable for interactive calling); | |
| 1770 a string or key sequence vector (treated as a keyboard macro); | |
| 1771 a keymap (to define a prefix key); | |
| 1772 a symbol; when the key is looked up, the symbol will stand for its | |
| 1773 function definition, that should at that time be one of the above, | |
| 1774 or another symbol whose function definition is used, and so on. | |
| 1775 a cons (STRING . DEFN), meaning that DEFN is the definition | |
| 1776 (DEFN should be a valid definition in its own right); | |
| 1777 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP. | |
| 1778 | |
| 3086 | 1779 A `key sequence' is a vector of one or more keystrokes. |
| 1780 A `keystroke' is a list containing a key and zero or more modifiers. The | |
| 1781 key must be the last element of the list. | |
| 1782 A `key' is a symbol corresponding to a key on the keyboard, or to a mouse | |
| 1783 gesture. Mouse clicks are denoted by symbols prefixed with "button", | |
| 1784 followed by a digit for which button, and optionally "up". Thus `button1' | |
| 1785 means the down-stroke and `button1up' means the up-stroke when clicking | |
| 1786 mouse button 1. | |
| 1787 A `modifier' is a symbol naming a physical key which is only "noticed" by | |
| 1788 XEmacs when chorded with another key. The `shift' modifier is a special | |
| 1789 case. You cannot use `(meta shift a)' to mean `(meta A)', since for | |
| 1790 characters that have ASCII equivalents, the state of the shift key is | |
| 1791 implicit in the keysym (a vs. A). You also cannot say `(shift =)' to mean | |
| 1792 `+', as that correspondence varies from keyboard to keyboard. The shift | |
| 1793 modifier can only be applied to keys that do not have a second keysym on the | |
| 1794 same key, such as `backspace' and `tab'. A mouse click may be combined with | |
| 1795 modifiers to create a compound "keystroke". | |
| 1796 | |
| 1797 The keys, mouse gestures, and modifiers that are available depend on your | |
| 1798 console and its driver. At a minimum the ASCII graphic characters will be | |
| 1799 available as keys, and shift, control, and meta as modifiers. | |
| 1800 | |
| 1801 To find out programmatically what a key is bound to, use `key-binding' to | |
| 1802 check all applicable keymaps, or `lookup-key' to check a specific keymap. | |
| 1803 The documentation for `key-binding' also contains a description of which | |
| 1804 keymaps are applicable in various situations. `where-is-internal' does | |
| 1805 the opposite of `key-binding', i.e. searches keymaps for the keys that | |
| 1806 map to a particular binding. | |
| 1807 | |
| 1808 If you are confused about why a particular key sequence is generating a | |
| 1809 particular binding, and looking through the keymaps doesn't help, setting | |
| 1810 the variable `debug-emacs-events' may help. If not, try checking | |
| 1811 what's in `function-key-map' and `key-translation-map'. | |
| 1812 | |
| 1813 When running under a window system, typically the repertoire of keys is | |
| 1814 vastly expanded. XEmacs does its best to use the names defined on each | |
| 1815 platform. Also, when running under a window system, XEmacs can tell the | |
| 1816 difference between the keystrokes control-h, control-shift-h, and backspace. | |
| 1817 If the symbols differ, you can bind different actions to each. For mouse | |
| 1818 clicks, different commands may be bound to the up and down strokes, though | |
| 1819 that is probably not what you want, so be careful. | |
| 1820 | |
| 1821 Variant representations: | |
| 1822 | |
| 1823 Besides the canonical representation as a vector of lists of symbols, | |
| 1824 `define-key' also accepts a number of abbreviations, aliases, and variants | |
| 1825 for convenience, compatibility, and internal use. | |
| 1826 | |
| 1827 A keystroke may be represented by a key; this is treated as though it were a | |
| 1828 list containing that key as the only element. A keystroke may also be | |
| 1829 represented by an event object, as returned by the `next-command-event' and | |
| 1830 `read-key-sequence' functions. A key sequence may be represented by a | |
| 1831 single keystroke; this is treated as a vector containing that keystroke as | |
| 1832 its only element. | |
| 1833 | |
| 1834 A key may be represented by a character or its equivalent integer code, | |
| 1835 if and only if it is equivalent to a character with a code in the range | |
| 1836 32 - 255. | |
| 1837 | |
| 1838 For backward compatibility, a key sequence may also be represented by a | |
| 1839 string. In this case, it represents the key sequence(s) that would | |
| 1840 produce that sequence of ASCII characters in a purely ASCII world. An | |
| 1841 alternative string representation is keyboard macro notation, which can | |
| 1842 be translated to the canonical representation with `kbd'. | |
| 1843 | |
| 1844 Examples: | |
| 1845 | |
| 1846 The key sequence `A' (which invokes `self-insert-command') is represented | |
| 1847 by all of these forms: | |
| 428 | 1848 A ?A 65 (A) (?A) (65) |
| 1849 [A] [?A] [65] [(A)] [(?A)] [(65)] | |
| 1850 | |
| 3086 | 1851 The key sequence `control-a' is represented by these forms: |
| 428 | 1852 (control A) (control ?A) (control 65) |
| 1853 [(control A)] [(control ?A)] [(control 65)] | |
| 3086 | 1854 |
| 1855 The key sequence `control-c control-a' is represented by these forms: | |
| 428 | 1856 [(control c) (control a)] [(control ?c) (control ?a)] |
| 1857 [(control 99) (control 65)] etc. | |
| 1858 | |
| 3086 | 1859 The keystroke `control-b' *may not* be represented by the number 2 (the |
| 1860 ASCII code for ^B) or the character `?\^B'. | |
| 1861 | |
| 1862 The `break' key may be represented only by the symbol `break'. | |
| 1863 | |
| 428 | 1864 Mouse button clicks work just like keypresses: (control button1) means |
| 1865 pressing the left mouse button while holding down the control key. | |
| 3086 | 1866 |
| 1867 A string containing the ASCII backspace character, "\\^H", would represent | |
| 1868 two key sequences: `(control h)' and `backspace'. Binding a | |
| 428 | 1869 command to this will actually bind both of those key sequences. Likewise |
| 1870 for the following pairs: | |
| 1871 | |
| 1872 control h backspace | |
| 1873 control i tab | |
| 1874 control m return | |
| 1875 control j linefeed | |
| 1876 control [ escape | |
| 1877 control @ control space | |
| 1878 | |
| 1879 After binding a command to two key sequences with a form like | |
| 1880 | |
| 1881 (define-key global-map "\\^X\\^I" \'command-1) | |
| 1882 | |
| 1883 it is possible to redefine only one of those sequences like so: | |
| 1884 | |
| 1885 (define-key global-map [(control x) (control i)] \'command-2) | |
| 1886 (define-key global-map [(control x) tab] \'command-3) | |
| 1887 */ | |
| 1888 (keymap, keys, def)) | |
| 1889 { | |
| 1890 /* This function can GC */ | |
| 1891 int idx; | |
| 1892 int metized = 0; | |
| 1893 int len; | |
| 1894 int ascii_hack; | |
| 1895 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 1896 | |
| 1897 if (VECTORP (keys)) | |
| 1898 len = XVECTOR_LENGTH (keys); | |
| 1899 else if (STRINGP (keys)) | |
| 826 | 1900 len = string_char_length (keys); |
| 428 | 1901 else if (CHAR_OR_CHAR_INTP (keys) || SYMBOLP (keys) || CONSP (keys)) |
| 1902 { | |
| 1903 if (!CONSP (keys)) keys = list1 (keys); | |
| 1904 len = 1; | |
| 1905 keys = make_vector (1, keys); /* this is kinda sleazy. */ | |
| 1906 } | |
| 1907 else | |
| 1908 { | |
| 1909 keys = wrong_type_argument (Qsequencep, keys); | |
| 1910 len = XINT (Flength (keys)); | |
| 1911 } | |
| 1912 if (len == 0) | |
| 1913 return Qnil; | |
| 1914 | |
| 1915 GCPRO3 (keymap, keys, def); | |
| 1916 | |
| 1917 /* ASCII grunge. | |
| 1918 When the user defines a key which, in a strictly ASCII world, would be | |
| 1919 produced by two different keys (^J and linefeed, or ^H and backspace, | |
| 1920 for example) then the binding will be made for both keysyms. | |
| 1921 | |
| 1922 This is done if the user binds a command to a string, as in | |
| 3086 | 1923 (define-key map "\^H" 'something), but not when using the canonical |
| 1924 syntax (define-key map '(control h) 'something). | |
| 428 | 1925 */ |
| 1926 ascii_hack = (STRINGP (keys)); | |
| 1927 | |
| 1928 keymap = get_keymap (keymap, 1, 1); | |
| 1929 | |
| 1930 idx = 0; | |
| 1931 while (1) | |
| 1932 { | |
| 1933 Lisp_Object c; | |
| 934 | 1934 Lisp_Key_Data raw_key1; |
| 1935 Lisp_Key_Data raw_key2; | |
| 428 | 1936 if (STRINGP (keys)) |
| 867 | 1937 c = make_char (string_ichar (keys, idx)); |
| 428 | 1938 else |
| 1939 c = XVECTOR_DATA (keys) [idx]; | |
| 1940 | |
| 1941 define_key_parser (c, &raw_key1); | |
| 1942 | |
| 1943 if (!metized && ascii_hack && meta_prefix_char_p (&raw_key1)) | |
| 1944 { | |
| 1945 if (idx == (len - 1)) | |
| 1946 { | |
| 1947 /* This is a hack to prevent a binding for the meta-prefix-char | |
| 1948 from being made in a map which already has a non-empty "meta" | |
| 1949 submap. That is, we can't let both "escape" and "meta" have | |
| 1950 a binding in the same keymap. This implies that the idiom | |
| 1951 (define-key my-map "\e" my-escape-map) | |
| 1952 (define-key my-escape-map "a" 'my-command) | |
| 1953 no longer works. That's ok. Instead the luser should do | |
| 1954 (define-key my-map "\ea" 'my-command) | |
| 1955 or, more correctly | |
| 1956 (define-key my-map "\M-a" 'my-command) | |
| 1957 and then perhaps | |
| 1958 (defvar my-escape-map (lookup-key my-map "\e")) | |
| 1959 if the luser really wants the map in a variable. | |
| 1960 */ | |
| 440 | 1961 Lisp_Object meta_map; |
| 428 | 1962 struct gcpro ngcpro1; |
| 1963 | |
| 1964 NGCPRO1 (c); | |
| 442 | 1965 meta_map = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META), |
| 440 | 1966 XKEYMAP (keymap)->table, Qnil); |
| 1967 if (!NILP (meta_map) | |
| 1968 && keymap_fullness (meta_map) != 0) | |
| 563 | 1969 invalid_operation_2 |
| 440 | 1970 ("Map contains meta-bindings, can't bind", |
| 1971 Fsingle_key_description (Vmeta_prefix_char), keymap); | |
| 428 | 1972 NUNGCPRO; |
| 1973 } | |
| 1974 else | |
| 1975 { | |
| 1976 metized = 1; | |
| 1977 idx++; | |
| 1978 continue; | |
| 1979 } | |
| 1980 } | |
| 1981 | |
| 1982 if (ascii_hack) | |
| 1983 define_key_alternate_name (&raw_key1, &raw_key2); | |
| 1984 else | |
| 1985 { | |
| 1986 raw_key2.keysym = Qnil; | |
| 1987 raw_key2.modifiers = 0; | |
| 1988 } | |
| 1989 | |
| 1990 if (metized) | |
| 1991 { | |
| 442 | 1992 raw_key1.modifiers |= XEMACS_MOD_META; |
| 1993 raw_key2.modifiers |= XEMACS_MOD_META; | |
| 428 | 1994 metized = 0; |
| 1995 } | |
| 1996 | |
| 1997 /* This crap is to make sure that someone doesn't bind something like | |
| 1998 "C-x M-a" while "C-x ESC" has a non-keymap binding. */ | |
| 442 | 1999 if (raw_key1.modifiers & XEMACS_MOD_META) |
| 428 | 2000 ensure_meta_prefix_char_keymapp (keys, idx, keymap); |
| 2001 | |
| 2002 if (++idx == len) | |
| 2003 { | |
| 2004 keymap_store (keymap, &raw_key1, def); | |
| 2005 if (ascii_hack && !NILP (raw_key2.keysym)) | |
| 2006 keymap_store (keymap, &raw_key2, def); | |
| 2007 UNGCPRO; | |
| 2008 return def; | |
| 2009 } | |
| 2010 | |
| 2011 { | |
| 2012 Lisp_Object cmd; | |
| 2013 struct gcpro ngcpro1; | |
| 2014 NGCPRO1 (c); | |
| 2015 | |
| 2016 cmd = keymap_lookup_1 (keymap, &raw_key1, 0); | |
| 2017 if (NILP (cmd)) | |
| 2018 { | |
| 2019 cmd = Fmake_sparse_keymap (Qnil); | |
| 2020 XKEYMAP (cmd)->name /* for debugging */ | |
| 2021 = list2 (make_key_description (&raw_key1, 1), keymap); | |
| 2022 keymap_store (keymap, &raw_key1, cmd); | |
| 2023 } | |
| 2024 if (NILP (Fkeymapp (cmd))) | |
| 563 | 2025 sferror_2 ("Invalid prefix keys in sequence", |
| 428 | 2026 c, keys); |
| 2027 | |
| 2028 if (ascii_hack && !NILP (raw_key2.keysym) && | |
| 2029 NILP (keymap_lookup_1 (keymap, &raw_key2, 0))) | |
| 2030 keymap_store (keymap, &raw_key2, cmd); | |
| 2031 | |
| 2032 keymap = get_keymap (cmd, 1, 1); | |
| 2033 NUNGCPRO; | |
| 2034 } | |
| 2035 } | |
| 2036 } | |
| 2037 | |
| 2038 | |
| 2039 /************************************************************************/ | |
| 2040 /* Looking up keys in keymaps */ | |
| 2041 /************************************************************************/ | |
| 2042 | |
| 2043 /* We need a very fast (i.e., non-consing) version of lookup-key in order | |
| 2044 to make where-is-internal really fly. */ | |
| 2045 | |
| 2046 struct raw_lookup_key_mapper_closure | |
| 2047 { | |
| 2048 int remaining; | |
| 934 | 2049 const Lisp_Key_Data *raw_keys; |
| 428 | 2050 int raw_keys_count; |
| 2051 int keys_so_far; | |
| 2052 int accept_default; | |
| 2053 }; | |
| 2054 | |
| 2055 static Lisp_Object raw_lookup_key_mapper (Lisp_Object k, void *); | |
| 2056 | |
| 2057 /* Caller should gc-protect args (keymaps may autoload) */ | |
| 2058 static Lisp_Object | |
| 2059 raw_lookup_key (Lisp_Object keymap, | |
| 934 | 2060 const Lisp_Key_Data *raw_keys, int raw_keys_count, |
| 428 | 2061 int keys_so_far, int accept_default) |
| 2062 { | |
| 2063 /* This function can GC */ | |
| 2064 struct raw_lookup_key_mapper_closure c; | |
| 2065 c.remaining = raw_keys_count - 1; | |
| 2066 c.raw_keys = raw_keys; | |
| 2067 c.raw_keys_count = raw_keys_count; | |
| 2068 c.keys_so_far = keys_so_far; | |
| 2069 c.accept_default = accept_default; | |
| 2070 | |
| 2071 return traverse_keymaps (keymap, Qnil, raw_lookup_key_mapper, &c); | |
| 2072 } | |
| 2073 | |
| 2074 static Lisp_Object | |
| 2075 raw_lookup_key_mapper (Lisp_Object k, void *arg) | |
| 2076 { | |
| 2077 /* This function can GC */ | |
| 2078 struct raw_lookup_key_mapper_closure *c = | |
| 2079 (struct raw_lookup_key_mapper_closure *) arg; | |
| 2080 int accept_default = c->accept_default; | |
| 2081 int remaining = c->remaining; | |
| 2082 int keys_so_far = c->keys_so_far; | |
| 934 | 2083 const Lisp_Key_Data *raw_keys = c->raw_keys; |
| 428 | 2084 Lisp_Object cmd; |
| 2085 | |
| 2086 if (! meta_prefix_char_p (&(raw_keys[0]))) | |
| 2087 { | |
| 2088 /* Normal case: every case except the meta-hack (see below). */ | |
| 2089 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default); | |
| 2090 | |
| 2091 if (remaining == 0) | |
| 2092 /* Return whatever we found if we're out of keys */ | |
| 2093 ; | |
| 2094 else if (NILP (cmd)) | |
| 2095 /* Found nothing (though perhaps parent map may have binding) */ | |
| 2096 ; | |
| 2097 else if (NILP (Fkeymapp (cmd))) | |
| 2098 /* Didn't find a keymap, and we have more keys. | |
| 2099 * Return a fixnum to indicate that keys were too long. | |
| 2100 */ | |
| 2101 cmd = make_int (keys_so_far + 1); | |
| 2102 else | |
| 2103 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining, | |
| 2104 keys_so_far + 1, accept_default); | |
| 2105 } | |
| 2106 else | |
| 2107 { | |
| 2108 /* This is a hack so that looking up a key-sequence whose last | |
| 2109 * element is the meta-prefix-char will return the keymap that | |
| 2110 * the "meta" keys are stored in, if there is no binding for | |
| 2111 * the meta-prefix-char (and if this map has a "meta" submap). | |
| 2112 * If this map doesn't have a "meta" submap, then the | |
| 2113 * meta-prefix-char is looked up just like any other key. | |
| 2114 */ | |
| 2115 if (remaining == 0) | |
| 2116 { | |
| 2117 /* First look for the prefix-char directly */ | |
| 2118 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default); | |
| 2119 if (NILP (cmd)) | |
| 2120 { | |
| 2121 /* Do kludgy return of the meta-map */ | |
| 442 | 2122 cmd = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META), |
| 428 | 2123 XKEYMAP (k)->table, Qnil); |
| 2124 } | |
| 2125 } | |
| 2126 else | |
| 2127 { | |
| 2128 /* Search for the prefix-char-prefixed sequence directly */ | |
| 2129 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default); | |
| 2130 cmd = get_keymap (cmd, 0, 1); | |
| 2131 if (!NILP (cmd)) | |
| 2132 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining, | |
| 2133 keys_so_far + 1, accept_default); | |
| 442 | 2134 else if ((raw_keys[1].modifiers & XEMACS_MOD_META) == 0) |
| 428 | 2135 { |
| 934 | 2136 Lisp_Key_Data metified; |
| 428 | 2137 metified.keysym = raw_keys[1].keysym; |
| 442 | 2138 metified.modifiers = raw_keys[1].modifiers | |
| 2139 (unsigned char) XEMACS_MOD_META; | |
| 428 | 2140 |
| 2141 /* Search for meta-next-char sequence directly */ | |
| 2142 cmd = keymap_lookup_1 (k, &metified, accept_default); | |
| 2143 if (remaining == 1) | |
| 2144 ; | |
| 2145 else | |
| 2146 { | |
| 2147 cmd = get_keymap (cmd, 0, 1); | |
| 2148 if (!NILP (cmd)) | |
| 2149 cmd = raw_lookup_key (cmd, raw_keys + 2, remaining - 1, | |
| 2150 keys_so_far + 2, | |
| 2151 accept_default); | |
| 2152 } | |
| 2153 } | |
| 2154 } | |
| 2155 } | |
| 2156 if (accept_default && NILP (cmd)) | |
| 2157 cmd = XKEYMAP (k)->default_binding; | |
| 2158 return cmd; | |
| 2159 } | |
| 2160 | |
| 2161 /* Value is number if `keys' is too long; NIL if valid but has no definition.*/ | |
| 2162 /* Caller should gc-protect arguments */ | |
| 2163 static Lisp_Object | |
| 2164 lookup_keys (Lisp_Object keymap, int nkeys, Lisp_Object *keys, | |
| 2165 int accept_default) | |
| 2166 { | |
| 2167 /* This function can GC */ | |
| 934 | 2168 Lisp_Key_Data kkk[20]; |
| 2169 Lisp_Key_Data *raw_keys; | |
| 428 | 2170 int i; |
| 2171 | |
| 2172 if (nkeys == 0) | |
| 2173 return Qnil; | |
| 2174 | |
| 438 | 2175 if (nkeys < countof (kkk)) |
| 428 | 2176 raw_keys = kkk; |
| 2177 else | |
| 934 | 2178 raw_keys = alloca_array (Lisp_Key_Data, nkeys); |
| 428 | 2179 |
| 2180 for (i = 0; i < nkeys; i++) | |
| 2181 { | |
| 2182 define_key_parser (keys[i], &(raw_keys[i])); | |
| 2183 } | |
| 2184 return raw_lookup_key (keymap, raw_keys, nkeys, 0, accept_default); | |
| 2185 } | |
| 2186 | |
| 2187 static Lisp_Object | |
| 2188 lookup_events (Lisp_Object event_head, int nmaps, Lisp_Object keymaps[], | |
| 2189 int accept_default) | |
| 2190 { | |
| 2191 /* This function can GC */ | |
| 934 | 2192 Lisp_Key_Data kkk[20]; |
| 428 | 2193 Lisp_Object event; |
| 2194 | |
| 2195 int nkeys; | |
| 934 | 2196 Lisp_Key_Data *raw_keys; |
| 428 | 2197 Lisp_Object tem = Qnil; |
| 2198 struct gcpro gcpro1, gcpro2; | |
| 2199 int iii; | |
| 2200 | |
| 2201 CHECK_LIVE_EVENT (event_head); | |
| 2202 | |
| 2203 nkeys = event_chain_count (event_head); | |
| 2204 | |
| 438 | 2205 if (nkeys < countof (kkk)) |
| 428 | 2206 raw_keys = kkk; |
| 2207 else | |
| 934 | 2208 raw_keys = alloca_array (Lisp_Key_Data, nkeys); |
| 428 | 2209 |
| 2210 nkeys = 0; | |
| 2211 EVENT_CHAIN_LOOP (event, event_head) | |
| 2212 define_key_parser (event, &(raw_keys[nkeys++])); | |
| 2213 GCPRO2 (keymaps[0], event_head); | |
| 2214 gcpro1.nvars = nmaps; | |
| 2215 /* ####raw_keys[].keysym slots aren't gc-protected. We rely (but shouldn't) | |
| 2216 * on somebody else somewhere (obarray) having a pointer to all keysyms. */ | |
| 2217 for (iii = 0; iii < nmaps; iii++) | |
| 2218 { | |
| 2219 tem = raw_lookup_key (keymaps[iii], raw_keys, nkeys, 0, | |
| 2220 accept_default); | |
| 2221 if (INTP (tem)) | |
| 2222 { | |
| 2223 /* Too long in some local map means don't look at global map */ | |
| 2224 tem = Qnil; | |
| 2225 break; | |
| 2226 } | |
| 2227 else if (!NILP (tem)) | |
| 2228 break; | |
| 2229 } | |
| 2230 UNGCPRO; | |
| 2231 return tem; | |
| 2232 } | |
| 2233 | |
| 2234 DEFUN ("lookup-key", Flookup_key, 2, 3, 0, /* | |
| 2235 In keymap KEYMAP, look up key-sequence KEYS. Return the definition. | |
| 2236 Nil is returned if KEYS is unbound. See documentation of `define-key' | |
| 2237 for valid key definitions and key-sequence specifications. | |
| 2238 A number is returned if KEYS is "too long"; that is, the leading | |
| 2239 characters fail to be a valid sequence of prefix characters in KEYMAP. | |
| 444 | 2240 The number is how many key strokes at the front of KEYS it takes to |
| 2241 reach a non-prefix command. | |
| 428 | 2242 */ |
| 2243 (keymap, keys, accept_default)) | |
| 2244 { | |
| 2245 /* This function can GC */ | |
| 2246 if (VECTORP (keys)) | |
| 2247 return lookup_keys (keymap, | |
| 2248 XVECTOR_LENGTH (keys), | |
| 2249 XVECTOR_DATA (keys), | |
| 2250 !NILP (accept_default)); | |
| 2251 else if (SYMBOLP (keys) || CHAR_OR_CHAR_INTP (keys) || CONSP (keys)) | |
| 2252 return lookup_keys (keymap, 1, &keys, !NILP (accept_default)); | |
| 2253 else if (STRINGP (keys)) | |
| 2254 { | |
| 826 | 2255 int length = string_char_length (keys); |
| 428 | 2256 int i; |
| 934 | 2257 Lisp_Key_Data *raw_keys = alloca_array (Lisp_Key_Data, length); |
| 428 | 2258 if (length == 0) |
| 2259 return Qnil; | |
| 2260 | |
| 2261 for (i = 0; i < length; i++) | |
| 2262 { | |
| 867 | 2263 Ichar n = string_ichar (keys, i); |
| 428 | 2264 define_key_parser (make_char (n), &(raw_keys[i])); |
| 2265 } | |
| 2266 return raw_lookup_key (keymap, raw_keys, length, 0, | |
| 2267 !NILP (accept_default)); | |
| 2268 } | |
| 2269 else | |
| 2270 { | |
| 2271 keys = wrong_type_argument (Qsequencep, keys); | |
| 2272 return Flookup_key (keymap, keys, accept_default); | |
| 2273 } | |
| 2274 } | |
| 2275 | |
| 2276 /* Given a key sequence, returns a list of keymaps to search for bindings. | |
| 2277 Does all manner of semi-hairy heuristics, like looking in the current | |
| 2278 buffer's map before looking in the global map and looking in the local | |
| 2279 map of the buffer in which the mouse was clicked in event0 is a click. | |
| 2280 | |
| 2281 It would be kind of nice if this were in Lisp so that this semi-hairy | |
| 2282 semi-heuristic command-lookup behavior could be readily understood and | |
| 2283 customised. However, this needs to be pretty fast, or performance of | |
| 2284 keyboard macros goes to shit; putting this in lisp slows macros down | |
| 2285 2-3x. And they're already slower than v18 by 5-6x. | |
| 2286 */ | |
| 2287 | |
| 2288 struct relevant_maps | |
| 2289 { | |
| 2290 int nmaps; | |
| 647 | 2291 int max_maps; |
| 428 | 2292 Lisp_Object *maps; |
| 2293 struct gcpro *gcpro; | |
| 2294 }; | |
| 2295 | |
| 2296 static void get_relevant_extent_keymaps (Lisp_Object pos, | |
| 2297 Lisp_Object buffer_or_string, | |
| 2298 Lisp_Object glyph, | |
| 2299 struct relevant_maps *closure); | |
| 2300 static void get_relevant_minor_maps (Lisp_Object buffer, | |
| 2301 struct relevant_maps *closure); | |
| 2302 | |
| 2303 static void | |
| 2304 relevant_map_push (Lisp_Object map, struct relevant_maps *closure) | |
| 2305 { | |
| 647 | 2306 int nmaps = closure->nmaps; |
| 428 | 2307 |
| 2308 if (!KEYMAPP (map)) | |
| 2309 return; | |
| 2310 closure->nmaps = nmaps + 1; | |
| 2311 if (nmaps < closure->max_maps) | |
| 2312 { | |
| 2313 closure->maps[nmaps] = map; | |
| 2314 closure->gcpro->nvars = nmaps; | |
| 2315 } | |
| 2316 } | |
| 2317 | |
| 2318 static int | |
| 2319 get_relevant_keymaps (Lisp_Object keys, | |
| 2320 int max_maps, Lisp_Object maps[]) | |
| 2321 { | |
| 2322 /* This function can GC */ | |
| 2323 Lisp_Object terminal = Qnil; | |
| 2324 struct gcpro gcpro1; | |
| 2325 struct relevant_maps closure; | |
| 2326 struct console *con; | |
| 2327 | |
| 2328 GCPRO1 (*maps); | |
| 2329 gcpro1.nvars = 0; | |
| 2330 closure.nmaps = 0; | |
| 2331 closure.max_maps = max_maps; | |
| 2332 closure.maps = maps; | |
| 2333 closure.gcpro = &gcpro1; | |
| 2334 | |
| 2335 if (EVENTP (keys)) | |
| 2336 terminal = event_chain_tail (keys); | |
| 2337 else if (VECTORP (keys)) | |
| 2338 { | |
| 2339 int len = XVECTOR_LENGTH (keys); | |
| 2340 if (len > 0) | |
| 2341 terminal = XVECTOR_DATA (keys)[len - 1]; | |
| 2342 } | |
| 2343 | |
| 2344 if (EVENTP (terminal)) | |
| 2345 { | |
| 2346 CHECK_LIVE_EVENT (terminal); | |
| 2347 con = event_console_or_selected (terminal); | |
| 2348 } | |
| 2349 else | |
| 2350 con = XCONSOLE (Vselected_console); | |
| 2351 | |
| 2352 if (KEYMAPP (con->overriding_terminal_local_map) | |
| 2353 || KEYMAPP (Voverriding_local_map)) | |
| 2354 { | |
| 2355 if (KEYMAPP (con->overriding_terminal_local_map)) | |
| 2356 relevant_map_push (con->overriding_terminal_local_map, &closure); | |
| 2357 if (KEYMAPP (Voverriding_local_map)) | |
| 2358 relevant_map_push (Voverriding_local_map, &closure); | |
| 2359 } | |
| 2360 else if (!EVENTP (terminal) | |
| 2361 || (XEVENT (terminal)->event_type != button_press_event | |
| 2362 && XEVENT (terminal)->event_type != button_release_event)) | |
| 2363 { | |
| 793 | 2364 Lisp_Object tem = wrap_buffer (current_buffer); |
| 2365 | |
| 428 | 2366 /* It's not a mouse event; order of keymaps searched is: |
| 2367 o keymap of any/all extents under the mouse | |
| 2368 o minor-mode maps | |
| 2369 o local-map of current-buffer | |
| 771 | 2370 o global-tty-map or global-window-system-map |
| 428 | 2371 o global-map |
| 2372 */ | |
| 2373 /* The terminal element of the lookup may be nil or a keysym. | |
| 2374 In those cases we don't want to check for an extent | |
| 2375 keymap. */ | |
| 2376 if (EVENTP (terminal)) | |
| 2377 { | |
| 2378 get_relevant_extent_keymaps (make_int (BUF_PT (current_buffer)), | |
| 2379 tem, Qnil, &closure); | |
| 2380 } | |
| 2381 get_relevant_minor_maps (tem, &closure); | |
| 2382 | |
| 2383 tem = current_buffer->keymap; | |
| 2384 if (!NILP (tem)) | |
| 2385 relevant_map_push (tem, &closure); | |
| 2386 } | |
| 2387 #ifdef HAVE_WINDOW_SYSTEM | |
| 2388 else | |
| 2389 { | |
| 2390 /* It's a mouse event; order of keymaps searched is: | |
| 2391 o vertical-divider-map, if event is over a divider | |
| 2392 o local-map of mouse-grabbed-buffer | |
| 2393 o keymap of any/all extents under the mouse | |
| 2394 if the mouse is over a modeline: | |
| 2395 o modeline-map of buffer corresponding to that modeline | |
| 2396 o else, local-map of buffer under the mouse | |
| 2397 o minor-mode maps | |
| 2398 o local-map of current-buffer | |
| 771 | 2399 o global-tty-map or global-window-system-map |
| 428 | 2400 o global-map |
| 2401 */ | |
| 2402 Lisp_Object window = Fevent_window (terminal); | |
| 2403 | |
| 2404 if (!NILP (Fevent_over_vertical_divider_p (terminal))) | |
| 2405 { | |
| 2406 if (KEYMAPP (Vvertical_divider_map)) | |
| 2407 relevant_map_push (Vvertical_divider_map, &closure); | |
| 2408 } | |
| 2409 | |
| 2410 if (BUFFERP (Vmouse_grabbed_buffer)) | |
| 2411 { | |
| 2412 Lisp_Object map = XBUFFER (Vmouse_grabbed_buffer)->keymap; | |
| 2413 | |
| 2414 get_relevant_minor_maps (Vmouse_grabbed_buffer, &closure); | |
| 2415 if (!NILP (map)) | |
| 2416 relevant_map_push (map, &closure); | |
| 2417 } | |
| 2418 | |
| 2419 if (!NILP (window)) | |
| 2420 { | |
| 2421 Lisp_Object buffer = Fwindow_buffer (window); | |
| 2422 | |
| 2423 if (!NILP (buffer)) | |
| 2424 { | |
| 2425 if (!NILP (Fevent_over_modeline_p (terminal))) | |
| 2426 { | |
| 2427 Lisp_Object map = symbol_value_in_buffer (Qmodeline_map, | |
| 2428 buffer); | |
| 2429 | |
| 2430 get_relevant_extent_keymaps | |
| 2431 (Fevent_modeline_position (terminal), | |
| 2432 XBUFFER (buffer)->generated_modeline_string, | |
| 438 | 2433 Fevent_glyph_extent (terminal), &closure); |
| 428 | 2434 |
| 2435 if (!UNBOUNDP (map) && !NILP (map)) | |
| 2436 relevant_map_push (get_keymap (map, 1, 1), &closure); | |
| 2437 } | |
| 2438 else | |
| 2439 { | |
| 2440 get_relevant_extent_keymaps (Fevent_point (terminal), buffer, | |
| 2441 Fevent_glyph_extent (terminal), | |
| 2442 &closure); | |
| 2443 } | |
| 2444 | |
| 2445 if (!EQ (buffer, Vmouse_grabbed_buffer)) /* already pushed */ | |
| 2446 { | |
| 2447 Lisp_Object map = XBUFFER (buffer)->keymap; | |
| 2448 | |
| 2449 get_relevant_minor_maps (buffer, &closure); | |
| 2450 if (!NILP(map)) | |
| 2451 relevant_map_push (map, &closure); | |
| 2452 } | |
| 2453 } | |
| 2454 } | |
| 2455 else if (!NILP (Fevent_over_toolbar_p (terminal))) | |
| 2456 { | |
| 2457 Lisp_Object map = Fsymbol_value (Qtoolbar_map); | |
| 2458 | |
| 2459 if (!UNBOUNDP (map) && !NILP (map)) | |
| 2460 relevant_map_push (map, &closure); | |
| 2461 } | |
| 2462 } | |
| 2463 #endif /* HAVE_WINDOW_SYSTEM */ | |
| 2464 | |
| 771 | 2465 if (CONSOLE_TTY_P (con)) |
| 2466 relevant_map_push (Vglobal_tty_map, &closure); | |
| 2467 else | |
| 2468 relevant_map_push (Vglobal_window_system_map, &closure); | |
| 2469 | |
| 428 | 2470 { |
| 2471 int nmaps = closure.nmaps; | |
| 2472 /* Silently truncate at 100 keymaps to prevent infinite lossage */ | |
| 2473 if (nmaps >= max_maps && max_maps > 0) | |
| 2474 maps[max_maps - 1] = Vcurrent_global_map; | |
| 2475 else | |
| 2476 maps[nmaps] = Vcurrent_global_map; | |
| 2477 UNGCPRO; | |
| 2478 return nmaps + 1; | |
| 2479 } | |
| 2480 } | |
| 2481 | |
| 2482 /* Returns a set of keymaps extracted from the extents at POS in | |
| 2483 BUFFER_OR_STRING. The GLYPH arg, if specified, is one more extent | |
| 2484 to look for a keymap in, and if it has one, its keymap will be the | |
| 2485 first element in the list returned. This is so we can correctly | |
| 2486 search the keymaps associated with glyphs which may be physically | |
| 2487 disjoint from their extents: for example, if a glyph is out in the | |
| 2488 margin, we should still consult the keymap of that glyph's extent, | |
| 2489 which may not itself be under the mouse. | |
| 2490 */ | |
| 2491 | |
| 2492 static void | |
| 2493 get_relevant_extent_keymaps (Lisp_Object pos, Lisp_Object buffer_or_string, | |
| 2494 Lisp_Object glyph, | |
| 2495 struct relevant_maps *closure) | |
| 2496 { | |
| 2497 /* This function can GC */ | |
| 2498 /* the glyph keymap, if any, comes first. | |
| 2499 (Processing it twice is no big deal: noop.) */ | |
| 2500 if (!NILP (glyph)) | |
| 2501 { | |
| 2502 Lisp_Object keymap = Fextent_property (glyph, Qkeymap, Qnil); | |
| 2503 if (!NILP (keymap)) | |
| 2504 relevant_map_push (get_keymap (keymap, 1, 1), closure); | |
| 2505 } | |
| 2506 | |
| 2507 /* Next check the extents at the text position, if any */ | |
| 2508 if (!NILP (pos)) | |
| 2509 { | |
| 2510 Lisp_Object extent; | |
| 2511 for (extent = Fextent_at (pos, buffer_or_string, Qkeymap, Qnil, Qnil); | |
| 2512 !NILP (extent); | |
| 2513 extent = Fextent_at (pos, buffer_or_string, Qkeymap, extent, Qnil)) | |
| 2514 { | |
| 2515 Lisp_Object keymap = Fextent_property (extent, Qkeymap, Qnil); | |
| 2516 if (!NILP (keymap)) | |
| 2517 relevant_map_push (get_keymap (keymap, 1, 1), closure); | |
| 2518 QUIT; | |
| 2519 } | |
| 2520 } | |
| 2521 } | |
| 2522 | |
| 2523 static Lisp_Object | |
| 2524 minor_mode_keymap_predicate (Lisp_Object assoc, Lisp_Object buffer) | |
| 2525 { | |
| 2526 /* This function can GC */ | |
| 2527 if (CONSP (assoc)) | |
| 2528 { | |
| 2529 Lisp_Object sym = XCAR (assoc); | |
| 2530 if (SYMBOLP (sym)) | |
| 2531 { | |
| 2532 Lisp_Object val = symbol_value_in_buffer (sym, buffer); | |
| 2533 if (!NILP (val) && !UNBOUNDP (val)) | |
| 2534 { | |
| 793 | 2535 return get_keymap (XCDR (assoc), 0, 1); |
| 428 | 2536 } |
| 2537 } | |
| 2538 } | |
| 2539 return Qnil; | |
| 2540 } | |
| 2541 | |
| 2542 static void | |
| 2543 get_relevant_minor_maps (Lisp_Object buffer, struct relevant_maps *closure) | |
| 2544 { | |
| 2545 /* This function can GC */ | |
| 2546 Lisp_Object alist; | |
| 2547 | |
| 2548 /* Will you ever lose badly if you make this circular! */ | |
| 2549 for (alist = symbol_value_in_buffer (Qminor_mode_map_alist, buffer); | |
| 2550 CONSP (alist); | |
| 2551 alist = XCDR (alist)) | |
| 2552 { | |
| 2553 Lisp_Object m = minor_mode_keymap_predicate (XCAR (alist), | |
| 2554 buffer); | |
| 2555 if (!NILP (m)) relevant_map_push (m, closure); | |
| 2556 QUIT; | |
| 2557 } | |
| 2558 } | |
| 2559 | |
| 2560 /* #### Would map-current-keymaps be a better thing?? */ | |
| 2561 DEFUN ("current-keymaps", Fcurrent_keymaps, 0, 1, 0, /* | |
| 2562 Return a list of the current keymaps that will be searched for bindings. | |
| 2563 This lists keymaps such as the current local map and the minor-mode maps, | |
| 2564 but does not list the parents of those keymaps. | |
| 2565 EVENT-OR-KEYS controls which keymaps will be listed. | |
| 2566 If EVENT-OR-KEYS is a mouse event (or a vector whose last element is a | |
| 2567 mouse event), the keymaps for that mouse event will be listed (see | |
| 2568 `key-binding'). Otherwise, the keymaps for key presses will be listed. | |
| 771 | 2569 See `key-binding' for a description of which keymaps are searched in |
| 2570 various situations. | |
| 428 | 2571 */ |
| 2572 (event_or_keys)) | |
| 2573 { | |
| 2574 /* This function can GC */ | |
| 2575 struct gcpro gcpro1; | |
| 2576 Lisp_Object maps[100]; | |
| 2577 Lisp_Object *gubbish = maps; | |
| 2578 int nmaps; | |
| 2579 | |
| 2580 GCPRO1 (event_or_keys); | |
| 2581 nmaps = get_relevant_keymaps (event_or_keys, countof (maps), | |
| 2582 gubbish); | |
| 2583 if (nmaps > countof (maps)) | |
| 2584 { | |
| 2585 gubbish = alloca_array (Lisp_Object, nmaps); | |
| 2586 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish); | |
| 2587 } | |
| 2588 UNGCPRO; | |
| 2589 return Flist (nmaps, gubbish); | |
| 2590 } | |
| 2591 | |
| 2592 DEFUN ("key-binding", Fkey_binding, 1, 2, 0, /* | |
| 2593 Return the binding for command KEYS in current keymaps. | |
| 2594 KEYS is a string, a vector of events, or a vector of key-description lists | |
| 2595 as described in the documentation for the `define-key' function. | |
| 2596 The binding is probably a symbol with a function definition; see | |
| 2597 the documentation for `lookup-key' for more information. | |
| 2598 | |
| 2599 For key-presses, the order of keymaps searched is: | |
| 2600 - the `keymap' property of any extent(s) at point; | |
| 2601 - any applicable minor-mode maps; | |
| 444 | 2602 - the current local map of the current-buffer; |
| 771 | 2603 - either `global-tty-map' or `global-window-system-map', depending on |
| 2604 whether the current console is a TTY or non-TTY console; | |
| 428 | 2605 - the current global map. |
| 2606 | |
| 2607 For mouse-clicks, the order of keymaps searched is: | |
| 2608 - the current-local-map of the `mouse-grabbed-buffer' if any; | |
| 2609 - vertical-divider-map, if the event happened over a vertical divider | |
| 2610 - the `keymap' property of any extent(s) at the position of the click | |
| 2611 (this includes modeline extents); | |
| 2612 - the modeline-map of the buffer corresponding to the modeline under | |
| 2613 the mouse (if the click happened over a modeline); | |
| 444 | 2614 - the value of `toolbar-map' in the current-buffer (if the click |
| 428 | 2615 happened over a toolbar); |
| 444 | 2616 - the current local map of the buffer under the mouse (does not |
| 428 | 2617 apply to toolbar clicks); |
| 2618 - any applicable minor-mode maps; | |
| 771 | 2619 - either `global-tty-map' or `global-window-system-map', depending on |
| 2620 whether the current console is a TTY or non-TTY console; | |
| 428 | 2621 - the current global map. |
| 2622 | |
| 2623 Note that if `overriding-local-map' or `overriding-terminal-local-map' | |
| 2624 is non-nil, *only* those two maps and the current global map are searched. | |
| 771 | 2625 |
| 2626 Note also that key sequences actually received from the keyboard driver | |
| 2627 may be processed in various ways to generate the key sequence that is | |
| 2628 actually looked up in the keymaps. In particular: | |
| 2629 | |
| 2630 -- Keysyms are individually passed through `keyboard-translate-table' before | |
| 2631 any other processing. | |
| 2632 -- After this, key sequences as a whole are passed through | |
| 2633 `key-translation-map'. | |
| 2634 -- The resulting key sequence is actually looked up in the keymaps. | |
| 2635 -- If there's no binding found, the key sequence is passed through | |
| 2636 `function-key-map' and looked up again. | |
| 2637 -- If no binding is found and `retry-undefined-key-binding-unshifted' is | |
| 2638 set (it usually is) and the final keysym is an uppercase character, | |
| 2639 we lowercase it and start over from the `key-translation-map' stage. | |
| 2640 -- If no binding is found and we're on MS Windows and have international | |
| 2641 support, we successively remap the key sequence using the keyboard layouts | |
| 2642 of various default locales (current language environment, user default, | |
| 2643 system default, US ASCII) and try again. This makes (e.g.) sequences | |
| 2644 such as `C-x b' work in a Russian locale, where the alphabetic keys are | |
| 2645 actually generating Russian characters and not the Roman letters written | |
| 2646 on the keycaps. (Not yet implemented) | |
| 2647 -- Finally, if the last keystroke matches `help-char', we automatically | |
| 2648 generate and display a list of possible key sequences and bindings | |
| 2649 given the prefix so far generated. | |
| 428 | 2650 */ |
| 2651 (keys, accept_default)) | |
| 2652 { | |
| 2653 /* This function can GC */ | |
| 2654 int i; | |
| 2655 Lisp_Object maps[100]; | |
| 2656 int nmaps; | |
| 2657 struct gcpro gcpro1, gcpro2; | |
| 2658 GCPRO2 (keys, accept_default); /* get_relevant_keymaps may autoload */ | |
| 2659 | |
| 2660 nmaps = get_relevant_keymaps (keys, countof (maps), maps); | |
| 2661 | |
| 2662 UNGCPRO; | |
| 2663 | |
| 2664 if (EVENTP (keys)) /* unadvertised "feature" for the future */ | |
| 2665 return lookup_events (keys, nmaps, maps, !NILP (accept_default)); | |
| 2666 | |
| 2667 for (i = 0; i < nmaps; i++) | |
| 2668 { | |
| 2669 Lisp_Object tem = Flookup_key (maps[i], keys, | |
| 2670 accept_default); | |
| 2671 if (INTP (tem)) | |
| 2672 { | |
| 2673 /* Too long in some local map means don't look at global map */ | |
| 2674 return Qnil; | |
| 2675 } | |
| 2676 else if (!NILP (tem)) | |
| 2677 return tem; | |
| 2678 } | |
| 2679 return Qnil; | |
| 2680 } | |
| 2681 | |
| 2682 static Lisp_Object | |
| 2683 process_event_binding_result (Lisp_Object result) | |
| 2684 { | |
| 2685 if (EQ (result, Qundefined)) | |
| 3025 | 2686 /* The suppress-keymap function binds keys to `undefined' - special-case |
| 428 | 2687 that here, so that being bound to that has the same error-behavior as |
| 2688 not being defined at all. | |
| 2689 */ | |
| 2690 result = Qnil; | |
| 2691 if (!NILP (result)) | |
| 2692 { | |
| 2693 Lisp_Object map; | |
| 2694 /* Snap out possible keymap indirections */ | |
| 2695 map = get_keymap (result, 0, 1); | |
| 2696 if (!NILP (map)) | |
| 2697 result = map; | |
| 2698 } | |
| 2699 | |
| 2700 return result; | |
| 2701 } | |
| 2702 | |
| 2703 /* Attempts to find a command corresponding to the event-sequence | |
| 2704 whose head is event0 (sequence is threaded though event_next). | |
| 2705 | |
| 2706 The return value will be | |
| 2707 | |
| 2708 -- nil (there is no binding; this will also be returned | |
| 2709 whenever the event chain is "too long", i.e. there | |
| 2710 is a non-nil, non-keymap binding for a prefix of | |
| 2711 the event chain) | |
| 2712 -- a keymap (part of a command has been specified) | |
| 2713 -- a command (anything that satisfies `commandp'; this includes | |
| 2714 some symbols, lists, subrs, strings, vectors, and | |
| 2715 compiled-function objects) */ | |
| 2716 Lisp_Object | |
| 2717 event_binding (Lisp_Object event0, int accept_default) | |
| 2718 { | |
| 2719 /* This function can GC */ | |
| 2720 Lisp_Object maps[100]; | |
| 2721 int nmaps; | |
| 2722 | |
| 2723 assert (EVENTP (event0)); | |
| 2724 | |
| 2725 nmaps = get_relevant_keymaps (event0, countof (maps), maps); | |
| 2726 if (nmaps > countof (maps)) | |
| 2727 nmaps = countof (maps); | |
| 2728 return process_event_binding_result (lookup_events (event0, nmaps, maps, | |
| 2729 accept_default)); | |
| 2730 } | |
| 2731 | |
| 2732 /* like event_binding, but specify a keymap to search */ | |
| 2733 | |
| 2734 Lisp_Object | |
| 2735 event_binding_in (Lisp_Object event0, Lisp_Object keymap, int accept_default) | |
| 2736 { | |
| 2737 /* This function can GC */ | |
| 2738 if (!KEYMAPP (keymap)) | |
| 2739 return Qnil; | |
| 2740 | |
| 2741 return process_event_binding_result (lookup_events (event0, 1, &keymap, | |
| 2742 accept_default)); | |
| 2743 } | |
| 2744 | |
| 2745 /* Attempts to find a function key mapping corresponding to the | |
| 2746 event-sequence whose head is event0 (sequence is threaded through | |
| 2747 event_next). The return value will be the same as for event_binding(). */ | |
| 2748 Lisp_Object | |
| 2749 munging_key_map_event_binding (Lisp_Object event0, | |
| 2750 enum munge_me_out_the_door munge) | |
| 2751 { | |
| 2752 Lisp_Object keymap = (munge == MUNGE_ME_FUNCTION_KEY) ? | |
| 2753 CONSOLE_FUNCTION_KEY_MAP (event_console_or_selected (event0)) : | |
| 2754 Vkey_translation_map; | |
| 2755 | |
| 2756 if (NILP (keymap)) | |
| 2757 return Qnil; | |
| 2758 | |
| 2759 return process_event_binding_result (lookup_events (event0, 1, &keymap, 1)); | |
| 2760 } | |
| 2761 | |
| 2762 | |
| 2763 /************************************************************************/ | |
| 2764 /* Setting/querying the global and local maps */ | |
| 2765 /************************************************************************/ | |
| 2766 | |
| 2767 DEFUN ("use-global-map", Fuse_global_map, 1, 1, 0, /* | |
| 2768 Select KEYMAP as the global keymap. | |
| 2769 */ | |
| 2770 (keymap)) | |
| 2771 { | |
| 2772 /* This function can GC */ | |
| 2773 keymap = get_keymap (keymap, 1, 1); | |
| 2774 Vcurrent_global_map = keymap; | |
| 2775 return Qnil; | |
| 2776 } | |
| 2777 | |
| 2778 DEFUN ("use-local-map", Fuse_local_map, 1, 2, 0, /* | |
| 2779 Select KEYMAP as the local keymap in BUFFER. | |
| 2780 If KEYMAP is nil, that means no local keymap. | |
| 2781 If BUFFER is nil, the current buffer is assumed. | |
| 2782 */ | |
| 2783 (keymap, buffer)) | |
| 2784 { | |
| 2785 /* This function can GC */ | |
| 2786 struct buffer *b = decode_buffer (buffer, 0); | |
| 2787 if (!NILP (keymap)) | |
| 2788 keymap = get_keymap (keymap, 1, 1); | |
| 2789 | |
| 2790 b->keymap = keymap; | |
| 2791 | |
| 2792 return Qnil; | |
| 2793 } | |
| 2794 | |
| 2795 DEFUN ("current-local-map", Fcurrent_local_map, 0, 1, 0, /* | |
| 2796 Return BUFFER's local keymap, or nil if it has none. | |
| 2797 If BUFFER is nil, the current buffer is assumed. | |
| 2798 */ | |
| 2799 (buffer)) | |
| 2800 { | |
| 2801 struct buffer *b = decode_buffer (buffer, 0); | |
| 2802 return b->keymap; | |
| 2803 } | |
| 2804 | |
| 2805 DEFUN ("current-global-map", Fcurrent_global_map, 0, 0, 0, /* | |
| 2806 Return the current global keymap. | |
| 2807 */ | |
| 2808 ()) | |
| 2809 { | |
| 2810 return Vcurrent_global_map; | |
| 2811 } | |
| 2812 | |
| 2813 | |
| 2814 /************************************************************************/ | |
| 2815 /* Mapping over keymap elements */ | |
| 2816 /************************************************************************/ | |
| 2817 | |
| 2818 /* Since keymaps are arranged in a hierarchy, one keymap per bucky bit or | |
| 2819 prefix key, it's not entirely obvious what map-keymap should do, but | |
| 2820 what it does is: map over all keys in this map; then recursively map | |
| 2821 over all submaps of this map that are "bucky" submaps. This means that, | |
| 2822 when mapping over a keymap, it appears that "x" and "C-x" are in the | |
| 2823 same map, although "C-x" is really in the "control" submap of this one. | |
| 2824 However, since we don't recursively descend the submaps that are bound | |
| 2825 to prefix keys (like C-x, C-h, etc) the caller will have to recurse on | |
| 2826 those explicitly, if that's what they want. | |
| 2827 | |
| 2828 So the end result of this is that the bucky keymaps (the ones indexed | |
| 2829 under the large integers returned from MAKE_MODIFIER_HASH_KEY()) are | |
| 2830 invisible from elisp. They're just an implementation detail that code | |
| 2831 outside of this file doesn't need to know about. | |
| 2832 */ | |
| 2833 | |
| 2834 struct map_keymap_unsorted_closure | |
| 2835 { | |
| 934 | 2836 void (*fn) (const Lisp_Key_Data *, Lisp_Object binding, void *arg); |
| 428 | 2837 void *arg; |
| 442 | 2838 int modifiers; |
| 428 | 2839 }; |
| 2840 | |
| 2841 /* used by map_keymap() */ | |
| 2842 static int | |
| 2843 map_keymap_unsorted_mapper (Lisp_Object keysym, Lisp_Object value, | |
| 2844 void *map_keymap_unsorted_closure) | |
| 2845 { | |
| 2846 /* This function can GC */ | |
| 2847 struct map_keymap_unsorted_closure *closure = | |
| 2848 (struct map_keymap_unsorted_closure *) map_keymap_unsorted_closure; | |
| 442 | 2849 int modifiers = closure->modifiers; |
| 2850 int mod_bit; | |
| 428 | 2851 mod_bit = MODIFIER_HASH_KEY_BITS (keysym); |
| 2852 if (mod_bit != 0) | |
| 2853 { | |
| 2854 int omod = modifiers; | |
| 2855 closure->modifiers = (modifiers | mod_bit); | |
| 2856 value = get_keymap (value, 1, 0); | |
| 2857 elisp_maphash (map_keymap_unsorted_mapper, | |
| 2858 XKEYMAP (value)->table, | |
| 2859 map_keymap_unsorted_closure); | |
| 2860 closure->modifiers = omod; | |
| 2861 } | |
| 2862 else | |
| 2863 { | |
| 934 | 2864 Lisp_Key_Data key; |
| 428 | 2865 key.keysym = keysym; |
| 2866 key.modifiers = modifiers; | |
| 2867 ((*closure->fn) (&key, value, closure->arg)); | |
| 2868 } | |
| 2869 return 0; | |
| 2870 } | |
| 2871 | |
| 2872 | |
| 2873 struct map_keymap_sorted_closure | |
| 2874 { | |
| 2875 Lisp_Object *result_locative; | |
| 2876 }; | |
| 2877 | |
| 2878 /* used by map_keymap_sorted() */ | |
| 2879 static int | |
| 2880 map_keymap_sorted_mapper (Lisp_Object key, Lisp_Object value, | |
| 2881 void *map_keymap_sorted_closure) | |
| 2882 { | |
| 2883 struct map_keymap_sorted_closure *cl = | |
| 2884 (struct map_keymap_sorted_closure *) map_keymap_sorted_closure; | |
| 2885 Lisp_Object *list = cl->result_locative; | |
| 2886 *list = Fcons (Fcons (key, value), *list); | |
| 2887 return 0; | |
| 2888 } | |
| 2889 | |
| 2890 | |
| 2891 /* used by map_keymap_sorted(), describe_map_sort_predicate(), | |
| 2892 and keymap_submaps(). | |
| 2893 */ | |
| 2894 static int | |
| 2895 map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, | |
| 2286 | 2896 Lisp_Object UNUSED (pred)) |
| 428 | 2897 { |
| 2898 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored. | |
| 2899 */ | |
| 442 | 2900 int bit1, bit2; |
| 428 | 2901 int sym1_p = 0; |
| 2902 int sym2_p = 0; | |
| 2828 | 2903 extern Lisp_Object Qcharacter_of_keysym; |
| 2904 | |
| 428 | 2905 obj1 = XCAR (obj1); |
| 2906 obj2 = XCAR (obj2); | |
| 2907 | |
| 2908 if (EQ (obj1, obj2)) | |
| 2909 return -1; | |
| 2910 bit1 = MODIFIER_HASH_KEY_BITS (obj1); | |
| 2911 bit2 = MODIFIER_HASH_KEY_BITS (obj2); | |
| 2912 | |
| 2828 | 2913 /* If either is a symbol with a Qcharacter_of_keysym property, then sort it by |
| 428 | 2914 that code instead of alphabetically. |
| 2915 */ | |
| 2916 if (! bit1 && SYMBOLP (obj1)) | |
| 2917 { | |
| 2828 | 2918 Lisp_Object code = Fget (obj1, Qcharacter_of_keysym, Qnil); |
| 428 | 2919 if (CHAR_OR_CHAR_INTP (code)) |
| 2920 { | |
| 2921 obj1 = code; | |
| 2922 CHECK_CHAR_COERCE_INT (obj1); | |
| 2923 sym1_p = 1; | |
| 2924 } | |
| 2925 } | |
| 2926 if (! bit2 && SYMBOLP (obj2)) | |
| 2927 { | |
| 2828 | 2928 Lisp_Object code = Fget (obj2, Qcharacter_of_keysym, Qnil); |
| 428 | 2929 if (CHAR_OR_CHAR_INTP (code)) |
| 2930 { | |
| 2931 obj2 = code; | |
| 2932 CHECK_CHAR_COERCE_INT (obj2); | |
| 2933 sym2_p = 1; | |
| 2934 } | |
| 2935 } | |
| 2936 | |
| 2937 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */ | |
| 2938 if (XTYPE (obj1) != XTYPE (obj2)) | |
| 2939 return SYMBOLP (obj2) ? 1 : -1; | |
| 2940 | |
| 2941 if (! bit1 && CHARP (obj1)) /* they're both ASCII */ | |
| 2942 { | |
| 2943 int o1 = XCHAR (obj1); | |
| 2944 int o2 = XCHAR (obj2); | |
| 2945 if (o1 == o2 && /* If one started out as a symbol and the */ | |
| 2946 sym1_p != sym2_p) /* other didn't, the symbol comes last. */ | |
| 2947 return sym2_p ? 1 : -1; | |
| 2948 | |
| 2949 return o1 < o2 ? 1 : -1; /* else just compare them */ | |
| 2950 } | |
| 2951 | |
| 2952 /* else they're both symbols. If they're both buckys, then order them. */ | |
| 2953 if (bit1 && bit2) | |
| 2954 return bit1 < bit2 ? 1 : -1; | |
| 2955 | |
| 2956 /* if only one is a bucky, then it comes later */ | |
| 2957 if (bit1 || bit2) | |
| 2958 return bit2 ? 1 : -1; | |
| 2959 | |
| 2960 /* otherwise, string-sort them. */ | |
| 2961 { | |
| 867 | 2962 Ibyte *s1 = XSTRING_DATA (XSYMBOL (obj1)->name); |
| 2963 Ibyte *s2 = XSTRING_DATA (XSYMBOL (obj2)->name); | |
| 793 | 2964 return 0 > qxestrcmp (s1, s2) ? 1 : -1; |
| 428 | 2965 } |
| 2966 } | |
| 2967 | |
| 2968 | |
| 2969 /* used by map_keymap() */ | |
| 2970 static void | |
| 2971 map_keymap_sorted (Lisp_Object keymap_table, | |
| 442 | 2972 int modifiers, |
| 934 | 2973 void (*function) (const Lisp_Key_Data *key, |
| 428 | 2974 Lisp_Object binding, |
| 2975 void *map_keymap_sorted_closure), | |
| 2976 void *map_keymap_sorted_closure) | |
| 2977 { | |
| 2978 /* This function can GC */ | |
| 2979 struct gcpro gcpro1; | |
| 2980 Lisp_Object contents = Qnil; | |
| 2981 | |
| 2982 if (XINT (Fhash_table_count (keymap_table)) == 0) | |
| 2983 return; | |
| 2984 | |
| 2985 GCPRO1 (contents); | |
| 2986 | |
| 2987 { | |
| 2988 struct map_keymap_sorted_closure c1; | |
| 2989 c1.result_locative = &contents; | |
| 2990 elisp_maphash (map_keymap_sorted_mapper, keymap_table, &c1); | |
| 2991 } | |
| 2992 contents = list_sort (contents, Qnil, map_keymap_sort_predicate); | |
| 2993 for (; !NILP (contents); contents = XCDR (contents)) | |
| 2994 { | |
| 2995 Lisp_Object keysym = XCAR (XCAR (contents)); | |
| 2996 Lisp_Object binding = XCDR (XCAR (contents)); | |
| 442 | 2997 int sub_bits = MODIFIER_HASH_KEY_BITS (keysym); |
| 428 | 2998 if (sub_bits != 0) |
| 2999 map_keymap_sorted (XKEYMAP (get_keymap (binding, | |
| 3000 1, 1))->table, | |
| 3001 (modifiers | sub_bits), | |
| 3002 function, | |
| 3003 map_keymap_sorted_closure); | |
| 3004 else | |
| 3005 { | |
| 934 | 3006 Lisp_Key_Data k; |
| 428 | 3007 k.keysym = keysym; |
| 3008 k.modifiers = modifiers; | |
| 3009 ((*function) (&k, binding, map_keymap_sorted_closure)); | |
| 3010 } | |
| 3011 } | |
| 3012 UNGCPRO; | |
| 3013 } | |
| 3014 | |
| 3015 | |
| 3016 /* used by Fmap_keymap() */ | |
| 3017 static void | |
| 934 | 3018 map_keymap_mapper (const Lisp_Key_Data *key, |
| 428 | 3019 Lisp_Object binding, |
| 3020 void *function) | |
| 3021 { | |
| 3022 /* This function can GC */ | |
| 3023 Lisp_Object fn; | |
| 5013 | 3024 fn = GET_LISP_FROM_VOID (function); |
| 428 | 3025 call2 (fn, make_key_description (key, 1), binding); |
| 3026 } | |
| 3027 | |
| 3028 | |
| 3029 static void | |
| 3030 map_keymap (Lisp_Object keymap_table, int sort_first, | |
| 934 | 3031 void (*function) (const Lisp_Key_Data *key, |
| 428 | 3032 Lisp_Object binding, |
| 3033 void *fn_arg), | |
| 3034 void *fn_arg) | |
| 3035 { | |
| 3036 /* This function can GC */ | |
| 3037 if (sort_first) | |
| 3038 map_keymap_sorted (keymap_table, 0, function, fn_arg); | |
| 3039 else | |
| 3040 { | |
| 3041 struct map_keymap_unsorted_closure map_keymap_unsorted_closure; | |
| 3042 map_keymap_unsorted_closure.fn = function; | |
| 3043 map_keymap_unsorted_closure.arg = fn_arg; | |
| 3044 map_keymap_unsorted_closure.modifiers = 0; | |
| 3045 elisp_maphash (map_keymap_unsorted_mapper, keymap_table, | |
| 3046 &map_keymap_unsorted_closure); | |
| 3047 } | |
| 3048 } | |
| 3049 | |
| 3050 DEFUN ("map-keymap", Fmap_keymap, 2, 3, 0, /* | |
| 3051 Apply FUNCTION to each element of KEYMAP. | |
| 3052 FUNCTION will be called with two arguments: a key-description list, and | |
| 3053 the binding. The order in which the elements of the keymap are passed to | |
| 3054 the function is unspecified. If the function inserts new elements into | |
| 3055 the keymap, it may or may not be called with them later. No element of | |
| 3056 the keymap will ever be passed to the function more than once. | |
| 3057 | |
| 3058 The function will not be called on elements of this keymap's parents | |
| 3059 \(see the function `keymap-parents') or upon keymaps which are contained | |
| 3060 within this keymap (multi-character definitions). | |
| 3061 It will be called on "meta" characters since they are not really | |
| 3062 two-character sequences. | |
| 3063 | |
| 3064 If the optional third argument SORT-FIRST is non-nil, then the elements of | |
| 3065 the keymap will be passed to the mapper function in a canonical order. | |
| 3066 Otherwise, they will be passed in hash (that is, random) order, which is | |
| 3067 faster. | |
| 3068 */ | |
| 3069 (function, keymap, sort_first)) | |
| 3070 { | |
| 3071 /* This function can GC */ | |
| 489 | 3072 struct gcpro gcpro1, gcpro2; |
| 428 | 3073 |
| 3074 /* tolerate obviously transposed args */ | |
| 3075 if (!NILP (Fkeymapp (function))) | |
| 3076 { | |
| 3077 Lisp_Object tmp = function; | |
| 3078 function = keymap; | |
| 3079 keymap = tmp; | |
| 3080 } | |
| 489 | 3081 GCPRO2 (function, keymap); |
| 428 | 3082 keymap = get_keymap (keymap, 1, 1); |
| 489 | 3083 map_keymap (XKEYMAP (keymap)->table, !NILP (sort_first), |
| 5013 | 3084 map_keymap_mapper, STORE_LISP_IN_VOID (function)); |
| 428 | 3085 UNGCPRO; |
| 3086 return Qnil; | |
| 3087 } | |
| 3088 | |
| 3089 | |
| 3090 | |
| 3091 /************************************************************************/ | |
| 3092 /* Accessible keymaps */ | |
| 3093 /************************************************************************/ | |
| 3094 | |
| 3095 struct accessible_keymaps_closure | |
| 3096 { | |
| 3097 Lisp_Object tail; | |
| 3098 }; | |
| 3099 | |
| 3100 | |
| 3101 static void | |
| 3102 accessible_keymaps_mapper_1 (Lisp_Object keysym, Lisp_Object contents, | |
| 442 | 3103 int modifiers, |
| 428 | 3104 struct accessible_keymaps_closure *closure) |
| 3105 { | |
| 3106 /* This function can GC */ | |
| 442 | 3107 int subbits = MODIFIER_HASH_KEY_BITS (keysym); |
| 428 | 3108 |
| 3109 if (subbits != 0) | |
| 3110 { | |
| 3111 Lisp_Object submaps; | |
| 3112 | |
| 3113 contents = get_keymap (contents, 1, 1); | |
| 3114 submaps = keymap_submaps (contents); | |
| 3115 for (; !NILP (submaps); submaps = XCDR (submaps)) | |
| 3116 { | |
| 3117 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)), | |
| 3118 XCDR (XCAR (submaps)), | |
| 3119 (subbits | modifiers), | |
| 3120 closure); | |
| 3121 } | |
| 3122 } | |
| 3123 else | |
| 3124 { | |
| 3125 Lisp_Object thisseq = Fcar (Fcar (closure->tail)); | |
| 3126 Lisp_Object cmd = get_keyelt (contents, 1); | |
| 3127 Lisp_Object vec; | |
| 3128 int j; | |
| 3129 int len; | |
| 934 | 3130 Lisp_Key_Data key; |
| 428 | 3131 key.keysym = keysym; |
| 3132 key.modifiers = modifiers; | |
| 3133 | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
3134 assert (!NILP (cmd)); |
| 428 | 3135 cmd = get_keymap (cmd, 0, 1); |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
3136 assert (KEYMAPP (cmd)); |
| 428 | 3137 |
| 3138 vec = make_vector (XVECTOR_LENGTH (thisseq) + 1, Qnil); | |
| 3139 len = XVECTOR_LENGTH (thisseq); | |
| 3140 for (j = 0; j < len; j++) | |
| 3141 XVECTOR_DATA (vec) [j] = XVECTOR_DATA (thisseq) [j]; | |
| 3142 XVECTOR_DATA (vec) [j] = make_key_description (&key, 1); | |
| 3143 | |
| 3144 nconc2 (closure->tail, list1 (Fcons (vec, cmd))); | |
| 3145 } | |
| 3146 } | |
| 3147 | |
| 3148 | |
| 3149 static Lisp_Object | |
| 3150 accessible_keymaps_keymap_mapper (Lisp_Object thismap, void *arg) | |
| 3151 { | |
| 3152 /* This function can GC */ | |
| 3153 struct accessible_keymaps_closure *closure = | |
| 3154 (struct accessible_keymaps_closure *) arg; | |
| 3155 Lisp_Object submaps = keymap_submaps (thismap); | |
| 3156 | |
| 3157 for (; !NILP (submaps); submaps = XCDR (submaps)) | |
| 3158 { | |
| 3159 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)), | |
| 3160 XCDR (XCAR (submaps)), | |
| 3161 0, | |
| 3162 closure); | |
| 3163 } | |
| 3164 return Qnil; | |
| 3165 } | |
| 3166 | |
| 3167 | |
| 3168 DEFUN ("accessible-keymaps", Faccessible_keymaps, 1, 2, 0, /* | |
| 3169 Find all keymaps accessible via prefix characters from KEYMAP. | |
| 3170 Returns a list of elements of the form (KEYS . MAP), where the sequence | |
| 3171 KEYS starting from KEYMAP gets you to MAP. These elements are ordered | |
| 3172 so that the KEYS increase in length. The first element is ([] . KEYMAP). | |
| 3173 An optional argument PREFIX, if non-nil, should be a key sequence; | |
| 3174 then the value includes only maps for prefixes that start with PREFIX. | |
| 3175 */ | |
| 3176 (keymap, prefix)) | |
| 3177 { | |
| 3178 /* This function can GC */ | |
| 3179 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
| 3180 Lisp_Object accessible_keymaps = Qnil; | |
| 3181 struct accessible_keymaps_closure c; | |
| 3182 c.tail = Qnil; | |
| 3183 GCPRO4 (accessible_keymaps, c.tail, prefix, keymap); | |
| 3184 | |
| 440 | 3185 keymap = get_keymap (keymap, 1, 1); |
| 3186 | |
| 428 | 3187 retry: |
| 3188 if (NILP (prefix)) | |
| 3189 { | |
| 440 | 3190 prefix = make_vector (0, Qnil); |
| 428 | 3191 } |
| 440 | 3192 else if (VECTORP (prefix) || STRINGP (prefix)) |
| 428 | 3193 { |
| 3194 int len = XINT (Flength (prefix)); | |
| 440 | 3195 Lisp_Object def; |
| 428 | 3196 Lisp_Object p; |
| 3197 int iii; | |
| 3198 struct gcpro ngcpro1; | |
| 3199 | |
| 440 | 3200 if (len == 0) |
| 3201 { | |
| 3202 prefix = Qnil; | |
| 3203 goto retry; | |
| 3204 } | |
| 3205 | |
| 3206 def = Flookup_key (keymap, prefix, Qnil); | |
| 428 | 3207 def = get_keymap (def, 0, 1); |
| 3208 if (!KEYMAPP (def)) | |
| 3209 goto RETURN; | |
| 3210 | |
| 3211 keymap = def; | |
| 3212 p = make_vector (len, Qnil); | |
| 3213 NGCPRO1 (p); | |
| 3214 for (iii = 0; iii < len; iii++) | |
| 3215 { | |
| 934 | 3216 Lisp_Key_Data key; |
| 428 | 3217 define_key_parser (Faref (prefix, make_int (iii)), &key); |
| 3218 XVECTOR_DATA (p)[iii] = make_key_description (&key, 1); | |
| 3219 } | |
| 3220 NUNGCPRO; | |
| 3221 prefix = p; | |
| 3222 } | |
| 440 | 3223 else |
| 3224 { | |
| 3225 prefix = wrong_type_argument (Qarrayp, prefix); | |
| 3226 goto retry; | |
| 3227 } | |
| 428 | 3228 |
| 3229 accessible_keymaps = list1 (Fcons (prefix, keymap)); | |
| 3230 | |
| 440 | 3231 /* For each map in the list maps, look at any other maps it points |
| 3232 to and stick them at the end if they are not already in the list */ | |
| 428 | 3233 |
| 3234 for (c.tail = accessible_keymaps; | |
| 3235 !NILP (c.tail); | |
| 3236 c.tail = XCDR (c.tail)) | |
| 3237 { | |
| 3238 Lisp_Object thismap = Fcdr (Fcar (c.tail)); | |
| 3239 CHECK_KEYMAP (thismap); | |
| 3240 traverse_keymaps (thismap, Qnil, | |
| 3241 accessible_keymaps_keymap_mapper, &c); | |
| 3242 } | |
| 3243 RETURN: | |
| 3244 UNGCPRO; | |
| 3245 return accessible_keymaps; | |
| 3246 } | |
| 3247 | |
| 3248 | |
| 3249 | |
| 3250 /************************************************************************/ | |
| 3251 /* Pretty descriptions of key sequences */ | |
| 3252 /************************************************************************/ | |
| 3253 | |
| 3254 DEFUN ("key-description", Fkey_description, 1, 1, 0, /* | |
| 3255 Return a pretty description of key-sequence KEYS. | |
| 3256 Control characters turn into "C-foo" sequences, meta into "M-foo", | |
| 3257 spaces are put between sequence elements, etc... | |
| 3258 */ | |
| 3259 (keys)) | |
| 3260 { | |
| 3261 if (CHAR_OR_CHAR_INTP (keys) || CONSP (keys) || SYMBOLP (keys) | |
| 3262 || EVENTP (keys)) | |
| 3263 { | |
| 3264 return Fsingle_key_description (keys); | |
| 3265 } | |
| 3266 else if (VECTORP (keys) || | |
| 3267 STRINGP (keys)) | |
| 3268 { | |
| 3269 Lisp_Object string = Qnil; | |
| 3270 /* Lisp_Object sep = Qnil; */ | |
| 3271 int size = XINT (Flength (keys)); | |
| 3272 int i; | |
| 3273 | |
| 3274 for (i = 0; i < size; i++) | |
| 3275 { | |
| 3276 Lisp_Object s2 = Fsingle_key_description | |
| 3277 (STRINGP (keys) | |
| 867 | 3278 ? make_char (string_ichar (keys, i)) |
| 428 | 3279 : XVECTOR_DATA (keys)[i]); |
| 3280 | |
| 3281 if (i == 0) | |
| 3282 string = s2; | |
| 3283 else | |
| 3284 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
3285 /* if (NILP (sep)) Lisp_Object sep = build_ascstring (" ") */; |
| 428 | 3286 string = concat2 (string, concat2 (Vsingle_space_string, s2)); |
| 3287 } | |
| 3288 } | |
| 3289 return string; | |
| 3290 } | |
| 3291 return Fkey_description (wrong_type_argument (Qsequencep, keys)); | |
| 3292 } | |
| 3293 | |
| 3294 DEFUN ("single-key-description", Fsingle_key_description, 1, 1, 0, /* | |
| 3295 Return a pretty description of command character KEY. | |
| 3296 Control characters turn into C-whatever, etc. | |
| 3297 This differs from `text-char-description' in that it returns a description | |
| 3298 of a key read from the user rather than a character from a buffer. | |
| 3299 */ | |
| 3300 (key)) | |
| 3301 { | |
| 3302 if (SYMBOLP (key)) | |
| 3303 key = Fcons (key, Qnil); /* sleaze sleaze */ | |
| 3304 | |
| 3305 if (EVENTP (key) || CHAR_OR_CHAR_INTP (key)) | |
| 3306 { | |
| 793 | 3307 DECLARE_EISTRING_MALLOC (buf); |
| 3308 Lisp_Object str; | |
| 3309 | |
| 428 | 3310 if (!EVENTP (key)) |
| 3311 { | |
| 934 | 3312 Lisp_Object event = Fmake_event (Qnil, Qnil); |
| 3313 CHECK_CHAR_COERCE_INT (key); | |
| 1204 | 3314 character_to_event (XCHAR (key), XEVENT (event), |
|
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3315 XCONSOLE (Vselected_console), |
|
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3316 high_bit_is_meta, 1); |
| 934 | 3317 format_event_object (buf, event, 1); |
| 1204 | 3318 Fdeallocate_event (event); |
| 934 | 3319 } |
| 3320 else | |
| 3321 format_event_object (buf, key, 1); | |
| 793 | 3322 str = eimake_string (buf); |
| 3323 eifree (buf); | |
| 3324 return str; | |
| 428 | 3325 } |
| 3326 | |
| 3327 if (CONSP (key)) | |
| 3328 { | |
| 793 | 3329 DECLARE_EISTRING (bufp); |
| 3330 | |
| 428 | 3331 Lisp_Object rest; |
| 3332 LIST_LOOP (rest, key) | |
| 3333 { | |
| 3334 Lisp_Object keysym = XCAR (rest); | |
| 2421 | 3335 if (EQ (keysym, Qcontrol)) eicat_ascii (bufp, "C-"); |
| 3336 else if (EQ (keysym, Qctrl)) eicat_ascii (bufp, "C-"); | |
| 3337 else if (EQ (keysym, Qmeta)) eicat_ascii (bufp, "M-"); | |
| 3338 else if (EQ (keysym, Qsuper)) eicat_ascii (bufp, "S-"); | |
| 3339 else if (EQ (keysym, Qhyper)) eicat_ascii (bufp, "H-"); | |
| 3340 else if (EQ (keysym, Qalt)) eicat_ascii (bufp, "A-"); | |
| 3341 else if (EQ (keysym, Qshift)) eicat_ascii (bufp, "Sh-"); | |
| 428 | 3342 else if (CHAR_OR_CHAR_INTP (keysym)) |
| 793 | 3343 eicat_ch (bufp, XCHAR_OR_CHAR_INT (keysym)); |
| 428 | 3344 else |
| 3345 { | |
| 3346 CHECK_SYMBOL (keysym); | |
| 3347 #if 0 /* This is bogus */ | |
| 2421 | 3348 if (EQ (keysym, QKlinefeed)) eicat_ascii (bufp, "LFD"); |
| 3349 else if (EQ (keysym, QKtab)) eicat_ascii (bufp, "TAB"); | |
| 3350 else if (EQ (keysym, QKreturn)) eicat_ascii (bufp, "RET"); | |
| 3351 else if (EQ (keysym, QKescape)) eicat_ascii (bufp, "ESC"); | |
| 3352 else if (EQ (keysym, QKdelete)) eicat_ascii (bufp, "DEL"); | |
| 3353 else if (EQ (keysym, QKspace)) eicat_ascii (bufp, "SPC"); | |
| 3354 else if (EQ (keysym, QKbackspace)) eicat_ascii (bufp, "BS"); | |
| 428 | 3355 else |
| 3356 #endif | |
| 793 | 3357 eicat_lstr (bufp, XSYMBOL (keysym)->name); |
| 428 | 3358 if (!NILP (XCDR (rest))) |
| 793 | 3359 invalid_argument ("Invalid key description", key); |
| 428 | 3360 } |
| 3361 } | |
| 793 | 3362 return eimake_string (bufp); |
| 428 | 3363 } |
| 3364 return Fsingle_key_description | |
| 3365 (wrong_type_argument (intern ("char-or-event-p"), key)); | |
| 3366 } | |
| 3367 | |
| 3368 DEFUN ("text-char-description", Ftext_char_description, 1, 1, 0, /* | |
| 3369 Return a pretty description of file-character CHR. | |
| 3370 Unprintable characters turn into "^char" or \\NNN, depending on the value | |
| 3371 of the `ctl-arrow' variable. | |
| 3372 This differs from `single-key-description' in that it returns a description | |
| 3373 of a character from a buffer rather than a key read from the user. | |
| 3374 */ | |
| 3375 (chr)) | |
| 3376 { | |
| 867 | 3377 Ibyte buf[200]; |
| 3378 Ibyte *p; | |
| 3379 Ichar c; | |
| 428 | 3380 Lisp_Object ctl_arrow = current_buffer->ctl_arrow; |
| 3381 int ctl_p = !NILP (ctl_arrow); | |
| 867 | 3382 Ichar printable_min = (CHAR_OR_CHAR_INTP (ctl_arrow) |
| 428 | 3383 ? XCHAR_OR_CHAR_INT (ctl_arrow) |
| 3384 : ((EQ (ctl_arrow, Qt) || NILP (ctl_arrow)) | |
| 3385 ? 256 : 160)); | |
| 3386 | |
| 3387 if (EVENTP (chr)) | |
| 3388 { | |
| 2862 | 3389 Lisp_Object ch = Fevent_to_character (chr, Qnil, Qnil, Qnil); |
| 428 | 3390 if (NILP (ch)) |
| 3391 return | |
| 563 | 3392 signal_continuable_error |
| 3393 (Qinvalid_argument, | |
| 2828 | 3394 "key has no character equivalent (that we know of)", |
| 3395 Fcopy_event (chr, Qnil)); | |
| 428 | 3396 chr = ch; |
| 3397 } | |
| 3398 | |
| 3399 CHECK_CHAR_COERCE_INT (chr); | |
| 3400 | |
| 3401 c = XCHAR (chr); | |
| 3402 p = buf; | |
| 3403 | |
| 3404 if (c >= printable_min) | |
| 3405 { | |
| 867 | 3406 p += set_itext_ichar (p, c); |
| 428 | 3407 } |
| 3408 else if (c < 040 && ctl_p) | |
| 3409 { | |
| 3410 *p++ = '^'; | |
| 3411 *p++ = c + 64; /* 'A' - 1 */ | |
| 3412 } | |
| 3413 else if (c == 0177) | |
| 3414 { | |
| 3415 *p++ = '^'; | |
| 3416 *p++ = '?'; | |
| 3417 } | |
| 3418 else if (c >= 0200 || c < 040) | |
| 3419 { | |
| 3420 *p++ = '\\'; | |
| 3421 #ifdef MULE | |
| 3422 /* !!#### This syntax is not readable. It will | |
| 3423 be interpreted as a 3-digit octal number rather | |
| 3424 than a 7-digit octal number. */ | |
| 3425 if (c >= 0400) | |
| 3426 { | |
| 3427 *p++ = '0' + ((c & 07000000) >> 18); | |
| 3428 *p++ = '0' + ((c & 0700000) >> 15); | |
| 3429 *p++ = '0' + ((c & 070000) >> 12); | |
| 3430 *p++ = '0' + ((c & 07000) >> 9); | |
| 3431 } | |
| 3432 #endif | |
| 3433 *p++ = '0' + ((c & 0700) >> 6); | |
| 3434 *p++ = '0' + ((c & 0070) >> 3); | |
| 3435 *p++ = '0' + ((c & 0007)); | |
| 3436 } | |
| 3437 else | |
| 3438 { | |
| 867 | 3439 p += set_itext_ichar (p, c); |
| 428 | 3440 } |
| 3441 | |
| 3442 *p = 0; | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3443 return build_istring (buf); |
| 428 | 3444 } |
| 3445 | |
| 3446 | |
| 3447 /************************************************************************/ | |
| 3448 /* where-is (mapping bindings to keys) */ | |
| 3449 /************************************************************************/ | |
| 3450 | |
| 3451 static Lisp_Object | |
| 3452 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps, | |
| 793 | 3453 Lisp_Object firstonly, Eistring *target_buffer); |
| 428 | 3454 |
| 3455 DEFUN ("where-is-internal", Fwhere_is_internal, 1, 5, 0, /* | |
| 3456 Return list of keys that invoke DEFINITION in KEYMAPS. | |
| 3457 KEYMAPS can be either a keymap (meaning search in that keymap and the | |
| 3458 current global keymap) or a list of keymaps (meaning search in exactly | |
| 3096 | 3459 those keymaps and no others). |
| 428 | 3460 |
| 3461 If optional 3rd arg FIRSTONLY is non-nil, return a vector representing | |
| 3462 the first key sequence found, rather than a list of all possible key | |
| 3463 sequences. | |
| 3464 | |
| 3096 | 3465 Optional 4th argument NOINDIRECT is ignored. (GNU Emacs uses it to allow |
| 3466 searching for an indirect keymap by inhibiting following of indirections to | |
| 3467 keymaps or slots, but XEmacs doesn't need it because keymaps are a type.) | |
| 3468 | |
| 3469 If optional 5th argument EVENT-OR-KEYS is non-nil and KEYMAPS is nil, | |
| 3470 search in the currently applicable maps for EVENT-OR-KEYS (this is | |
| 3471 equivalent to specifying `(current-keymaps EVENT-OR-KEYS)' as the | |
| 3472 argument to KEYMAPS). | |
| 428 | 3473 */ |
| 2286 | 3474 (definition, keymaps, firstonly, UNUSED (noindirect), event_or_keys)) |
| 428 | 3475 { |
| 3476 /* This function can GC */ | |
| 3477 Lisp_Object maps[100]; | |
| 3478 Lisp_Object *gubbish = maps; | |
| 3479 int nmaps; | |
| 3480 | |
| 3481 /* Get keymaps as an array */ | |
| 3482 if (NILP (keymaps)) | |
| 3483 { | |
| 3484 nmaps = get_relevant_keymaps (event_or_keys, countof (maps), | |
| 3485 gubbish); | |
| 3486 if (nmaps > countof (maps)) | |
| 3487 { | |
| 3488 gubbish = alloca_array (Lisp_Object, nmaps); | |
| 3489 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish); | |
| 3490 } | |
| 3491 } | |
| 3492 else if (CONSP (keymaps)) | |
| 3493 { | |
| 3494 Lisp_Object rest; | |
| 3495 int i; | |
| 3496 | |
| 3497 nmaps = XINT (Flength (keymaps)); | |
| 3498 if (nmaps > countof (maps)) | |
| 3499 { | |
| 3500 gubbish = alloca_array (Lisp_Object, nmaps); | |
| 3501 } | |
| 3502 for (rest = keymaps, i = 0; !NILP (rest); | |
| 3503 rest = XCDR (keymaps), i++) | |
| 3504 { | |
| 3505 gubbish[i] = get_keymap (XCAR (keymaps), 1, 1); | |
| 3506 } | |
| 3507 } | |
| 3508 else | |
| 3509 { | |
| 3510 nmaps = 1; | |
| 3511 gubbish[0] = get_keymap (keymaps, 1, 1); | |
| 3512 if (!EQ (gubbish[0], Vcurrent_global_map)) | |
| 3513 { | |
| 3514 gubbish[1] = Vcurrent_global_map; | |
| 3515 nmaps++; | |
| 3516 } | |
| 3517 } | |
| 3518 | |
| 3519 return where_is_internal (definition, gubbish, nmaps, firstonly, 0); | |
| 3520 } | |
| 3521 | |
| 3522 /* This function is like | |
| 3523 (key-description (where-is-internal definition nil t)) | |
| 3524 except that it writes its output into a (char *) buffer that you | |
| 3525 provide; it doesn't cons (or allocate memory) at all, so it's | |
| 3526 very fast. This is used by menubar.c. | |
| 3527 */ | |
| 3528 void | |
| 793 | 3529 where_is_to_char (Lisp_Object definition, Eistring *buffer) |
| 428 | 3530 { |
| 3531 /* This function can GC */ | |
| 3532 Lisp_Object maps[100]; | |
| 3533 Lisp_Object *gubbish = maps; | |
| 3534 int nmaps; | |
| 3535 | |
| 3536 /* Get keymaps as an array */ | |
| 3537 nmaps = get_relevant_keymaps (Qnil, countof (maps), gubbish); | |
| 3538 if (nmaps > countof (maps)) | |
| 3539 { | |
| 3540 gubbish = alloca_array (Lisp_Object, nmaps); | |
| 3541 nmaps = get_relevant_keymaps (Qnil, nmaps, gubbish); | |
| 3542 } | |
| 3543 | |
| 3544 where_is_internal (definition, maps, nmaps, Qt, buffer); | |
| 3545 } | |
| 3546 | |
| 3547 | |
| 3548 static Lisp_Object | |
| 934 | 3549 raw_keys_to_keys (Lisp_Key_Data *keys, int count) |
| 428 | 3550 { |
| 3551 Lisp_Object result = make_vector (count, Qnil); | |
| 3552 while (count--) | |
| 3553 XVECTOR_DATA (result) [count] = make_key_description (&(keys[count]), 1); | |
| 3554 return result; | |
| 3555 } | |
| 3556 | |
| 3557 | |
| 3558 static void | |
| 934 | 3559 format_raw_keys (Lisp_Key_Data *keys, int count, Eistring *buf) |
| 428 | 3560 { |
| 3561 int i; | |
| 934 | 3562 Lisp_Object event = Fmake_event (Qnil, Qnil); |
| 3563 XSET_EVENT_TYPE (event, key_press_event); | |
| 3564 XSET_EVENT_CHANNEL (event, Vselected_console); | |
| 428 | 3565 for (i = 0; i < count; i++) |
| 3566 { | |
| 1204 | 3567 XSET_EVENT_KEY_KEYSYM (event, keys[i].keysym); |
| 3568 XSET_EVENT_KEY_MODIFIERS (event, KEY_DATA_MODIFIERS (&keys[i])); | |
| 934 | 3569 format_event_object (buf, event, 1); |
| 793 | 3570 if (i < count - 1) |
| 2421 | 3571 eicat_ascii (buf, " "); |
| 428 | 3572 } |
| 1204 | 3573 Fdeallocate_event (event); |
| 428 | 3574 } |
| 3575 | |
| 3576 | |
| 3577 /* definition is the thing to look for. | |
| 3578 map is a keymap. | |
| 3579 shadow is an array of shadow_count keymaps; if there is a different | |
| 3580 binding in any of the keymaps of a key that we are considering | |
| 3581 returning, then we reconsider. | |
| 3582 firstonly means give up after finding the first match; | |
| 3583 keys_so_far and modifiers_so_far describe which map we're looking in; | |
| 3584 If we're in the "meta" submap of the map that "C-x 4" is bound to, | |
| 3585 then keys_so_far will be {(control x), \4}, and modifiers_so_far | |
| 442 | 3586 will be XEMACS_MOD_META. That is, keys_so_far is the chain of keys that we |
| 428 | 3587 have followed, and modifiers_so_far_so_far is the bits (partial keys) |
| 3588 beyond that. | |
| 3589 | |
| 3590 (keys_so_far is a global buffer and the keys_count arg says how much | |
| 3591 of it we're currently interested in.) | |
| 3592 | |
| 3593 If target_buffer is provided, then we write a key-description into it, | |
| 3594 to avoid consing a string. This only works with firstonly on. | |
| 3595 */ | |
| 3596 | |
| 3597 struct where_is_closure | |
| 3598 { | |
| 3599 Lisp_Object definition; | |
| 3600 Lisp_Object *shadow; | |
| 3601 int shadow_count; | |
| 3602 int firstonly; | |
| 3603 int keys_count; | |
| 442 | 3604 int modifiers_so_far; |
| 793 | 3605 Eistring *target_buffer; |
| 934 | 3606 Lisp_Key_Data *keys_so_far; |
| 428 | 3607 int keys_so_far_total_size; |
| 3608 int keys_so_far_malloced; | |
| 3609 }; | |
| 3610 | |
| 3611 static Lisp_Object where_is_recursive_mapper (Lisp_Object map, void *arg); | |
| 3612 | |
| 3613 static Lisp_Object | |
| 3614 where_is_recursive_mapper (Lisp_Object map, void *arg) | |
| 3615 { | |
| 3616 /* This function can GC */ | |
| 3617 struct where_is_closure *c = (struct where_is_closure *) arg; | |
| 3618 Lisp_Object definition = c->definition; | |
| 442 | 3619 const int firstonly = c->firstonly; |
| 3620 const int keys_count = c->keys_count; | |
| 3621 const int modifiers_so_far = c->modifiers_so_far; | |
| 793 | 3622 Eistring *target_buffer = c->target_buffer; |
| 428 | 3623 Lisp_Object keys = Fgethash (definition, |
| 3624 XKEYMAP (map)->inverse_table, | |
| 3625 Qnil); | |
| 3626 Lisp_Object submaps; | |
| 3627 Lisp_Object result = Qnil; | |
| 3628 | |
| 3629 if (!NILP (keys)) | |
| 3630 { | |
| 3631 /* One or more keys in this map match the definition we're looking for. | |
| 3632 Verify that these bindings aren't shadowed by other bindings | |
| 3633 in the shadow maps. Either nil or number as value from | |
| 3634 raw_lookup_key() means undefined. */ | |
| 934 | 3635 Lisp_Key_Data *so_far = c->keys_so_far; |
| 428 | 3636 |
| 3637 for (;;) /* loop over all keys that match */ | |
| 3638 { | |
| 3639 Lisp_Object k = CONSP (keys) ? XCAR (keys) : keys; | |
| 3640 int i; | |
| 3641 | |
| 3642 so_far [keys_count].keysym = k; | |
| 934 | 3643 SET_KEY_DATA_MODIFIERS (&so_far [keys_count], modifiers_so_far); |
| 428 | 3644 |
| 3645 /* now loop over all shadow maps */ | |
| 3646 for (i = 0; i < c->shadow_count; i++) | |
| 3647 { | |
| 3648 Lisp_Object shadowed = raw_lookup_key (c->shadow[i], | |
| 3649 so_far, | |
| 3650 keys_count + 1, | |
| 3651 0, 1); | |
| 3652 | |
| 3653 if (NILP (shadowed) || CHARP (shadowed) || | |
| 3654 EQ (shadowed, definition)) | |
| 3655 continue; /* we passed this test; it's not shadowed here. */ | |
| 3656 else | |
| 3657 /* ignore this key binding, since it actually has a | |
| 3658 different binding in a shadowing map */ | |
| 3659 goto c_doesnt_have_proper_loop_exit_statements; | |
| 3660 } | |
| 3661 | |
| 3662 /* OK, the key is for real */ | |
| 3663 if (target_buffer) | |
| 3664 { | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
3665 assert (firstonly); |
| 428 | 3666 format_raw_keys (so_far, keys_count + 1, target_buffer); |
| 3667 return make_int (1); | |
| 3668 } | |
| 3669 else if (firstonly) | |
| 3670 return raw_keys_to_keys (so_far, keys_count + 1); | |
| 3671 else | |
| 3672 result = Fcons (raw_keys_to_keys (so_far, keys_count + 1), | |
| 3673 result); | |
| 3674 | |
| 3675 c_doesnt_have_proper_loop_exit_statements: | |
| 3676 /* now on to the next matching key ... */ | |
| 3677 if (!CONSP (keys)) break; | |
| 3678 keys = XCDR (keys); | |
| 3679 } | |
| 3680 } | |
| 3681 | |
| 3682 /* Now search the sub-keymaps of this map. | |
| 3683 If we're in "firstonly" mode and have already found one, this | |
| 3684 point is not reached. If we get one from lower down, either | |
| 3685 return it immediately (in firstonly mode) or tack it onto the | |
| 3686 end of the ones we've gotten so far. | |
| 3687 */ | |
| 3688 for (submaps = keymap_submaps (map); | |
| 3689 !NILP (submaps); | |
| 3690 submaps = XCDR (submaps)) | |
| 3691 { | |
| 3692 Lisp_Object key = XCAR (XCAR (submaps)); | |
| 3693 Lisp_Object submap = XCDR (XCAR (submaps)); | |
| 442 | 3694 int lower_modifiers; |
| 428 | 3695 int lower_keys_count = keys_count; |
| 442 | 3696 int bucky; |
| 428 | 3697 |
| 3698 submap = get_keymap (submap, 0, 0); | |
| 3699 | |
| 3700 if (EQ (submap, map)) | |
| 3701 /* Arrgh! Some loser has introduced a loop... */ | |
| 3702 continue; | |
| 3703 | |
| 3704 /* If this is not a keymap, then that's probably because someone | |
| 3705 did an `fset' of a symbol that used to point to a map such that | |
| 3706 it no longer does. Sigh. Ignore this, and invalidate the cache | |
| 3707 so that it doesn't happen to us next time too. | |
| 3708 */ | |
| 3709 if (NILP (submap)) | |
| 3710 { | |
| 3711 XKEYMAP (map)->sub_maps_cache = Qt; | |
| 3712 continue; | |
| 3713 } | |
| 3714 | |
| 3715 /* If the map is a "bucky" map, then add a bit to the | |
| 3716 modifiers_so_far list. | |
| 3717 Otherwise, add a new raw_key onto the end of keys_so_far. | |
| 3718 */ | |
| 3719 bucky = MODIFIER_HASH_KEY_BITS (key); | |
| 3720 if (bucky != 0) | |
| 3721 lower_modifiers = (modifiers_so_far | bucky); | |
| 3722 else | |
| 3723 { | |
| 934 | 3724 Lisp_Key_Data *so_far = c->keys_so_far; |
| 428 | 3725 lower_modifiers = 0; |
| 3726 so_far [lower_keys_count].keysym = key; | |
| 934 | 3727 SET_KEY_DATA_MODIFIERS (&so_far [lower_keys_count], modifiers_so_far); |
| 428 | 3728 lower_keys_count++; |
| 3729 } | |
| 3730 | |
| 3731 if (lower_keys_count >= c->keys_so_far_total_size) | |
| 3732 { | |
| 3733 int size = lower_keys_count + 50; | |
| 3734 if (! c->keys_so_far_malloced) | |
| 3735 { | |
| 3025 | 3736 Lisp_Key_Data *new_ = xnew_array (Lisp_Key_Data, size); |
| 3737 memcpy ((void *)new_, (const void *)c->keys_so_far, | |
| 934 | 3738 c->keys_so_far_total_size * sizeof (Lisp_Key_Data)); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
3739 xfree (c->keys_so_far); |
| 3550 | 3740 c->keys_so_far = new_; |
| 428 | 3741 } |
| 3742 else | |
| 934 | 3743 XREALLOC_ARRAY (c->keys_so_far, Lisp_Key_Data, size); |
| 428 | 3744 |
| 3745 c->keys_so_far_total_size = size; | |
| 3746 c->keys_so_far_malloced = 1; | |
| 3747 } | |
| 3748 | |
| 3749 { | |
| 3750 Lisp_Object lower; | |
| 3751 | |
| 3752 c->keys_count = lower_keys_count; | |
| 3753 c->modifiers_so_far = lower_modifiers; | |
| 3754 | |
| 3755 lower = traverse_keymaps (submap, Qnil, where_is_recursive_mapper, c); | |
| 3756 | |
| 3757 c->keys_count = keys_count; | |
| 3758 c->modifiers_so_far = modifiers_so_far; | |
| 3759 | |
| 3760 if (!firstonly) | |
| 3761 result = nconc2 (lower, result); | |
| 3762 else if (!NILP (lower)) | |
| 3763 return lower; | |
| 3764 } | |
| 3765 } | |
| 3766 return result; | |
| 3767 } | |
| 3768 | |
| 3769 | |
| 3770 static Lisp_Object | |
| 3771 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps, | |
| 793 | 3772 Lisp_Object firstonly, Eistring *target_buffer) |
| 428 | 3773 { |
| 3774 /* This function can GC */ | |
| 3775 Lisp_Object result = Qnil; | |
| 3776 int i; | |
| 934 | 3777 Lisp_Key_Data raw[20]; |
| 428 | 3778 struct where_is_closure c; |
| 3779 | |
| 3780 c.definition = definition; | |
| 3781 c.shadow = maps; | |
| 3782 c.firstonly = !NILP (firstonly); | |
| 3783 c.target_buffer = target_buffer; | |
| 3784 c.keys_so_far = raw; | |
| 3785 c.keys_so_far_total_size = countof (raw); | |
| 3786 c.keys_so_far_malloced = 0; | |
| 3787 | |
| 3788 /* Loop over each of the maps, accumulating the keys found. | |
| 3789 For each map searched, all previous maps shadow this one | |
| 3790 so that bogus keys aren't listed. */ | |
| 3791 for (i = 0; i < nmaps; i++) | |
| 3792 { | |
| 3793 Lisp_Object this_result; | |
| 3794 c.shadow_count = i; | |
| 3795 /* Reset the things set in each iteration */ | |
| 3796 c.keys_count = 0; | |
| 3797 c.modifiers_so_far = 0; | |
| 3798 | |
| 3799 this_result = traverse_keymaps (maps[i], Qnil, where_is_recursive_mapper, | |
| 3800 &c); | |
| 3801 if (!NILP (firstonly)) | |
| 3802 { | |
| 3803 result = this_result; | |
| 3804 if (!NILP (result)) | |
| 3805 break; | |
| 3806 } | |
| 3807 else | |
| 3808 result = nconc2 (this_result, result); | |
| 3809 } | |
| 3810 | |
| 3811 if (NILP (firstonly)) | |
| 3812 result = Fnreverse (result); | |
| 3813 | |
| 3814 if (c.keys_so_far_malloced) | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
3815 xfree (c.keys_so_far); |
| 428 | 3816 return result; |
| 3817 } | |
| 3818 | |
| 3819 | |
| 3820 /************************************************************************/ | |
| 3821 /* Describing keymaps */ | |
| 3822 /************************************************************************/ | |
| 3823 | |
| 3824 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, 1, 5, 0, /* | |
| 3825 Insert a list of all defined keys and their definitions in MAP. | |
| 3826 Optional second argument ALL says whether to include even "uninteresting" | |
| 3827 definitions (ie symbols with a non-nil `suppress-keymap' property. | |
| 3828 Third argument SHADOW is a list of keymaps whose bindings shadow those | |
| 3829 of map; if a binding is present in any shadowing map, it is not printed. | |
| 3830 Fourth argument PREFIX, if non-nil, should be a key sequence; | |
| 3831 only bindings which start with that key sequence will be printed. | |
| 3832 Fifth argument MOUSE-ONLY-P says to only print bindings for mouse clicks. | |
| 3833 */ | |
| 3834 (map, all, shadow, prefix, mouse_only_p)) | |
| 3835 { | |
| 3836 /* This function can GC */ | |
| 3837 | |
| 3838 /* #### At some point, this function should be changed to accept a | |
| 3839 BUFFER argument. Currently, the BUFFER argument to | |
| 3840 describe_map_tree is being used only internally. */ | |
| 3841 describe_map_tree (map, NILP (all), shadow, prefix, | |
| 3842 !NILP (mouse_only_p), Fcurrent_buffer ()); | |
| 3843 return Qnil; | |
| 3844 } | |
| 3845 | |
| 3846 | |
| 3847 /* Insert a description of the key bindings in STARTMAP, | |
| 3848 followed by those of all maps reachable through STARTMAP. | |
| 3849 If PARTIAL is nonzero, omit certain "uninteresting" commands | |
| 3850 (such as `undefined'). | |
| 3851 If SHADOW is non-nil, it is a list of other maps; | |
| 3852 don't mention keys which would be shadowed by any of them | |
| 3853 If PREFIX is non-nil, only list bindings which start with those keys. | |
| 3854 */ | |
| 3855 | |
| 3856 void | |
| 3857 describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow, | |
| 3858 Lisp_Object prefix, int mice_only_p, Lisp_Object buffer) | |
| 3859 { | |
| 3860 /* This function can GC */ | |
| 3861 Lisp_Object maps = Qnil; | |
| 3862 struct gcpro gcpro1, gcpro2; /* get_keymap may autoload */ | |
| 3863 GCPRO2 (maps, shadow); | |
| 3864 | |
| 3865 maps = Faccessible_keymaps (startmap, prefix); | |
| 3866 | |
| 3867 for (; !NILP (maps); maps = Fcdr (maps)) | |
| 3868 { | |
| 3869 Lisp_Object sub_shadow = Qnil; | |
| 3870 Lisp_Object elt = Fcar (maps); | |
| 3871 Lisp_Object tail; | |
| 3872 int no_prefix = (VECTORP (Fcar (elt)) | |
| 3873 && XINT (Flength (Fcar (elt))) == 0); | |
| 3874 struct gcpro ngcpro1, ngcpro2, ngcpro3; | |
| 3875 NGCPRO3 (sub_shadow, elt, tail); | |
| 3876 | |
| 3877 for (tail = shadow; CONSP (tail); tail = XCDR (tail)) | |
| 3878 { | |
| 3879 Lisp_Object shmap = XCAR (tail); | |
| 3880 | |
| 3881 /* If the sequence by which we reach this keymap is zero-length, | |
| 3882 then the shadow maps for this keymap are just SHADOW. */ | |
| 3883 if (no_prefix) | |
| 3884 ; | |
| 3885 /* If the sequence by which we reach this keymap actually has | |
| 3886 some elements, then the sequence's definition in SHADOW is | |
| 3887 what we should use. */ | |
| 3888 else | |
| 3889 { | |
| 3890 shmap = Flookup_key (shmap, Fcar (elt), Qt); | |
| 3891 if (CHARP (shmap)) | |
| 3892 shmap = Qnil; | |
| 3893 } | |
| 3894 | |
| 3895 if (!NILP (shmap)) | |
| 3896 { | |
| 3897 Lisp_Object shm = get_keymap (shmap, 0, 1); | |
| 3898 /* If shmap is not nil and not a keymap, it completely | |
| 3899 shadows this map, so don't describe this map at all. */ | |
| 3900 if (!KEYMAPP (shm)) | |
| 3901 goto SKIP; | |
| 3902 sub_shadow = Fcons (shm, sub_shadow); | |
| 3903 } | |
| 3904 } | |
| 3905 | |
| 3906 { | |
| 3907 /* Describe the contents of map MAP, assuming that this map | |
| 3908 itself is reached by the sequence of prefix keys KEYS (a vector). | |
| 3909 PARTIAL and SHADOW are as in `describe_map_tree'. */ | |
| 3910 Lisp_Object keysdesc | |
| 3911 = ((!no_prefix) | |
| 3912 ? concat2 (Fkey_description (Fcar (elt)), Vsingle_space_string) | |
| 3913 : Qnil); | |
| 3914 describe_map (Fcdr (elt), keysdesc, | |
| 3915 describe_command, | |
| 3916 partial, | |
| 3917 sub_shadow, | |
| 3918 mice_only_p, | |
| 3919 buffer); | |
| 3920 } | |
| 3921 SKIP: | |
| 3922 NUNGCPRO; | |
| 3923 } | |
| 3924 UNGCPRO; | |
| 3925 } | |
| 3926 | |
| 3927 | |
| 3928 static void | |
| 3929 describe_command (Lisp_Object definition, Lisp_Object buffer) | |
| 3930 { | |
| 3931 /* This function can GC */ | |
| 3932 int keymapp = !NILP (Fkeymapp (definition)); | |
| 3933 struct gcpro gcpro1; | |
| 3934 GCPRO1 (definition); | |
| 3935 | |
| 3936 Findent_to (make_int (16), make_int (3), buffer); | |
| 3937 if (keymapp) | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3938 buffer_insert_ascstring (XBUFFER (buffer), "<< "); |
| 428 | 3939 |
| 3940 if (SYMBOLP (definition)) | |
| 3941 { | |
| 3942 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (definition)); | |
| 3943 } | |
| 3944 else if (STRINGP (definition) || VECTORP (definition)) | |
| 3945 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3946 buffer_insert_ascstring (XBUFFER (buffer), "Kbd Macro: "); |
| 428 | 3947 buffer_insert1 (XBUFFER (buffer), Fkey_description (definition)); |
| 3948 } | |
| 3949 else if (COMPILED_FUNCTIONP (definition)) | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3950 buffer_insert_ascstring (XBUFFER (buffer), "Anonymous Compiled Function"); |
| 428 | 3951 else if (CONSP (definition) && EQ (XCAR (definition), Qlambda)) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3952 buffer_insert_ascstring (XBUFFER (buffer), "Anonymous Lambda"); |
| 428 | 3953 else if (KEYMAPP (definition)) |
| 3954 { | |
| 3955 Lisp_Object name = XKEYMAP (definition)->name; | |
| 3956 if (STRINGP (name) || (SYMBOLP (name) && !NILP (name))) | |
| 3957 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3958 buffer_insert_ascstring (XBUFFER (buffer), "Prefix command "); |
| 428 | 3959 if (SYMBOLP (name) |
| 3960 && EQ (find_symbol_value (name), definition)) | |
| 3961 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (name)); | |
| 3962 else | |
| 3963 { | |
| 3964 buffer_insert1 (XBUFFER (buffer), Fprin1_to_string (name, Qnil)); | |
| 3965 } | |
| 3966 } | |
| 3967 else | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3968 buffer_insert_ascstring (XBUFFER (buffer), "Prefix Command"); |
| 428 | 3969 } |
| 3970 else | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3971 buffer_insert_ascstring (XBUFFER (buffer), "??"); |
| 428 | 3972 |
| 3973 if (keymapp) | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3974 buffer_insert_ascstring (XBUFFER (buffer), " >>"); |
|
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3975 buffer_insert_ascstring (XBUFFER (buffer), "\n"); |
| 428 | 3976 UNGCPRO; |
| 3977 } | |
| 3978 | |
| 3979 struct describe_map_closure | |
| 3980 { | |
| 3981 Lisp_Object *list; /* pointer to the list to update */ | |
| 3982 Lisp_Object partial; /* whether to ignore suppressed commands */ | |
| 3983 Lisp_Object shadow; /* list of maps shadowing this one */ | |
| 3984 Lisp_Object self; /* this map */ | |
| 3985 Lisp_Object self_root; /* this map, or some map that has this map as | |
| 3986 a parent. this is the base of the tree */ | |
| 3987 int mice_only_p; /* whether we are to display only button bindings */ | |
| 3988 }; | |
| 3989 | |
| 3990 struct describe_map_shadow_closure | |
| 3991 { | |
| 934 | 3992 const Lisp_Key_Data *raw_key; |
| 428 | 3993 Lisp_Object self; |
| 3994 }; | |
| 3995 | |
| 3996 static Lisp_Object | |
| 3997 describe_map_mapper_shadow_search (Lisp_Object map, void *arg) | |
| 3998 { | |
| 3999 struct describe_map_shadow_closure *c = | |
| 4000 (struct describe_map_shadow_closure *) arg; | |
| 4001 | |
| 4002 if (EQ (map, c->self)) | |
| 4003 return Qzero; /* Not shadowed; terminate search */ | |
| 4004 | |
| 934 | 4005 return !NILP (keymap_lookup_directly (map, |
| 4006 KEY_DATA_KEYSYM (c->raw_key), | |
| 4007 KEY_DATA_MODIFIERS (c->raw_key))) | |
| 428 | 4008 ? Qt : Qnil; |
| 4009 } | |
| 4010 | |
| 4011 | |
| 4012 static Lisp_Object | |
| 4013 keymap_lookup_inherited_mapper (Lisp_Object km, void *arg) | |
| 4014 { | |
| 934 | 4015 Lisp_Key_Data *k = (Lisp_Key_Data *) arg; |
| 4016 return keymap_lookup_directly (km, KEY_DATA_KEYSYM (k), KEY_DATA_MODIFIERS (k)); | |
| 428 | 4017 } |
| 4018 | |
| 4019 | |
| 4020 static void | |
| 934 | 4021 describe_map_mapper (const Lisp_Key_Data *key, |
| 428 | 4022 Lisp_Object binding, |
| 4023 void *describe_map_closure) | |
| 4024 { | |
| 4025 /* This function can GC */ | |
| 4026 struct describe_map_closure *closure = | |
| 4027 (struct describe_map_closure *) describe_map_closure; | |
| 934 | 4028 Lisp_Object keysym = KEY_DATA_KEYSYM (key); |
| 4029 int modifiers = KEY_DATA_MODIFIERS (key); | |
| 428 | 4030 |
| 4031 /* Don't mention suppressed commands. */ | |
| 4032 if (SYMBOLP (binding) | |
| 4033 && !NILP (closure->partial) | |
| 4034 && !NILP (Fget (binding, closure->partial, Qnil))) | |
| 4035 return; | |
| 4036 | |
| 4037 /* If we're only supposed to display mouse bindings and this isn't one, | |
| 4038 then bug out. */ | |
| 4039 if (closure->mice_only_p && | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4040 (! ( |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4041 #define INCLUDE_BUTTON_ZERO |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4042 #define FROB(num) EQ (keysym, Qbutton##num) || \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4043 EQ (keysym, Qbutton##num##up) || |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4044 #include "keymap-buttons.h" |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4045 0))) |
| 428 | 4046 return; |
| 4047 | |
| 4048 /* If this command in this map is shadowed by some other map, ignore it. */ | |
| 4049 { | |
| 4050 Lisp_Object tail; | |
| 4051 | |
| 4052 for (tail = closure->shadow; CONSP (tail); tail = XCDR (tail)) | |
| 4053 { | |
| 4054 QUIT; | |
| 4055 if (!NILP (traverse_keymaps (XCAR (tail), Qnil, | |
| 4056 keymap_lookup_inherited_mapper, | |
| 4057 /* Cast to discard `const' */ | |
| 4058 (void *)key))) | |
| 4059 return; | |
| 4060 } | |
| 4061 } | |
| 4062 | |
| 4063 /* If this key is in some map of which this map is a parent, then ignore | |
| 4064 it (in that case, it has been shadowed). | |
| 4065 */ | |
| 4066 { | |
| 4067 Lisp_Object sh; | |
| 4068 struct describe_map_shadow_closure c; | |
| 4069 c.raw_key = key; | |
| 4070 c.self = closure->self; | |
| 4071 | |
| 4072 sh = traverse_keymaps (closure->self_root, Qnil, | |
| 4073 describe_map_mapper_shadow_search, &c); | |
| 4074 if (!NILP (sh) && !ZEROP (sh)) | |
| 4075 return; | |
| 4076 } | |
| 4077 | |
| 4078 /* Otherwise add it to the list to be sorted. */ | |
| 4079 *(closure->list) = Fcons (Fcons (Fcons (keysym, make_int (modifiers)), | |
| 4080 binding), | |
| 4081 *(closure->list)); | |
| 4082 } | |
| 4083 | |
| 4084 | |
| 4085 static int | |
| 4086 describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, | |
| 4087 Lisp_Object pred) | |
| 4088 { | |
| 4089 /* obj1 and obj2 are conses of the form | |
| 4090 ( ( <keysym> . <modifiers> ) . <binding> ) | |
| 4091 keysym and modifiers are used, binding is ignored. | |
| 4092 */ | |
| 442 | 4093 int bit1, bit2; |
| 428 | 4094 obj1 = XCAR (obj1); |
| 4095 obj2 = XCAR (obj2); | |
| 4096 bit1 = XINT (XCDR (obj1)); | |
| 4097 bit2 = XINT (XCDR (obj2)); | |
| 4098 if (bit1 != bit2) | |
| 4099 return bit1 < bit2 ? 1 : -1; | |
| 4100 else | |
| 4101 return map_keymap_sort_predicate (obj1, obj2, pred); | |
| 4102 } | |
| 4103 | |
| 4104 /* Elide 2 or more consecutive numeric keysyms bound to the same thing, | |
| 4105 or 2 or more symbolic keysyms that are bound to the same thing and | |
| 4106 have consecutive character-set-properties. | |
| 4107 */ | |
| 4108 static int | |
| 4109 elide_next_two_p (Lisp_Object list) | |
| 4110 { | |
| 4111 Lisp_Object s1, s2; | |
| 2828 | 4112 extern Lisp_Object Qcharacter_of_keysym; |
| 428 | 4113 |
| 4114 if (NILP (XCDR (list))) | |
| 4115 return 0; | |
| 4116 | |
| 4117 /* next two bindings differ */ | |
| 4118 if (!EQ (XCDR (XCAR (list)), | |
| 4119 XCDR (XCAR (XCDR (list))))) | |
| 4120 return 0; | |
| 4121 | |
| 4122 /* next two modifier-sets differ */ | |
| 4123 if (!EQ (XCDR (XCAR (XCAR (list))), | |
| 4124 XCDR (XCAR (XCAR (XCDR (list)))))) | |
| 4125 return 0; | |
| 4126 | |
| 4127 s1 = XCAR (XCAR (XCAR (list))); | |
| 4128 s2 = XCAR (XCAR (XCAR (XCDR (list)))); | |
| 4129 | |
| 4130 if (SYMBOLP (s1)) | |
| 4131 { | |
| 2828 | 4132 Lisp_Object code = Fget (s1, Qcharacter_of_keysym, Qnil); |
| 428 | 4133 if (CHAR_OR_CHAR_INTP (code)) |
| 4134 { | |
| 4135 s1 = code; | |
| 4136 CHECK_CHAR_COERCE_INT (s1); | |
| 4137 } | |
| 4138 else return 0; | |
| 4139 } | |
| 4140 if (SYMBOLP (s2)) | |
| 4141 { | |
| 2828 | 4142 Lisp_Object code = Fget (s2, Qcharacter_of_keysym, Qnil); |
| 428 | 4143 if (CHAR_OR_CHAR_INTP (code)) |
| 4144 { | |
| 4145 s2 = code; | |
| 4146 CHECK_CHAR_COERCE_INT (s2); | |
| 4147 } | |
| 4148 else return 0; | |
| 4149 } | |
| 4150 | |
| 4151 return (XCHAR (s1) == XCHAR (s2) || | |
| 4152 XCHAR (s1) + 1 == XCHAR (s2)); | |
| 4153 } | |
| 4154 | |
| 4155 | |
| 4156 static Lisp_Object | |
| 4157 describe_map_parent_mapper (Lisp_Object keymap, void *arg) | |
| 4158 { | |
| 4159 /* This function can GC */ | |
| 4160 struct describe_map_closure *describe_map_closure = | |
| 4161 (struct describe_map_closure *) arg; | |
| 4162 describe_map_closure->self = keymap; | |
| 4163 map_keymap (XKEYMAP (keymap)->table, | |
| 4164 0, /* don't sort: we'll do it later */ | |
| 4165 describe_map_mapper, describe_map_closure); | |
| 4166 return Qnil; | |
| 4167 } | |
| 4168 | |
| 4169 | |
| 4170 /* Describe the contents of map MAP, assuming that this map itself is | |
| 4171 reached by the sequence of prefix keys KEYS (a string or vector). | |
| 4172 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */ | |
| 4173 | |
| 4174 static void | |
| 4175 describe_map (Lisp_Object keymap, Lisp_Object elt_prefix, | |
| 4176 void (*elt_describer) (Lisp_Object, Lisp_Object), | |
| 4177 int partial, | |
| 4178 Lisp_Object shadow, | |
| 4179 int mice_only_p, | |
| 4180 Lisp_Object buffer) | |
| 4181 { | |
| 4182 /* This function can GC */ | |
| 4183 struct describe_map_closure describe_map_closure; | |
| 4184 Lisp_Object list = Qnil; | |
| 4185 struct buffer *buf = XBUFFER (buffer); | |
| 867 | 4186 Ichar printable_min = (CHAR_OR_CHAR_INTP (buf->ctl_arrow) |
| 428 | 4187 ? XCHAR_OR_CHAR_INT (buf->ctl_arrow) |
| 4188 : ((EQ (buf->ctl_arrow, Qt) | |
| 4189 || EQ (buf->ctl_arrow, Qnil)) | |
| 4190 ? 256 : 160)); | |
| 4191 int elided = 0; | |
| 4192 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
| 2828 | 4193 extern Lisp_Object Qcharacter_of_keysym; |
| 428 | 4194 |
| 4195 keymap = get_keymap (keymap, 1, 1); | |
| 4196 describe_map_closure.partial = (partial ? Qsuppress_keymap : Qnil); | |
| 4197 describe_map_closure.shadow = shadow; | |
| 4198 describe_map_closure.list = &list; | |
| 4199 describe_map_closure.self_root = keymap; | |
| 4200 describe_map_closure.mice_only_p = mice_only_p; | |
| 4201 | |
| 4202 GCPRO4 (keymap, elt_prefix, shadow, list); | |
| 4203 | |
| 4204 traverse_keymaps (keymap, Qnil, | |
| 4205 describe_map_parent_mapper, &describe_map_closure); | |
| 4206 | |
| 4207 if (!NILP (list)) | |
| 4208 { | |
| 4209 list = list_sort (list, Qnil, describe_map_sort_predicate); | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4210 buffer_insert_ascstring (buf, "\n"); |
| 428 | 4211 while (!NILP (list)) |
| 4212 { | |
| 4213 Lisp_Object elt = XCAR (XCAR (list)); | |
| 4214 Lisp_Object keysym = XCAR (elt); | |
| 442 | 4215 int modifiers = XINT (XCDR (elt)); |
| 428 | 4216 |
| 4217 if (!NILP (elt_prefix)) | |
| 4218 buffer_insert_lisp_string (buf, elt_prefix); | |
| 4219 | |
| 442 | 4220 if (modifiers & XEMACS_MOD_META) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4221 buffer_insert_ascstring (buf, "M-"); |
| 442 | 4222 if (modifiers & XEMACS_MOD_CONTROL) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4223 buffer_insert_ascstring (buf, "C-"); |
| 442 | 4224 if (modifiers & XEMACS_MOD_SUPER) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4225 buffer_insert_ascstring (buf, "S-"); |
| 442 | 4226 if (modifiers & XEMACS_MOD_HYPER) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4227 buffer_insert_ascstring (buf, "H-"); |
| 442 | 4228 if (modifiers & XEMACS_MOD_ALT) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4229 buffer_insert_ascstring (buf, "Alt-"); |
| 442 | 4230 if (modifiers & XEMACS_MOD_SHIFT) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4231 buffer_insert_ascstring (buf, "Sh-"); |
| 428 | 4232 if (SYMBOLP (keysym)) |
| 4233 { | |
| 2828 | 4234 Lisp_Object code = Fget (keysym, Qcharacter_of_keysym, Qnil); |
| 867 | 4235 Ichar c = (CHAR_OR_CHAR_INTP (code) |
| 4236 ? XCHAR_OR_CHAR_INT (code) : (Ichar) -1); | |
| 428 | 4237 /* Calling Fsingle_key_description() would cons more */ |
| 4238 #if 0 /* This is bogus */ | |
| 4239 if (EQ (keysym, QKlinefeed)) | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4240 buffer_insert_ascstring (buf, "LFD"); |
| 428 | 4241 else if (EQ (keysym, QKtab)) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4242 buffer_insert_ascstring (buf, "TAB"); |
| 428 | 4243 else if (EQ (keysym, QKreturn)) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4244 buffer_insert_ascstring (buf, "RET"); |
| 428 | 4245 else if (EQ (keysym, QKescape)) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4246 buffer_insert_ascstring (buf, "ESC"); |
| 428 | 4247 else if (EQ (keysym, QKdelete)) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4248 buffer_insert_ascstring (buf, "DEL"); |
| 428 | 4249 else if (EQ (keysym, QKspace)) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4250 buffer_insert_ascstring (buf, "SPC"); |
| 428 | 4251 else if (EQ (keysym, QKbackspace)) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4252 buffer_insert_ascstring (buf, "BS"); |
| 428 | 4253 else |
| 4254 #endif | |
| 4255 if (c >= printable_min) | |
| 4256 buffer_insert_emacs_char (buf, c); | |
| 4257 else buffer_insert1 (buf, Fsymbol_name (keysym)); | |
| 4258 } | |
| 4259 else if (CHARP (keysym)) | |
| 4260 buffer_insert_emacs_char (buf, XCHAR (keysym)); | |
| 4261 else | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4262 buffer_insert_ascstring (buf, "---bad keysym---"); |
| 428 | 4263 |
| 4264 if (elided) | |
| 4265 elided = 0; | |
| 4266 else | |
| 4267 { | |
| 4268 int k = 0; | |
| 4269 | |
| 4270 while (elide_next_two_p (list)) | |
| 4271 { | |
| 4272 k++; | |
| 4273 list = XCDR (list); | |
| 4274 } | |
| 4275 if (k != 0) | |
| 4276 { | |
| 4277 if (k == 1) | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4278 buffer_insert_ascstring (buf, ", "); |
| 428 | 4279 else |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
4280 buffer_insert_ascstring (buf, " .. "); |
| 428 | 4281 elided = 1; |
| 4282 continue; | |
| 4283 } | |
| 4284 } | |
| 4285 | |
| 4286 /* Print a description of the definition of this character. */ | |
| 4287 (*elt_describer) (XCDR (XCAR (list)), buffer); | |
| 4288 list = XCDR (list); | |
| 4289 } | |
| 4290 } | |
| 4291 UNGCPRO; | |
| 4292 } | |
| 4293 | |
| 4294 | |
| 4295 void | |
| 4296 syms_of_keymap (void) | |
| 4297 { | |
| 442 | 4298 INIT_LRECORD_IMPLEMENTATION (keymap); |
| 4299 | |
| 502 | 4300 DEFSYMBOL (Qminor_mode_map_alist); |
| 4301 | |
| 4302 DEFSYMBOL (Qkeymapp); | |
| 4303 | |
| 4304 DEFSYMBOL (Qsuppress_keymap); | |
| 4305 | |
| 4306 DEFSYMBOL (Qmodeline_map); | |
| 4307 DEFSYMBOL (Qtoolbar_map); | |
| 428 | 4308 |
| 4309 DEFSUBR (Fkeymap_parents); | |
| 4310 DEFSUBR (Fset_keymap_parents); | |
| 4311 DEFSUBR (Fkeymap_name); | |
| 4312 DEFSUBR (Fset_keymap_name); | |
| 4313 DEFSUBR (Fkeymap_prompt); | |
| 4314 DEFSUBR (Fset_keymap_prompt); | |
| 4315 DEFSUBR (Fkeymap_default_binding); | |
| 4316 DEFSUBR (Fset_keymap_default_binding); | |
| 4317 | |
| 4318 DEFSUBR (Fkeymapp); | |
| 4319 DEFSUBR (Fmake_keymap); | |
| 4320 DEFSUBR (Fmake_sparse_keymap); | |
| 4321 | |
| 4322 DEFSUBR (Fcopy_keymap); | |
| 4323 DEFSUBR (Fkeymap_fullness); | |
| 4324 DEFSUBR (Fmap_keymap); | |
| 4325 DEFSUBR (Fevent_matches_key_specifier_p); | |
| 4326 DEFSUBR (Fdefine_key); | |
| 4327 DEFSUBR (Flookup_key); | |
| 4328 DEFSUBR (Fkey_binding); | |
| 4329 DEFSUBR (Fuse_global_map); | |
| 4330 DEFSUBR (Fuse_local_map); | |
| 4331 DEFSUBR (Fcurrent_local_map); | |
| 4332 DEFSUBR (Fcurrent_global_map); | |
| 4333 DEFSUBR (Fcurrent_keymaps); | |
| 4334 DEFSUBR (Faccessible_keymaps); | |
| 4335 DEFSUBR (Fkey_description); | |
| 4336 DEFSUBR (Fsingle_key_description); | |
| 4337 DEFSUBR (Fwhere_is_internal); | |
| 4338 DEFSUBR (Fdescribe_bindings_internal); | |
| 4339 | |
| 4340 DEFSUBR (Ftext_char_description); | |
| 4341 | |
| 502 | 4342 DEFSYMBOL (Qcontrol); |
| 4343 DEFSYMBOL (Qctrl); | |
| 4344 DEFSYMBOL (Qmeta); | |
| 4345 DEFSYMBOL (Qsuper); | |
| 4346 DEFSYMBOL (Qhyper); | |
| 4347 DEFSYMBOL (Qalt); | |
| 4348 DEFSYMBOL (Qshift); | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4349 #define INCLUDE_BUTTON_ZERO |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4350 #define FROB(num) \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4351 DEFSYMBOL (Qbutton##num); \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4352 DEFSYMBOL (Qbutton##num##up); |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4353 #include "keymap-buttons.h" |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4354 #define FROB(num) \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4355 DEFSYMBOL (Qmouse_##num); \ |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4356 DEFSYMBOL (Qdown_mouse_##num); |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4357 #include "keymap-buttons.h" |
| 502 | 4358 DEFSYMBOL (Qmenu_selection); |
| 4359 DEFSYMBOL (QLFD); | |
| 4360 DEFSYMBOL (QTAB); | |
| 4361 DEFSYMBOL (QRET); | |
| 4362 DEFSYMBOL (QESC); | |
| 4363 DEFSYMBOL (QDEL); | |
| 4364 DEFSYMBOL (QSPC); | |
| 4365 DEFSYMBOL (QBS); | |
| 428 | 4366 } |
| 4367 | |
| 4368 void | |
| 4369 vars_of_keymap (void) | |
| 4370 { | |
| 4371 DEFVAR_LISP ("meta-prefix-char", &Vmeta_prefix_char /* | |
| 4372 Meta-prefix character. | |
| 4373 This character followed by some character `foo' turns into `Meta-foo'. | |
| 4374 This can be any form recognized as a single key specifier. | |
| 4375 To disable the meta-prefix-char, set it to a negative number. | |
| 4376 */ ); | |
| 4377 Vmeta_prefix_char = make_char (033); | |
| 4378 | |
| 4379 DEFVAR_LISP ("mouse-grabbed-buffer", &Vmouse_grabbed_buffer /* | |
| 4380 A buffer which should be consulted first for all mouse activity. | |
| 4381 When a mouse-click is processed, it will first be looked up in the | |
| 4382 local-map of this buffer, and then through the normal mechanism if there | |
| 4383 is no binding for that click. This buffer's value of `mode-motion-hook' | |
| 4384 will be consulted instead of the `mode-motion-hook' of the buffer of the | |
| 4385 window under the mouse. You should *bind* this, not set it. | |
| 4386 */ ); | |
| 4387 Vmouse_grabbed_buffer = Qnil; | |
| 4388 | |
| 4389 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map /* | |
| 4390 Keymap that overrides all other local keymaps. | |
| 4391 If this variable is non-nil, it is used as a keymap instead of the | |
| 4392 buffer's local map, and the minor mode keymaps and extent-local keymaps. | |
| 4393 You should *bind* this, not set it. | |
| 4394 */ ); | |
| 4395 Voverriding_local_map = Qnil; | |
| 4396 | |
| 4397 Fset (Qminor_mode_map_alist, Qnil); | |
| 4398 | |
| 4399 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map /* | |
| 4400 Keymap of key translations that can override keymaps. | |
| 2027 | 4401 |
| 4402 This keymap works like `function-key-map', but is searched before it, | |
| 428 | 4403 and applies even for keys that have ordinary bindings. |
| 2027 | 4404 |
| 4405 The `read-key-sequence' function replaces any subsequence bound by | |
| 4406 `key-translation-map' with its binding. More precisely, when the active | |
| 4407 keymaps have no binding for the current key sequence but | |
| 4408 `key-translation-map' binds a suffix of the sequence to a vector or string, | |
| 4409 `read-key-sequence' replaces the matching suffix with its binding, and | |
| 4410 continues with the new sequence. See `key-binding' for details. | |
| 4411 | |
| 4412 The events that come from bindings in `key-translation-map' are not | |
| 4413 themselves looked up in `key-translation-map'. | |
| 4414 | |
| 4415 #### FIXME: stolen from `function-key-map'; need better example. | |
| 4416 #### I guess you could implement a Dvorak keyboard with this? | |
| 4417 For example, suppose `key-translation-map' binds `ESC O P' to [f1]. | |
| 4418 Typing `ESC O P' to `read-key-sequence' would return | |
| 4419 \[#<keypress-event f1>]. Typing `C-x ESC O P' would return | |
| 4420 \[#<keypress-event control-X> #<keypress-event f1>]. If [f1] | |
| 4421 were a prefix key, typing `ESC O P x' would return | |
| 4422 \[#<keypress-event f1> #<keypress-event x>]. | |
| 428 | 4423 */ ); |
| 4424 Vkey_translation_map = Qnil; | |
| 4425 | |
| 771 | 4426 DEFVAR_LISP ("global-tty-map", &Vglobal_tty_map /* |
| 4427 Global keymap that applies only to TTY's. | |
| 4428 Key bindings are looked up in this map just before looking in the global map, | |
| 4429 but only when the current console is a TTY console. See also | |
| 4430 `global-window-system-map'. | |
| 4431 */ ); | |
| 4432 Vglobal_tty_map = Qnil; | |
| 4433 | |
| 4434 DEFVAR_LISP ("global-window-system-map", &Vglobal_window_system_map /* | |
| 4435 Global keymap that applies only to window systems. | |
| 4436 Key bindings are looked up in this map just before looking in the global map, | |
| 4437 but only when the current console is not a TTY console. See also | |
| 4438 `global-tty-map'. | |
| 4439 */ ); | |
| 4440 Vglobal_window_system_map = Qnil; | |
| 4441 | |
| 428 | 4442 DEFVAR_LISP ("vertical-divider-map", &Vvertical_divider_map /* |
| 4443 Keymap which handles mouse clicks over vertical dividers. | |
| 4444 */ ); | |
| 4445 Vvertical_divider_map = Qnil; | |
| 4446 | |
| 4447 DEFVAR_INT ("keymap-tick", &keymap_tick /* | |
| 4448 Incremented for each change to any keymap. | |
| 4449 */ ); | |
| 4450 keymap_tick = 0; | |
| 4451 | |
| 4452 staticpro (&Vcurrent_global_map); | |
| 4453 | |
| 867 | 4454 Vsingle_space_string = make_string ((const Ibyte *) " ", 1); |
| 428 | 4455 staticpro (&Vsingle_space_string); |
| 4456 } | |
| 4457 | |
| 4458 void | |
| 4459 complex_vars_of_keymap (void) | |
| 4460 { | |
| 4461 /* This function can GC */ | |
| 4462 Lisp_Object ESC_prefix = intern ("ESC-prefix"); | |
| 4463 Lisp_Object meta_disgustitute; | |
| 4464 | |
| 4465 Vcurrent_global_map = Fmake_keymap (Qnil); | |
| 771 | 4466 Vglobal_tty_map = Fmake_keymap (intern ("global-tty-map")); |
| 4467 Vglobal_window_system_map = | |
| 4468 Fmake_keymap (intern ("global-window-system-map")); | |
| 428 | 4469 |
| 4470 meta_disgustitute = Fmake_keymap (Qnil); | |
| 4471 Ffset (ESC_prefix, meta_disgustitute); | |
| 4472 /* no need to protect meta_disgustitute, though */ | |
| 442 | 4473 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META), |
| 428 | 4474 XKEYMAP (Vcurrent_global_map), |
| 4475 meta_disgustitute); | |
| 4476 XKEYMAP (Vcurrent_global_map)->sub_maps_cache = Qt; | |
| 4477 | |
| 4478 Vkey_translation_map = Fmake_sparse_keymap (intern ("key-translation-map")); | |
| 4479 } |