[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/icomplete-vertical-mode-related-work c678265 2/2: Overhaul annot
|
From: |
João Távora |
|
Subject: |
scratch/icomplete-vertical-mode-related-work c678265 2/2: Overhaul annotation-function to match affixation-function |
|
Date: |
Mon, 24 May 2021 14:49:29 -0400 (EDT) |
branch: scratch/icomplete-vertical-mode-related-work
commit c6782655f70d9b18677372642765fd24c9a141e7
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>
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
---
doc/lispref/minibuf.texi | 30 ++++++++++++++-----------
lisp/help-fns.el | 58 ++++++++++++++++++++++++------------------------
lisp/minibuffer.el | 18 ++++++++++-----
lisp/simple.el | 36 ++++++++++++++----------------
4 files changed, 76 insertions(+), 66 deletions(-)
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 196dd99..6324c29 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -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.
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 0b0ae43..aa5256d 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -126,38 +126,38 @@ 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)))))
+ (propertize
+ completion
+ '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 (and doc
+ (propertize (format " -- %s" doc)
+ 'face 'completions-annotations)))))
(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)))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index e04f104..b01bd67 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2251,11 +2251,19 @@ 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
+ (or (get-text-property 0 'prefix ann)
+ ann))
+ (suffix-hint
+ (or (get-text-property 0 'suffix ann)
+ "")))
+ (if ann
+ (list s prefix-hint suffix-hint)
+ s)))
+ completions))))
(with-current-buffer standard-output
(setq-local completion-base-position
(list (+ start base-size)
diff --git a/lisp/simple.el b/lisp/simple.el
index eecbb1e..8232fdf 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -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,23 @@ 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))
+ (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)
+ (propertize command-name 'prefix "" 'suffix suffix))))
(defcustom suggest-key-bindings t
"Non-nil means show the equivalent key-binding when M-x command has one.