emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: on helm substantial differences


From: Juri Linkov
Subject: Re: on helm substantial differences
Date: Wed, 18 Nov 2020 11:10:20 +0200
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (x86_64-pc-linux-gnu)

> Actually, I discovered that unfortunately annotation-function
> is unsuitable for formatting data in a columnar format.
> It needs to receive a complete list of completions to be able
> to adjust their widths for more optimal overall columnar layout.
>
> So a new function is needed that is like annotation-function
> but accepts a list of all completions.  There is an existing
> similar function 'display-sort-function' that could be abused
> to add prefix/suffix annotations, but maybe a separate function
> would be preferable for cleaner API?

It turned out that 'display-function' is not a suitable name either.
What a new function should do is to prepend/append affixes
on both sides of a completion, accept a list of all completions,
and return a list of two separate strings for prefix and suffix:

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 9d57a817b2..3f700803b6 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -121,6 +117,9 @@ completion-metadata
 - `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.
+- `affix-function': function to prepend/append a prefix/suffix to entries.
+   Takes one argument (COMPLETIONS) and should return a list
+   of completions with a 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.
@@ -1689,8 +1688,7 @@ completion--insert-strings
     (let* ((length (apply #'max
                          (mapcar (lambda (s)
                                    (if (consp s)
-                                       (+ (string-width (car s))
-                                           (string-width (cadr s)))
+                                        (cl-reduce #'+ (mapcar #'string-width 
s))
                                      (string-width s)))
                                  strings)))
           (window (get-buffer-window (current-buffer) 0))
@@ -1715,8 +1713,7 @@ completion--insert-strings
           ;; FIXME: `string-width' doesn't pay attention to
           ;; `display' properties.
           (let ((length (if (consp str)
-                            (+ (string-width (car str))
-                               (string-width (cadr str)))
+                            (cl-reduce #'+ (mapcar #'string-width str))
                           (string-width str))))
             (cond
             ((eq completions-format 'vertical)
@@ -1754,13 +1751,21 @@ completion--insert-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)))
+              (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)
+                    (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)
+                  (font-lock-prepend-text-property beg end 'face
+                                                   'completions-annotations))))
            (cond
             ((eq completions-format 'vertical)
              ;; Vertical format
@@ -1880,6 +1885,9 @@ completion-extra-properties
    completion).  The function can access the completion data via
    `minibuffer-completion-table' and related variables.
 
+`:affix-function': Function to prepend/append a prefix/suffix to completions.
+   The function must accept one argument, a list of completions.
+
 `:exit-function': Function to run after completion is performed.
 
    The function must accept two arguments, STRING and STATUS.
@@ -1966,6 +1974,9 @@ minibuffer-completion-help
                        (plist-get completion-extra-properties
                                   :annotation-function)
                        completion-annotate-function))
+             (xfun (or (completion-metadata-get all-md 'affix-function)
+                       (plist-get completion-extra-properties
+                                  :affix-function)))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
@@ -2012,6 +2023,9 @@ minibuffer-completion-help
                                         (let ((ann (funcall afun s)))
                                           (if ann (list s ann) s)))
                                       completions)))
+                      (when xfun
+                        (setq completions
+                              (funcall xfun completions)))
 
                       (with-current-buffer standard-output
                         (set (make-local-variable 'completion-base-position)

reply via email to

[Prev in Thread] Current Thread [Next in Thread]