branch: externals/embark
commit b415040c21e5bfca7c00639386c4c4ff531544e6
Author: Omar Antolín <omar.anto...@gmail.com>
Commit: Omar Antolín <omar.anto...@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)
