From: Lars Ingebrigtsen Date: Tue, 16 Nov 2021 07:02:22 +0000 (+0100) Subject: Allow removing keymap definitions X-Git-Tag: emacs-29.0.90~2852^2~261 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=560c921ed8d2d14e593aaee68b8be57b189128e5;p=emacs.git 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. --- diff --git a/etc/NEWS b/etc/NEWS index 0a19dcaf7ab..ed95f891db7 100644 --- a/etc/NEWS +++ b/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. diff --git a/src/keymap.c b/src/keymap.c index 29d2ca7ab7e..c6990cffaf6 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 b4f3dfc25e4..8e106e7c639 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 8e28faf2b26..629d6c55849 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