procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Lift {global,local}-key-binding to Lisp

Browse source 
* lisp/subr.el (local-key-binding, global-key-binding): New defuns.
* src/keymap.c (Flocal_key_binding, Fglobal_key_binding): Remove DEFUNs.
(syms_of_keymap): Remove defsubrs for above DEFUNs.
* test/lisp/subr-tests.el (subr-test-local-key-binding)
(subr-test-global-key-binding): New tests.
This commit is contained in:
Stefan Kangas 2021-01-13 18:54:09 +01:00
parent be9b7e83bc
commit a9658cd5b0
3 changed files with 35 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
lisp/subr.el
View file

@ -1178,6 +1178,30 @@ KEY is a string or vector representing a sequence of keystrokes."
(if (current-local-map)
(local-set-key key nil))
nil)
(defun local-key-binding (keys &optional accept-default)
"Return the binding for command KEYS in current local keymap only.
KEYS is a string or vector, a sequence of keystrokes.
The binding is probably a symbol with a function definition.
If optional argument ACCEPT-DEFAULT is non-nil, recognize default
bindings; see the description of `lookup-key' for more details
about this."
(let ((map (current-local-map)))
(when map (lookup-key map keys accept-default))))
(defun global-key-binding (keys &optional accept-default)
"Return the binding for command KEYS in current global keymap only.
KEYS is a string or vector, a sequence of keystrokes.
The binding is probably a symbol with a function definition.
This function's return values are the same as those of `lookup-key'
\(which see).
If optional argument ACCEPT-DEFAULT is non-nil, recognize default
bindings; see the description of `lookup-key' for more details
about this."
(lookup-key (current-global-map) keys accept-default))
;;;; substitute-key-definition and its subroutines.

35
src/keymap.c
View file

@ -1646,39 +1646,6 @@ specified buffer position instead of point are used.
/* GC is possible in this function if it autoloads a keymap. */
DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
doc: /* Return the binding for command KEYS in current local keymap only.
KEYS is a string or vector, a sequence of keystrokes.
The binding is probably a symbol with a function definition.
If optional argument ACCEPT-DEFAULT is non-nil, recognize default
bindings; see the description of `lookup-key' for more details about this. */)
(Lisp_Object keys, Lisp_Object accept_default)
{
register Lisp_Object map = BVAR (current_buffer, keymap);
if (NILP (map))
return Qnil;
return Flookup_key (map, keys, accept_default);
}
/* GC is possible in this function if it autoloads a keymap. */
DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
doc: /* Return the binding for command KEYS in current global keymap only.
KEYS is a string or vector, a sequence of keystrokes.
The binding is probably a symbol with a function definition.
This function's return values are the same as those of `lookup-key'
\(which see).
If optional argument ACCEPT-DEFAULT is non-nil, recognize default
bindings; see the description of `lookup-key' for more details about this. */)
(Lisp_Object keys, Lisp_Object accept_default)
{
return Flookup_key (current_global_map, keys, accept_default);
}
/* GC is possible in this function if it autoloads a keymap. */
DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
doc: /* Find the visible minor mode bindings of KEY.
Return an alist of pairs (MODENAME . BINDING), where MODENAME is
@ -3253,8 +3220,6 @@ be preferred. */);
defsubr (&Scopy_keymap);
defsubr (&Scommand_remapping);
defsubr (&Skey_binding);
defsubr (&Slocal_key_binding);
defsubr (&Sglobal_key_binding);
defsubr (&Sminor_mode_key_binding);
defsubr (&Sdefine_key);
defsubr (&Slookup_key);

11
test/lisp/subr-tests.el
View file

@ -87,6 +87,17 @@
;; Returns the symbol.
(should (eq (define-prefix-command 'foo-bar) 'foo-bar)))
(ert-deftest subr-test-local-key-binding ()
(with-temp-buffer
(emacs-lisp-mode)
(should (keymapp (local-key-binding [menu-bar])))
(should-not (local-key-binding [f12]))))
(ert-deftest subr-test-global-key-binding ()
(should (eq (global-key-binding [f1]) 'help-command))
(should (eq (global-key-binding "x") 'self-insert-command))
(should-not (global-key-binding [f12])))
;;;; Mode hooks.