Hello! GNU have had support for command remapping for a while, an alternative to #'substitute-key-definition that works better as keymaps are updated. And this is used in the package code, which is fair enough, useful features will be. Unfortunately, this feature doesn’t really appear to have had much care put into its design. The aspect of this that I hate the most is the NO-REMAP argument to #'where-is-internal, its fifth. See the sample code below. I’d prefer to have the second example return nil, and the fourth the list it currently returns but without the entries starting with [remap ...]. The function #'command-remapping allows the second result to be constructed; I’d like to add a function to allow the fourth result to be constructed. Very little code uses *our* existing fifth argument to #'where-is-internal, EVENT-OR-KEYS, but it is an existing incompatibility. Maybe keyword arguments are an option. Best, Aidan (let* ((map (make-keymap 'help-map-copy)) (parent-map (make-keymap 'help-map-copy-parent)) (help-map-copy t) (minor-mode-map-alist (acons 'help-map-copy map minor-mode-map-alist))) (set-keymap-parent map parent-map) (loop for (keys def) on '((shift tab) help-prev-symbol tab help-next-symbol F find-function-at-point) by #'cddr do (define-key map (vector keys) def)) (loop for (keys def) on '(\0 find-function-at-point) by #'cddr do (define-key parent-map (vector keys) def)) (define-key map [remap find-function-at-point] #'find-file) (define-key parent-map [remap help-next-symbol] #'find-file) (list (where-is-internal 'help-next-symbol map nil nil t) (where-is-internal 'help-next-symbol map nil nil nil) (lookup-key map [tab]) (where-is-internal 'find-file map nil nil t) (where-is-internal 'find-file map nil nil nil))) ;; First result, NO-REMAP t, fair enough: => (([tab]) ;; NO-REMAP nil, but we get key sequences that will never invoke ;; #'help-next-symbol?! ([open] [24 6] [menu-bar file new-file] [tab] [F] [\0]) ;; Next ... but [tab] doesn’t invoke #'help-next-symbol. This is a ;; divergence between #'lookup-key and #'key-binding that is ;; unintuitive and underdocumented. help-next-symbol ;; Am I really interested in those commands that are remapped *to* ;; DEFINITION? Surely that’s a separate question and separate syntax ;; would be better? ([remap find-function-at-point] [remap help-next-symbol] [open] [24 6] [menu-bar file new-file]) ;; OK, this makes some sense, all these key sequences will invoke ;; #'find-file. ([open] [24 6] [menu-bar file new-file] [tab] [F] [\0])) diff -r ee95ef1e644c src/keymap.c --- a/src/keymap.c Mon Jul 02 20:39:12 2012 +0200 +++ b/src/keymap.c Sun Aug 12 20:28:01 2012 +0100 ＠＠ -188,6 +188,11 ＠＠ Lisp_Object Qmodeline_map; Lisp_Object Qtoolbar_map; +Lisp_Object Qremap; + +Lisp_Object Qxemacs_remap_command; /* Uninterned, so there's no conflict + with any key named remap. */ + EXFUN (Fkeymap_fullness, 1); EXFUN (Fset_keymap_name, 2); EXFUN (Fsingle_key_description, 1); ＠＠ -1826,6 +1831,12 ＠＠ `define-key' also accepts a number of abbreviations, aliases, and variants for convenience, compatibility, and internal use. +A key sequence can also be the vector [remap COMMAND]; this shadows any +bindings for COMMAND in KEYMAP, using DEF instead of COMMAND. See +`command-remapping' and `remap-command'. Specify [(remap) KEYSTROKE] if +your keyboard has a key with the name `remap' and you'd like to use it as a +prefix. + A keystroke may be represented by a key; this is treated as though it were a list containing that key as the only element. A keystroke may also be represented by an event object, as returned by the `next-command-event' and ＠＠ -1916,6 +1927,12 ＠＠ GCPRO3 (keymap, keys, def); + /* Allow access to any keys named remap, use our uninterned symbol. */ + if (2 == len && VECTORP (keys) && EQ (Qremap, XVECTOR_DATA (keys) [0])) + { + keys = vector2 (Qxemacs_remap_command, XVECTOR_DATA (keys) [1]); + } + /* ASCII grunge. When the user defines a key which, in a strictly ASCII world, would be produced by two different keys (^J and linefeed, or ^H and backspace, ＠＠ -2036,7 +2053,83 ＠＠ } } } - + +static int get_relevant_keymaps (Lisp_Object, Lisp_Object, int, + Lisp_Object maps[]); +static Lisp_Object lookup_keys (Lisp_Object, int, Lisp_Object *, int); + +static Lisp_Object +command_remapping (Lisp_Object definition, int nmaps, Lisp_Object *maps) +{ + Lisp_Object remapping = Qnil; + Lisp_Object keys[2] = { Qxemacs_remap_command, definition }; + int jj; + + for (jj = 0; jj < nmaps; jj++) + { + remapping = lookup_keys (maps[jj], countof (keys), keys, 0); + if (!NILP (remapping) && !FIXNUMP (remapping)) + { + return remapping; + } + } + + return Qnil; +} + +DEFUN ("command-remapping", Fcommand_remapping, 1, 3, 0, /* +Return the remapping for command COMMAND. +Returns nil if COMMAND is not remapped (or not a symbol). + +If the optional argument POSITION is non-nil, it specifies a mouse +position as returned by `event-start' and `event-end', and the +remapping occurs in the keymaps associated with it. It can also be a +number or marker, in which case the keymap properties at the specified +buffer position instead of point are used. The KEYMAPS argument is +ignored if POSITION is non-nil. + +If the optional argument KEYMAPS is non-nil, it should be a list of +keymaps to search for command remapping. Otherwise, search for the +remapping in all currently active keymaps. +*/ + (command, position, keymaps)) +{ + Lisp_Object maps[100]; + Lisp_Object *gubbish = maps; + int nmaps, maps_count = countof (maps); + + CHECK_LIST (keymaps); + + /* Get keymaps as an array */ + if (NILP (keymaps) || !NILP (position)) + { + nmaps = get_relevant_keymaps (Qnil, position, maps_count, gubbish); + } + else + { + Elemcount jj = 0; + nmaps = XFIXNUM (Flength (keymaps)); + if (nmaps > maps_count) + { + gubbish = alloca_array (Lisp_Object, nmaps); + } + + { + LIST_LOOP_2 (elt, keymaps) + { + gubbish[jj++] = elt; + } + } + } + + if (nmaps > maps_count); + { + gubbish = alloca_array (Lisp_Object, nmaps); + nmaps = get_relevant_keymaps (Qnil, position, nmaps, gubbish); + } + + return command_remapping (command, nmaps, gubbish); +}  /************************************************************************/ /* Looking up keys in keymaps */ ＠＠ -2318,8 +2411,8 ＠＠ } static int -get_relevant_keymaps (Lisp_Object keys, - int max_maps, Lisp_Object maps[]) +get_relevant_keymaps (Lisp_Object keys, Lisp_Object position, int max_maps, + Lisp_Object maps[]) { /* This function can GC */ Lisp_Object terminal = Qnil; ＠＠ -2464,6 +2557,18 ＠＠ } #endif /* HAVE_WINDOW_SYSTEM */ + if (FIXNUMP (position)) + { + get_relevant_extent_keymaps (position, wrap_buffer (current_buffer), + Qnil, &closure); + } + else if (MARKERP (position) && !NILP (Fmarker_buffer (position))) + { + get_relevant_extent_keymaps (Fmarker_position (position), + Fmarker_buffer (position), + Qnil, &closure); + } + if (CONSOLE_TTY_P (con)) relevant_map_push (Vglobal_tty_map, &closure); else ＠＠ -2580,18 +2685,18 ＠＠ int nmaps; GCPRO1 (event_or_keys); - nmaps = get_relevant_keymaps (event_or_keys, countof (maps), + nmaps = get_relevant_keymaps (event_or_keys, Qnil, countof (maps), gubbish); if (nmaps > countof (maps)) { gubbish = alloca_array (Lisp_Object, nmaps); - nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish); + nmaps = get_relevant_keymaps (event_or_keys, Qnil, nmaps, gubbish); } UNGCPRO; return Flist (nmaps, gubbish); } -DEFUN ("key-binding", Fkey_binding, 1, 2, 0, /* +DEFUN ("key-binding", Fkey_binding, 1, 4, 0, /* Return the binding for command KEYS in current keymaps. KEYS is a string, a vector of events, or a vector of key-description lists as described in the documentation for the `define-key' function. ＠＠ -2650,7 +2755,7 ＠＠ generate and display a list of possible key sequences and bindings given the prefix so far generated. */ - (keys, accept_default)) + (keys, accept_default, no_remap, position)) { /* This function can GC */ int i; ＠＠ -2659,7 +2764,7 ＠＠ struct gcpro gcpro1, gcpro2; GCPRO2 (keys, accept_default); /* get_relevant_keymaps may autoload */ - nmaps = get_relevant_keymaps (keys, countof (maps), maps); + nmaps = get_relevant_keymaps (keys, position, countof (maps), maps); UNGCPRO; ＠＠ -2668,15 +2773,19 ＠＠ for (i = 0; i < nmaps; i++) { - Lisp_Object tem = Flookup_key (maps[i], keys, - accept_default); + Lisp_Object tem = Flookup_key (maps[i], keys, accept_default); + if (FIXNUMP (tem)) { /* Too long in some local map means don't look at global map */ return Qnil; } - else if (!NILP (tem)) - return tem; + + if (!NILP (tem) && NILP (no_remap) && SYMBOLP (tem)) + { + Lisp_Object remap = command_remapping (tem, nmaps, maps); + return NILP (remap) ? tem : remap; + } } return Qnil; } ＠＠ -2724,7 +2833,7 ＠＠ assert (EVENTP (event0)); - nmaps = get_relevant_keymaps (event0, countof (maps), maps); + nmaps = get_relevant_keymaps (event0, Qnil, countof (maps), maps); if (nmaps > countof (maps)) nmaps = countof (maps); return process_event_binding_result (lookup_events (event0, nmaps, maps, ＠＠ -3452,7 +3561,8 ＠＠ static Lisp_Object where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps, - Lisp_Object firstonly, Eistring *target_buffer); + Lisp_Object firstonly, Lisp_Object no_remap, + Eistring *target_buffer); DEFUN ("where-is-internal", Fwhere_is_internal, 1, 5, 0, /* Return list of keys that invoke DEFINITION in KEYMAPS. ＠＠ -3460,20 +3570,26 ＠＠ current global keymap) or a list of keymaps (meaning search in exactly those keymaps and no others). -If optional 3rd arg FIRSTONLY is non-nil, return a vector representing - the first key sequence found, rather than a list of all possible key - sequences. +If optional 3rd arg FIRSTONLY is non-nil, return a vector representing the +first key sequence found, rather than a list of all possible key sequences. Optional 4th argument NOINDIRECT is ignored. (GNU Emacs uses it to allow searching for an indirect keymap by inhibiting following of indirections to keymaps or slots, but XEmacs doesn't need it because keymaps are a type.) -If optional 5th argument EVENT-OR-KEYS is non-nil and KEYMAPS is nil, -search in the currently applicable maps for EVENT-OR-KEYS (this is -equivalent to specifying `(current-keymaps EVENT-OR-KEYS)' as the -argument to KEYMAPS). +The optional 5th arg NO-REMAP alters how command remapping is handled: + +- If some other command OTHER-COMMAND is remapped to DEFINITION, normally + search for the bindings of OTHER-COMMAND and include them in the returned + list. But if NO-REMAP is non-nil, include the vector [remap + OTHER-COMMAND] in the returned list instead, without searching for those + other bindings. + +- If DEFINITION is remapped to OTHER-COMMAND, normally return the + bindings for OTHER-COMMAND. But if NO-REMAP is non-nil, return the + bindings for DEFINITION instead, ignoring its remapping. */ - (definition, keymaps, firstonly, UNUSED (noindirect), event_or_keys)) + (definition, keymaps, firstonly, UNUSED (noindirect), no_remap)) { /* This function can GC */ Lisp_Object maps[100]; ＠＠ -3483,12 +3599,11 ＠＠ /* Get keymaps as an array */ if (NILP (keymaps)) { - nmaps = get_relevant_keymaps (event_or_keys, countof (maps), - gubbish); + nmaps = get_relevant_keymaps (Qnil, Qnil, countof (maps), gubbish); if (nmaps > countof (maps)) { gubbish = alloca_array (Lisp_Object, nmaps); - nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish); + nmaps = get_relevant_keymaps (Qnil, Qnil, nmaps, gubbish); } } else if (CONSP (keymaps)) ＠＠ -3518,7 +3633,8 ＠＠ } } - return where_is_internal (definition, gubbish, nmaps, firstonly, 0); + return where_is_internal (definition, gubbish, nmaps, firstonly, no_remap, + 0); } /* This function is like ＠＠ -3536,14 +3652,14 ＠＠ int nmaps; /* Get keymaps as an array */ - nmaps = get_relevant_keymaps (Qnil, countof (maps), gubbish); + nmaps = get_relevant_keymaps (Qnil, Qnil, countof (maps), gubbish); if (nmaps > countof (maps)) { gubbish = alloca_array (Lisp_Object, nmaps); - nmaps = get_relevant_keymaps (Qnil, nmaps, gubbish); + nmaps = get_relevant_keymaps (Qnil, Qnil, nmaps, gubbish); } - where_is_internal (definition, maps, nmaps, Qt, buffer); + where_is_internal (definition, maps, nmaps, Qt, Qnil, buffer); } ＠＠ -3602,6 +3718,7 ＠＠ Lisp_Object *shadow; int shadow_count; int firstonly; + int no_remap; int keys_count; int modifiers_so_far; Eistring *target_buffer; ＠＠ -3619,6 +3736,7 ＠＠ struct where_is_closure *c = (struct where_is_closure *) arg; Lisp_Object definition = c->definition; const int firstonly = c->firstonly; + const int no_remap = c->no_remap; const int keys_count = c->keys_count; const int modifiers_so_far = c->modifiers_so_far; Eistring *target_buffer = c->target_buffer; ＠＠ -3771,17 +3889,31 ＠＠ static Lisp_Object where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps, - Lisp_Object firstonly, Eistring *target_buffer) + Lisp_Object firstonly, Lisp_Object no_remap, + Eistring *target_buffer) { /* This function can GC */ Lisp_Object result = Qnil; int i; Lisp_Key_Data raw[20]; struct where_is_closure c; + struct gcpro gcpro1; + + if (NILP (no_remap)) + { + Lisp_Object remapped = command_remapping (definition, nmaps, maps); + if (!NILP (remapped)) + { + definition = remapped; + } + } + + GCPRO1 (definition); c.definition = definition; c.shadow = maps; c.firstonly = !NILP (firstonly); + c.no_remap = !NILP (no_remap); c.target_buffer = target_buffer; c.keys_so_far = raw; c.keys_so_far_total_size = countof (raw); ＠＠ -3815,6 +3947,9 ＠＠ if (c.keys_so_far_malloced) xfree (c.keys_so_far); + + UNGCPRO; + return result; } ＠＠ -4307,6 +4442,7 ＠＠ DEFSYMBOL (Qmodeline_map); DEFSYMBOL (Qtoolbar_map); + DEFSYMBOL (Qremap); DEFSUBR (Fkeymap_parents); DEFSUBR (Fset_keymap_parents); ＠＠ -4326,6 +4462,7 ＠＠ DEFSUBR (Fmap_keymap); DEFSUBR (Fevent_matches_key_specifier_p); DEFSUBR (Fdefine_key); + DEFSUBR (Fcommand_remapping); DEFSUBR (Flookup_key); DEFSUBR (Fkey_binding); DEFSUBR (Fuse_global_map); ＠＠ -4455,6 +4592,10 ＠＠ Vsingle_space_string = make_string ((const Ibyte *) " ", 1); staticpro (&Vsingle_space_string); + + Qxemacs_remap_command + = Fmake_symbol (build_ascstring ("remap-xemacs-command")); + staticpro (&Qxemacs_remap_command); } void -- ‘Liston operated so fast that he once accidentally amputated an assistant’s fingers along with a patient’s leg, […] The patient and the assistant both died of sepsis, and a spectator reportedly died of shock, resulting in the only known procedure with a 300% mortality.’ (Atul Gawande, NEJM, 2012) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches