[elpa] externals/embark b415040c21 2/7: Simplify collect candidate storage, stop using revert

[ELPA Syncer]

branch: externals/embark
commit b415040c21e5bfca7c00639386c4c4ff531544e6
Author: Omar Antolín <omar.antolin@gmail.com>
Commit: Omar Antolín <omar.antolin@gmail.com>

    Simplify collect candidate storage, stop using revert
    
    Remove the variable embark-collect--candidates. The entries were
    duplicated in variable tabulated-list-entries anyway, now we only
    store them there.
    
    Also, instead of storing the original candidate (with tofu and
    whatnot) in a text property, we now store it as the id of the
    tabulated list entry.
    
    Finally, some internal things used to rely on revert-buffer being
    tabulated-list-revert. We now call tabulated-list-revert or
    tabulated-list-print directly as appropriate. This will allow use to
    change the value of revert-buffer-function to mean "rerun the command
    that created this collect buffer".
---
 embark-consult.el |   5 ++-
 embark.el         | 105 ++++++++++++++++++++----------------------------------
 2 files changed, 41 insertions(+), 69 deletions(-)

diff --git a/embark-consult.el b/embark-consult.el
index a3b405f504..dc4795919b 100644
--- a/embark-consult.el
+++ b/embark-consult.el
@@ -168,9 +168,8 @@ The elements of LINES are assumed to be values of category 
`consult-line'."
   "Upgrade consult-location cheap markers to real markers.
 This function is meant to be added to `embark-collect-mode-hook'."
   (when (eq embark--type 'consult-location)
-    (let ((fn (if (consp (car embark-collect--candidates)) #'car #'identity)))
-      (mapc (lambda (x) (consult--get-location (funcall fn x)))
-            embark-collect--candidates))))
+    (mapc (lambda (entry) (consult--get-location (car entry)))
+          tabulated-list-entries)))
 
 (setf (alist-get 'consult-location embark-exporters-alist)
       #'embark-consult-export-occur)
diff --git a/embark.el b/embark.el
index 76d56be6c0..3771b403e8 100644
--- a/embark.el
+++ b/embark.el
@@ -693,9 +693,6 @@ This function is meant to be added to 
`minibuffer-setup-hook'."
 (defvar embark--prompter-history nil
   "History used by the `embark-completing-read-prompter'.")
 
-(defvar-local embark-collect--candidates nil
-  "List of candidates in current collect buffer.")
-
 (defvar-local embark--export-pre-revert-hook nil
   "Hook run before reverting an Embark Export buffer.")
 
@@ -939,7 +936,7 @@ their own target finder.  See for example
                   ("Annotation" (previous-button (point)))))
                (start (button-start button))
                (end (button-end button))
-               (candidate (get-text-property start 'embark--candidate)))
+               (candidate (tabulated-list-get-id)))
       `(,embark--type
         ,(if (eq embark--type 'file)
              (abbreviate-file-name (expand-file-name candidate))
@@ -2528,13 +2525,7 @@ This makes `embark-export' work in Embark Collect 
buffers."
                           (lambda (ov)
                             (eq (overlay-get ov 'face) 'embark-collect-marked))
                           (overlays-in (point-min) (point-max))))))
-              (let ((fn (if (consp (car embark-collect--candidates))
-                            #'car
-                          #'identity)))
-                (mapcar (lambda (x)
-                          (get-text-property 0 'embark--candidate
-                                             (funcall fn x)))
-                        embark-collect--candidates))))))
+              (mapcar #'car tabulated-list-entries)))))
 
 (defun embark-completions-buffer-candidates ()
   "Return all candidates in a completions buffer."
@@ -2674,40 +2665,6 @@ embark collect direct action minor mode by adding the 
function
 `embark-collect-direct-action-minor-mode' to
 `embark-collect-mode-hook'.")
 
-(defun embark-collect--revert ()
-  "List view of candidates and annotations for Embark Collect buffer."
-  (let ((max-width 0)
-        (affixed (consp (car embark-collect--candidates))))
-    (if tabulated-list-use-header-line
-        (tabulated-list-init-header)
-      (setq header-line-format nil tabulated-list--header-string nil))
-    (setq tabulated-list-entries
-          (mapcar
-           (if affixed
-               (pcase-lambda (`(,cand ,prefix ,annotation))
-                 (setq max-width (max max-width (+ (string-width prefix)
-                                                   (string-width cand))))
-                 (let* ((length (length annotation))
-                        (faces (text-property-not-all
-                                0 length 'face nil annotation)))
-                   (when faces
-                     (add-face-text-property 0 length 'default t annotation))
-                   `(,cand
-                     [(,(propertize cand 'line-prefix prefix)
-                       type embark-collect-entry)
-                      (,annotation
-                       skip t
-                       ,@(unless faces
-                           '(face embark-collect-annotation)))])))
-             (lambda (cand)
-               (setq max-width (max max-width (string-width cand)))
-               `(,cand [(,cand type embark-collect-entry)])))
-           embark-collect--candidates))
-    (setq tabulated-list-format
-          (if affixed
-              `[("Candidate" ,max-width t) ("Annotation" 0 t)]
-            [("Candidate" 0 t)]))))
-
 (defun embark-collect--remove-zebra-stripes ()
   "Remove highlighting of alternate rows."
   (remove-overlays nil nil 'face 'embark-collect-zebra-highlight))
@@ -2758,19 +2715,14 @@ For non-minibuffers, assume candidates are of given 
TYPE."
   "Get affixation function for current buffer's candidates.
 For non-minibuffers, assume candidates are of given TYPE."
   (or (embark-collect--metadatum type 'affixation-function)
-      (when-let ((annotator
-                  (embark-collect--metadatum type 'annotation-function)))
+      (let ((annotator
+             (or (embark-collect--metadatum type 'annotation-function)
+                 (cl-constantly ""))))
         (lambda (candidates)
           (mapcar (lambda (c)
                     (if-let (a (funcall annotator c)) (list c "" a) c))
                   candidates)))))
 
-(defun embark-collect-toggle-header ()
-  "Toggle the visibility of the header line of Embark Collect buffer."
-  (interactive)
-  (setq tabulated-list-use-header-line (not tabulated-list-use-header-line))
-  (revert-buffer))
-
 (defun embark-collect--marked-p (&optional location)
   "Is the candidate at LOCATION marked?
 LOCATION defaults to point."
@@ -2836,6 +2788,31 @@ candidate."
      (if chunks (apply #'concat (nreverse chunks)) string)
      'embark--candidate string)))
 
+(defun embark-collect--format-entries (candidates)
+  "Format CANDIDATES for `tabulated-list-mode'."
+  (let ((max-width 0))
+    (setq tabulated-list-entries
+          (mapcar
+           (pcase-lambda (`(,cand ,prefix ,annotation))
+             (let* ((display (embark--for-display cand))
+                    (length (length annotation))
+                    (faces (text-property-not-all
+                            0 length 'face nil annotation)))
+               (setq max-width (max max-width (+ (string-width prefix)
+                                                 (string-width display))))
+               (when faces
+                 (add-face-text-property 0 length 'default t annotation))
+               `(,cand
+                 [(,(propertize display 'line-prefix prefix)
+                   type embark-collect-entry)
+                  (,annotation
+                   skip t
+                   ,@(unless faces
+                       '(face embark-collect-annotation)))])))
+           candidates))
+    (setq tabulated-list-format
+          `[("Candidate" ,max-width t) ("Annotation" 0 t)])))
+
 (defun embark-collect--update-candidates (buffer)
   "Update candidates for Embark Collect BUFFER."
   (let* ((transformed (embark--maybe-transform-candidates))
@@ -2849,15 +2826,11 @@ candidate."
                         (let ((rel (file-relative-name cand dir)))
                           (if (string-prefix-p "../" rel) cand rel)))
                       candidates))))
-    (when affixator (setq candidates (funcall affixator candidates)))
-    (setq candidates
-          (if (stringp (car candidates))
-              (mapcar #'embark--for-display candidates)
-            (mapcar (pcase-lambda (`(,cand ,prefix ,annotation))
-                      (list (embark--for-display cand) prefix annotation))
-                    candidates)))
+    (setq candidates (funcall affixator candidates))
     (with-current-buffer buffer
-      (setq embark--type type embark-collect--candidates candidates))))
+      (setq embark--type type)
+      (embark-collect--format-entries candidates))
+    candidates))
 
 (defun embark--collect (buffer-name)
   "Create an Embark Collect buffer named BUFFER-NAME.
@@ -2875,15 +2848,16 @@ buffer has a unique name."
       (user-error "No candidates to collect"))
 
     (with-current-buffer buffer
-      (setq tabulated-list-use-header-line nil) ; default to no header
-      (add-hook 'tabulated-list-revert-hook #'embark-collect--revert nil t)
+      (setq tabulated-list-use-header-line nil  ; default to no header
+            header-line-format nil
+            tabulated-list--header-string nil)
       (when (memq embark--type embark-collect-zebra-types)
         (embark-collect-zebra-minor-mode)))
 
     (let ((window (display-buffer buffer)))
       (with-selected-window window
         (run-mode-hooks)
-        (revert-buffer))
+        (tabulated-list-revert))
       (set-window-dedicated-p window t)
       buffer)))
 
@@ -2940,8 +2914,7 @@ with key \"Embark Live\"."
                          (embark-collect--update-candidates live-buffer)
                          (with-current-buffer live-buffer
                            ;; TODO figure out why I can't restore point
-                           (embark-collect--revert)
-                           (tabulated-list-print nil t))
+                           (tabulated-list-print t t))
                          (setq timer nil))))))))
     (add-hook 'after-change-functions run-collect nil t)
     (when (minibufferp)