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