forked from Github/emacs
Compare commits
1 commit
master
...
scratch/an
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
93342b5776 |
4 changed files with 80 additions and 66 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
Loading…
Reference in a new issue