[elpa] externals/hyperbole af73116 07/25: hib-kbd.el: Recognize helm-M-x or counsel-M-x bound to M-x

[Stefan Monnier]

branch: externals/hyperbole
commit af731168cf7d7057da8e4e9716c45571b49d2bad
Author: Bob Weiner <Bob.Weiner@DuffandPhelps.com>
Commit: Bob Weiner <Bob.Weiner@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  <rsw@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  <rsw@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.")