(multiple-choice (styles basic substring) (sort-function . identity))
(calendar-month (sort-function . identity))
(keybinding (sort-function . minibuffer-sort-alphabetically))
- (function (sort-function . minibuffer-sort-alphabetically))
+ (function (sort-function . minibuffer-sort-alphabetically)
+ (affixation-function . minibuffer-function-affixation))
(library (sort-function . minibuffer-sort-alphabetically)))
"Default settings for specific completion categories.
'keymap completions-header-order-map))
" "))
+(defface completions-header-restriction-separator-highlight
+ '((t :inherit mode-line-highlight))
+ "Face for restriction separator in completions header when mouse is on it."
+ :version "31.1")
+
(defvar completions-header-restriction
- '("/"
- (:eval (or (completions-predicate-description completions-predicate)
- (and completions-predicate
- (symbolp completions-predicate)
- (not (eq completions-predicate 'always))
- (symbol-name completions-predicate))
- "all"))
- "/ "))
+ '(:eval (let* ((neg (advice-function-member-p #'not completions-predicate))
+ (sep
+ (propertize (if neg "\\" "/")
+ 'help-echo (concat (when neg "Negated\n")
+ "mouse-2: Toggle negation")
+ 'mouse-face 'completions-header-restriction-separator-highlight
+ 'keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [header-line mouse-2]
+ (lambda (e)
+ (interactive "e")
+ (with-current-buffer
+ (buffer-local-value
+ 'completion-reference-buffer
+ (window-buffer (posn-window (event-end e))))
+ (minibuffer-negate-completion-predicate))))
+ map))))
+ (concat
+ sep
+ (or (completions-predicate-description completions-predicate)
+ (and completions-predicate
+ (symbolp completions-predicate)
+ (not (eq completions-predicate 'always))
+ (symbol-name completions-predicate))
+ "all")
+ sep
+ " "))))
(defvar completions-header-action
'(completions-action
(nconc completions base-size))))
(defun completions-predicate-description (pred)
+ "Return string describing predicate PRED, or nil."
(and (functionp pred)
(let ((descs nil))
(advice-function-mapc
(when-let ((description (alist-get 'description alist)))
(push description descs)))
pred)
- (when descs (mapconcat #'identity descs ", ")))))
+ (when descs (mapconcat
+ (lambda (desc)
+ (propertize
+ desc
+ 'mouse-face 'mode-line-highlight
+ 'help-echo "mouse-2: Negate\nmouse-3: Remove"
+ 'keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [header-line mouse-2]
+ (lambda (e)
+ (interactive "e")
+ (with-current-buffer
+ (buffer-local-value
+ 'completion-reference-buffer
+ (window-buffer (posn-window (event-end e))))
+ (minibuffer-negate-completion-predicate desc))))
+ (define-key map [header-line mouse-3]
+ (lambda (e)
+ (interactive "e")
+ (with-current-buffer
+ (buffer-local-value
+ 'completion-reference-buffer
+ (window-buffer (posn-window (event-end e))))
+ (minibuffer-widen-completions desc))))
+ map)))
+ descs ", ")))))
(defvar minibuffer-completions-sort-function nil
"Function for sorting minibuffer completion candidates, or nil.
"h" #'minibuffer-narrow-completions-to-history
"m" #'minibuffer-narrow-completions
"g" #'minibuffer-narrow-completions-by-regexp
+ "p" #'minibuffer-add-completion-predicate
+ "-" #'minibuffer-negate-completion-predicate
"w" #'minibuffer-widen-completions)
(defvar-keymap minibuffer-local-ns-map
(setq done t)
(message "Done"))))))
-(defun minibuffer--set-action-affixation (cands)
+(defun minibuffer-function-affixation (cands)
"Annotate completion candidates CANDS with their documentation strings."
(let ((max (seq-max (cons 0 (mapcar #'string-width cands)))))
(mapcar
(let ((enable-recursive-minibuffers t))
(list (completing-read "Action function: "
(completion-table-with-metadata
- obarray
- '((category . function)
- (affixation-function . minibuffer--set-action-affixation)))
+ obarray '((category . function)))
#'fboundp
nil nil 'minibuffer-action-history)))
minibuffer-mode)
pred `((description . ,desc)))
(when completion-auto-help (minibuffer-completion-help)))
+(defun minibuffer-read-predicate-description (prompt &optional default)
+ "Prompt with PROMPT for current completion predicate description.
+Optional argument DEFAULT is the default minibuffer argument. If
+omitted or nil, it defaults to the description of the predicate you
+added last."
+ (let ((default (or default (minibuffer-latest-predicate-description))))
+ (completing-read (format-prompt prompt default)
+ (completion-table-dynamic
+ (let ((buf (current-buffer)))
+ (lambda (&rest _)
+ (with-current-buffer buf
+ (let ((descs nil))
+ (advice-function-mapc
+ (lambda (_a p)
+ (when-let ((d (alist-get 'description p)))
+ (push d descs)))
+ minibuffer-completion-predicate)
+ ;; Put latest restriction first.
+ (reverse descs))))))
+ nil t nil nil default)))
+
+(defun minibuffer-predicate-description-to-function (desc)
+ (catch 'stop
+ (advice-function-mapc
+ (lambda (a p)
+ (when (equal (alist-get 'description p) desc)
+ (throw 'stop (cons (alist-get 'description p) a))))
+ minibuffer-completion-predicate)
+ nil))
+
+(defun minibuffer-latest-predicate-description ()
+ "Return the completion predicate you added most recently."
+ (catch 'stop
+ (advice-function-mapc
+ (lambda (_ p)
+ (when-let ((desc (alist-get 'description p)))
+ (throw 'stop desc)))
+ minibuffer-completion-predicate)
+ nil))
+
+(defun minibuffer-negate-completion-predicate (&optional desc)
+ "Negate completion predicate with description DESC.
+
+Optional argument DESC says which predicate to negate. If it is a
+string, negate the predicate that DESC describes. Otherwise, negate the
+conjunction of all current predicates together.
+
+Interactively, prompt for DESC among curent predicates, unless there is
+only one predicate, in which case DESC is the string describing that
+predicate. With a prefix argument, negate the conjunction of all
+predicates together."
+ (interactive (list (or current-prefix-arg
+ (minibuffer-read-predicate-description "Negate")))
+ minibuffer-mode)
+ (unless minibuffer-completion-predicate
+ (setq-local minibuffer-completion-predicate #'always))
+ (if (stringp desc)
+ ;; Negate the conjuct with description DESC.
+ (if-let* ((desc-fn (minibuffer-predicate-description-to-function desc))
+ (desc (car desc-fn))
+ (fn (cdr desc-fn)))
+ (progn
+ (remove-function (local 'minibuffer-completion-predicate) fn)
+ (if-let ((neg (get-text-property 0 'negated desc)))
+ (minibuffer--add-completions-predicate (cdr neg) (car neg))
+ (minibuffer--add-completions-predicate
+ (compose #'not fn)
+ (propertize (concat "-(" desc ")") 'negated (cons desc fn)))))
+ (user-error "`%s' is not a description of a current predicate" desc))
+ ;; Negate the entire predicate.
+ (if (advice-function-member-p #'not minibuffer-completion-predicate)
+ (remove-function (local 'minibuffer-completion-predicate) #'not)
+ (add-function :filter-return (local 'minibuffer-completion-predicate)
+ #'not '((depth . -100)))))
+ (when completion-auto-help (minibuffer-completion-help)))
+
+(put 'minibuffer-negate-completion-predicate 'minibuffer-action
+ (cons (lambda (d)
+ (with-current-buffer minibuffer--original-buffer
+ (minibuffer-negate-completion-predicate d)))
+ "negate"))
+
(defun minibuffer-narrow-completions ()
"Restrict completion candidates for current minibuffer interaction."
(interactive "" minibuffer-mode)
(filter-desc (minibuffer-completions-regexp-predicate)))
(minibuffer--add-completions-predicate (car filter-desc) (cdr filter-desc))))
+(defun minibuffer-add-completion-predicate (pred)
+ "Restrict completion candidates to those satisfying PRED."
+ (interactive
+ (list
+ (let ((enable-recursive-minibuffers t))
+ (completing-read "Predicate: "
+ (completion-table-with-metadata
+ obarray '((category . function)))
+ #'fboundp
+ nil nil 'minibuffer-completions-predicate-history
+ "minibuffer-collect")))
+ minibuffer-mode)
+ (when (stringp pred) (setq pred (read pred)))
+ (minibuffer--add-completions-predicate pred (prin1-to-string pred)))
+
(defun minibuffer-narrow-completions-to-current (arg)
"Restrict completion candidates according to current minibuffer input.
ARG is the numeric prefix argument. When ARG is negative,
(minibuffer-message "Completion annotations %sabled"
(if minibuffer-completion-annotations "en" "dis")))
-(defun minibuffer-widen-completions (&optional all)
+(defun minibuffer-widen-completions (&optional desc)
"Remove restrictions on current minibuffer completions list.
-Prompt for one or more restrictions that currently apply to the
-list of possible minibuffer completions, and remove those
-restrictions. You can use completion to select the restrictions
-to remove, separating each of your selections with
-`crm-separator' (usually, a comma).
+Optional argument DESC says which restrictions to remove. If it is a
+string, remove the restriction that DESC describes. Otherwise, remove
+all current restrictions.
-When there is only one restriction, remove it without prompting.
-With optional argument ALL (interactively, the prefix argument),
-remove all current restrictions without prompting."
- (interactive "P" minibuffer-mode)
- (let ((desc-pred-alist nil))
- (advice-function-mapc
- (lambda (a p)
- (when-let ((d (alist-get 'description p)))
- (push (cons d a) desc-pred-alist)))
- minibuffer-completion-predicate)
- (unless desc-pred-alist
- (user-error "No completions restrictions"))
- ;; Put latest restriction first.
- (setq desc-pred-alist (reverse desc-pred-alist))
- (mapc
- (lambda (pair)
- (remove-function (local 'minibuffer-completion-predicate) (cdr pair)))
- (if (or all
- ;; Only one restriction.
- (not (cdr desc-pred-alist)))
- desc-pred-alist
- (mapcar (lambda (desc)
- (assoc desc desc-pred-alist))
- (let ((enable-recursive-minibuffers t))
- (completing-read-multiple
- (format-prompt "Remove completions restrictions"
- (caar desc-pred-alist))
- desc-pred-alist nil t nil nil (caar desc-pred-alist)))))))
+Interactively, prompt for DESC among curent restrictions, unless there
+is only one restriction, in which case DESC is the string describing
+that restriction. With a prefix argument, remove all restrictions,
+regardless of how many there are."
+ (interactive (list (or current-prefix-arg
+ (minibuffer-read-predicate-description "Remove")))
+ minibuffer-mode)
+ (if (stringp desc)
+ ;; Remove conjunct with description DESC.
+ (if-let* ((fn (cdr (minibuffer-predicate-description-to-function desc))))
+ (remove-function (local 'minibuffer-completion-predicate) fn)
+ (user-error "`%s' is not a description of a current predicate" desc))
+ ;; Remove all restrictions.
+ (let ((preds nil))
+ (advice-function-mapc
+ (lambda (a p)
+ (when (alist-get 'description p)
+ (push a preds)))
+ minibuffer-completion-predicate)
+ (dolist (pred preds)
+ (remove-function (local 'minibuffer-completion-predicate) pred))))
(when completion-auto-help (minibuffer-completion-help)))
+(put 'minibuffer-widen-completions 'minibuffer-action
+ (cons (lambda (d)
+ (with-current-buffer minibuffer--original-buffer
+ (minibuffer-widen-completions d)))
+ "remove"))
+
(defcustom minibuffer-default-prompt-format " (default %s)"
"Format string used to output \"default\" values.
When prompting for input, there will often be a default value,
(completing-read
(format-prompt "Export function" "minibuffer-collect")
(completion-table-with-metadata
- obarray
- '((category . function)
- (affixation-function . minibuffer--set-action-affixation)))
+ obarray '((category . function)))
#'fboundp
nil nil 'minibuffer-export-history "minibuffer-collect")))
t)
projects / emacs.git / commitdiff