Make counsel-M-x collection customizable

* ivy.el (ivy--flx-available-p): Remove, replacing all uses...
(ivy--features, ivy--feature-p): ...with these new definitions
instead.  These are like 'features' and 'require', respectively,
except they hit the filesystem at most once, caching the
result (#1246).

* counsel.el (counsel-M-x-transformer): Don't show key binding when
suggest-key-bindings is nil, as per read-extended-command-1.  Don't
assume key-description result is mutable.
(counsel-M-x-collection): New user option (#2870).
(counsel--M-x-make-predicate): Rename...
(counsel--M-x-predicate): ...to this.  Accept all completion table
types.  Treat unknown read-extended-command-predicate value as a
match, for more graceful degradation.
(counsel--M-x-externs): Remove, breaking functionality out...
(counsel--M-x-collection, counsel--amx-collection)
(counsel--smex-collection): ...into these new functions.  Obey
counsel-M-x-collection.  Use ivy--feature-p to avoid hitting
filesystem up to twice (#1246, #3019).  Return amx-cache as-is now
that counsel--M-x-predicate supports it.
(counsel--M-x-externs-predicate): Remove, replacing with
counsel--M-x-predicate across the board for consistency.
(counsel--M-x-prompt): Take prefix as an argument and refactor.
(counsel-M-x-action): Bind prefix-arg around command-execute instead
of setting it before, as per execute-extended-command.  Obey
ivy-current-prefix-arg (#1639).  Break amx/smex ranking out...
(counsel--M-x-extern-rank): ...into this new function obeying
counsel-M-x-collection.
(counsel-M-x): Revert #893 which set this-command to last-command,
as this is misleading during minibuffer-setup-hook (#891, #2874).

* ivy-test.el (counsel--M-x-prompt): New test.

Closes #891.
Fixes #1246.
Fixes #1639.
Fixes #2870.
Fixes #2874.

3 files changed, 146 insertions, 97 deletions

diff --git a/counsel.el b/counsel.el
index b94ee11..67d0b49 100644
--- a/counsel.el
+++ b/counsel.el
@@ -846,6 +846,7 @@ With prefix arg MODE a query for the symbol help mode is offered."
 ;;;; `counsel-M-x'
 
 (defface counsel-key-binding
+  ;; Default Emacs 28 `help-key-binding' doesn't look great in parentheses.
   '((t :inherit font-lock-keyword-face))
   "Face used by `counsel-M-x' for key bindings."
   :group 'ivy-faces)
@@ -874,7 +875,7 @@ With prefix arg MODE a query for the symbol help mode is offered."
     (concat cmd
             (when (and (symbolp alias) counsel-alias-expand)
               (format " (%s)" alias))
-            (when key
+            (when (and key suggest-key-bindings)
               ;; Prefer `<f2>' over `C-x 6' where applicable
               (let ((i (cl-search [?\C-x ?6] key)))
                 (when i
@@ -884,73 +885,109 @@ With prefix arg MODE a query for the symbol help mode is offered."
                                  (lookup-key map dup))
                       (setq key dup)))))
               (setq key (key-description key))
-              (put-text-property 0 (length key) 'face 'counsel-key-binding key)
+              (setq key (propertize key 'face 'counsel-key-binding))
               (format " (%s)" key)))))
 
-(defvar amx-initialized)
-(defvar amx-cache)
-(declare-function amx-initialize "ext:amx")
-(declare-function amx-detect-new-commands "ext:amx")
-(declare-function amx-update "ext:amx")
-(declare-function amx-rank "ext:amx")
-(defvar smex-initialized-p)
-(defvar smex-ido-cache)
-(declare-function smex-initialize "ext:smex")
-(declare-function smex-detect-new-commands "ext:smex")
-(declare-function smex-update "ext:smex")
-(declare-function smex-rank "ext:smex")
-
-(defun counsel--M-x-externs ()
-  "Return `counsel-M-x' candidates from external packages.
-The return value is a list of strings.  The currently supported
-packages are, in order of precedence, `amx' and `smex'."
-  (cond ((require 'amx nil t)
-         (unless amx-initialized
-           (amx-initialize))
-         (when (amx-detect-new-commands)
-           (amx-update))
-         (mapcar (lambda (entry)
-                   (symbol-name (car entry)))
-                 amx-cache))
-        ((require 'smex nil t)
-         (unless smex-initialized-p
-           (smex-initialize))
-         (when (smex-detect-new-commands)
-           (smex-update))
-         smex-ido-cache)))
-
-(defun counsel--M-x-externs-predicate (cand)
-  "Return non-nil if `counsel-M-x' should complete CAND.
-CAND is a string returned by `counsel--M-x-externs'."
-  (not (function-get (intern cand) 'no-counsel-M-x)))
-
-(defun counsel--M-x-make-predicate ()
+(defcustom counsel-M-x-collection 'auto
+  "Where to source `counsel-M-x' completion candidates from.
+`obarray' - Use the default M-x collection built into Emacs.
+`amx'     - Source candidates from the external `amx' package.
+`smex'    - Source candidates from the external `smex' package.
+`auto'    - Automatically detect one of the previous options,
+            falling back to `obarray'.  This is the default.
+The value can alternatively be a function of no arguments
+that returns a completion table suitable for `ivy-read'."
+  :package-version '(counsel . "0.16.0")
+  :type '(choice (const :tag "Built-in" obarray)
+                 (const :tag "Amx package" amx)
+                 (const :tag "Smex package" smex)
+                 (const :tag "Auto-detect" auto)
+                 (function :tag "Custom function")))
+
+(defun counsel--M-x-collection ()
+  "Return a completion table obeying `counsel-M-x-collection'."
+  (let ((src counsel-M-x-collection))
+    (cond ((eq src 'obarray) obarray)
+          ((eq src 'auto)
+           (cond ((ivy--feature-p 'amx)
+                  (counsel--amx-collection))
+                 ((ivy--feature-p 'smex)
+                  (counsel--smex-collection))
+                 (obarray)))
+          ((eq src 'amx)
+           (unless (ivy--feature-p 'amx)
+             (user-error "Package `amx' not installed"))
+           (counsel--amx-collection))
+          ((eq src 'smex)
+           (unless (ivy--feature-p 'smex)
+             (user-error "Package `smex' not installed"))
+           (counsel--smex-collection))
+          ((functionp src) (funcall src))
+          ((user-error "Unknown `counsel-M-x-collection': %S" src)))))
+
+(defun counsel--M-x-extern-rank (cmd)
+  "Tell external `counsel-M-x-collection' that CMD was selected."
+  (declare-function amx-rank "ext:amx")
+  (declare-function smex-rank "ext:smex")
+  (let ((src counsel-M-x-collection))
+    (cond ((and (memq src '(auto amx))
+                (bound-and-true-p amx-initialized))
+           (amx-rank cmd))
+          ((and (memq src '(auto smex))
+                (bound-and-true-p smex-initialized-p))
+           (smex-rank cmd)))))
+
+(defun counsel--amx-collection ()
+  "Return `counsel-M-x' candidates from the `amx' package."
+  (declare-function amx-detect-new-commands "ext:amx")
+  (declare-function amx-initialize "ext:amx")
+  (declare-function amx-update "ext:amx")
+  (defvar amx-cache)
+  (defvar amx-initialized)
+  (unless amx-initialized
+    (amx-initialize))
+  (when (amx-detect-new-commands)
+    (amx-update))
+  amx-cache)
+
+(defun counsel--smex-collection ()
+  "Return `counsel-M-x' candidates from the `smex' package."
+  (declare-function smex-detect-new-commands "ext:smex")
+  (declare-function smex-initialize "ext:smex")
+  (declare-function smex-update "ext:smex")
+  (defvar smex-ido-cache)
+  (defvar smex-initialized-p)
+  (unless smex-initialized-p
+    (smex-initialize))
+  (when (smex-detect-new-commands)
+    (smex-update))
+  smex-ido-cache)
+
+(defun counsel--M-x-predicate ()
   "Return a predicate for `counsel-M-x' in the current buffer."
-  (defvar read-extended-command-predicate)
   (let ((buf (current-buffer)))
-    (lambda (sym)
-      (and (commandp sym)
-           (not (function-get sym 'byte-obsolete-info))
-           (not (function-get sym 'no-counsel-M-x))
-           (cond ((not (bound-and-true-p read-extended-command-predicate)))
-                 ((functionp read-extended-command-predicate)
-                  (condition-case-unless-debug err
-                      (funcall read-extended-command-predicate sym buf)
-                    (error (message "read-extended-command-predicate: %s: %s"
-                                    sym (error-message-string err))))))))))
-
-(defun counsel--M-x-prompt ()
-  "String for `M-x' plus the string representation of `current-prefix-arg'."
-  (concat (cond ((null current-prefix-arg)
-                 nil)
-                ((eq current-prefix-arg '-)
-                 "- ")
-                ((integerp current-prefix-arg)
-                 (format "%d " current-prefix-arg))
-                ((= (car current-prefix-arg) 4)
-                 "C-u ")
-                (t
-                 (format "%d " (car current-prefix-arg))))
+    ;; Should work with all completion table types.
+    (lambda (key &optional _val)
+      (when (consp key) (setq key (car key)))
+      (when (stringp key) (setq key (intern key)))
+      (and (commandp key)
+           (not (function-get key 'byte-obsolete-info))
+           (not (function-get key 'no-counsel-M-x))
+           ;; New in Emacs 28.
+           (let ((pred (bound-and-true-p read-extended-command-predicate)))
+             (or (not (functionp pred))
+                 (condition-case-unless-debug err
+                     (funcall pred key buf)
+                   (error (message "read-extended-command-predicate: %s: %s"
+                                   key (error-message-string err))))))))))
+
+(defun counsel--M-x-prompt (arg)
+  "Prompt for `counsel-M-x' preceded by a printed form of prefix ARG."
+  (concat (cond ((null arg) ())
+                ((eq (car-safe arg) 4) "C-u ")
+                ((or (eq arg '-)
+                     (integerp (or (car-safe arg) arg)))
+                 (format "%s " (or (car-safe arg) arg))))
           "M-x "))
 
 (defvar counsel-M-x-history nil
@@ -960,38 +997,29 @@ CAND is a string returned by `counsel--M-x-externs'."
   "Execute CMD."
   (setq cmd (intern
              (subst-char-in-string ?\s ?- (string-remove-prefix "^" cmd))))
-  (cond ((bound-and-true-p amx-initialized)
-         (amx-rank cmd))
-        ((bound-and-true-p smex-initialized-p)
-         (smex-rank cmd)))
-  (setq prefix-arg current-prefix-arg)
+  (counsel--M-x-extern-rank cmd)
+  ;; As per `execute-extended-command'.
   (setq this-command cmd)
   (setq real-this-command cmd)
-  (command-execute cmd 'record))
+  (let ((prefix-arg (or ivy-current-prefix-arg current-prefix-arg)))
+    (command-execute cmd 'record)))
 
 ;;;###autoload
 (defun counsel-M-x (&optional initial-input)
   "Ivy version of `execute-extended-command'.
 Optional INITIAL-INPUT is the initial input in the minibuffer.
-This function integrates with either the `amx' or `smex' package
-when available, in that order of precedence."
+This function integrates with either the `amx' or `smex' package when
+available, in that order of precedence; see `counsel-M-x-collection'."
   (interactive)
-  ;; When `counsel-M-x' returns, `last-command' would be set to
-  ;; `counsel-M-x' because :action hasn't been invoked yet.
-  ;; Instead, preserve the old value of `this-command'.
-  (setq this-command last-command)
-  (setq real-this-command real-last-command)
-  (let ((externs (counsel--M-x-externs)))
-    (ivy-read (counsel--M-x-prompt) (or externs obarray)
-              :predicate (if externs
-                             #'counsel--M-x-externs-predicate
-                           (counsel--M-x-make-predicate))
-              :require-match t
-              :history 'counsel-M-x-history
-              :action #'counsel-M-x-action
-              :keymap counsel-describe-map
-              :initial-input initial-input
-              :caller 'counsel-M-x)))
+  (ivy-read (counsel--M-x-prompt current-prefix-arg)
+            (counsel--M-x-collection)
+            :predicate (counsel--M-x-predicate)
+            :require-match t
+            :history 'counsel-M-x-history
+            :action #'counsel-M-x-action
+            :keymap counsel-describe-map
+            :initial-input initial-input
+            :caller 'counsel-M-x))
 
 (ivy-configure 'counsel-M-x
   :initial-input "^"
diff --git a/ivy-test.el b/ivy-test.el
index 12bfeb0..c8a984b 100644
--- a/ivy-test.el
+++ b/ivy-test.el
@@ -519,6 +519,24 @@ Since `execute-kbd-macro' doesn't pick up a let-bound `default-directory'.")
                   '(("foo")) t)
                  "^(?!.*foo)")))
 
+(ert-deftest counsel--M-x-prompt ()
+  "Test `counsel--M-x-prompt' behavior."
+  (should (equal (counsel--M-x-prompt ()) "M-x "))
+  (should (equal (counsel--M-x-prompt t) "M-x "))
+  (should (equal (counsel--M-x-prompt '(())) "M-x "))
+  (should (equal (counsel--M-x-prompt '(t)) "M-x "))
+  (should (equal (counsel--M-x-prompt -1) "-1 M-x "))
+  (should (equal (counsel--M-x-prompt '(-1)) "-1 M-x "))
+  (should (equal (counsel--M-x-prompt 0) "0 M-x "))
+  (should (equal (counsel--M-x-prompt '(0)) "0 M-x "))
+  (should (equal (counsel--M-x-prompt 1) "1 M-x "))
+  (should (equal (counsel--M-x-prompt '(1)) "1 M-x "))
+  (should (equal (counsel--M-x-prompt 4) "4 M-x "))
+  (should (equal (counsel--M-x-prompt '(4)) "C-u M-x "))
+  (should (equal (counsel--M-x-prompt 16) "16 M-x "))
+  (should (equal (counsel--M-x-prompt '(16)) "16 M-x "))
+  (should (equal (counsel--M-x-prompt '-) "- M-x ")))
+
 (defmacro ivy--string-buffer (text &rest body)
   "Test helper that wraps TEXT in a temp buffer while running BODY."
   `(with-temp-buffer
diff --git a/ivy.el b/ivy.el
index 329732b..efe565a 100644
--- a/ivy.el
+++ b/ivy.el
@@ -3876,12 +3876,15 @@ The alist VAL is a sorting function with the signature of
   (let ((default-directory ivy--directory))
     (sort (copy-sequence candidates) #'file-newer-than-file-p)))
 
-(defvar ivy--flx-available-p)
-(defun ivy--flx-available-p ()
-  "Try to load package `flx' once; return non-nil on success."
-  (if (boundp 'ivy--flx-available-p)
-      ivy--flx-available-p
-    (setq ivy--flx-available-p (require 'flx nil t))))
+(defvar ivy--features ()
+  "Alist mapping features to their `require' result.")
+
+(defun ivy--feature-p (feature)
+  "Try to load FEATURE once; return non-nil on success."
+  (cdr (or (assq feature ivy--features)
+           (let ((entry (cons feature (require feature nil t))))
+             (push entry ivy--features)
+             entry))))
 
 (defun ivy--sort (name candidates)
   "Re-sort candidates by NAME.
@@ -3890,7 +3893,7 @@ All CANDIDATES are assumed to match NAME."
     (cond ((setq fun (ivy-alist-setting ivy-sort-matches-functions-alist))
            (funcall fun name candidates))
           ((and (eq ivy--regex-function #'ivy--regex-fuzzy)
-                (ivy--flx-available-p))
+                (ivy--feature-p 'flx))
            (ivy--flx-sort name candidates))
           (t
            candidates))))
@@ -3990,7 +3993,7 @@ CANDS are the current candidates."
                      ((and (not empty)
                            (not (eq caller 'swiper))
                            (not (and (eq ivy--regex-function #'ivy--regex-fuzzy)
-                                     (ivy--flx-available-p)
+                                     (ivy--feature-p 'flx)
                                      ;; Limit to configured number of candidates
                                      (null (nthcdr ivy-flx-limit cands))))
                            ;; If there was a preselected candidate, don't try to
@@ -4263,7 +4266,7 @@ with the extended highlighting of `ivy-format-function-line'."
 (defun ivy--highlight-fuzzy (str)
   "Highlight STR, using the fuzzy method."
   (if (and (eq (ivy-alist-setting ivy-re-builders-alist) #'ivy--regex-fuzzy)
-           (ivy--flx-available-p))
+           (ivy--feature-p 'flx))
       (let ((flx-name (string-remove-prefix "^" ivy-text)))
         (ivy--flx-propertize
          (cons (flx-score str flx-name ivy--flx-cache) str)))