>From 274bfcc7ddb64cd18b214d0884d985ebde2d6c70 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Sun, 8 Dec 2024 20:05:07 +0100 Subject: [PATCH] New customization variable `completion-eager-display' The customization option can be set to t or nil, to respectively always or never show the *Completions* buffer eagerly at the beginning of a completion session. Furthermore the option can be set to the value auto. In this case the *Completions* buffer will only be shown if requested by the completion table. Completion tables can use the `eager-display' completion metadata to do so. * lisp/minibuffer.el (completion-eager-display): New customization variable. (completion-metadata): Update docstring, document the new `eager-display' completion metadata. (completion-extra-properties): Update docstring, document the new `:eager-display' completion metadata. (completion-category-overrides): Add `eager-display' to the custom type specification. (completing-read-default): Handle the `completion-eager-display' customization variable and the `eager-display' completion metadata. (completion-table-with-metadata): New function to create a completion table with metadata. (minibuffer-complete-defaults, minibuffer-complete-history): Use it. * lisp/ffap.el (ffap-menu-ask): Add `ffap-menu' completion category and `eager-display' completion metadata. Use `completion-table-with-metadata'. * lisp/imenu.el (imenu-eager-completion-buffer): Correct docstring, which had been inverted. (imenu--completion-buffer): Add `eager-display' completion metadata. Use `completion-table-with-metadata'. * lisp/tmm.el (tmm-prompt): Add `tmm' completion category and `eager-display' completion metadata. Use `completion-table-with-metadata'. Add keymap setup. (tmm-add-prompt): Remove keymap setup. (tmm-goto-completions): Call `tmm-add-prompt' to ensure that a *Completions* buffer is shown. (tmm--completion-table): Remove unused internal function. --- lisp/ffap.el | 17 ++++++------- lisp/imenu.el | 40 +++++++++++++++---------------- lisp/minibuffer.el | 60 ++++++++++++++++++++++++++++++++++++---------- lisp/tmm.el | 19 ++++++++------- 4 files changed, 86 insertions(+), 50 deletions(-) diff --git a/lisp/ffap.el b/lisp/ffap.el index 6a4915fb5a3..c869e234140 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1738,14 +1738,15 @@ ffap-menu-ask alist)))))) ;; minibuffer with completion buffer: (t - (let ((minibuffer-setup-hook 'minibuffer-completion-help)) - ;; Bug: prompting may assume unique strings, no "". - (setq choice - (completing-read - (format-prompt title (car (car alist))) - alist nil t - ;; (cons (car (car alist)) 0) - nil))) + ;; Bug: prompting may assume unique strings, no "". + (setq choice + (completing-read + (format-prompt title (car (car alist))) + (completion-table-with-metadata + alist '((category . ffap-menu) (eager-display . t))) + nil t + ;; (cons (car (car alist)) 0) + nil)) (sit-for 0) ; redraw original screen ;; Convert string to its entry, or else the default: (setq choice (or (assoc choice alist) (car alist))))) diff --git a/lisp/imenu.el b/lisp/imenu.el index 2d64970bfcf..ba1ba5fcd00 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -100,7 +100,7 @@ imenu-use-popup-menu (other :tag "Always" t))) (defcustom imenu-eager-completion-buffer t - "If non-nil, eagerly pop up the completion buffer." + "If nil, eagerly pop up the completion buffer." :type 'boolean :version "22.1") @@ -767,27 +767,25 @@ imenu--completion-buffer (imenu--in-alist name prepared-index-alist) ;; Default to `name' if it's in the alist. name)))) - ;; Display the completion buffer. (minibuffer-with-setup-hook - (lambda () - (setq-local minibuffer-allow-text-properties t) - (setq-local completion-extra-properties - `( :category imenu - ,@(when (eq imenu-flatten 'annotation) - `(:annotation-function - ,(lambda (s) (get-text-property - 0 'imenu-section s)))) - ,@(when (eq imenu-flatten 'group) - `(:group-function - ,(lambda (s transform) - (if transform s - (get-text-property - 0 'imenu-section s))))))) - (unless imenu-eager-completion-buffer - (minibuffer-completion-help))) - (setq name (completing-read prompt - prepared-index-alist - nil t nil 'imenu--history-list name))) + (lambda () (setq-local minibuffer-allow-text-properties t)) + (setq name (completing-read + prompt + (completion-table-with-metadata + prepared-index-alist + `((category . imenu) + (eager-display . ,(not imenu-eager-completion-buffer)) + ,@(when (eq imenu-flatten 'annotation) + `((annotation-function + . ,(lambda (s) (get-text-property + 0 'imenu-section s))))) + ,@(when (eq imenu-flatten 'group) + `((group-function + . ,(lambda (s transform) + (if transform s + (get-text-property + 0 'imenu-section s)))))))) + nil t nil 'imenu--history-list name))) (when (stringp name) (or (get-text-property 0 'imenu-choice name) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 405ee21cdb2..b0fec75cd0a 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -138,6 +138,9 @@ completion-metadata of completions. Can operate destructively. - `cycle-sort-function': function to sort entries when cycling. Works like `display-sort-function'. +- `eager-display': non-nil to request eager display of the + completion candidates. Can also be a function which is invoked + after minibuffer setup. The metadata of a completion table should be constant between two boundaries." (let ((metadata (if (functionp table) (funcall table string pred 'metadata)))) @@ -277,6 +280,15 @@ completion-table-case-fold (let ((completion-ignore-case (not dont-fold))) (complete-with-action action table string pred)))) +(defun completion-table-with-metadata (table metadata) + "Return new completion TABLE with METADATA. +METADATA should be an alist of completion metadata. See +`completion-metadata' for a list of supported metadata." + (lambda (string pred action) + (if (eq action 'metadata) + `(metadata . ,metadata) + (complete-with-action action table string pred)))) + (defun completion-table-subvert (table s1 s2) "Return a completion table from TABLE with S1 replaced by S2. The result is a completion table which completes strings of the @@ -1031,6 +1043,18 @@ minibuffer--completion-prompt-end (defvar completion-show-inline-help t "If non-nil, print helpful inline messages during completion.") +(defcustom completion-eager-display 'auto + "Display the *Completions* buffer eagerly. + +If the variable is set to t or nil, respectively show the *Completions* +buffer always or never eagerly. The value `auto' shows the +*Completions* buffer eagerly only if requested by the completion +command. Completion tables can request eager display via the +`eager-display' metadata." + :type '(choice (const :tag "Never show *Completions* eagerly" nil) + (const :tag "Always show *Completions* eagerly" t) + (const :tag "If requested by the completion command" auto))) + (defcustom completion-auto-help t "Non-nil means automatically provide help for invalid completion input. If the value is t, the *Completions* buffer is displayed whenever completion @@ -1247,7 +1271,11 @@ completion-category-overrides (cons :tag "Completion Affixation" (const :tag "Select one value from the menu." affixation-function) - (choice (function :tag "Custom function")))))) + (choice (function :tag "Custom function"))) + (cons :tag "Eager display" + (const :tag "Select one value from the menu." + eager-display) + boolean)))) (defun completion--category-override (category tag) (or (assq tag (cdr (assq category completion-category-overrides))) @@ -2493,6 +2521,8 @@ completion-extra-properties `:cycle-sort-function': Function to sort entries when cycling. +`:eager-display': Show the *Completions* buffer eagerly. + See more information about these functions above in `completion-metadata'. @@ -4809,7 +4839,17 @@ completing-read-default (setq-local minibuffer--require-match require-match) (setq-local minibuffer--original-buffer buffer) ;; Copy the value from original buffer to the minibuffer. - (setq-local completion-ignore-case c-i-c)) + (setq-local completion-ignore-case c-i-c) + ;; Show the completion help eagerly if + ;; `completion-eager-display' is t or if eager display + ;; has been requested by the completion table. + (when completion-eager-display + (let* ((md (completion-metadata + initial-input collection predicate)) + (fun (completion-metadata-get md 'eager-display))) + (when (or fun (eq completion-eager-display t)) + (funcall (if (functionp fun) + fun #'minibuffer-completion-help)))))) (read-from-minibuffer prompt initial-input keymap nil hist def inherit-input-method)))) (when (and (equal result "") def) @@ -4999,11 +5039,9 @@ minibuffer-complete-history (lambda () (get-buffer-window "*Completions*" 0)))) (completion-in-region (minibuffer--completion-prompt-end) (point-max) - (lambda (string pred action) - (if (eq action 'metadata) - '(metadata (display-sort-function . identity) - (cycle-sort-function . identity)) - (complete-with-action action completions string pred))))))) + (completion-table-with-metadata + completions '((display-sort-function . identity) + (cycle-sort-function . identity))))))) (defun minibuffer-complete-defaults () "Complete minibuffer defaults as far as possible. @@ -5019,11 +5057,9 @@ minibuffer-complete-defaults (lambda () (get-buffer-window "*Completions*" 0)))) (completion-in-region (minibuffer--completion-prompt-end) (point-max) - (lambda (string pred action) - (if (eq action 'metadata) - '(metadata (display-sort-function . identity) - (cycle-sort-function . identity)) - (complete-with-action action completions string pred)))))) + (completion-table-with-metadata + completions '((display-sort-function . identity) + (cycle-sort-function . identity)))))) (define-key minibuffer-local-map [?\C-x up] 'minibuffer-complete-history) (define-key minibuffer-local-map [?\C-x down] 'minibuffer-complete-defaults) diff --git a/lisp/tmm.el b/lisp/tmm.el index 632e55e47a8..45afbe4a3c2 100644 --- a/lisp/tmm.el +++ b/lisp/tmm.el @@ -119,12 +119,6 @@ tmm-inactive '((t :inherit shadow)) "Face used for inactive menu items.") -(defun tmm--completion-table (items) - (lambda (string pred action) - (if (eq action 'metadata) - '(metadata (display-sort-function . identity)) - (complete-with-action action items string pred)))) - (defvar tmm--history nil) ;;;###autoload @@ -222,7 +216,9 @@ tmm-prompt (setq out (if default-item (car (nth index-of-default tmm-km-list)) - (minibuffer-with-setup-hook #'tmm-add-prompt + (minibuffer-with-setup-hook + (lambda () + (setq tmm-old-mb-map (tmm-define-keys t))) ;; tmm-km-list is reversed, because history ;; needs it in LIFO order. But default list ;; needs it in non-reverse order, so that the @@ -233,7 +229,12 @@ tmm-prompt (completing-read-default (concat gl-str " (up/down to change, PgUp to menu): ") - (tmm--completion-table tmm-km-list) nil t nil + (completion-table-with-metadata + tmm-km-list '((category . tmm) + (eager-display . tmm-add-prompt) + (display-sort-function . identity) + (cycle-sort-function . identity))) + nil t nil 'tmm--history (reverse tmm--history))))))) (if (and (stringp out) (string= "^" out)) ;; A fake choice to please the destructuring later. @@ -402,7 +403,6 @@ tmm-remove-inactive-mouse-face (defun tmm-add-prompt () (unless tmm-c-prompt (error "No active menu entries")) - (setq tmm-old-mb-map (tmm-define-keys t)) (or tmm-completion-prompt (add-hook 'completion-setup-hook #'tmm-completion-delete-prompt 'append)) @@ -458,6 +458,7 @@ tmm-shortcut (defun tmm-goto-completions () "Jump to the completions buffer." (interactive) + (tmm-add-prompt) (setq tmm-c-prompt (buffer-substring (minibuffer-prompt-end) (point-max))) ;; Clear minibuffer old contents before using *Completions* buffer for ;; selection. -- 2.45.2