[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 3b74059: Add 'completions-detailed' to add prefix/suffix with 'af
From: |
Juri Linkov |
Subject: |
master 3b74059: Add 'completions-detailed' to add prefix/suffix with 'affixation-function' |
Date: |
Wed, 25 Nov 2020 03:47:21 -0500 (EST) |
branch: master
commit 3b740591b0a1d0e7a24be38471499ecace96936b
Author: Juri Linkov <juri@linkov.net>
Commit: Juri Linkov <juri@linkov.net>
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
---
doc/lispref/minibuf.texi | 16 ++++++++
etc/NEWS | 10 +++++
lisp/help-fns.el | 51 ++++++++++++++++++-----
lisp/minibuffer.el | 103 ++++++++++++++++++++++++++++++++---------------
4 files changed, 138 insertions(+), 42 deletions(-)
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index f1cfd29..56bc0b8 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 0a3854d..9091643 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
@@ -1803,6 +1807,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,
then pressing 'C-h' (help-char) causes the function to evaluate 'help-form'
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 170f497..1c55d0e 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 9d57a81..48bd395 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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 3b74059: Add 'completions-detailed' to add prefix/suffix with 'affixation-function',
Juri Linkov <=