Handle minibuffer completion table, predicate and metadata

CHANGELOG.md

@@ -64,6 +64,20 @@ The format is based on [Keep a Changelog].
   Appearance can be configured using the faces
   `selectrum-completion-annotation`, `selectrum-completion-docsig`,
   and `completions-common-part` ([#86]).
+* `selectrum-read` accepts two additional keyword arguments
+  `minibuffer-completion-table` and
+  `minibuffer-completion-predicate`. These can be used to pass the
+  `completing-read` collection and predicate so they are available for
+  internal handling of completion API features and for other external
+  commands or packages which make use of them ([#94], [#95]).
+* If the completion table passed to `completing-read` provides
+  `annotation-function` or `display-sort-function` in its metadata,
+  Selectrum will use this information to annotate or sort the
+  candidates accordingly. Annotations defined by
+  `completion-extra-properties` are handled, too ([#82], [#95]).
+* One can trigger an update of Selectrum's completions UI manually by
+  calling `selectrum-exhibit` ([#95]).
+
 
 ### Enhancements
 * `selectrum-read-file-name` which is used as
@@ -175,9 +189,12 @@ The format is based on [Keep a Changelog].
 [#76]: https://github.com/raxod502/selectrum/pull/76
 [#77]: https://github.com/raxod502/selectrum/pull/77
 [#80]: https://github.com/raxod502/selectrum/issues/80
+[#82]: https://github.com/raxod502/selectrum/issues/82
 [#85]: https://github.com/raxod502/selectrum/pull/85
 [#86]: https://github.com/raxod502/selectrum/pull/86
 [#89]: https://github.com/raxod502/selectrum/pull/89
+[#94]: https://github.com/raxod502/selectrum/issues/94
+[#95]: https://github.com/raxod502/selectrum/pull/95
 [raxod502/ctrlf#41]: https://github.com/raxod502/ctrlf/issues/41
 
 ## 1.0 (released 2020-03-23)

selectrum.el

@@ -357,6 +357,25 @@ If PREDICATE is non-nil, then it filters the collection as in
   (or (get-text-property 0 'selectrum-candidate-full candidate)
       candidate))
 
+(defun selectrum--get-annotation-suffix (string annotation-func)
+  "Get `selectrum-candidate-display-suffix' value for annotation.
+Used to display STRING according to ANNOTATION-FUNC from
+metadata."
+  ;; Rule out situations where the annotation
+  ;; is nil.
+  (when-let ((annotation (funcall annotation-func string)))
+    (propertize
+     annotation
+     'face 'selectrum-completion-annotation)))
+
+(defun selectrum--get-margin-docsig (string docsig-func)
+  "Get `selectrum-candidate-display-right-margin' value for docsig.
+Used to display STRING according to DOCSIG-FUNC from metadata."
+  (when-let ((docsig (funcall docsig-func string)))
+    (propertize
+     (format "%s" docsig)
+     'face 'selectrum-completion-docsig)))
+
 ;;;; Minibuffer state
 
 (defvar selectrum--start-of-input-marker nil
@@ -475,6 +494,58 @@ This is used to implement `selectrum-repeat'.")
      selectrum--start-of-input-marker
      selectrum--end-of-input-marker)))
 
+(defun selectrum--get-meta (setting &optional table pred input)
+  "Get metadata SETTING from TABLE.
+TABLE defaults to `minibuffer-completion-table'.
+PRED defaults to `minibuffer-completion-predicate'.
+INPUT defaults to current selectrum input string."
+  (let ((input (or input (selectrum--current-input)))
+        (pred (or pred minibuffer-completion-predicate))
+        (table (or table minibuffer-completion-table)))
+    (when table
+      (completion-metadata-get
+       (completion-metadata input table pred) setting))))
+
+(defun selectrum--get-candidates-from-table (&optional table pred)
+  "Get candidates from TABLE.
+TABLE defaults to `minibuffer-completion-table'.
+PRED defaults to `minibuffer-completion-predicate'."
+  (let ((annotf (or (selectrum--get-meta 'annotation-function table pred)
+                    (plist-get completion-extra-properties
+                               :annotation-function)))
+        (strings (selectrum--normalize-collection
+                  (or table minibuffer-completion-table)
+                  (or pred minibuffer-completion-predicate))))
+    (cond (annotf
+           (let ((cands ()))
+             (dolist (string strings (nreverse cands))
+               (push (propertize
+                      string
+                      'selectrum-candidate-display-suffix
+                      (selectrum--get-annotation-suffix
+                       string annotf))
+                     cands))))
+          (t strings))))
+
+(defun selectrum--current-input ()
+  "Get current Selectrum input."
+  (if (and selectrum--start-of-input-marker
+           selectrum--end-of-input-marker)
+      (buffer-substring
+       selectrum--start-of-input-marker
+       selectrum--end-of-input-marker)
+    ""))
+
+(defun selectrum-exhibit ()
+  "Trigger an update of Selectrum's completion UI."
+  (when-let ((mini (active-minibuffer-window)))
+    (with-selected-window mini
+      (when (and minibuffer-completion-table
+                 (not (functionp selectrum--preprocessed-candidates)))
+        (setq selectrum--preprocessed-candidates nil))
+      (setq selectrum--previous-input-string nil)
+      (selectrum--minibuffer-post-command-hook))))
+
 ;;;; Hook functions
 
 (defun selectrum--count-info ()
@@ -550,6 +621,13 @@ just rendering it to the screen and then checking."
           (bound (marker-position selectrum--end-of-input-marker))
           (keep-mark-active (not deactivate-mark)))
       (unless (equal input selectrum--previous-input-string)
+        (when (and (not selectrum--preprocessed-candidates)
+                   minibuffer-completion-table)
+          ;; No candidates were passed, initialize them from
+          ;; `minibuffer-completion-table'.
+          (setq selectrum--preprocessed-candidates
+                (funcall selectrum-preprocess-candidates-function
+                         (selectrum--get-candidates-from-table))))
         (setq selectrum--previous-input-string input)
         ;; Reset the persistent input, so that it will be nil if
         ;; there's no special attention needed.
@@ -783,6 +861,10 @@ into the user input area to start with."
       (insert initial-input)))
   (setq selectrum--end-of-input-marker (point-marker))
   (set-marker-insertion-type selectrum--end-of-input-marker t)
+  ;; If metadata specifies a custom sort function use it as
+  ;; `selectrum-preprocess-candidates-function' for this session.
+  (when-let ((sortf (selectrum--get-meta 'display-sort-function)))
+    (setq-local selectrum-preprocess-candidates-function sortf))
   (setq selectrum--preprocessed-candidates
         (if (functionp candidates)
             candidates
@@ -1042,14 +1124,17 @@ Otherwise, just eval BODY."
     (prompt candidates &rest args &key
             default-candidate initial-input require-match
             history no-move-default-candidate
-            may-modify-candidates)
+            may-modify-candidates
+            minibuffer-completion-table
+            minibuffer-completion-predicate)
   "Prompt user with PROMPT to select one of CANDIDATES.
 Return the selected string.
 
 CANDIDATES is a list of strings or a function to dynamically
 generate them. If CANDIDATES is a function, then it receives one
 argument, the current user input, and returns the list of
-strings.
+strings. If CANDIDATES are nil the candidates will be computed
+from MINIBUFFER-COMPLETION-TABLE.
 
 Instead of a list of strings, the function may alternatively
 return an alist with the following keys:
@@ -1082,7 +1167,14 @@ is very confusing.
 
 MAY-MODIFY-CANDIDATES, if non-nil, means that Selectrum is
 allowed to modify the CANDIDATES list destructively. Otherwise a
-copy is made."
+copy is made.
+
+For MINIBUFFER-COMPLETION-TABLE and
+MINIBUFFER-COMPLETION-PREDICATE see `minibuffer-completion-table'
+and `minibuffer-completion-predicate'. They are used for internal
+purposes and compatibility to Emacs completion API. By passing
+these as keyword arguments they will be dynamically bound as per
+semantics of `cl-defun'."
   (unless may-modify-candidates
     (setq candidates (copy-sequence candidates)))
   (selectrum--save-global-state
@@ -1142,14 +1234,16 @@ For PROMPT, COLLECTION, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT,
 HIST, DEF, and INHERIT-INPUT-METHOD, see `completing-read'."
   (ignore initial-input inherit-input-method)
   (selectrum-read
-   prompt (selectrum--normalize-collection collection predicate)
+   prompt nil
    ;; Don't pass `initial-input'. We use it internally but it's
    ;; deprecated in `completing-read' and doesn't work well with the
    ;; Selectrum paradigm except in specific cases that we control.
    :default-candidate (or (car-safe def) def)
    :require-match (eq require-match t)
    :history hist
-   :may-modify-candidates t))
+   :may-modify-candidates t
+   :minibuffer-completion-table collection
+   :minibuffer-completion-predicate predicate))
 
 (defvar selectrum--old-completing-read-function nil
   "Previous value of `completing-read-function'.")
@@ -1206,7 +1300,9 @@ INHERIT-INPUT-METHOD, see `completing-read-multiple'."
         :initial-input initial-input
         :history hist
         :default-candidate def
-        :may-modify-candidates t)))
+        :may-modify-candidates t
+        :minibuffer-completion-table table
+        :minibuffer-completion-predicate predicate)))
     (split-string res crm-separator t)))
 
 ;;;###autoload
@@ -1250,29 +1346,30 @@ COLLECTION, and PREDICATE, see `completion-in-region'."
                            cand
                            'selectrum-candidate-display-suffix
                            (when annotation-func
-                             ;; Rule out situations where the annotation
-                             ;; is nil.
-                             (when-let ((annotation
-                                         (funcall annotation-func cand)))
-                               (propertize
-                                annotation
-                                'face 'selectrum-completion-annotation)))
+                             (selectrum--get-annotation-suffix
+                              cand annotation-func))
                            'selectrum-candidate-display-right-margin
                            (when docsig-func
-                             (when-let ((docsig (funcall docsig-func cand)))
-                               (propertize
-                                (format "%s" docsig)
-                                'face 'selectrum-completion-docsig)))))
+                             (selectrum--get-margin-docsig
+                              cand docsig-func))))
                         cands))
                 (selectrum-should-sort-p selectrum-should-sort-p))
            (when display-sort-func
              (setq cands (funcall display-sort-func cands))
+             ;; FIXME: This will set `selectrum-should-sort-p' for any
+             ;; recursive minibuffer sessions, too.
              (setq selectrum-should-sort-p nil))
            (pcase (length cands)
              ;; We already rule out the situation where `cands' is empty.
              (`1 (setq result (car cands)))
              ( _ (setq result (selectrum-read
                                "Completion: " cands
+                               ;; Don't pass
+                               ;; `minibuffer-completion-table' and
+                               ;; `minibuffer-completion-predicate'
+                               ;; here because currently this function
+                               ;; handles all metadata for region
+                               ;; completion itself.
                                :may-modify-candidates t))))
            (setq exit-status
                  (cond ((not (member result cands)) 'sole)
@@ -1326,7 +1423,9 @@ PREDICATE, see `read-buffer'."
      :require-match (eq require-match t)
      :history 'buffer-name-history
      :no-move-default-candidate t
-     :may-modify-candidates t)))
+     :may-modify-candidates t
+     :minibuffer-completion-table #'internal-complete-buffer
+     :minibuffer-completion-predicate predicate)))
 
 (defvar selectrum--old-read-buffer-function nil
   "Previous value of `read-buffer-function'.")
@@ -1371,7 +1470,9 @@ For PROMPT, COLLECTION, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT,
      :initial-input (or (car-safe initial-input) initial-input)
      :history hist
      :require-match (eq require-match t)
-     :may-modify-candidates t)))
+     :may-modify-candidates t
+     :minibuffer-completion-table collection
+     :minibuffer-completion-predicate predicate)))
 
 ;;;###autoload
 (defun selectrum-read-file-name