branch: externals/ivy
commit 22ec74344697efd2d1d1c624338c21764dc862ce
Author: Basil L. Contovounesios <[email protected]>
Commit: Basil L. Contovounesios <[email protected]>
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.
---
counsel.el | 204 ++++++++++++++++++++++++++++++++++--------------------------
ivy-test.el | 18 ++++++
ivy.el | 21 ++++---
3 files changed, 146 insertions(+), 97 deletions(-)
diff --git a/counsel.el b/counsel.el
index b94ee1180a..67d0b49412 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 12bfeb0112..c8a984b4bd 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 329732b29b..efe565a965 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)))
