From 802283d7db00eb327e0353350fc6416ffe689138 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Wed, 28 Feb 2024 18:26:42 +0100 Subject: [PATCH] More multi-commands --- lisp/files.el | 23 +++++++++++++------- lisp/help.el | 4 ++++ lisp/minibuffer.el | 54 ++++++++++++++++++++++++++++++++++++++++++++-- lisp/simple.el | 53 ++++++++++++++++++++++++++++----------------- lisp/subr.el | 4 ++++ 5 files changed, 108 insertions(+), 30 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index 9f9943ebbf8..543ef6c3615 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1870,19 +1870,17 @@ suppress wildcard expansion by setting `find-file-wildcards' to nil. \\To visit a file without any kind of conversion and without automatically choosing a major mode, use \\[find-file-literally]." (interactive - (minibuffer-with-setup-hook - (lambda () - (setq-local minibuffer-completion-action - (cons (lambda (file) - (display-buffer (find-file-noselect file))) - "find"))) - (find-file-read-args "Find file: " - (confirm-nonexistent-file-or-buffer)))) + (find-file-read-args "Find file: " + (confirm-nonexistent-file-or-buffer))) (let ((value (find-file-noselect filename nil nil wildcards))) (if (listp value) (mapcar 'pop-to-buffer-same-window (nreverse value)) (pop-to-buffer-same-window value)))) +(put 'find-file 'minibuffer-action + (cons (lambda (file) (display-buffer (find-file-noselect file))) + "find")) + (defun find-file-other-window (filename &optional wildcards) "Edit file FILENAME, in another window. @@ -1916,6 +1914,8 @@ expand wildcards (if any) and visit multiple files." value) (switch-to-buffer-other-window value)))) +(put 'find-file-other-window 'minibuffer-action 'find-file) + (defun find-file-other-frame (filename &optional wildcards) "Edit file FILENAME, in another frame. @@ -1960,6 +1960,8 @@ file names with wildcards." (find-file filename) (current-buffer))) +(put 'find-file-existing 'minibuffer-action 'find-file) + (defun find-file--read-only (fun filename wildcards) (unless (or (and wildcards find-file-wildcards (not (file-name-quoted-p filename)) @@ -2125,6 +2127,9 @@ killed." ;; We already ran these; don't run them again. (let (kill-buffer-query-functions kill-buffer-hook) (kill-buffer obuf)))))) + +(put 'find-alternate-file 'minibuffer-action 'find-file) + ;; FIXME we really need to fold the uniquify stuff in here by default, (defun create-file-buffer (filename) @@ -6491,6 +6496,8 @@ With a prefix argument, TRASH is nil." ((and delete-by-moving-to-trash trash) (move-file-to-trash filename)) (t (delete-file-internal filename))))) +(put 'delete-file 'minibuffer-action "delete") + (defun delete-directory (directory &optional recursive trash) "Delete the directory named DIRECTORY. Does not follow symlinks. If RECURSIVE is non-nil, delete files in DIRECTORY as well, with diff --git a/lisp/help.el b/lisp/help.el index 07eed2861c2..bdf1081a1b6 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -857,6 +857,10 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (princ string))))) nil) +(put 'where-is 'minibuffer-action + (cons (lambda (cmd) (where-is (intern cmd))) + "show keys")) + (defun help-key-description (key untranslated) (let ((string (help--key-description-fontified key))) (if (or (not untranslated) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 8df8bb62815..bb44f1dbc89 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3433,7 +3433,10 @@ The completion method is determined by `completion-at-point-functions'." "C-x C-v" #'minibuffer-sort-completions "C-x n" 'minibuffer-narrow-completions-map "C-x /" #'minibuffer-set-completion-styles - "C-j" #'minibuffer-apply) + "C-j" #'minibuffer-apply + "C-p" #'minibuffer-previous-line-or-completion + "C-n" #'minibuffer-next-line-or-completion + "C-%" #'minibuffer-query-apply) (defvar-keymap minibuffer-local-must-match-map :doc "Local keymap for minibuffer input with completion, for exact match." @@ -4213,7 +4216,8 @@ possible completions." (interactive (let* ((input-prefix (minibuffer-current-input)) (input (car input-prefix)) (prefix (cdr input-prefix))) - (list input prefix))) + (list input prefix)) + minibuffer-mode) (funcall (or (car (minibuffer-completion-action)) (user-error "No applicable action")) @@ -4231,6 +4235,40 @@ possible completions." (add-face-text-property (prop-match-beginning pm) (point) 'completions-used-input))))))) +(defun minibuffer-query-apply () + "Suggest applying the minibuffer action to each completion candidate in turn." + (interactive nil minibuffer-mode) + (with-minibuffer-completions-window + (let ((prev (point)) + all done) + (goto-char (point-min)) + (when (get-text-property (point) 'first-completion) + (let ((inhibit-read-only t)) + (remove-text-properties (point) (1+ (point)) '(first-completion)))) + (while (not done) + (setq prev (point)) + (with-current-buffer completion-reference-buffer + (minibuffer-next-completion)) + (if (<= prev (point)) + (pcase + (or all (car (read-multiple-choice + (format "Apply \"%s\" to input?" + (propertize (cdr completions-action) + 'face 'bold)) + '((?y "yes" "Apply") + (?n "no" "Skip") + (?q "quit" "Quit") + (?! "all" "Apply to all"))))) + (?y ; Apply. + (with-current-buffer completion-reference-buffer + (call-interactively #'minibuffer-apply))) + (?n) ; Skip. + (?q (setq done t)) ; Quit. + (?! (setq all ?y))) ; Apply to all. + ;; We're back at the first candidate, stop. + (setq done t) + (message "Done")))))) + ;;; Old-style completion, used in Emacs-21 and Emacs-22. (defun completion-emacs21-try-completion (string table pred _point) @@ -5385,6 +5423,18 @@ insert the selected completion candidate to the minibuffer." (interactive "p") (minibuffer-next-completion (- (or n 1)) t)) +(defun minibuffer-next-line-or-completion (&optional arg) + "Move cursor down ARG lines, or to the next completion candidate." + (interactive "^p") + (or arg (setq arg 1)) + (minibuffer-next-line-or-call #'minibuffer-next-completion arg)) + +(defun minibuffer-previous-line-or-completion (&optional arg) + "Move cursor up ARG lines, or to the previous completion candidate." + (interactive "^p") + (or arg (setq arg 1)) + (minibuffer-previous-line-or-call #'minibuffer-previous-completion arg)) + (defun minibuffer-choose-completion (&optional no-exit no-quit) "Run `choose-completion' from the minibuffer in its completions window. With prefix argument NO-EXIT, insert the completion candidate at point to diff --git a/lisp/simple.el b/lisp/simple.el index 2c31621cfe1..afa6538641e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2640,9 +2640,9 @@ Also see `suggest-key-bindings'." 'face 'help-key-binding))) (defun execute-extended-command (prefixarg &optional command-name typed) - "Read a command name, then read the arguments and call the command. -To pass a prefix argument to the command you are -invoking, give a prefix argument to `execute-extended-command'. + "Read COMMAND-NAME and call that command interactively. +To pass a prefix argument PREFIXARG to the command you are invoking, +give a prefix argument to `execute-extended-command'. This command provides completion when reading the command name. Which completion candidates are shown can be controlled by @@ -2655,12 +2655,6 @@ customizing `read-extended-command-predicate'." (list current-prefix-arg (read-extended-command) execute-extended-command--last-typed))) - ;; Emacs<24 calling-convention was with a single `prefixarg' argument. - (unless command-name - (let ((current-prefix-arg prefixarg) ; for prompt - (execute-extended-command--last-typed nil)) - (setq command-name (read-extended-command)) - (setq typed execute-extended-command--last-typed))) (let* ((function (and (stringp command-name) (intern-soft command-name))) (binding (and suggest-key-bindings (not executing-kbd-macro) @@ -2730,6 +2724,13 @@ customizing `read-extended-command-predicate'." suggest-key-bindings 2)))))))))))) +(put 'execute-extended-command 'minibuffer-action + (cons (lambda (cmd) + ;; TODO: Improve error handling. + (with-minibuffer-selected-window + (call-interactively (intern cmd)))) + "execute")) + (defun execute-extended-command-for-buffer (prefixarg &optional command-name typed) "Query user for a command relevant for the current mode, and then execute it. @@ -3165,10 +3166,8 @@ Interactively, N is the prefix numeric argument and defaults to 1." (or (zerop n) (goto-history-element (+ minibuffer-history-position n)))) -(defun next-line-or-history-element (&optional arg) - "Move cursor vertically down ARG lines, or to the next history element. -When point moves over the bottom line of multi-line minibuffer, puts ARGth -next element of the minibuffer history in the minibuffer." +(defun minibuffer-next-line-or-call (fun arg) + "Move cursor vertically down ARG lines, or call function FUN." (interactive "^p") (or arg (setq arg 1)) (let* ((old-point (point)) @@ -3192,7 +3191,7 @@ next element of the minibuffer history in the minibuffer." ;; Restore old position since `line-move-visual' moves point to ;; the end of the line when it fails to go to the next line. (goto-char old-point) - (next-history-element arg) + (funcall fun arg) ;; Reset `temporary-goal-column' because a correct value is not ;; calculated when `next-line' above fails by bumping against ;; the bottom of the minibuffer (bug#22544). @@ -3208,10 +3207,16 @@ next element of the minibuffer history in the minibuffer." (current-column)))) (move-to-column old-column))))))) -(defun previous-line-or-history-element (&optional arg) - "Move cursor vertically up ARG lines, or to the previous history element. -When point moves over the top line of multi-line minibuffer, puts ARGth -previous element of the minibuffer history in the minibuffer." +(defun next-line-or-history-element (&optional arg) + "Move cursor vertically down ARG lines, or to the next history element. +When point moves over the bottom line of multi-line minibuffer, puts ARGth +next element of the minibuffer history in the minibuffer." + (interactive "^p") + (or arg (setq arg 1)) + (minibuffer-next-line-or-call #'next-history-element arg)) + +(defun minibuffer-previous-line-or-call (fun arg) + "Move cursor vertically up ARG lines, or call function FUN." (interactive "^p") (or arg (setq arg 1)) (let* ((old-point (point)) @@ -3246,7 +3251,7 @@ previous element of the minibuffer history in the minibuffer." ;; Restore old position since `line-move-visual' moves point to ;; the beginning of the line when it fails to go to the previous line. (goto-char old-point) - (previous-history-element arg) + (funcall fun arg) ;; Reset `temporary-goal-column' because a correct value is not ;; calculated when `previous-line' above fails by bumping against ;; the top of the minibuffer (bug#22544). @@ -3273,6 +3278,14 @@ previous element of the minibuffer history in the minibuffer." ;; of the first visual line (bug#22544). (unless (eolp) (backward-char 1)))))))) +(defun previous-line-or-history-element (&optional arg) + "Move cursor vertically up ARG lines, or to the previous history element. +When point moves over the top line of multi-line minibuffer, puts ARGth +previous element of the minibuffer history in the minibuffer." + (interactive "^p") + (or arg (setq arg 1)) + (minibuffer-previous-line-or-call #'previous-history-element arg)) + (defun next-complete-history-element (n) "Get next history element that completes the minibuffer before the point. The contents of the minibuffer after the point are deleted and replaced @@ -6541,7 +6554,7 @@ PROMPT is a string to prompt with." (completing-read prompt (completion-table-with-metadata - completions '((display-sort-function . identity))) + completions '((sort-function . identity))) nil nil nil (if history-pos (cons 'read-from-kill-ring-history diff --git a/lisp/subr.el b/lisp/subr.el index c317d558e24..3387328ad3b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2184,6 +2184,7 @@ one will be removed." (fn-alist (mapcar (lambda (x) (cons (with-output-to-string (prin1 x)) x)) (if local (symbol-value hook) (default-value hook)))) + ;; TODO: Add minibuffer action. (function (alist-get (completing-read (format "%s hook to remove: " (if local "Buffer-local" "Global")) @@ -3125,6 +3126,9 @@ and the file name is displayed in the echo area." (message "No library %s in search path" library))) file)) +(put 'locate-library 'minibuffer-action + (cons (lambda (lib) (locate-library lib nil nil t)) + "locate")) ;;;; Process stuff. -- 2.39.5