Compare commits

...

1 commit

Author SHA1 Message Date
João Távora
93342b5776 Overhaul annotation-function to match affixation-function
* doc/lispref/minibuf.texi (Programmed Completion): Rework
annotation-function and affixation-function.

* lisp/help-fns.el (help--symbol-completion-table-annotation): Rename
from help--symbol-completion-table-affixation.
(help--symbol-completion-table): Use
help--symbol-completion-table-annotation.

* lisp/minibuffer.el (minibuffer-completion-help): Interpret
annotation-function with more sophistication.

* lisp/simple.el (read-extended-command): Use
read-extended-command--annotation
(read-extended-command--annotation): Rename from
read-extended-command--affixation
2021-05-26 00:47:22 +01:00
4 changed files with 80 additions and 66 deletions

View file

@ -1927,21 +1927,25 @@ completion behavior is overridden. @xref{Completion Variables}.
@item annotation-function
The value should be a function for @dfn{annotating} completions. The
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.
Unless this function puts own face on the annotation suffix string,
the @code{completions-annotations} face is added by default to
that string.
completion. It may return a string, which is meant to be displayed
along with @var{string} in the settings such as the
@file{*Completions*}. If the returned is propertized with strings for
the @code{prefix} or @code{suffix} text properties (@pxref{Text
Properties}), those properties function as more specific hints of how
to display. Unless this function puts own face on the annotation
strings, the @code{completions-annotations} face is added by default
to them.
@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. This function
takes priority over @code{annotation-function}.
This function does exactly the same as @code{annotation-function} but
takes priority over it and uses a different protocol. 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 group-function
The value should be a function for grouping the completion candidates.

View file

@ -126,38 +126,40 @@ 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-annotation (completion)
(let* ((s (intern completion))
(doc (ignore-errors (documentation s)))
(doc (and doc (substring doc 0 (string-match "\n" doc))))
(annotation (and doc
(propertize (format " -- %s" doc)
'face 'completions-annotations))))
(when annotation
(propertize
annotation
'prefix (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)
'suffix annotation))))
(defun help--symbol-completion-table (string pred action)
(if (and completions-detailed (eq action 'metadata))
'(metadata (affixation-function . help--symbol-completion-table-affixation))
'(metadata (annotation-function . help--symbol-completion-table-annotation))
(when help-enable-completion-autoload
(let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string)))
(help--load-prefixes prefixes)))

View file

@ -2251,11 +2251,20 @@ variables.")
(funcall aff-fun completions)))
(ann-fun
(setq completions
(mapcar (lambda (s)
(let ((ann (funcall ann-fun s)))
(if ann (list s ann) s)))
completions))))
(mapcar
(lambda (s)
(let* ((ann (funcall ann-fun s))
(prefix-hint
(and ann
(get-text-property 0 'prefix ann)))
(suffix-hint
(and ann
(get-text-property 0 'suffix ann))))
(cond (prefix-hint
(list s prefix-hint (or suffix-hint "")))
(ann (list s ann))
(t s))))
completions))))
(with-current-buffer standard-output
(setq-local completion-base-position
(list (+ start base-size)

View file

@ -2004,7 +2004,7 @@ This function uses the `read-extended-command-predicate' user option."
(lambda (string pred action)
(if (and suggest-key-bindings (eq action 'metadata))
'(metadata
(affixation-function . read-extended-command--affixation)
(annotation-function . read-extended-command--annotation)
(category . command))
(let ((pred
(if (memq action '(nil t))
@ -2093,25 +2093,24 @@ or (if one of MODES is a minor mode), if it is switched on in BUFFER."
(and (get-text-property (point) 'button)
(eq (get-text-property (point) 'category) category))))
(defun read-extended-command--affixation (command-names)
(defun read-extended-command--annotation (command-name)
;; why is this `with-selected-window' here?
(with-selected-window (or (minibuffer-selected-window) (selected-window))
(mapcar
(lambda (command-name)
(let* ((fun (and (stringp command-name) (intern-soft command-name)))
(binding (where-is-internal fun overriding-local-map t))
(obsolete (get fun 'byte-obsolete-info))
(alias (symbol-function fun))
(suffix (cond ((symbolp alias)
(format " (%s)" alias))
(obsolete
(format " (%s)" (car obsolete)))
((and binding (not (stringp binding)))
(format " (%s)" (key-description binding)))
(t ""))))
(put-text-property 0 (length suffix)
'face 'completions-annotations suffix)
(list command-name "" suffix)))
command-names)))
(let* ((fun (and (stringp command-name) (intern-soft command-name)))
(binding (where-is-internal fun overriding-local-map t))
(obsolete (get fun 'byte-obsolete-info))
(alias (symbol-function fun))
(annotation (cond ((symbolp alias)
(format " (%s)" alias))
(obsolete
(format " (%s)" (car obsolete)))
((and binding (not (stringp binding)))
(format " (%s)" (key-description binding)))
(t ""))))
(put-text-property 0 (length annotation)
'face 'completions-annotations annotation)
(when annotation
(propertize annotation 'prefix "" 'suffix annotation)))))
(defcustom suggest-key-bindings t
"Non-nil means show the equivalent key-binding when M-x command has one.