Further integrate minibuffer alternative actions

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 08a5ef7bcbcbd4adf0ae1b2ce3e9e76423aa73fa..1846f4039f37901a6824c50b55f097b68dc1d638 100644 (file)
--- 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-local-map>\\[minibuffer-apply]: " desc)
+        'mouse-face 'minibuffer-action-prompt-indicator-highlight)))
+    (minibuffer-alternative-action
+     (:eval
       (propertize
-       minibuffer-action-prompt-indicator
-       'help-echo (concat "\\<minibuffer-local-map>\\[minibuffer-apply]: " desc)
-       'mouse-face 'minibuffer-action-prompt-indicator-highlight))))
+       minibuffer-alt-action-prompt-indicator
+       'help-echo (concat "\\<minibuffer-local-map>\\[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
   "<mouse-2>" #'minibuffer-collect-apply
+  "S-RET" #'minibuffer-collect-apply-alt
+  "S-<return>" #'minibuffer-collect-apply-alt
+  "S-<mouse-1>" #'minibuffer-collect-apply-alt
   "<follow-link>" '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 99faeb6087ade30e15dcaad0c143ca8a4b090777..38db0450a4d8fc06888fbda4a3f1500d08c7e247 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -9706,12 +9706,12 @@ makes it easier to edit it."
 \f
 ;; 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
   "<mouse-2>" #'choose-completion
+  "C-j"       #'completions-apply
+  "C-S-j"     #'completions-apply-alt
   "C-<mouse-1>" #'completions-apply
+  "C-S-<mouse-1>" #'completions-apply-alt
   "<up>"      #'previous-line-completion
   "<down>"    #'next-line-completion
   "<left>"    #'previous-completion