[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Updated Patch for command remapping through keymaps
From: |
Kim F. Storm |
Subject: |
Updated Patch for command remapping through keymaps |
Date: |
03 Feb 2002 02:23:55 +0100 |
User-agent: |
Gnus/5.09 (Gnus v5.9.0) Emacs/21.2.50 |
Thanks to Richard and Eli for comments on my previous patch.
I've tried to accomodate all of your comments, and I have
reorganized some of the code to make it easier to explain
(and understand - I hope).
Here is an updated patch for your review.
Index: etc/NEWS
===================================================================
RCS file: /cvs/emacs/etc/NEWS,v
retrieving revision 1.586
diff -c -r1.586 NEWS
*** etc/NEWS 2 Feb 2002 13:12:45 -0000 1.586
--- etc/NEWS 3 Feb 2002 01:14:37 -0000
***************
*** 130,135 ****
--- 130,156 ----
The info-search bindings on C-h C-f, C-h C-k and C-h C-i
have been moved to C-h F, C-h K and C-h S.
+ C-h c, C-h k, C-h w, and C-h f now handle remapped interactive commands.
+
+ - C-h c and C-h k report the actual command (after possible remapping)
+ run by the key sequence.
+
+ - C-h w and C-h f on a command which has been remapped now report the
+ command it is remapped to, and the keys which can be used to run
+ that command.
+
+ For example, if kill-line is bound to C-k, and kill-line is remapped
+ to new-kill-line, these commands now report:
+
+ - C-h c and C-h k C-k reports:
+ C-k runs the command new-kill-line
+
+ - C-h w and C-h f kill-line reports:
+ kill-line is remapped to new-kill-line which is on C-k, <deleteline>
+
+ - C-h w and C-h f new-kill-line reports:
+ new-kill-line is on C-k
+
** C-w in incremental search now grabs either a character or a word,
making the decision in a heuristic way. This new job is done by the
command `isearch-yank-word-or-char'. To restore the old behavior,
***************
*** 409,414 ****
--- 430,495 ----
* Lisp Changes in Emacs 21.3
+
+ ** Interactive commands can be remapped through keymaps.
+
+ This is an alternative to using defadvice or substitute-key-definition
+ to modify the behaviour of a key binding using the normal keymap
+ binding and lookup functionality.
+
+ When a key sequence is bound to a command, and that command is
+ remapped to another command, that command is run instead of the
+ original command.
+
+ Example:
+ Suppose that minor mode my-mode has defined the commands
+ my-kill-line and my-kill-word, and it wants C-k (and any other key
+ bound to kill-line) to run the command my-kill-line instead of
+ kill-line, and likewise it wants to run my-kill-word instead of
+ kill-word.
+
+ Instead of rebinding C-k and the other keys in the minor mode map,
+ command remapping allows you to directly map kill-line into
+ my-kill-line and kill-word into my-kill-word through the minor mode
+ map using define-key:
+
+ (define-key my-mode-map 'kill-line 'my-kill-line)
+ (define-key my-mode-map 'kill-word 'my-kill-word)
+
+ Now, when my-mode is enabled, and the user enters C-k or M-d,
+ the commands my-kill-line and my-kill-word are run.
+
+ Notice that only one level of remapping is supported. In the above
+ example, this means that if my-kill-line is remapped to other-kill,
+ then C-k still runs my-kill-line.
+
+ The following changes have been made to provide command remapping:
+
+ - define-key now accepts a command name as the KEY argument.
+ This identifies the command to be remapped in the specified keymap.
+ This is equivalent to specifying the command name as the only
+ element of a vector, e.g [kill-line].
+
+ - global-set-key, global-unset-key, local-set-key, and local-unset-key
+ also accept a command name as the KEY argument.
+
+ - key-binding now remaps interactive commands unless the optional
+ third argument NO-REMAP is non-nil. It also accepts a command name
+ as the KEY argument.
+
+ - lookup-key now accepts a command name as the KEY argument.
+
+ - where-is-internal now returns nil for a remapped command (e.g.
+ kill-line if my-mode is enabled), and the actual key binding for
+ the command it is remapped to (e.g. C-k for my-kill-line).
+ It also has a new optional fifth argument, NO-REMAP, which inhibits
+ remapping if non-nil (e.g. it returns C-k for kill-line and
+ <kill-line> for my-kill-line).
+
+ - The new variable `this-original-command' contains the original
+ command before remapping. It is equal to `this-command' when the
+ command was not remapped.
+
** New function substring-no-properties.
Index: lisp/help-fns.el
===================================================================
RCS file: /cvs/emacs/lisp/help-fns.el,v
retrieving revision 1.5
diff -c -r1.5 help-fns.el
*** lisp/help-fns.el 7 Jan 2002 05:20:33 -0000 1.5
--- lisp/help-fns.el 3 Feb 2002 01:14:37 -0000
***************
*** 207,218 ****
(princ ".")
(terpri)
(when (commandp function)
! (let ((keys (where-is-internal
! function overriding-local-map nil nil)))
(when keys
! (princ "It is bound to ")
;; FIXME: This list can be very long (f.ex. for self-insert-command).
! (princ (mapconcat 'key-description keys ", "))
(princ ".")
(terpri))))
;; Handle symbols aliased to other symbols.
--- 207,226 ----
(princ ".")
(terpri)
(when (commandp function)
! (let* ((binding (and (symbolp function) (commandp function)
! (key-binding function nil t)))
! (remapped (and (symbolp binding) (commandp binding) binding))
! (keys (where-is-internal
! (or remapped function) overriding-local-map nil nil)))
! (when remapped
! (princ "It is remapped to `")
! (princ (symbol-name remapped))
! (princ "'"))
(when keys
! (princ (if remapped " which is bound to " "It is bound to "))
;; FIXME: This list can be very long (f.ex. for self-insert-command).
! (princ (mapconcat 'key-description keys ", ")))
! (when (or remapped keys)
(princ ".")
(terpri))))
;; Handle symbols aliased to other symbols.
Index: lisp/help.el
===================================================================
RCS file: /cvs/emacs/lisp/help.el,v
retrieving revision 1.243
diff -c -r1.243 help.el
*** lisp/help.el 17 Jan 2002 01:40:47 -0000 1.243
--- lisp/help.el 3 Feb 2002 01:14:37 -0000
***************
*** 412,426 ****
(list (if (equal val "")
fn (intern val))
current-prefix-arg)))
! (let* ((keys (where-is-internal definition overriding-local-map nil nil))
(keys1 (mapconcat 'key-description keys ", "))
(standard-output (if insert (current-buffer) t)))
(if insert
(if (> (length keys1) 0)
! (princ (format "%s (%s)" keys1 definition))
(princ (format "M-x %s RET" definition)))
(if (> (length keys1) 0)
! (princ (format "%s is on %s" definition keys1))
(princ (format "%s is not on any key" definition)))))
nil)
--- 412,433 ----
(list (if (equal val "")
fn (intern val))
current-prefix-arg)))
! (let* ((binding (and (symbolp definition) (commandp definition)
! (key-binding definition nil t)))
! (remap (and (symbolp binding) (commandp binding) binding))
! (keys (where-is-internal definition overriding-local-map nil nil
remap))
(keys1 (mapconcat 'key-description keys ", "))
(standard-output (if insert (current-buffer) t)))
(if insert
(if (> (length keys1) 0)
! (if remap
! (princ (format "%s (%s) (remapped from %s)" keys1 remap
definition))
! (princ (format "%s (%s)" keys1 definition)))
(princ (format "M-x %s RET" definition)))
(if (> (length keys1) 0)
! (if remap
! (princ (format "%s is remapped to %s which is on %s" definition
remap keys1))
! (princ (format "%s is on %s" definition keys1)))
(princ (format "%s is not on any key" definition)))))
nil)
Index: lisp/subr.el
===================================================================
RCS file: /cvs/emacs/lisp/subr.el,v
retrieving revision 1.284
diff -c -r1.284 subr.el
*** lisp/subr.el 25 Jan 2002 05:05:16 -0000 1.284
--- lisp/subr.el 3 Feb 2002 01:14:38 -0000
***************
*** 1571,1577 ****
that local binding will continue to shadow any global binding
that you make with this function."
(interactive "KSet key globally: \nCSet key %s to command: ")
! (or (vectorp key) (stringp key)
(signal 'wrong-type-argument (list 'arrayp key)))
(define-key (current-global-map) key command))
--- 1571,1577 ----
that local binding will continue to shadow any global binding
that you make with this function."
(interactive "KSet key globally: \nCSet key %s to command: ")
! (or (vectorp key) (stringp key) (symbolp key)
(signal 'wrong-type-argument (list 'arrayp key)))
(define-key (current-global-map) key command))
***************
*** 1589,1595 ****
(let ((map (current-local-map)))
(or map
(use-local-map (setq map (make-sparse-keymap))))
! (or (vectorp key) (stringp key)
(signal 'wrong-type-argument (list 'arrayp key)))
(define-key map key command)))
--- 1589,1595 ----
(let ((map (current-local-map)))
(or map
(use-local-map (setq map (make-sparse-keymap))))
! (or (vectorp key) (stringp key) (symbolp key)
(signal 'wrong-type-argument (list 'arrayp key)))
(define-key map key command)))
Index: src/doc.c
===================================================================
RCS file: /cvs/emacs/src/doc.c,v
retrieving revision 1.89
diff -c -r1.89 doc.c
*** src/doc.c 22 Dec 2001 13:59:08 -0000 1.89
--- src/doc.c 3 Feb 2002 01:14:39 -0000
***************
*** 671,677 ****
/* Note the Fwhere_is_internal can GC, so we have to take
relocation of string contents into account. */
! tem = Fwhere_is_internal (tem, keymap, Qt, Qnil);
strp = XSTRING (string)->data + idx;
start = XSTRING (string)->data + start_idx;
--- 671,677 ----
/* Note the Fwhere_is_internal can GC, so we have to take
relocation of string contents into account. */
! tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil);
strp = XSTRING (string)->data + idx;
start = XSTRING (string)->data + start_idx;
Index: src/keyboard.c
===================================================================
RCS file: /cvs/emacs/src/keyboard.c,v
retrieving revision 1.652
diff -c -r1.652 keyboard.c
*** src/keyboard.c 2 Feb 2002 10:09:38 -0000 1.652
--- src/keyboard.c 3 Feb 2002 01:14:41 -0000
***************
*** 373,378 ****
--- 373,382 ----
/* This is like Vthis_command, except that commands never set it. */
Lisp_Object real_this_command;
+ /* If the lookup of the command returns a binding, the original
+ command is stored in this-original-command. It is nil otherwise. */
+ Lisp_Object Vthis_original_command;
+
/* The value of point when the last command was executed. */
int last_point_position;
***************
*** 1503,1508 ****
--- 1507,1523 ----
reset it before we execute the command. */
Vdeactivate_mark = Qnil;
+ /* Remap command through active keymaps */
+ Vthis_original_command = cmd;
+ if (is_command_symbol (cmd))
+ {
+ Lisp_Object cmd1;
+
+ cmd1 = Fkey_binding (cmd, Qnil, Qt);
+ if (!NILP (cmd1) && is_command_symbol (cmd1))
+ cmd = cmd1;
+ }
+
/* Execute the command. */
Vthis_command = cmd;
***************
*** 6947,6953 ****
Lisp_Object prefix;
if (!NILP (tem))
! tem = Fkey_binding (tem, Qnil);
prefix = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
if (CONSP (prefix))
--- 6962,6968 ----
Lisp_Object prefix;
if (!NILP (tem))
! tem = Fkey_binding (tem, Qnil, Qnil);
prefix = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
if (CONSP (prefix))
***************
*** 6993,6999 ****
&& SYMBOLP (XSYMBOL (def)->function)
&& ! NILP (Fget (def, Qmenu_alias)))
def = XSYMBOL (def)->function;
! tem = Fwhere_is_internal (def, Qnil, Qt, Qnil);
XSETCAR (cachelist, tem);
if (NILP (tem))
{
--- 7008,7014 ----
&& SYMBOLP (XSYMBOL (def)->function)
&& ! NILP (Fget (def, Qmenu_alias)))
def = XSYMBOL (def)->function;
! tem = Fwhere_is_internal (def, Qnil, Qt, Qnil, Qt);
XSETCAR (cachelist, tem);
if (NILP (tem))
{
***************
*** 9408,9414 ****
&& NILP (Vexecuting_macro)
&& SYMBOLP (function))
bindings = Fwhere_is_internal (function, Voverriding_local_map,
! Qt, Qnil);
else
bindings = Qnil;
--- 9423,9429 ----
&& NILP (Vexecuting_macro)
&& SYMBOLP (function))
bindings = Fwhere_is_internal (function, Voverriding_local_map,
! Qt, Qnil, Qnil);
else
bindings = Qnil;
***************
*** 10634,10639 ****
--- 10649,10660 ----
The command can set this variable; whatever is put here
will be in `last-command' during the following command. */);
Vthis_command = Qnil;
+
+ DEFVAR_LISP ("this-original-command", &Vthis_original_command,
+ doc: /* If non-nil, the original command bound to the current
key sequence.
+ The value of `this-command' is the result of looking up the original
+ command in the active keymaps. */);
+ Vthis_original_command = Qnil;
DEFVAR_INT ("auto-save-interval", &auto_save_interval,
doc: /* *Number of input events between auto-saves.
Index: src/keymap.c
===================================================================
RCS file: /cvs/emacs/src/keymap.c,v
retrieving revision 1.254
diff -c -r1.254 keymap.c
*** src/keymap.c 3 Jan 2002 21:28:04 -0000 1.254
--- src/keymap.c 3 Feb 2002 01:14:42 -0000
***************
*** 954,963 ****
DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
doc: /* Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as
DEF.
! KEYMAP is a keymap. KEY is a string or a vector of symbols and characters
! meaning a sequence of keystrokes and events.
! Non-ASCII characters with codes above 127 (such as ISO Latin-1)
! can be included if you use a vector.
DEF is anything that can be a key's definition:
nil (means key is undefined in this keymap),
a command (a Lisp function suitable for interactive calling)
--- 954,965 ----
DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
doc: /* Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as
DEF.
! KEYMAP is a keymap.
!
! KEY is a string or a vector of symbols and characters meaning a
! sequence of keystrokes and events. Non-ASCII characters with codes
! above 127 (such as ISO Latin-1) can be included if you use a vector.
!
DEF is anything that can be a key's definition:
nil (means key is undefined in this keymap),
a command (a Lisp function suitable for interactive calling)
***************
*** 971,977 ****
or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at
! the front of KEYMAP. */)
(keymap, key, def)
Lisp_Object keymap;
Lisp_Object key;
--- 973,982 ----
or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at
! the front of KEYMAP.
!
! KEY may also be a command name which is remapped to DEF. In this case,
! DEF must be a symbol or nil (to remove a previous binding of KEY). */)
(keymap, key, def)
Lisp_Object keymap;
Lisp_Object key;
***************
*** 987,994 ****
keymap = get_keymap (keymap, 1, 1);
! if (!VECTORP (key) && !STRINGP (key))
! key = wrong_type_argument (Qarrayp, key);
length = XFASTINT (Flength (key));
if (length == 0)
--- 992,1015 ----
keymap = get_keymap (keymap, 1, 1);
! if (SYMBOLP (key))
! {
! /* A command may only be remapped to another command. */
!
! /* It would probably be more correct to use is_command_symbol
! above and below instead of SYMBOLP, since remapping only
! works for sych symbols. However, to make that a requirement
! would make it impossible to remap a command before it has
! been defined. So if a minor mode were to remap a command of
! another minor mode which has not yet been loaded, it would
! fail. So use the least restrictive sanity check here. */
! if (!SYMBOLP (def))
! key = wrong_type_argument (Qsymbolp, def);
! else
! key = Fmake_vector (make_number (1), key);
! }
! else if (!VECTORP (key) && !STRINGP (key))
! key = wrong_type_argument (Qarrayp, key);
length = XFASTINT (Flength (key));
if (length == 0)
***************
*** 1084,1089 ****
--- 1105,1117 ----
keymap = get_keymap (keymap, 1, 1);
+ if (SYMBOLP (key))
+ {
+ GCPRO1 (key);
+ cmd = access_keymap (keymap, key, t_ok, 0, 1);
+ RETURN_UNGCPRO (cmd);
+ }
+
if (!VECTORP (key) && !STRINGP (key))
key = wrong_type_argument (Qarrayp, key);
***************
*** 1361,1369 ****
return keymaps;
}
/* GC is possible in this function if it autoloads a keymap. */
! DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,
doc: /* Return the binding for command KEY in current keymaps.
KEY is a string or vector, a sequence of keystrokes.
The binding is probably a symbol with a function definition.
--- 1389,1432 ----
return keymaps;
}
+ /* Like Fcommandp, but looks specifically for a command symbol, and
+ doesn't signal errors. Returns 1 if FUNCTION is a command symbol. */
+ int
+ is_command_symbol (function)
+ Lisp_Object function;
+ {
+ if (!SYMBOLP (function) || EQ (function, Qunbound))
+ return 0;
+
+ function = indirect_function (function);
+ if (SYMBOLP (function) && EQ (function, Qunbound))
+ return 0;
+
+ if (SUBRP (function))
+ return (XSUBR (function)->prompt != 0);
+
+ if (COMPILEDP (function))
+ return ((ASIZE (function) & PSEUDOVECTOR_SIZE_MASK) >
COMPILED_INTERACTIVE);
+
+ if (CONSP (function))
+ {
+ Lisp_Object funcar;
+
+ funcar = Fcar (function);
+ if (SYMBOLP (funcar))
+ {
+ if (EQ (funcar, Qlambda))
+ return !NILP (Fassq (Qinteractive, Fcdr (Fcdr (function))));
+ if (EQ (funcar, Qautoload))
+ return !NILP (Fcar (Fcdr (Fcdr (Fcdr (function)))));
+ }
+ }
+ return 0;
+ }
+
/* GC is possible in this function if it autoloads a keymap. */
! DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 3, 0,
doc: /* Return the binding for command KEY in current keymaps.
KEY is a string or vector, a sequence of keystrokes.
The binding is probably a symbol with a function definition.
***************
*** 1372,1380 ****
bindings, used when nothing else in the keymap applies; this makes it
usable as a general function for probing keymaps. However, if the
optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
! recognize the default bindings, just as `read-key-sequence' does. */)
! (key, accept_default)
! Lisp_Object key, accept_default;
{
Lisp_Object *maps, value;
int nmaps, i;
--- 1435,1448 ----
bindings, used when nothing else in the keymap applies; this makes it
usable as a general function for probing keymaps. However, if the
optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
! recognize the default bindings, just as `read-key-sequence' does.
!
! Like the normal command loop, `key-binding' will remap the command
! resulting from looking up KEY by looking up the command in the
! currrent keymaps. However, if the optional third argument NO-REMAP
! is non-nil, `key-binding' returns the unmapped command. */)
! (key, accept_default, no_remap)
! Lisp_Object key, accept_default, no_remap;
{
Lisp_Object *maps, value;
int nmaps, i;
***************
*** 1387,1399 ****
value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
key, accept_default);
if (! NILP (value) && !INTEGERP (value))
! RETURN_UNGCPRO (value);
}
else if (!NILP (Voverriding_local_map))
{
value = Flookup_key (Voverriding_local_map, key, accept_default);
if (! NILP (value) && !INTEGERP (value))
! RETURN_UNGCPRO (value);
}
else
{
--- 1455,1467 ----
value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
key, accept_default);
if (! NILP (value) && !INTEGERP (value))
! goto done;
}
else if (!NILP (Voverriding_local_map))
{
value = Flookup_key (Voverriding_local_map, key, accept_default);
if (! NILP (value) && !INTEGERP (value))
! goto done;
}
else
{
***************
*** 1404,1410 ****
{
value = Flookup_key (local, key, accept_default);
if (! NILP (value) && !INTEGERP (value))
! RETURN_UNGCPRO (value);
}
nmaps = current_minor_maps (0, &maps);
--- 1472,1478 ----
{
value = Flookup_key (local, key, accept_default);
if (! NILP (value) && !INTEGERP (value))
! goto done;
}
nmaps = current_minor_maps (0, &maps);
***************
*** 1416,1422 ****
{
value = Flookup_key (maps[i], key, accept_default);
if (! NILP (value) && !INTEGERP (value))
! RETURN_UNGCPRO (value);
}
local = get_local_map (PT, current_buffer, Qlocal_map);
--- 1484,1490 ----
{
value = Flookup_key (maps[i], key, accept_default);
if (! NILP (value) && !INTEGERP (value))
! goto done;
}
local = get_local_map (PT, current_buffer, Qlocal_map);
***************
*** 1424,1439 ****
{
value = Flookup_key (local, key, accept_default);
if (! NILP (value) && !INTEGERP (value))
! RETURN_UNGCPRO (value);
}
}
value = Flookup_key (current_global_map, key, accept_default);
UNGCPRO;
! if (! NILP (value) && !INTEGERP (value))
! return value;
! return Qnil;
}
/* GC is possible in this function if it autoloads a keymap. */
--- 1492,1521 ----
{
value = Flookup_key (local, key, accept_default);
if (! NILP (value) && !INTEGERP (value))
! goto done;
}
}
value = Flookup_key (current_global_map, key, accept_default);
+
+ done:
UNGCPRO;
! if (NILP (value) || INTEGERP (value))
! return Qnil;
!
! /* If the result of the ordinary keymap lookup is an interactive
! command, look for a key binding (ie. remapping) for that command. */
!
! if (NILP (no_remap) && is_command_symbol (value))
! {
! Lisp_Object value1;
!
! value1 = Fkey_binding(value, accept_default, Qt);
! if (!NILP (value1) && is_command_symbol (value1))
! value = value1;
! }
! return value;
}
/* GC is possible in this function if it autoloads a keymap. */
***************
*** 2156,2161 ****
--- 2238,2244 ----
/* where-is - finding a command in a set of keymaps. */
+ static Lisp_Object where_is_internal ();
static Lisp_Object where_is_internal_1 ();
static void where_is_internal_2 ();
***************
*** 2180,2188 ****
/* This function can GC if Flookup_key autoloads any keymaps. */
static Lisp_Object
! where_is_internal (definition, keymaps, firstonly, noindirect)
Lisp_Object definition, keymaps;
! Lisp_Object firstonly, noindirect;
{
Lisp_Object maps = Qnil;
Lisp_Object found, sequences;
--- 2263,2271 ----
/* This function can GC if Flookup_key autoloads any keymaps. */
static Lisp_Object
! where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
Lisp_Object definition, keymaps;
! Lisp_Object firstonly, noindirect, no_remap;
{
Lisp_Object maps = Qnil;
Lisp_Object found, sequences;
***************
*** 2190,2195 ****
--- 2273,2284 ----
/* 1 means ignore all menu bindings entirely. */
int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
+ /* If this command is remapped, then it has no key bindings
+ of its own. */
+ if (NILP (no_remap)
+ && !NILP (Fkey_binding (definition, Qnil, Qt)))
+ return Qnil;
+
found = keymaps;
while (CONSP (found))
{
***************
*** 2295,2305 ****
}
! for (; !NILP (sequences); sequences = XCDR (sequences))
{
Lisp_Object sequence;
sequence = XCAR (sequences);
/* Verify that this key binding is not shadowed by another
binding for the same key, before we say it exists.
--- 2384,2424 ----
}
! while (!NILP (sequences))
{
Lisp_Object sequence;
+ Lisp_Object remapped;
sequence = XCAR (sequences);
+ sequences = XCDR (sequences);
+
+ /* If the current sequence is of the form [command],
+ this may be a remapped command, so look for the key
+ sequences which run that command, and return those
+ sequences instead. */
+ remapped = Qnil;
+ if (NILP (no_remap)
+ && VECTORP (sequence) && XVECTOR (sequence)->size == 1)
+ {
+ Lisp_Object function;
+
+ function = AREF (sequence, 0);
+ if (is_command_symbol (function))
+ {
+ Lisp_Object remapped1;
+ remapped1 = where_is_internal (function, keymaps,
firstonly, noindirect, Qt);
+ if (CONSP (remapped1))
+ {
+ /* Verify that this key binding actually maps to the
+ remapped command (see below). */
+ if (!EQ (shadow_lookup (keymaps, XCAR (remapped1),
Qnil), function))
+ continue;
+ sequence = XCAR (remapped1);
+ remapped = XCDR (remapped1);
+ goto record_sequence;
+ }
+ }
+ }
/* Verify that this key binding is not shadowed by another
binding for the same key, before we say it exists.
***************
*** 2313,2318 ****
--- 2432,2438 ----
if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
continue;
+ record_sequence:
/* It is a true unshadowed match. Record it, unless it's already
been seen (as could happen when inheriting keymaps). */
if (NILP (Fmember (sequence, found)))
***************
*** 2326,2331 ****
--- 2446,2458 ----
RETURN_UNGCPRO (sequence);
else if (!NILP (firstonly) && ascii_sequence_p (sequence))
RETURN_UNGCPRO (sequence);
+
+ if (CONSP (remapped))
+ {
+ sequence = XCAR (remapped);
+ remapped = XCDR (remapped);
+ goto record_sequence;
+ }
}
}
}
***************
*** 2343,2349 ****
return found;
}
! DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
doc: /* Return list of keys that invoke DEFINITION.
If KEYMAP is non-nil, search only KEYMAP and the global keymap.
If KEYMAP is nil, search all the currently active keymaps.
--- 2470,2476 ----
return found;
}
! DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
doc: /* Return list of keys that invoke DEFINITION.
If KEYMAP is non-nil, search only KEYMAP and the global keymap.
If KEYMAP is nil, search all the currently active keymaps.
***************
*** 2358,2367 ****
If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
to other keymaps or slots. This makes it possible to search for an
! indirect definition itself. */)
! (definition, keymap, firstonly, noindirect)
Lisp_Object definition, keymap;
! Lisp_Object firstonly, noindirect;
{
Lisp_Object sequences, keymaps;
/* 1 means ignore all menu bindings entirely. */
--- 2485,2498 ----
If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
to other keymaps or slots. This makes it possible to search for an
! indirect definition itself.
!
! If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
! that invoke a command which is remapped to DEFINITION, but include the
! remapped command in the returned list. */)
! (definition, keymap, firstonly, noindirect, no_remap)
Lisp_Object definition, keymap;
! Lisp_Object firstonly, noindirect, no_remap;
{
Lisp_Object sequences, keymaps;
/* 1 means ignore all menu bindings entirely. */
***************
*** 2382,2388 ****
{
Lisp_Object *defns;
int i, j, n;
! struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
/* Check heuristic-consistency of the cache. */
if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
--- 2513,2519 ----
{
Lisp_Object *defns;
int i, j, n;
! struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
/* Check heuristic-consistency of the cache. */
if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
***************
*** 2396,2403 ****
where_is_cache_keymaps = Qt;
/* Fill in the cache. */
! GCPRO4 (definition, keymaps, firstonly, noindirect);
! where_is_internal (definition, keymaps, firstonly, noindirect);
UNGCPRO;
where_is_cache_keymaps = keymaps;
--- 2527,2534 ----
where_is_cache_keymaps = Qt;
/* Fill in the cache. */
! GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap);
! where_is_internal (definition, keymaps, firstonly, noindirect,
no_remap);
UNGCPRO;
where_is_cache_keymaps = keymaps;
***************
*** 2434,2440 ****
/* Kill the cache so that where_is_internal_1 doesn't think
we're filling it up. */
where_is_cache = Qnil;
! result = where_is_internal (definition, keymaps, firstonly, noindirect);
}
return result;
--- 2565,2571 ----
/* Kill the cache so that where_is_internal_1 doesn't think
we're filling it up. */
where_is_cache = Qnil;
! result = where_is_internal (definition, keymaps, firstonly, noindirect,
no_remap);
}
return result;
Index: src/keymap.h
===================================================================
RCS file: /cvs/emacs/src/keymap.h,v
retrieving revision 1.3
diff -c -r1.3 keymap.h
*** src/keymap.h 19 Nov 2001 22:46:29 -0000 1.3
--- src/keymap.h 3 Feb 2002 01:14:42 -0000
***************
*** 28,37 ****
EXFUN (Fkeymap_prompt, 1);
EXFUN (Fdefine_key, 3);
EXFUN (Flookup_key, 3);
! EXFUN (Fkey_binding, 2);
EXFUN (Fkey_description, 1);
EXFUN (Fsingle_key_description, 2);
! EXFUN (Fwhere_is_internal, 4);
extern Lisp_Object access_keymap P_ ((Lisp_Object, Lisp_Object, int, int,
int));
extern Lisp_Object get_keyelt P_ ((Lisp_Object, int));
extern Lisp_Object get_keymap P_ ((Lisp_Object, int, int));
--- 28,38 ----
EXFUN (Fkeymap_prompt, 1);
EXFUN (Fdefine_key, 3);
EXFUN (Flookup_key, 3);
! EXFUN (Fkey_binding, 3);
EXFUN (Fkey_description, 1);
EXFUN (Fsingle_key_description, 2);
! EXFUN (Fwhere_is_internal, 5);
! extern int is_command_symbol P_ ((Lisp_Object));
extern Lisp_Object access_keymap P_ ((Lisp_Object, Lisp_Object, int, int,
int));
extern Lisp_Object get_keyelt P_ ((Lisp_Object, int));
extern Lisp_Object get_keymap P_ ((Lisp_Object, int, int));
--
Kim F. Storm <address@hidden> http://www.cua.dk
- Updated Patch for command remapping through keymaps,
Kim F. Storm <=
- Re: Updated Patch for command remapping through keymaps, Richard Stallman, 2002/02/04
- Re: Updated Patch for command remapping through keymaps, Kim F. Storm, 2002/02/05
- Re: Updated Patch for command remapping through keymaps, Richard Stallman, 2002/02/06
- Re: Updated Patch for command remapping through keymaps, Kim F. Storm, 2002/02/06
- Re: Updated Patch for command remapping through keymaps, Kim F. Storm, 2002/02/06
- Re: Updated Patch for command remapping through keymaps, Eli Zaretskii, 2002/02/07
- Re: Updated Patch for command remapping through keymaps, Stefan Monnier, 2002/02/07
- Re: Updated Patch for command remapping through keymaps, Richard Stallman, 2002/02/08
- Re: Updated Patch for command remapping through keymaps, Richard Stallman, 2002/02/08
- Re: Updated Patch for command remapping through keymaps, Stefan Monnier, 2002/02/08