[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Patch for command remapping through keymaps
|
From: |
Kim F. Storm |
|
Subject: |
Patch for command remapping through keymaps |
|
Date: |
28 Jan 2002 02:36:59 +0100 |
|
User-agent: |
Gnus/5.09 (Gnus v5.9.0) Emacs/21.1 |
Here is the patch (sans changelogs) which implements the remapping of
interactive commands through keymaps feature.
I plan to install this in a few days, so comments are very welcome.
Once this is in place, I think substitute-key-definition can be
rewritten to a simple call to define-key, but I haven't had time to
play with that yet.
Index: etc/NEWS
===================================================================
RCS file: /cvs/emacs/etc/NEWS,v
retrieving revision 1.581
diff -c -r1.581 NEWS
*** etc/NEWS 27 Jan 2002 18:24:04 -0000 1.581
--- etc/NEWS 28 Jan 2002 01:23:06 -0000
***************
*** 115,120 ****
--- 115,129 ----
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 k now reports the actual command (after possible remapping) run by
+ the key sequence.
+
+ C-h w on a command which has been remapped now reports the command it
+ is remapped to, and the keys which can be used to run that command.
+
+ C-h f now reports if the command is remapped to another command, and
+ the key bindings which runs that command.
+
** 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,
***************
*** 394,399 ****
--- 403,450 ----
* 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 in a specific (minor) mode.
+ When a key sequence is read from the keyboard corresponds to a
+ command which has been remapped, the command it is remapped to will be
+ executed instead of the original command. For example, if minor mode
+ my-mode need to "advice" kill-line and kill-word in "my" way, this can
+ be accomplished by writing functions my-kill-line and my-kill-word
+ (which may call kill-line and kill-word if necessary), and the make
+ with the following remappings 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.
+
+ The following changes have been made to use this functionality:
+
+ - define-key now accepts a command name as the KEY argument,
+ identifying the command to be remapped in the specified keymap.
+ This is equivalent to specifying the command name as the only
+ element of a vector.
+
+ - key-binding will also remap 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.
+
+ - the new variable `this-original-command' contains the original command
+ when executing a key sequence results in a remapping of that command.
+
+ - where-is-internal will now return no key bindings for a remapped command
+ (e.g. kill-line if my-mode is enabled). Instead, it will report the
+ key bindings of the original command when the argument is the
+ command it is mapped to (e.g. it will return C-k for my-kill-line).
+ It now has a new optional fifth argument, NO-REMAP, to inhibit this
+ behaviour (e.g. it will return C-k for kill-line and <kill-line> for
+ my-kill-line).
** 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 28 Jan 2002 01:23:06 -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 28 Jan 2002 01:23:07 -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 t))
(keys1 (mapconcat 'key-description keys ", "))
(standard-output (if insert (current-buffer) t)))
(if insert
(if (> (length keys1) 0)
! (if remap
! (princ (format "%s (%s (%s remapped))" 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 28 Jan 2002 01:23:07 -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 28 Jan 2002 01:23:08 -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.650
diff -c -r1.650 keyboard.c
*** src/keyboard.c 26 Jan 2002 17:06:55 -0000 1.650
--- src/keyboard.c 28 Jan 2002 01:23:11 -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;
***************
*** 1309,1315 ****
Lisp_Object
command_loop_1 ()
{
! Lisp_Object cmd;
int lose;
int nonundocount;
Lisp_Object keybuf[30];
--- 1313,1319 ----
Lisp_Object
command_loop_1 ()
{
! Lisp_Object cmd, cmd1;
int lose;
int nonundocount;
Lisp_Object keybuf[30];
***************
*** 1503,1508 ****
--- 1507,1520 ----
reset it before we execute the command. */
Vdeactivate_mark = Qnil;
+ /* Remap command through active keymaps */
+ cmd1 = Fkey_binding (cmd, Qnil, Qt);
+ if (!NILP (cmd1))
+ {
+ Vthis_original_command = cmd;
+ cmd = cmd1;
+ }
+
/* Execute the command. */
Vthis_command = cmd;
***************
*** 6945,6951 ****
Lisp_Object prefix;
if (!NILP (tem))
! tem = Fkey_binding (tem, Qnil);
prefix = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
if (CONSP (prefix))
--- 6957,6963 ----
Lisp_Object prefix;
if (!NILP (tem))
! tem = Fkey_binding (tem, Qnil, Qnil);
prefix = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
if (CONSP (prefix))
***************
*** 6991,6997 ****
&& 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))
{
--- 7003,7009 ----
&& SYMBOLP (XSYMBOL (def)->function)
&& ! NILP (Fget (def, Qmenu_alias)))
def = XSYMBOL (def)->function;
! tem = Fwhere_is_internal (def, Qnil, Qt, Qnil, Qnil);
XSETCAR (cachelist, tem);
if (NILP (tem))
{
***************
*** 9406,9412 ****
&& NILP (Vexecuting_macro)
&& SYMBOLP (function))
bindings = Fwhere_is_internal (function, Voverriding_local_map,
! Qt, Qnil);
else
bindings = Qnil;
--- 9418,9424 ----
&& NILP (Vexecuting_macro)
&& SYMBOLP (function))
bindings = Fwhere_is_internal (function, Voverriding_local_map,
! Qt, Qnil, Qnil);
else
bindings = Qnil;
***************
*** 10632,10637 ****
--- 10644,10655 ----
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 28 Jan 2002 01:23:12 -0000
***************
*** 987,992 ****
--- 987,995 ----
keymap = get_keymap (keymap, 1, 1);
+ if (SYMBOLP (key))
+ key = Fmake_vector (make_number (1), key);
+
if (!VECTORP (key) && !STRINGP (key))
key = wrong_type_argument (Qarrayp, key);
***************
*** 1084,1089 ****
--- 1087,1099 ----
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);
***************
*** 1363,1369 ****
/* 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.
--- 1373,1379 ----
/* 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,1385 ****
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;
struct gcpro gcpro1;
GCPRO1 (key);
if (!NILP (current_kboard->Voverriding_terminal_local_map))
--- 1382,1401 ----
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, value1;
int nmaps, i;
struct gcpro gcpro1;
+ do_remap:
GCPRO1 (key);
if (!NILP (current_kboard->Voverriding_terminal_local_map))
***************
*** 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
{
--- 1403,1415 ----
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);
--- 1420,1426 ----
{
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);
--- 1432,1438 ----
{
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. */
--- 1440,1462 ----
{
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 (NILP (no_remap) && SYMBOLP (value)) {
! value1 = Fkey_binding(value, accept_default, Qt);
! if (!NILP (value1) && SYMBOLP (value1))
! value = value1;
! }
! return value;
}
/* GC is possible in this function if it autoloads a keymap. */
***************
*** 2156,2161 ****
--- 2179,2185 ----
/* 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 ();
***************
*** 2177,2188 ****
return Qnil;
}
/* 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;
--- 2201,2280 ----
return Qnil;
}
+ static Lisp_Object
+ remap_sequence (sequence, keymaps, firstonly, noindirect)
+ Lisp_Object sequence, keymaps;
+ Lisp_Object firstonly, noindirect;
+ {
+ Lisp_Object remapped;
+ Lisp_Object function, fun;
+
+ /* This code is similar to Fcommandp, but looks
+ specifically for a command symbol, and don't
+ signal errors. */
+
+ function = AREF (sequence, 0);
+ if (!SYMBOLP (function) || EQ (fun, Qunbound))
+ return Qnil;
+
+ fun = indirect_function (function);
+ if (SYMBOLP (fun) && EQ (fun, Qunbound))
+ return Qnil;
+
+ if (SUBRP (fun))
+ {
+ if (!XSUBR (fun)->prompt)
+ return Qnil;
+ }
+ else if (COMPILEDP (fun))
+ {
+ if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_INTERACTIVE)
+ return Qnil;
+ }
+ else if (CONSP (fun))
+ {
+ Lisp_Object funcar;
+
+ funcar = Fcar (fun);
+ if (!SYMBOLP (funcar))
+ return Qnil;
+
+ if (EQ (funcar, Qlambda))
+ {
+ if (NILP (Fassq (Qinteractive, Fcdr (Fcdr (fun)))))
+ return Qnil;
+ }
+ else if (EQ (funcar, Qautoload))
+ {
+ if (NILP (Fcar (Fcdr (Fcdr (Fcdr (fun))))))
+ return Qnil;
+ }
+ else
+ return Qnil;
+ }
+ else
+ return Qnil;
+
+ remapped = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
+ if (!CONSP (remapped))
+ return Qnil;
+
+ sequence = XCAR(remapped);
+
+ /* Verify that this key binding actually maps to the
+ remapped command (see below). */
+ if (!EQ (shadow_lookup (keymaps, sequence, Qnil), function))
+ return Qt;
+
+ return remapped;
+ }
+
/* 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 ****
--- 2282,2293 ----
/* 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 it's own. */
+ if (NILP (no_remap)
+ && !NILP (Fkey_binding (definition, Qnil, Qt)))
+ return Qnil;
+
found = keymaps;
while (CONSP (found))
{
***************
*** 2295,2331 ****
}
! 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.
! Mechanism: look for local definition of this key and if
! it is defined and does not match what we found then
! ignore this key.
!
! Either nil or number as value from Flookup_key
! means undefined. */
! if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
! continue;
! /* 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)))
! found = Fcons (sequence, found);
!
! /* If firstonly is Qnon_ascii, then we can return the first
! binding we find. If firstonly is not Qnon_ascii but not
! nil, then we should return the first ascii-only binding
! we find. */
! if (EQ (firstonly, Qnon_ascii))
! RETURN_UNGCPRO (sequence);
! else if (!NILP (firstonly) && ascii_sequence_p (sequence))
! RETURN_UNGCPRO (sequence);
}
}
}
--- 2393,2457 ----
}
! while (!NILP (sequences))
{
Lisp_Object sequence;
+ Lisp_Object remapped;
sequence = XCAR (sequences);
+ sequences = XCDR (sequences);
! if (NILP (no_remap)
! && VECTORP (sequence) && XVECTOR (sequence)->size == 1)
! {
! remapped = remap_sequence (sequence, keymaps, firstonly,
noindirect);
! if (EQ (remapped, Qt))
! continue;
! }
! else
! remapped = Qnil;
! if (!NILP (remapped))
! {
! sequence = XCAR (remapped);
! remapped = XCDR (remapped);
! }
! else
! {
! /* Verify that this key binding is not shadowed by another
! binding for the same key, before we say it exists.
!
! Mechanism: look for local definition of this key and if
! it is defined and does not match what we found then
! ignore this key.
!
! Either nil or number as value from Flookup_key
! means undefined. */
! if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
! continue;
! }
! while (1)
! {
! /* 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)))
! found = Fcons (sequence, found);
!
! /* If firstonly is Qnon_ascii, then we can return the first
! binding we find. If firstonly is not Qnon_ascii but not
! nil, then we should return the first ascii-only binding
! we find. */
! if (EQ (firstonly, Qnon_ascii))
! RETURN_UNGCPRO (sequence);
! else if (!NILP (firstonly) && ascii_sequence_p (sequence))
! RETURN_UNGCPRO (sequence);
!
! if (!CONSP (remapped))
! break;
! sequence = XCAR (remapped);
! remapped = XCDR (remapped);
! }
}
}
}
***************
*** 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.
--- 2469,2475 ----
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. */
--- 2484,2496 ----
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 follow remapped command
! symbols to find the actual key bindings. */)
! (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)))
--- 2511,2517 ----
{
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;
--- 2525,2532 ----
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;
--- 2563,2569 ----
/* 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 28 Jan 2002 01:23:12 -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,37 ----
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 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
- Patch for command remapping through keymaps,
Kim F. Storm <=