]> git.eshelyaron.com Git - emacs.git/commitdiff
Add minibuffer alternative actions
authorEshel Yaron <me@eshelyaron.com>
Fri, 12 Jul 2024 17:48:35 +0000 (19:48 +0200)
committerEshel Yaron <me@eshelyaron.com>
Fri, 12 Jul 2024 17:52:32 +0000 (19:52 +0200)
lisp/minibuffer.el

index 7f043c8bd92e7c71cee6280257f6e3e16216c336..0a9bddd810307e4a2be924429fb5d208aa17b144 100644 (file)
@@ -2001,7 +2001,7 @@ Interactively, ARG is the prefix argument, and it defaults to 1."
       (cond
        ((atom all) (completion--message "No completions"))
        ((atom (cdr all))
-        (let ((done (equal (car all) (buffer-substring-no-properties base end))))
+        (let ((done (equal cur (buffer-substring-no-properties base end))))
           (unless done (completion--replace base end cur))
           (completion--done (buffer-substring-no-properties start (point))
                             'finished (if done "Sole completion" "."))
@@ -2034,7 +2034,9 @@ Interactively, ARG is the prefix argument, and it defaults to 1."
                      digit-argument
                      minibuffer-cycle-completion
                      minibuffer-apply-and-cycle-completion
-                     minibuffer-cycle-completion-and-apply)))
+                     minibuffer-apply-alt-and-cycle-completion
+                     minibuffer-cycle-completion-and-apply
+                     minibuffer-cycle-completion-and-apply-alt)))
          (lambda ()
            (setq completion-all-sorted-completions nil))))))))
 
@@ -2045,6 +2047,13 @@ Interactively, ARG is the prefix argument, and it defaults to 1."
     (minibuffer-apply (car input-prefix) (cdr input-prefix)))
   (minibuffer-cycle-completion n))
 
+(defun minibuffer-apply-alt-and-cycle-completion (n)
+  "Apply minibuffer action to current input and cycle N candidates forward."
+  (interactive "p" minibuffer-mode)
+  (let ((input-prefix (minibuffer-current-input)))
+    (minibuffer-apply-alt (car input-prefix) (cdr input-prefix)))
+  (minibuffer-cycle-completion n))
+
 (defun minibuffer-cycle-completion-and-apply (n)
   "Cycle N candidates forward and apply minibuffer action to that candidate."
   (interactive "p" minibuffer-mode)
@@ -2052,6 +2061,13 @@ Interactively, ARG is the prefix argument, and it defaults to 1."
   (let ((input-prefix (minibuffer-current-input)))
     (minibuffer-apply (car input-prefix) (cdr input-prefix))))
 
+(defun minibuffer-cycle-completion-and-apply-alt (n)
+  "Cycle N candidates forward and apply alternative minibuffer action."
+  (interactive "p" minibuffer-mode)
+  (minibuffer-cycle-completion n)
+  (let ((input-prefix (minibuffer-current-input)))
+    (minibuffer-apply-alt (car input-prefix) (cdr input-prefix))))
+
 (defvar minibuffer-confirm-exit-commands
   '(completion-at-point minibuffer-complete)
   "List of commands which cause an immediately following
@@ -3507,6 +3523,7 @@ The completion method is determined by `completion-at-point-functions'."
   (define-key map "\C-x\C-w" 'minibuffer-insert-symbol-at-point)
   (define-key map "\C-xj" 'minibuffer-set-action)
   (define-key map "\n" 'minibuffer-apply)
+  (define-key map (kbd "C-S-j") 'minibuffer-apply-alt)
   (define-key map "\r" 'exit-minibuffer))
 
 (defvar-keymap minibuffer-local-completion-map
@@ -3514,8 +3531,10 @@ The completion method is determined by `completion-at-point-functions'."
   :parent minibuffer-local-map
   "TAB"       #'minibuffer-complete
   "C-o"       #'minibuffer-cycle-completion
-  "C-M-o"     #'minibuffer-cycle-completion-and-apply
-  "C-M-S-o"   #'minibuffer-apply-and-cycle-completion
+  "C-M-o"     #'minibuffer-apply-and-cycle-completion
+  "C-M-S-o"   #'minibuffer-apply-alt-and-cycle-completion
+  ;; "..."    #'minibuffer-cycle-completion-and-apply
+  ;; "..."    #'minibuffer-cycle-completion-and-apply-alt
   "C-l"       #'minibuffer-restore-completion-input
   "C-S-a"     #'minibuffer-toggle-completion-ignore-case
   "?"         #'minibuffer-completion-help
@@ -4292,6 +4311,7 @@ possible completions."
   '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))
@@ -4383,22 +4403,23 @@ possible completions."
 (add-hook 'minibuffer-setup-hook #'minibuffer-record-command)
 (add-hook 'minibuffer-setup-hook #'minibuffer-update-prompt-indicators 95)
 
-(defun minibuffer-action ()
+(defun minibuffer-action (&optional alt)
   "Return the minibuffer action function for the current minibuffer."
-  (or minibuffer-action
+  (or (and alt minibuffer-alternative-action)
+      minibuffer-action
       (when-let* ((cmd current-minibuffer-command)
                   (cmd (car (last (cons cmd (function-alias-p cmd))))))
         (when (symbolp cmd) (minibuffer--get-action cmd)))))
 
-(defun minibuffer-apply (input &optional prefix)
-  "Apply ACTION to current minibuffer INPUT prefixed by PREFIX."
+(defun minibuffer-apply (input &optional prefix alt)
+  "Apply action to current minibuffer INPUT prefixed by PREFIX."
   (interactive (let* ((input-prefix (minibuffer-current-input))
                       (input (car input-prefix))
                       (prefix (cdr input-prefix)))
                  (list input prefix))
                minibuffer-mode)
   (funcall
-   (or (car (minibuffer-action)) (user-error "No applicable action"))
+   (or (car (minibuffer-action alt)) (user-error "No applicable action"))
    (concat prefix input))
   (when-let ((buf (get-buffer completions-buffer-name))
              (win (get-buffer-window buf 0)))
@@ -4419,9 +4440,18 @@ possible completions."
             (add-face-text-property (prop-match-beginning pm) (point)
                                     'completions-used-input)))))))
 
-(defun minibuffer-query-apply ()
+(defun minibuffer-apply-alt (input &optional prefix)
+  "Apply action to current minibuffer INPUT prefixed by PREFIX."
+  (interactive (let* ((input-prefix (minibuffer-current-input))
+                      (input (car input-prefix))
+                      (prefix (cdr input-prefix)))
+                 (list input prefix))
+               minibuffer-mode)
+  (minibuffer-apply input prefix t))
+
+(defun minibuffer-query-apply (&optional alt)
   "Suggest applying the minibuffer action to each completion candidate in turn."
-  (interactive "" minibuffer-mode)
+  (interactive "P" minibuffer-mode)
   (with-minibuffer-completions-window
     (let (prev all done)
       (goto-char (point-min))
@@ -4447,7 +4477,8 @@ possible completions."
                                 (?!  "all"  "Apply to all")))))
               (?y                       ; Apply.
                (with-current-buffer completion-reference-buffer
-                 (call-interactively #'minibuffer-apply)))
+                 (call-interactively (if alt #'minibuffer-apply-alt
+                                       #'minibuffer-apply))))
               (?n)                      ; Skip.
               (?q (setq done t))        ; Quit.
               (?!                       ; Apply to all.