[elpa] externals/embark 6a8e6ded2d 1/2: Add mark/unmark functionality to embark collect buffers

[ELPA Syncer]

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

    Add mark/unmark functionality to embark collect buffers
    
    This code is based on @minad's PR #467.
---
 embark.el | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 73 insertions(+), 6 deletions(-)

diff --git a/embark.el b/embark.el
index 8cf2b605ee..ea2dc8eba4 100644
--- a/embark.el
+++ b/embark.el
@@ -2408,6 +2408,9 @@ default is `embark-collect'"
   "Face for annotations in Embark Collect.
 This is only used for annotation that are not already fontified.")
 
+(defface embark-collect-marked '((t (:inherit warning)))
+  "Face for marked candidates in an Embark Collect buffer.")
+
 (defcustom embark-collect-post-revert-hook nil
   "Hook run after an Embark Collect buffer is updated."
   :type 'hook)
@@ -2508,11 +2511,23 @@ all buffers."
   "Return candidates in Embark Collect buffer.
 This makes `embark-export' work in Embark Collect buffers."
   (when (derived-mode-p 'embark-collect-mode)
-    (let ((fn (if (consp (car embark-collect--candidates)) #'car #'identity)))
-      (cons embark--type
-            (mapcar (lambda (x)
-                      (get-text-property 0 'embark--candidate (funcall fn x)))
-                    embark-collect--candidates)))))
+    (cons embark--type
+          (or (save-excursion
+                (mapcar (lambda (ov)
+                          (goto-char (overlay-start ov))
+                          (cadr (embark-target-collect-candidate)))
+                        (nreverse
+                         (seq-filter
+                          (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))))))
 
 (defun embark-completions-buffer-candidates ()
   "Return all candidates in a completions buffer."
@@ -2630,11 +2645,16 @@ For other Embark Collect buffers, run the default 
action on ENTRY."
   "Keymap for Embark collect mode."
   :parent tabulated-list-mode-map
   ("a" embark-act)
-  ("A" embark-collect-direct-action-minor-mode)
+  ("A" embark-act-all)
+  ("M-a" embark-collect-direct-action-minor-mode)
   ("z" embark-collect-zebra-minor-mode)
   ("M-q" embark-collect-toggle-view)
   ("v" embark-collect-toggle-view)
   ("e" embark-export)
+  ("t" embark-collect-toggle-marks)
+  ("m" embark-collect-mark)
+  ("u" embark-collect-unmark)
+  ("U" embark-collect-unmark-all)
   ("s" isearch-forward)
   ("f" forward-button)
   ("b" backward-button)
@@ -2810,6 +2830,52 @@ Refresh the buffer afterwards."
   (interactive)
   (embark-collect--toggle 'tabulated-list-use-header-line t nil))
 
+(defun embark-collect--marked-p (&optional location)
+  "Is the candidate at LOCATION marked?
+LOCATION defaults to point."
+  (seq-find (lambda (ov) (eq (overlay-get ov 'face) 'embark-collect-marked))
+            (overlays-at (or location (point)))))
+
+(defun embark-collect-mark (&optional unmark)
+  "Mark the candidate at point in an Embark collect buffer.
+If called from Lisp with a non-nil UNMARK, instead unmark the
+candidate."
+  (interactive)
+  (unless (derived-mode-p 'embark-collect-mode)
+    (user-error "Not in an Embark Collect mode buffer"))
+  (pcase (embark-target-collect-candidate)
+    (`(,_type ,_cand ,start . ,end)
+     (if-let ((ov (embark-collect--marked-p)))
+         (when unmark (delete-overlay ov))
+       (unless unmark
+         (overlay-put (make-overlay start end)
+                      'face 'embark-collect-marked)))
+     (forward-button 1 nil nil t))
+    ('nil (user-error "No candidate at point"))))
+
+(defun embark-collect-unmark ()
+  "Unmark the candidate at point in an Embark collect buffer."
+  (interactive)
+  (embark-collect-mark t))
+
+(defun embark-collect-unmark-all ()
+  "Unmark all marked candidates in an Embark Collect buffer."
+  (interactive)
+  (unless (derived-mode-p 'embark-collect-mode)
+    (user-error "Not in an Embark Collect mode buffer"))
+  (dolist (ov (overlays-in (point-min) (point-max)))
+    (when (eq (overlay-get ov 'face) 'embark-collect-marked)
+      (delete-overlay ov))))
+
+(defun embark-collect-toggle-marks ()
+  "Toggle marks: marked candidates become unmarked, and vice versa."
+  (interactive)
+  (unless (derived-mode-p 'embark-collect-mode)
+    (user-error "Not in an Embark Collect mode buffer"))
+  (save-excursion
+    (goto-char (point-min))
+    (while (embark-collect-mark (embark-collect--marked-p)))))
+
 (defun embark-collect--update-candidates (buffer)
   "Update candidates for Embark Collect BUFFER."
   (pcase-let* ((`(,type . ,candidates)
@@ -3626,6 +3692,7 @@ The advice is self-removing so it only affects ACTION 
once."
   ("w" kill-new)
   ("E" embark-export)
   ("S" embark-collect)
+  ("L" embark-live)
   ("B" embark-become)
   ("A" embark-act-all)
   ("C-s" embark-isearch)