Re: on helm substantial differences

[Juri Linkov <juri@linkov.net>]

[-- Attachment #1: Type: text/plain, Size: 558 bytes --]

>> -					(+ (string-width (car s))
>> -                                           (string-width (cadr s)))
>> +                                        (cl-reduce #'+ (mapcar #'string-width s))
>
> Nit: If you're calling mapcar anyway, why not simply (apply #'+ 0 ...)?

Thanks, fixed.  Now the patch also adds a new user option
'completions-detailed'.  An option separate from 'completions-format'
is needed in case when a completion function doesn't provide :affix-function,
so there is a need to fall back to the customized value of 'completions-format'.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: completions-detailed.patch --]
[-- Type: text/x-diff, Size: 9685 bytes --]

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 170f497541..de4005d6cd 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -127,16 +127,45 @@ help-enable-completion-autoload
   :version "26.3")
 
 (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 (eq action 'metadata)
+      (when completions-detailed
+        '(metadata
+	  (affix-function
+           . (lambda (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 (concat (cond ((commandp s)
+                                                  "c")
+                                                 ((eq (car-safe (symbol-function s)) 'macro)
+                                                  "m")
+                                                 ((fboundp s)
+                                                  "f")
+                                                 ((custom-variable-p s)
+                                                  "u") ; user option
+                                                 ((boundp s)
+                                                  "v")
+                                                 ((facep s)
+                                                  "a")
+                                                 ((and (fboundp 'cl-find-class)
+                                                       (cl-find-class s))
+                                                  "t") ; CL type
+                                                 (" "))
+                                           " ")
+                                 (if doc (format " -- %s" doc) ""))))
+                       completions)))))
+
+    (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 9d57a817b2..7e1d806059 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -83,7 +80,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 +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.
@@ -1669,7 +1668,7 @@ completion-in-region--single-word
     (#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 +1680,16 @@ completions-format
   :type '(choice (const horizontal) (const vertical))
   :version "23.2")
 
+(defcustom completions-detailed nil
+  "When non-nil, display completions vertically with one completion per row.
+This option overrides another related option `completions-format'.
+Some commands might provide a detailed view with more information added
+to completions.  When the used completion function doesn't provide
+a detailed view via `affix-function', then fall back to the value
+defined by `completions-format'."
+  :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 +1698,7 @@ completion--insert-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,10 +1723,14 @@ 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)))
+                            (apply #'+ (mapcar #'string-width str))
                           (string-width str))))
             (cond
+             ((and completions-detailed (= (length str) 3))
+              ;; Detailed view
+              ;; When `str' contains prefix and suffix this means
+              ;; that caller specified `affix-function'.
+              )
 	     ((eq completions-format 'vertical)
 	      ;; Vertical format
 	      (when (> row rows)
@@ -1754,14 +1766,27 @@ 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
+	     ((and completions-detailed (= (length str) 3))
+	      ;; Detailed view
+	      (when (zerop row) (setq truncate-lines t))
+	      (insert "\n")
+	      (setq row (1+ row)))
 	     ((eq completions-format 'vertical)
 	      ;; Vertical format
 	      (if (> column 0)
@@ -1880,6 +1905,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 +1994,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 +2043,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)