From: Juri Linkov Date: Wed, 25 Nov 2020 08:46:59 +0000 (+0200) Subject: Add 'completions-detailed' to add prefix/suffix with 'affixation-function' X-Git-Tag: emacs-28.0.90~5033 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=3b740591b0a1d0e7a24be38471499ecace96936b;p=emacs.git Add 'completions-detailed' to add prefix/suffix with 'affixation-function' * doc/lispref/minibuf.texi (Completion Variables) (Programmed Completion): Add affixation-function. * lisp/help-fns.el (help--symbol-completion-table-affixation): New function. (help--symbol-completion-table): Set affixation-function when completions-detailed is non-nil. * lisp/minibuffer.el (completion-metadata): Add affixation-function to docstring. (completions-annotations): Inherit from shadow with italic. (completions-detailed): New defcustom. (completion--insert-strings): Count string-width on all strings in completion list. Insert prefix and suffix. (completion-extra-properties): Add affixation-function to docstring. (minibuffer-completion-help): Call affixation-function. (minibuffer-default-prompt-format): Move down closer to its use. https://lists.gnu.org/archive/html/emacs-devel/2020-11/msg00613.html --- diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index f1cfd29ef14..56bc0b8ab67 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1798,6 +1798,13 @@ buffer. This function must accept one argument, a completion, and should either return @code{nil} or a string to be displayed next to the completion. +@item :affixation-function +The value should be a function to add prefixes and suffixes to +completions. This function must accept one argument, a list of +completions, and should return such a list of completions where +each element contains a list of three elements: a completion, +a prefix string, and a suffix string. + @item :exit-function The value should be a function to run after performing completion. The function should accept two arguments, @var{string} and @@ -1897,6 +1904,15 @@ function should take one argument, @var{string}, which is a possible completion. It should return a string, which is displayed after the completion @var{string} in the @file{*Completions*} buffer. +@item affixation-function +The value should be a function for adding prefixes and suffixes to +completions. The function should take one argument, +@var{completions}, which is a list of possible completions. It should +return such a list of @var{completions} where each element contains a list +of three elements: a completion, a prefix which is displayed before +the completion string in the @file{*Completions*} buffer, and +a suffix displayed after the completion string. + @item display-sort-function The value should be a function for sorting completions. The function should take one argument, a list of completion strings, and return a diff --git a/etc/NEWS b/etc/NEWS index 0a3854d0df0..9091643da5a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1341,6 +1341,10 @@ This new command (bound to 'C-c C-l') regenerates the current hunk. ** Miscellaneous +*** New user option 'completions-detailed'. +When non-nil, some commands like 'describe-symbol' show more detailed +completions with more information in completion prefix and suffix. + --- *** New user option 'bibtex-unify-case-convert'. This new option allows the user to customize how case is converted @@ -1802,6 +1806,12 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. * Lisp Changes in Emacs 28.1 ++++ +** New completion function 'affixation-function' to add prefix/suffix. +It accepts a list of completions and should return a list where +each element is a list with three elements: a completion, +a prefix string, and a suffix string. + +++ ** 'read-char-from-minibuffer' and 'y-or-n-p' support 'help-form'. If you bind 'help-form' to a non-nil value while calling these functions, diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 170f497541a..1c55d0ed79a 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -126,17 +126,48 @@ with the current prefix. The files are chosen according to :group 'help :version "26.3") +(defun help--symbol-completion-table-affixation (completions) + (mapcar (lambda (c) + (let* ((s (intern c)) + (doc (condition-case nil (documentation s) (error nil))) + (doc (and doc (substring doc 0 (string-match "\n" doc))))) + (list c (propertize + (concat (cond ((commandp s) + "c") ; command + ((eq (car-safe (symbol-function s)) 'macro) + "m") ; macro + ((fboundp s) + "f") ; function + ((custom-variable-p s) + "u") ; user option + ((boundp s) + "v") ; variable + ((facep s) + "a") ; fAce + ((and (fboundp 'cl-find-class) + (cl-find-class s)) + "t") ; CL type + (" ")) ; something else + " ") ; prefix separator + 'face 'completions-annotations) + (if doc (propertize (format " -- %s" doc) + 'face 'completions-annotations) + "")))) + completions)) + (defun help--symbol-completion-table (string pred action) - (when help-enable-completion-autoload - (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string))) - (help--load-prefixes prefixes))) - (let ((prefix-completions - (and help-enable-completion-autoload - (mapcar #'intern (all-completions string definition-prefixes))))) - (complete-with-action action obarray string - (if pred (lambda (sym) - (or (funcall pred sym) - (memq sym prefix-completions))))))) + (if (and completions-detailed (eq action 'metadata)) + '(metadata (affixation-function . help--symbol-completion-table-affixation)) + (when help-enable-completion-autoload + (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string))) + (help--load-prefixes prefixes))) + (let ((prefix-completions + (and help-enable-completion-autoload + (mapcar #'intern (all-completions string definition-prefixes))))) + (complete-with-action action obarray string + (if pred (lambda (sym) + (or (funcall pred sym) + (memq sym prefix-completions)))))))) (defvar describe-function-orig-buffer nil "Buffer that was current when `describe-function' was invoked. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 9d57a817b25..48bd39587bc 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -83,7 +83,6 @@ ;; - add support for ** to pcm. ;; - Add vc-file-name-completion-table to read-file-name-internal. -;; - A feature like completing-help.el. ;;; Code: @@ -121,6 +120,10 @@ This metadata is an alist. Currently understood keys are: - `annotation-function': function to add annotations in *Completions*. Takes one argument (STRING), which is a possible completion and returns a string to append to STRING. +- `affixation-function': function to prepend/append a prefix/suffix to + entries. Takes one argument (COMPLETIONS) and should return a list + of completions with a list of three elements: completion, its prefix + and suffix. - `display-sort-function': function to sort entries in *Completions*. Takes one argument (COMPLETIONS) and should return a new list of completions. Can operate destructively. @@ -1669,7 +1672,7 @@ Return nil if there is no valid completion, else t." (#b000 nil) (_ t)))) -(defface completions-annotations '((t :inherit italic)) +(defface completions-annotations '((t :inherit (italic shadow))) "Face to use for annotations in the *Completions* buffer.") (defcustom completions-format 'horizontal @@ -1681,6 +1684,13 @@ horizontally in alphabetical order, rather than down the screen." :type '(choice (const horizontal) (const vertical)) :version "23.2") +(defcustom completions-detailed nil + "When non-nil, display completions with details added as prefix/suffix. +Some commands might provide a detailed view with more information prepended +or appended to completions." + :type 'boolean + :version "28.1") + (defun completion--insert-strings (strings) "Insert a list of STRINGS into the current buffer. Uses columns to keep the listing readable but compact. @@ -1689,8 +1699,7 @@ It also eliminates runs of equal strings." (let* ((length (apply #'max (mapcar (lambda (s) (if (consp s) - (+ (string-width (car s)) - (string-width (cadr s))) + (apply #'+ (mapcar #'string-width s)) (string-width s))) strings))) (window (get-buffer-window (current-buffer) 0)) @@ -1715,8 +1724,7 @@ It also eliminates runs of equal strings." ;; FIXME: `string-width' doesn't pay attention to ;; `display' properties. (let ((length (if (consp str) - (+ (string-width (car str)) - (string-width (cadr str))) + (apply #'+ (mapcar #'string-width str)) (string-width str)))) (cond ((eq completions-format 'vertical) @@ -1754,13 +1762,33 @@ It also eliminates runs of equal strings." (if (not (consp str)) (put-text-property (point) (progn (insert str) (point)) 'mouse-face 'highlight) - (put-text-property (point) (progn (insert (car str)) (point)) - 'mouse-face 'highlight) - (let ((beg (point)) - (end (progn (insert (cadr str)) (point)))) - (put-text-property beg end 'mouse-face nil) - (font-lock-prepend-text-property beg end 'face - 'completions-annotations))) + ;; If `str' is a list that has 2 elements, + ;; then the second element is a suffix annotation. + ;; If `str' has 3 elements, then the second element + ;; is a prefix, and the third element is a suffix. + (let* ((prefix (when (nth 2 str) (nth 1 str))) + (suffix (or (nth 2 str) (nth 1 str)))) + (when prefix + (let ((beg (point)) + (end (progn (insert prefix) (point)))) + (put-text-property beg end 'mouse-face nil) + ;; When both prefix and suffix are added + ;; by the caller via affixation-function, + ;; then allow the caller to decide + ;; what faces to put on prefix and suffix. + (unless prefix + (font-lock-prepend-text-property + beg end 'face 'completions-annotations)))) + (put-text-property (point) (progn (insert (car str)) (point)) + 'mouse-face 'highlight) + (let ((beg (point)) + (end (progn (insert suffix) (point)))) + (put-text-property beg end 'mouse-face nil) + ;; Put the predefined face only when suffix + ;; is added via annotation-function. + (unless prefix + (font-lock-prepend-text-property + beg end 'face 'completions-annotations))))) (cond ((eq completions-format 'vertical) ;; Vertical format @@ -1880,6 +1908,11 @@ These include: completion). The function can access the completion data via `minibuffer-completion-table' and related variables. +`:affixation-function': Function to prepend/append a prefix/suffix to + completions. The function must accept one argument, a list of + completions, and return a list where each element is a list of + three elements: a completion, a prefix and a suffix. + `:exit-function': Function to run after completion is performed. The function must accept two arguments, STRING and STATUS. @@ -1962,10 +1995,13 @@ variables.") base-size md minibuffer-completion-table minibuffer-completion-predicate)) - (afun (or (completion-metadata-get all-md 'annotation-function) - (plist-get completion-extra-properties - :annotation-function) - completion-annotate-function)) + (ann-fun (or (completion-metadata-get all-md 'annotation-function) + (plist-get completion-extra-properties + :annotation-function) + completion-annotate-function)) + (aff-fun (or (completion-metadata-get all-md 'affixation-function) + (plist-get completion-extra-properties + :affixation-function))) (mainbuf (current-buffer)) ;; If the *Completions* buffer is shown in a new ;; window, mark it as softly-dedicated, so bury-buffer in @@ -2006,12 +2042,15 @@ variables.") (if sort-fun (funcall sort-fun completions) (sort completions 'string-lessp)))) - (when afun + (when ann-fun (setq completions (mapcar (lambda (s) - (let ((ann (funcall afun s))) + (let ((ann (funcall ann-fun s))) (if ann (list s ann) s))) completions))) + (when aff-fun + (setq completions + (funcall aff-fun completions))) (with-current-buffer standard-output (set (make-local-variable 'completion-base-position) @@ -3034,19 +3073,6 @@ the commands start with a \"-\" or a SPC." :version "24.1" :type 'boolean) -(defcustom minibuffer-default-prompt-format " (default %s)" - "Format string used to output \"default\" values. -When prompting for input, there will often be a default value, -leading to prompts like \"Number of articles (default 50): \". -The \"default\" part of that prompt is controlled by this -variable, and can be set to, for instance, \" [%s]\" if you want -a shorter displayed prompt, or \"\", if you don't want to display -the default at all. - -This variable is used by the `format-prompt' function." - :version "28.1" - :type 'string) - (defun completion-pcm--pattern-trivial-p (pattern) (and (stringp (car pattern)) ;; It can be followed by `point' and "" and still be trivial. @@ -3864,6 +3890,19 @@ the minibuffer was activated, and execute the forms." (with-minibuffer-selected-window (scroll-other-window-down arg))) +(defcustom minibuffer-default-prompt-format " (default %s)" + "Format string used to output \"default\" values. +When prompting for input, there will often be a default value, +leading to prompts like \"Number of articles (default 50): \". +The \"default\" part of that prompt is controlled by this +variable, and can be set to, for instance, \" [%s]\" if you want +a shorter displayed prompt, or \"\", if you don't want to display +the default at all. + +This variable is used by the `format-prompt' function." + :version "28.1" + :type 'string) + (defun format-prompt (prompt default &rest format-args) "Format PROMPT with DEFAULT according to `minibuffer-default-prompt-format'. If FORMAT-ARGS is nil, PROMPT is used as a plain string. If