From 1638a7640a3cd8ec5819adccb20bae9f06154fa1 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 13 Jul 2024 19:19:11 +0200 Subject: [PATCH] Further integrate minibuffer alternative actions --- lisp/minibuffer.el | 123 ++++++++++++++++++++++++++++++++++----------- lisp/simple.el | 16 ++++-- 2 files changed, 107 insertions(+), 32 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 08a5ef7bcbc..1846f4039f3 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2228,6 +2228,7 @@ completions." (defvar-local completions-exceptional-candidates nil) (defvar-local completions-ignore-case nil) (defvar-local completions-action nil) +(defvar-local completions-alternative-action nil) (defvar-local completions-style nil) (defvar-local completions-minibuffer-state nil) @@ -2320,7 +2321,11 @@ completions." (defvar completions-header-action '(completions-action - ("+" (:eval (cdr completions-action)) "+ "))) + ("+" + (:eval (cdr completions-action)) + (completions-alternative-action + ("[" (:eval (cdr completions-alternative-action)) "]")) + "+ "))) (defvar completions-header-style '(completions-style @@ -2724,6 +2729,10 @@ when you select this sort order." (defface completions-used-input '((t :inherit link-visited)) "Face for highlighting used inputs in the *Completions* buffer.") +(defface completions-used-input-alt + '((t :foreground "blue" :inherit completions-used-input)) + "Face for candidates to which you applied the alternative minibuffer action.") + (defcustom completions-highlight-previous-inputs t "Whether to highlight previously used inputs in the *Completions* buffer." :version "30.1" @@ -2936,6 +2945,10 @@ completions list." :type 'boolean :version "30.1") +(defvar-local minibuffer-action nil) + +(defvar-local minibuffer-alternative-action nil) + (defun minibuffer-completion-help (&optional start end) "Display a list of possible completions of the current minibuffer contents." (interactive "" minibuffer-mode) @@ -3096,6 +3109,7 @@ completions list." :predicate cpred :exceptional-candidates exceptional-candidates :action action + :alt-action minibuffer-alternative-action :base-position base-position :base-prefix base-prefix :ignore-case completion-ignore-case @@ -3204,6 +3218,7 @@ PLIST is a property list with optional extra information about COMPLETIONS." completions-exceptional-candidates (plist-get plist :exceptional-candidates) completions-ignore-case (plist-get plist :ignore-case) completions-action (plist-get plist :action) + completions-alternative-action (plist-get plist :alt-action) completions-minibuffer-state (plist-get plist :minibuffer-state))) (run-hooks 'completion-setup-hook) (display-buffer buf @@ -3533,6 +3548,7 @@ The completion method is determined by `completion-at-point-functions'." (define-key map "\C-x\M-h" 'minibuffer-alternate-history) (define-key map "\C-x\C-w" 'minibuffer-insert-symbol-at-point) (define-key map "\C-xj" 'minibuffer-set-action) + (define-key map "\C-xM-j" 'minibuffer-exchange-actions) (define-key map "\n" 'minibuffer-apply) (define-key map (kbd "C-S-j") 'minibuffer-apply-alt) (define-key map "\r" 'exit-minibuffer)) @@ -4321,9 +4337,6 @@ possible completions." (define-obsolete-function-alias 'internal-complete-buffer 'completion-buffer-name-table "30.1") -(defvar-local minibuffer-action nil) -(defvar-local minibuffer-alternative-action nil) - (defun minibuffer-current-input () (let* ((beg-end (minibuffer--completion-boundaries)) (beg (car beg-end)) (end (cdr beg-end)) @@ -4356,6 +4369,10 @@ possible completions." '((t :inherit mode-line-highlight)) "Face for minibuffer action prompt indicator when mouse is over it.") +(defface minibuffer-alt-action-prompt-indicator-highlight + '((t :inherit mode-line-highlight)) + "Face for minibuffer action prompt indicator when mouse is over it.") + (defface minibuffer-completion-prompt-indicator-highlight '((t :inherit mode-line-highlight)) "Face for minibuffer completion prompt indicator when mouse is over it.") @@ -4367,6 +4384,13 @@ possible completions." :group 'minibuffer :risky t) +(defcustom minibuffer-alt-action-prompt-indicator "<" + "String to show in minibuffer prompt when there's an alternative action." + :type 'string + :version "31.1" + :group 'minibuffer + :risky t) + (defcustom minibuffer-strict-prompt-indicator "=>" "String to show in minibuffer prompt to indicate strict completion." :type 'string @@ -4389,12 +4413,20 @@ possible completions." :risky t) (defvar minibuffer-action-prompt-indicator-format - '(:eval - (when-let ((desc (cdr (minibuffer-action)))) + '("" + (:eval + (when-let ((desc (cdr (minibuffer-action)))) + (propertize + minibuffer-action-prompt-indicator + 'help-echo (concat "\\\\[minibuffer-apply]: " desc) + 'mouse-face 'minibuffer-action-prompt-indicator-highlight))) + (minibuffer-alternative-action + (:eval (propertize - minibuffer-action-prompt-indicator - 'help-echo (concat "\\\\[minibuffer-apply]: " desc) - 'mouse-face 'minibuffer-action-prompt-indicator-highlight)))) + minibuffer-alt-action-prompt-indicator + 'help-echo (concat "\\\\[minibuffer-apply-alt]: " + (cdr minibuffer-alternative-action)) + 'mouse-face 'minibuffer-alt-action-prompt-indicator-highlight))))) (defvar minibuffer-extra-prompt-indicators-format nil) @@ -4482,7 +4514,8 @@ base, PREFIX is the completion base, and ALT is nil." (setq pm (text-property-search-forward 'cursor-face)) (let ((inhibit-read-only t)) (add-face-text-property (prop-match-beginning pm) (point) - 'completions-used-input))))))) + (if alt 'completions-used-input-alt + 'completions-used-input)))))))) (defun minibuffer-apply-alt (input &optional prefix) "Apply alternative minibuffer action to current INPUT. @@ -4525,7 +4558,9 @@ minibuffer action, apply the alternative action instead." (pcase (or all (car (read-multiple-choice (format "Apply \"%s\" to input?" - (propertize (cdr completions-action) + (propertize (if alt + (cdr completions-alternative-action) + (cdr completions-action)) 'face 'bold)) '((?y "yes" "Apply") (?n "no" "Skip") @@ -4564,21 +4599,39 @@ minibuffer action, apply the alternative action instead." (defvar minibuffer-action-history nil "History list for `minibuffer-set-action'.") -(defun minibuffer-set-action (action-fn) - "Set minibuffer action function of current minibuffer to ACTION-FN." +(defun minibuffer-set-action (action-fn &optional alt) + "Set minibuffer (ALT) action function of current minibuffer to ACTION-FN." (interactive - (list (completing-read "Action function: " + (list (completing-read (format "Set %saction function: " + (if current-prefix-arg "alternative " "")) (completion-table-with-metadata obarray '((category . function))) #'fboundp - nil nil 'minibuffer-action-history)) + nil nil 'minibuffer-action-history) + current-prefix-arg) minibuffer-mode) (when (stringp action-fn) (setq action-fn (read action-fn))) - (setq-local minibuffer-action - (cons action-fn - (or (and (symbolp action-fn) - (cdr (minibuffer--get-action action-fn))) - "custom action"))) + (let ((action (cons action-fn + (or (and (symbolp action-fn) + (cdr (minibuffer--get-action action-fn))) + "custom action")))) + (if alt + (setq-local minibuffer-alternative-action action) + (setq-local minibuffer-action action))) + (minibuffer-update-prompt-indicators)) + +(defun minibuffer-exchange-actions () + "Exchange minibuffer primary and alternative actions." + (interactive "" minibuffer-mode) + (if-let ((prm (minibuffer-action)) + (alt minibuffer-alternative-action)) + (progn + (setq minibuffer-alternative-action prm + minibuffer-action alt) + (minibuffer-message + "Minibuffer action in now `%s', alternative is `%s'" + (cdr minibuffer-action) (cdr minibuffer-alternative-action))) + (user-error "No current alternative minibuffer action")) (minibuffer-update-prompt-indicators)) ;;; Old-style completion, used in Emacs-21 and Emacs-22. @@ -6640,22 +6693,31 @@ interactions is customizable via `minibuffer-regexp-prompts'." (defvar minibuffer-collect-completions nil) (defvar minibuffer-collect-base nil) (defvar minibuffer-collect-action nil) +(defvar minibuffer-collect-alt-action nil) + +(defun minibuffer-collect-apply (&optional event alt) + "Apply minibuffer action to the candidate at mouse EVENT or at point. -(defun minibuffer-collect-apply (&optional event) - "Apply minibuffer action to the candidate at mouse EVENT or at point." +Non-nil optional argument ALT says to apply the alternative minibuffer +action instead." (interactive (list last-nonmenu-event) minibuffer-collect-mode) (with-current-buffer (window-buffer (posn-window (event-start event))) - (funcall (car minibuffer-collect-action) + (funcall (car (if alt minibuffer-collect-alt-action minibuffer-collect-action)) (concat minibuffer-collect-base (get-text-property (posn-point (event-start event)) 'completion--string))))) +(defun minibuffer-collect-apply-alt (&optional event) + "Apply alternative action to the candidate at mouse EVENT or at point." + (interactive (list last-nonmenu-event) minibuffer-collect-mode) + (minibuffer-collect-apply event t)) + (defun minibuffer-collect-revert (&rest _) (let ((inhibit-read-only t)) - (erase-buffer) - (delete-all-overlays) - (completion--insert-one-column minibuffer-collect-completions nil)) - (goto-char (point-min))) + (erase-buffer) + (delete-all-overlays) + (completion--insert-one-column minibuffer-collect-completions nil)) + (goto-char (point-min))) (defvar-keymap minibuffer-collect-mode-map :doc "Keymap for Minibuffer Collect mode." @@ -6663,6 +6725,9 @@ interactions is customizable via `minibuffer-regexp-prompts'." "p" #'previous-completion "RET" #'minibuffer-collect-apply "" #'minibuffer-collect-apply + "S-RET" #'minibuffer-collect-apply-alt + "S-" #'minibuffer-collect-apply-alt + "S-" #'minibuffer-collect-apply-alt "" 'mouse-face) (define-derived-mode minibuffer-collect-mode special-mode "Minibuffer Collect" @@ -6696,6 +6761,7 @@ interactions is customizable via `minibuffer-regexp-prompts'." (defun minibuffer-collect (completions base md) (let ((buffer (generate-new-buffer "*Collection*")) (action (minibuffer-action)) + (altact (minibuffer-action t)) (sort-fun (completion-metadata-get md 'sort-function)) (aff-fun (completion-metadata-get md 'affixation-function)) (ann-fun (completion-metadata-get md 'annotation-function))) @@ -6730,7 +6796,8 @@ interactions is customizable via `minibuffer-regexp-prompts'." (goto-char (point-min)) (setq-local minibuffer-collect-completions completions minibuffer-collect-base base - minibuffer-collect-action action)) + minibuffer-collect-action action + minibuffer-collect-alt-action altact)) buffer)) (defvar minibuffer-default-export-function #'minibuffer-collect) diff --git a/lisp/simple.el b/lisp/simple.el index 99faeb6087a..38db0450a4d 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9706,12 +9706,12 @@ makes it easier to edit it." ;; Define the major mode for lists of completions. -(defun completions-apply (e) - (interactive "e") +(defun completions-apply (e &optional alt) + (interactive (list last-nonmenu-event) completions-list-mode) (with-current-buffer (window-buffer (posn-window (event-end e))) (let ((str (get-text-property (posn-point (event-start e)) 'completion--string)) (prf completions-base-prefix) - (act (car completions-action))) + (act (car (if alt completions-alternative-action completions-action)))) (with-current-buffer completion-reference-buffer (when-let ((adjust-fn (alist-get 'adjust-base-function (completion-metadata @@ -9728,13 +9728,21 @@ makes it easier to edit it." (setq pm (text-property-search-forward 'cursor-face)) (let ((inhibit-read-only t)) (add-face-text-property (prop-match-beginning pm) (point) - 'completions-used-input))))))) + (if alt 'completions-used-input-alt + 'completions-used-input)))))))) + +(defun completions-apply-alt (e) + (interactive (list last-nonmenu-event) completions-list-mode) + (completions-apply e t)) (defvar-keymap completion-list-mode-map :doc "Local map for completion list buffers." "RET" #'choose-completion "" #'choose-completion + "C-j" #'completions-apply + "C-S-j" #'completions-apply-alt "C-" #'completions-apply + "C-S-" #'completions-apply-alt "" #'previous-line-completion "" #'next-line-completion "" #'previous-completion -- 2.39.5