[nongnu] elpa/helm 5344c1f093 1/2: Show shortdoc when completions-detailed is non nil

[ELPA Syncer]

branch: elpa/helm
commit 5344c1f093f39d6bf020633407b8241592bed5e4
Author: Thierry Volpiatto <thievol@posteo.net>
Commit: Thierry Volpiatto <thievol@posteo.net>

    Show shortdoc when completions-detailed is non nil
    
    This is provided only when helm-completion-style == emacs.
---
 helm-mode.el | 89 ++++++++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 62 insertions(+), 27 deletions(-)

diff --git a/helm-mode.el b/helm-mode.el
index d685aa2cfb..6f5bb0e834 100644
--- a/helm-mode.el
+++ b/helm-mode.el
@@ -37,6 +37,7 @@
 (declare-function helm-apropos-init "helm-elisp")
 (declare-function helm-lisp-completion-persistent-action "helm-elisp")
 (declare-function helm-lisp-completion-persistent-help "helm-elisp")
+(declare-function help--symbol-class "help-fns.el")
 
 (defgroup helm-mode nil
   "Enable helm completion."
@@ -991,6 +992,8 @@ This handler uses dynamic matching which allows honouring 
`completion-styles'."
                        '(metadata)))
          (afun (or (plist-get completion-extra-properties :annotation-function)
                    (completion-metadata-get metadata 'annotation-function)))
+         (afix (or (plist-get completion-extra-properties :affixation-function)
+                   (completion-metadata-get metadata 'affixation-function)))
          (file-comp-p (eq (completion-metadata-get metadata 'category) 'file))
          (compfn (lambda (str _predicate _action)
                    (let* ((completion-ignore-case (helm-set-case-fold-search))
@@ -1034,10 +1037,15 @@ This handler uses dynamic matching which allows 
honouring `completion-styles'."
                                   (memq helm-completion-style '(helm 
helm-fuzzy))
                                   (list default))
                              (helm-completion-in-region--initial-filter
-                              (if (and sort-fn (> (length str) 0))
-                                  (funcall sort-fn all)
-                                all)
-                              afun file-comp-p)))))
+                              (pcase-let ((lst (if (and sort-fn (> (length 
str) 0))
+                                                   (funcall sort-fn all)
+                                                 all)))
+                                (if (and default afix)
+                                    (prog1 (append (list default)
+                                                   (delete default lst))
+                                      (setq default nil))
+                                  lst))
+                              afun afix file-comp-p)))))
          (data (if (memq helm-completion-style '(helm helm-fuzzy))
                    (funcall compfn (or input "") nil nil)
                  compfn))
@@ -1060,7 +1068,7 @@ This handler uses dynamic matching which allows honouring 
`completion-styles'."
          :reverse-history helm-mode-reverse-history
          ;; In helm h-c-styles default is passed directly in
          ;; candidates.
-         :default (and (eq helm-completion-style 'emacs) default)
+         :default (and (eq helm-completion-style 'emacs) (null afix) default)
          :fc-transformer
          ;; Ensure sort fn is at the end.
          (append '(helm-cr-default-transformer)
@@ -1664,32 +1672,55 @@ The `helm-find-files' history `helm-ff-history' is used 
here."
       (propertize str 'read-only t 'face 'helm-mode-prefix 'rear-nonsticky t)
     str))
 
-(defun helm-completion-in-region--initial-filter (comps afun file-comp-p)
-  "Add annotations at end of candidates and filter out dot files."
+(defun helm--symbol-completion-table-affixation (completions)
+  "Same as `help--symbol-completion-table-affixation' but for helm.
+
+Return a list of cons cells of the form (disp . real)."
+  (mapcar (lambda (c)
+            (let* ((s   (intern c))
+                   (doc (ignore-errors
+                          (helm-get-first-line-documentation s))))
+              (cons (concat (propertize
+                             (format "%-4s" (help--symbol-class s))
+                             'face 'completions-annotations)
+                            c
+                            (if doc
+                                (propertize (format " -- %s" doc)
+                                            'face 'completions-annotations)
+                              ""))
+                    c)))
+          completions))
+
+(defun helm-completion-in-region--initial-filter (comps afun afix file-comp-p)
+  "Compute COMPS with function AFUN or AFIX unless FILE-COMP-P non nil.
+
+If both AFUN and AFIX are provided only AFIX is used.
+When FILE-COMP-P is provided only filter out dot files."
   (if file-comp-p
       ;; Filter out dot files in file completion.
       (cl-loop for f in comps unless
                (string-match "\\`\\.\\{1,2\\}/\\'" f)
                collect f)
-    (if afun
-        ;; Add annotation at end of
-        ;; candidate if needed, e.g. foo<f>, this happen when
-        ;; completing against a quoted symbol.
-        (mapcar (lambda (s)
-                  (let ((ann (funcall afun s)))
-                    (if ann
-                        (cons
-                         (concat
-                          s
-                          (propertize
-                           " " 'display
-                           (propertize
-                            ann
-                            'face 'completions-annotations)))
-                         s)
-                      s)))
-                comps)
-      comps)))
+    (cond (afix (helm--symbol-completion-table-affixation comps))
+          (afun
+           ;; Add annotation at end of
+           ;; candidate if needed, e.g. foo<f>, this happen when
+           ;; completing against a quoted symbol.
+           (mapcar (lambda (s)
+                     (let ((ann (funcall afun s)))
+                       (if ann
+                           (cons
+                            (concat
+                             s
+                             (propertize
+                              " " 'display
+                              (propertize
+                               ann
+                               'face 'completions-annotations)))
+                            s)
+                         s)))
+                   comps))
+          (t comps))))
 
 ;; Helm multi matching style
 
@@ -1917,6 +1948,10 @@ Can be used for `completion-in-region-function' by 
advicing it with an
                  ;; See Bug#407.
                  (afun (or (plist-get completion-extra-properties 
:annotation-function)
                            (completion-metadata-get metadata 
'annotation-function)))
+                 ;; Not sure if affixations are provided in
+                 ;; completion-in-region, try anyway never know.
+                 (afix (or (plist-get completion-extra-properties 
:affixation-function)
+                           (completion-metadata-get metadata 
'affixation-function)))
                  (init-space-suffix (unless (or (memq helm-completion-style 
'(helm-fuzzy emacs))
                                                 (string-suffix-p " " input)
                                                 (string= input ""))
@@ -1979,7 +2014,7 @@ Can be used for `completion-in-region-function' by 
advicing it with an
                               (if (and sort-fn (> (length str) 0))
                                   (funcall sort-fn all)
                                 all)
-                              afun file-comp-p))))
+                              afun afix file-comp-p))))
                  (data (if (memq helm-completion-style '(helm helm-fuzzy))
                            (funcall compfn input nil nil)
                          compfn))