[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 560c921 2/5: Allow removing keymap definitions
|
From: |
Lars Ingebrigtsen |
|
Subject: |
master 560c921 2/5: Allow removing keymap definitions |
|
Date: |
Tue, 16 Nov 2021 02:26:34 -0500 (EST) |
branch: master
commit 560c921ed8d2d14e593aaee68b8be57b189128e5
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
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.
---
etc/NEWS | 6 +++++
src/keymap.c | 58 +++++++++++++++++++++++++++++++++++-------------
src/term.c | 16 +++++++------
test/src/keymap-tests.el | 34 ++++++++++++++++++++++++++++
4 files changed, 92 insertions(+), 22 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 0a19dca..ed95f89 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -594,6 +594,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.
diff --git a/src/keymap.c b/src/keymap.c
index 29d2ca7..c6990cf 100644
--- a/src/keymap.c
+++ b/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;
}
diff --git a/src/term.c b/src/term.c
index b4f3dfc..8e106e7 100644
--- a/src/term.c
+++ b/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 */
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index 8e28faf..629d6c5 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -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