mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-05 11:45:45 +00:00
Code Issues Releases Activity

Add 'completions-detailed' to add prefix/suffix with 'affixation-function'

Browse Source 
* 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
This commit is contained in:
Juri Linkov 2020-11-25 10:46:59 +02:00
parent d7a580c7eb
commit 3b740591b0
4 changed files with 138 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
doc/lispref/minibuf.texi
View File

@ -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

10
etc/NEWS
View File

@ -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,

51
lisp/help-fns.el
View File

@ -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.

103
lisp/minibuffer.el
View File

@ -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