branch: externals/hyperbole
commit af731168cf7d7057da8e4e9716c45571b49d2bad
Author: Bob Weiner <bob.wei...@duffandphelps.com>
Commit: Bob Weiner <bob.wei...@duffandphelps.com>
hib-kbd.el: Recognize helm-M-x or counsel-M-x bound to M-x
---
Changes | 5 +++++
HY-NEWS | 7 +++++++
hib-kbd.el | 50 ++++++++++++++++++++++++++++++++++++++------------
3 files changed, 50 insertions(+), 12 deletions(-)
diff --git a/Changes b/Changes
index d4d97a5..2aef647 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,8 @@
+2020-07-25 Bob Weiner <r...@gnu.org>
+
+* hib-kbd.el (kbd-key:execute-special-series): Added and used in kbd-key:act
+ to make key series work properly when helm-mode or counsel-mode are
enabled.
+
2020-07-23 Bob Weiner <r...@gnu.org>
* hui.el (hui:ibut-label-create): Fixed to skip back past opening delimiter
diff --git a/HY-NEWS b/HY-NEWS
index c3df751..d980eb7 100644
--- a/HY-NEWS
+++ b/HY-NEWS
@@ -15,6 +15,13 @@
associated with Agenda items such as TODOs in another window. The
Assist Key shows help.
+ BUTTON TYPES
+
+ - {Key Series} Button Support for Helm and Counsel: Key series buttons
+ with M-x commands now work properly when counsel-mode or helm-mode are
+ enabled and M-x is rebound.
+
+
===========================================================================
* V7.1.2
===========================================================================
diff --git a/hib-kbd.el b/hib-kbd.el
index b3736cc..074d5f8 100644
--- a/hib-kbd.el
+++ b/hib-kbd.el
@@ -29,6 +29,7 @@
;;; ************************************************************************
(require 'hactypes)
+(require 'seq)
(defvar kbd-key:named-key-list
'("add" "backspace" "begin" "bs" "clear" "decimal" "delete" "del"
@@ -117,10 +118,8 @@ Returns t if KEY-SERIES has a binding, 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)
- ;; If this is a special key seqence, execute it by adding
- ;; its keys to the stream of unread command events.
(when (kbd-key:special-sequence-p key-series)
- (kbd-key:key-series-to-events key-series)
+ (kbd-key:execute-special-series key-series)
t))
((memq binding '(action-key action-mouse-key hkey-either))
(beep)
@@ -128,9 +127,32 @@ Returns t if KEY-SERIES has a binding, else nil."
t)
(t (call-interactively binding) t))))
+(defun kbd-key:execute-special-series (key-series)
+ "Execute key series."
+ (if (eq (key-binding [?\M-x]) #'execute-extended-command)
+ (kbd-key:key-series-to-events key-series)
+ ;; Disable helm or counsel while processing M-x commands; helm at
+ ;; least gobbles final RET key,
+ (let ((orig-binding (global-key-binding [?\M-x]))
+ (counsel-flag (and (boundp 'counsel-mode) counsel-mode))
+ (helm-flag (and (boundp 'helm-mode) helm-mode)))
+ (unwind-protect
+ (progn
+ (when counsel-flag (counsel-mode -1))
+ (when helm-flag (helm-mode -1))
+ (global-set-key [?\M-x] 'execute-extended-command)
+ (kbd-key:key-series-to-events key-series)
+ (sit-for 0.001))
+ (when counsel-flag (counsel-mode 1))
+ (when helm-flag (helm-mode 1))
+ (global-set-key [?\M-x] orig-binding)))))
+
(defun kbd-key:key-series-to-events (key-series)
"Insert the key-series as a series of keyboard events into Emacs' unread
input stream."
- (setq unread-command-events (nconc unread-command-events
(listify-key-sequence (kbd-key:kbd key-series)))))
+ (setq unread-command-events (nconc unread-command-events
+ (listify-key-sequence
+ (kbd-key:kbd
+ key-series)))))
(defun kbd-key:doc (key-series &optional full)
"Show first line of doc for binding of keyboard KEY-SERIES in minibuffer.
@@ -263,12 +285,13 @@ For an approximate inverse of this, see
`key-description'."
(setq times (string-to-number (substring word 0 (match-end 1))))
(setq word (substring word (1+ (match-end 1)))))
(cond ((string-match "^<<.+>>$" word)
- (setq key (vconcat (if (eq (key-binding [?\M-x])
- 'execute-extended-command)
- [?\M-x]
- (or (car (where-is-internal
- 'execute-extended-command))
- [?\M-x]))
+ (setq key (vconcat (cond ((memq (key-binding [?\M-x])
+
kbd-key:extended-command-binding-list)
+ [?\M-x])
+ ((seq-filter
+ (lambda (elt) (car (where-is-internal
elt)))
+ kbd-key:extended-command-binding-list)
+ [?\M-x]))
(substring word 2 -2) "\r")))
((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word)
(progn
@@ -409,8 +432,11 @@ a M-x extended command,
;;; ************************************************************************
(defconst kbd-key:extended-command-prefix
- (kbd-key:normalize (key-description (where-is-internal
'execute-extended-command (current-global-map) t)))
- "Normalized prefix string that invokes an extended command; typically ESC
x.")
+ (format "\\_<%s\\_>" (kbd-key:normalize "M-x"))
+ "Normalized prefix regular expression that invokes an extended command; by
default, M-x.")
+
+(defconst kbd-key:extended-command-binding-list '(execute-extended-command
helm-M-x counsel-M-x)
+ "List of commands that may be bound to M-x to invoke extended/named
commands.")
(defvar kbd-key:mini-menu-key nil
"The key sequence that invokes the Hyperbole minibuffer menu.")
