branch: externals/hyperbole
commit dc6c8dcfcd0cbc58e6c8811a50e7b4b6e21f935c
Author: Bob Weiner <r...@gnu.org>
Commit: Bob Weiner <r...@gnu.org>
hyperbole-set-key: Change to bind cmds or Hypb minibuffer menu items in any
keymap
---
ChangeLog | 7 +++++++
HY-NEWS | 4 ++--
hib-kbd.el | 17 ++++++++++-------
hui-mini.el | 48 +++++++++++++++++++++++++++++++-----------------
4 files changed, 50 insertions(+), 26 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 4d49f1cddd..e89d730950 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,12 @@
2022-04-24 Bob Weiner <r...@gnu.org>
+* hib-kbd.el (kbd-key:act): Fix to handle non-special key series that
+ contains more than one command, e.g "C-uC-n C-uC-n".
+
+* hui-mini.el (hyperbole-set-key): Generalize to bind commands or
+ Hyperbole minibuffer menu key strings in any keymap, with
+ (global-key-map) as a default.
+
* hyperbole.el (hkey-set-key): Turn into a command with interactive
calling support.
diff --git a/HY-NEWS b/HY-NEWS
index 2be208b400..0a8b09cc81 100644
--- a/HY-NEWS
+++ b/HY-NEWS
@@ -87,8 +87,8 @@
** TEST CASES
*** Hyperbole Automated Testing: Extensive quality improvements throughout
- Hyperbole thanks in part to over 200 test cases now included in the
- test/ subdirectory. Simply run 'make test' or 'make test-all' from the
+ Hyperbole thanks in part to over 230 test cases now included in the
+ test/ subdirectory. Simply run 'make test-all' or 'make test' from the
command-line when in the Hyperbole source directory and you should see
all tests pass. If any fail, you can press the Action Key to see the
source of the failure. Full testing is supported under POSIX systems
diff --git a/hib-kbd.el b/hib-kbd.el
index dca56b3862..5da56e163e 100644
--- a/hib-kbd.el
+++ b/hib-kbd.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 22-Nov-91 at 01:37:57
-;; Last-Mod: 17-Apr-22 at 12:53:49 by Bob Weiner
+;; Last-Mod: 24-Apr-22 at 17:34:04 by Bob Weiner
;;
;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -85,7 +85,7 @@ Return t if the sequence appears to be valid, else nil."
Key sequences should be in human readable form, e.g. {C-x C-b}, or what
`key-description' returns.
Forms such as {\C-b}, {\^b}, and {^M} will not be recognized.
-Any key sequence must be a string of one of the following:
+Any key sequence within the series must be a string of one of the following:
a Hyperbole minibuffer menu item key sequence,
a HyControl key sequence,
a M-x extended command,
@@ -148,14 +148,17 @@ Return t if KEY-SERIES appears valid, else nil."
(setq current-prefix-arg nil) ;; Execution of the key-series may set it.
(let ((binding (kbd-key:binding key-series)))
(cond ((null binding)
- (when (kbd-key:special-sequence-p key-series)
- (kbd-key:execute-special-series key-series)
- t))
+ (if (kbd-key:special-sequence-p key-series)
+ (kbd-key:execute-special-series key-series)
+ (kbd-key:key-series-to-events key-series))
+ t)
((memq binding '(action-key action-mouse-key hkey-either))
(beep)
(message "(kbd-key:act): This key does what the Action Key does.")
t)
- (t (call-interactively binding) t))))
+ ((not (integerp binding))
+ (call-interactively binding)
+ t))))
(defun kbd-key:execute (key-series)
"Execute a possibly non-normalized KEY-SERIES with or without curly brace
delimiters.
@@ -232,7 +235,7 @@ With optional prefix arg FULL, display full documentation
for command."
Key sequences should be in human readable form, e.g. {C-x C-b}, or what
`key-description' returns.
Forms such as {\C-b}, {\^b}, and {^M} will not be recognized.
-Any key sequence must be a string of one of the following:
+Any key sequence within the series must be a string of one of the following:
a Hyperbole minibuffer menu item key sequence,
a HyControl key sequence,
a M-x extended command,
diff --git a/hui-mini.el b/hui-mini.el
index e3dec86834..b791a2201e 100644
--- a/hui-mini.el
+++ b/hui-mini.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 15-Oct-91 at 20:13:17
-;; Last-Mod: 17-Apr-22 at 11:24:59 by Bob Weiner
+;; Last-Mod: 24-Apr-22 at 16:33:12 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -91,34 +91,48 @@ With a prefix arg, display the older, more extensive DEMO
file."
(hypb:display-file-with-logo (if arg "DEMO" "FAST-DEMO")))
;;;###autoload
-(defun hyperbole-set-key (global-key menu-keys)
- "Bind GLOBAL-KEY to Hyperbole minibuffer MENU-KEYS.
-GLOBAL-KEY is a key sequence; noninteractively, it is a string or vector
+(defun hyperbole-set-key (keymap key binding)
+ "In KEYMAP, bind KEY to Hyperbole minibuffer BINDING.
+If KEYMAP is nil, use the value of (global-key-map).
+
+KEY is a key sequence; noninteractively, it is a string or vector
of characters or event types, and non-ASCII characters with codes
above 127 (such as ISO Latin-1) can be included if you use a vector.
-MENU-KEYS is a string of the ASCII key presses used to invoke a
-Hyperbole minibuffer command.
+BINDING is one of:
+ nil - immediately remove key binding from keymap
+ string - upon key press, execute the BINDING string as a key series
+ command - upon key press, run the command interactively.
-Note that if GLOBAL-KEY has a local binding in the current buffer,
-that local binding will continue to shadow any global binding
-that you make with this function."
+Note that other local or minor mode bindings may shadow/override any
+binding made with this function."
(interactive
(let* ((menu-prompting nil)
(key (read-key-sequence "Set Hyperbole key globally: ")))
(setq hui:menu-keys "")
- (list key
+ (list nil
+ key
+ ;; Read Hyperbole minibuffer menu keys to bind to 'key' in 'keymap'
(concat
;; Normalize the key prefix that invokes the Hyperbole minibuffer
menu
(kbd (key-description (car (where-is-internal 'hyperbole))))
- (hui:get-keys)))))
- (or (vectorp global-key) (stringp global-key)
- (signal 'wrong-type-argument (list 'arrayp global-key)))
- (if (or (not (stringp menu-keys)) (string-empty-p menu-keys))
- (user-error "(hyperbole-set-key): No Hyperbole menu item selected")
- (define-key (current-global-map) global-key `(lambda () (interactive)
(kbd-key:act ,menu-keys)))
+ (hui:get-keys)))))
+ (when (and keymap (not (keymapp keymap)))
+ (error "(hyperbole-set-key): First arg must be either nil or a keymap, not
'%s'" keymap))
+ (unless keymap
+ (setq keymap (current-global-map)))
+ (or (vectorp key) (stringp key)
+ (error "(hyperbole-set-key): Second arg must be a vector or string key
sequence, not '%s'" key))
+ (prog1 (cond ((stringp binding)
+ (if (string-empty-p binding)
+ (error "(hyperbole-set-key): Third arg must be a non-empty
string")
+ (define-key keymap key `(lambda () (interactive) (kbd-key:act
,binding)))))
+ ((or (null binding) (commandp binding))
+ (define-key keymap key binding))
+ (t
+ (error "(hyperbole-set-key): Invalid binding for {%s}: '%s'"
key binding)))
(when (called-interactively-p 'interactive)
- (message "{%s} globally set to invoke {%s}" (key-description global-key)
(key-description menu-keys)))))
+ (message "{%s} set to invoke {%s}" (key-description key) binding))))
(defun hui:menu-act (menu &optional menu-list doc-flag help-string-flag)
"Prompt user with Hyperbole MENU (a symbol) and perform selected item.
