Allow removing keymap definitions
* src/keymap.c (initial_define_lispy_key): Adjust caller. (store_in_keymap): Allow removing definitions in addition to setting them to nil. (Fdefine_key): Ditto. (define_as_prefix): Adjust caller. * src/term.c (term_get_fkeys_1): Adjust caller.
This commit is contained in:
Lars Ingebrigtsen
parent
aa4cffccac
commit
560c921ed8
4 changed files with 92 additions and 22 deletions
6
etc/NEWS
6
etc/NEWS
|
|
@ -593,6 +593,12 @@ Use 'exif-parse-file' and 'exif-field' instead.
|
|||
|
||||
* Lisp Changes in Emacs 29.1
|
||||
|
||||
+++
|
||||
** 'define-key' now takes an optional REMOVE argument.
|
||||
If non-nil, remove the definition from the keymap. This is subtly
|
||||
different from setting a definition to nil (when the keymap has a
|
||||
parent).
|
||||
|
||||
+++
|
||||
** New function 'file-name-split'.
|
||||
This returns a list of all the components of a file name.
|
||||
|
|
|
|||
58
src/keymap.c
58
src/keymap.c
|
|
@ -73,7 +73,8 @@ static Lisp_Object where_is_cache;
|
|||
/* Which keymaps are reverse-stored in the cache. */
|
||||
static Lisp_Object where_is_cache_keymaps;
|
||||
|
||||
static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object);
|
||||
static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object,
|
||||
bool);
|
||||
|
||||
static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object);
|
||||
static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object,
|
||||
|
|
@ -130,7 +131,8 @@ in case you use it as a menu with `x-popup-menu'. */)
|
|||
void
|
||||
initial_define_lispy_key (Lisp_Object keymap, const char *keyname, const char *defname)
|
||||
{
|
||||
store_in_keymap (keymap, intern_c_string (keyname), intern_c_string (defname));
|
||||
store_in_keymap (keymap, intern_c_string (keyname),
|
||||
intern_c_string (defname), Qnil);
|
||||
}
|
||||
|
||||
DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
|
||||
|
|
@ -729,7 +731,8 @@ get_keyelt (Lisp_Object object, bool autoload)
|
|||
}
|
||||
|
||||
static Lisp_Object
|
||||
store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
|
||||
store_in_keymap (Lisp_Object keymap, register Lisp_Object idx,
|
||||
Lisp_Object def, bool remove)
|
||||
{
|
||||
/* Flush any reverse-map cache. */
|
||||
where_is_cache = Qnil;
|
||||
|
|
@ -805,21 +808,26 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
|
|||
}
|
||||
else if (CHAR_TABLE_P (elt))
|
||||
{
|
||||
Lisp_Object sdef = def;
|
||||
if (remove)
|
||||
sdef = Qnil;
|
||||
/* nil has a special meaning for char-tables, so
|
||||
we use something else to record an explicitly
|
||||
unbound entry. */
|
||||
else if (NILP (sdef))
|
||||
sdef = Qt;
|
||||
|
||||
/* Character codes with modifiers
|
||||
are not included in a char-table.
|
||||
All character codes without modifiers are included. */
|
||||
if (FIXNATP (idx) && !(XFIXNAT (idx) & CHAR_MODIFIER_MASK))
|
||||
{
|
||||
Faset (elt, idx,
|
||||
/* nil has a special meaning for char-tables, so
|
||||
we use something else to record an explicitly
|
||||
unbound entry. */
|
||||
NILP (def) ? Qt : def);
|
||||
Faset (elt, idx, sdef);
|
||||
return def;
|
||||
}
|
||||
else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
|
||||
{
|
||||
Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
|
||||
Fset_char_table_range (elt, idx, sdef);
|
||||
return def;
|
||||
}
|
||||
insertion_point = tail;
|
||||
|
|
@ -838,7 +846,12 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
|
|||
else if (EQ (idx, XCAR (elt)))
|
||||
{
|
||||
CHECK_IMPURE (elt, XCONS (elt));
|
||||
XSETCDR (elt, def);
|
||||
if (remove)
|
||||
/* Remove the element. */
|
||||
insertion_point = Fdelq (elt, insertion_point);
|
||||
else
|
||||
/* Just set the definition. */
|
||||
XSETCDR (elt, def);
|
||||
return def;
|
||||
}
|
||||
else if (CONSP (idx)
|
||||
|
|
@ -851,7 +864,10 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
|
|||
if (from <= XFIXNAT (XCAR (elt))
|
||||
&& to >= XFIXNAT (XCAR (elt)))
|
||||
{
|
||||
XSETCDR (elt, def);
|
||||
if (remove)
|
||||
insertion_point = Fdelq (elt, insertion_point);
|
||||
else
|
||||
XSETCDR (elt, def);
|
||||
if (from == to)
|
||||
return def;
|
||||
}
|
||||
|
|
@ -1054,8 +1070,11 @@ possibly_translate_key_sequence (Lisp_Object key, ptrdiff_t *length)
|
|||
|
||||
/* GC is possible in this function if it autoloads a keymap. */
|
||||
|
||||
DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
|
||||
DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 4, 0,
|
||||
doc: /* In KEYMAP, define key sequence KEY as DEF.
|
||||
This is a legacy function; see `keymap-set' for the recommended
|
||||
function to use instead.
|
||||
|
||||
KEYMAP is a keymap.
|
||||
|
||||
KEY is a string or a vector of symbols and characters, representing a
|
||||
|
|
@ -1082,10 +1101,16 @@ DEF is anything that can be a key's definition:
|
|||
or an extended menu item definition.
|
||||
(See info node `(elisp)Extended Menu Items'.)
|
||||
|
||||
If REMOVE is non-nil, the definition will be removed. This is almost
|
||||
the same as setting the definition to nil, but makes a difference if
|
||||
the KEYMAP has a parent, and KEY is shadowing the same binding in the
|
||||
parent. With REMOVE, subsequent lookups will return the binding in
|
||||
the parent, and with a nil DEF, the lookups will return nil.
|
||||
|
||||
If KEYMAP is a sparse keymap with a binding for KEY, the existing
|
||||
binding is altered. If there is no binding for KEY, the new pair
|
||||
binding KEY to DEF is added at the front of KEYMAP. */)
|
||||
(Lisp_Object keymap, Lisp_Object key, Lisp_Object def)
|
||||
(Lisp_Object keymap, Lisp_Object key, Lisp_Object def, Lisp_Object remove)
|
||||
{
|
||||
bool metized = false;
|
||||
|
||||
|
|
@ -1155,7 +1180,7 @@ binding KEY to DEF is added at the front of KEYMAP. */)
|
|||
message_with_string ("Key sequence contains invalid event %s", c, 1);
|
||||
|
||||
if (idx == length)
|
||||
return store_in_keymap (keymap, c, def);
|
||||
return store_in_keymap (keymap, c, def, !NILP (remove));
|
||||
|
||||
Lisp_Object cmd = access_keymap (keymap, c, 0, 1, 1);
|
||||
|
||||
|
|
@ -1260,6 +1285,9 @@ lookup_key_1 (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default)
|
|||
|
||||
DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
|
||||
doc: /* Look up key sequence KEY in KEYMAP. Return the definition.
|
||||
This is a legacy function; see `keymap-lookup' for the recommended
|
||||
function to use instead.
|
||||
|
||||
A value of nil means undefined. See doc of `define-key'
|
||||
for kinds of definitions.
|
||||
|
||||
|
|
@ -1413,7 +1441,7 @@ static Lisp_Object
|
|||
define_as_prefix (Lisp_Object keymap, Lisp_Object c)
|
||||
{
|
||||
Lisp_Object cmd = Fmake_sparse_keymap (Qnil);
|
||||
store_in_keymap (keymap, c, cmd);
|
||||
store_in_keymap (keymap, c, cmd, Qnil);
|
||||
|
||||
return cmd;
|
||||
}
|
||||
|
|
|
|||
16
src/term.c
16
src/term.c
|
|
@ -1358,7 +1358,7 @@ term_get_fkeys_1 (void)
|
|||
char *sequence = tgetstr (keys[i].cap, address);
|
||||
if (sequence)
|
||||
Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence),
|
||||
make_vector (1, intern (keys[i].name)));
|
||||
make_vector (1, intern (keys[i].name)), Qnil);
|
||||
}
|
||||
|
||||
/* The uses of the "k0" capability are inconsistent; sometimes it
|
||||
|
|
@ -1377,13 +1377,13 @@ term_get_fkeys_1 (void)
|
|||
/* Define f0 first, so that f10 takes precedence in case the
|
||||
key sequences happens to be the same. */
|
||||
Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0),
|
||||
make_vector (1, intern ("f0")));
|
||||
make_vector (1, intern ("f0")), Qnil);
|
||||
Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k_semi),
|
||||
make_vector (1, intern ("f10")));
|
||||
make_vector (1, intern ("f10")), Qnil);
|
||||
}
|
||||
else if (k0)
|
||||
Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0),
|
||||
make_vector (1, intern (k0_name)));
|
||||
make_vector (1, intern (k0_name)), Qnil);
|
||||
}
|
||||
|
||||
/* Set up cookies for numbered function keys above f10. */
|
||||
|
|
@ -1405,8 +1405,10 @@ term_get_fkeys_1 (void)
|
|||
if (sequence)
|
||||
{
|
||||
sprintf (fkey, "f%d", i);
|
||||
Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence),
|
||||
make_vector (1, intern (fkey)));
|
||||
Fdefine_key (KVAR (kboard, Vinput_decode_map),
|
||||
build_string (sequence),
|
||||
make_vector (1, intern (fkey)),
|
||||
Qnil);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -1422,7 +1424,7 @@ term_get_fkeys_1 (void)
|
|||
char *sequence = tgetstr (cap2, address); \
|
||||
if (sequence) \
|
||||
Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), \
|
||||
make_vector (1, intern (sym))); \
|
||||
make_vector (1, intern (sym)), Qnil); \
|
||||
}
|
||||
|
||||
/* if there's no key_next keycap, map key_npage to `next' keysym */
|
||||
|
|
|
|||
|
|
@ -373,6 +373,40 @@ g .. h foo
|
|||
(should (eq (lookup-key (current-global-map) ["C-x C-f"]) 'find-file))
|
||||
(should (eq (lookup-key (current-global-map) [?\C-x ?\C-f]) 'find-file)))
|
||||
|
||||
(ert-deftest keymap-removal ()
|
||||
;; Set to nil.
|
||||
(let ((map (define-keymap "a" 'foo)))
|
||||
(should (equal map '(keymap (97 . foo))))
|
||||
(define-key map "a" nil)
|
||||
(should (equal map '(keymap (97)))))
|
||||
;; Remove.
|
||||
(let ((map (define-keymap "a" 'foo)))
|
||||
(should (equal map '(keymap (97 . foo))))
|
||||
(define-key map "a" nil t)
|
||||
(should (equal map '(keymap)))))
|
||||
|
||||
(ert-deftest keymap-removal-inherit ()
|
||||
;; Set to nil.
|
||||
(let ((parent (make-sparse-keymap))
|
||||
(child (make-keymap)))
|
||||
(set-keymap-parent child parent)
|
||||
(define-key parent [?a] 'foo)
|
||||
(define-key child [?a] 'bar)
|
||||
|
||||
(should (eq (lookup-key child [?a]) 'bar))
|
||||
(define-key child [?a] nil)
|
||||
(should (eq (lookup-key child [?a]) nil)))
|
||||
;; Remove.
|
||||
(let ((parent (make-sparse-keymap))
|
||||
(child (make-keymap)))
|
||||
(set-keymap-parent child parent)
|
||||
(define-key parent [?a] 'foo)
|
||||
(define-key child [?a] 'bar)
|
||||
|
||||
(should (eq (lookup-key child [?a]) 'bar))
|
||||
(define-key child [?a] nil t)
|
||||
(should (eq (lookup-key child [?a]) 'foo))))
|
||||
|
||||
(provide 'keymap-tests)
|
||||
|
||||
;;; keymap-tests.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue