Skip to content

Commit

Permalink
Unzebra
Browse files Browse the repository at this point in the history
Just opening this such that the discussion in oantolin#593 does not get lost.
Remove the zebra and the (almost useless) embark-collect-revert-hook.
Given how much code space the Zebra needs, I don't think it is
justified to keep it in captivity in our zoo. As alternative I suggest
a meerkat mode.
  • Loading branch information
minad committed Feb 10, 2023
1 parent 4882b39 commit 74f6822
Showing 1 changed file with 3 additions and 67 deletions.
70 changes: 3 additions & 67 deletions embark.el
Original file line number Diff line number Diff line change
Expand Up @@ -2452,13 +2452,6 @@ candidates and whose `cdr' is the list of candidates, each of
which should be a string."
:type 'hook)

(defcustom embark-collect-zebra-types
'(kill-ring)
"List of completion types for which zebra stripes should be activated.
The candidates of the given types are displayed with zebra stripes
in Embark Collect buffers."
:type '(repeat symbol))

(defcustom embark-exporters-alist
'((buffer . embark-export-ibuffer)
(file . embark-export-dired)
Expand Down Expand Up @@ -2506,25 +2499,13 @@ default is `embark-collect'"
"Format string used for the group title in Embark Collect buffers."
:type 'string)

(defface embark-collect-zebra-highlight
'((default :extend t)
(((class color) (min-colors 88) (background light))
:background "#efefef")
(((class color) (min-colors 88) (background dark))
:background "#242424"))
"Face to highlight alternate rows in Embark Collect zebra minor mode.")

(defface embark-collect-annotation '((t :inherit completions-annotations))
"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)

(defvar-local embark--rerun-function nil
"Function to rerun the collect or export that made the current buffer.")

Expand Down Expand Up @@ -2767,7 +2748,6 @@ If NESTED is non-nil subkeymaps are not flattened."
"a" #'embark-act
"A" #'embark-act-all
"M-a" #'embark-collect-direct-action-minor-mode
"z" #'embark-collect-zebra-minor-mode
"E" #'embark-export
"t" #'embark-collect-toggle-marks
"m" #'embark-collect-mark
Expand Down Expand Up @@ -2804,47 +2784,6 @@ perhaps editing the minibuffer contents, and, if you wish, you
can rerun `embark-collect' to get an updated buffer."
:interactive nil :abbrev-table nil :syntax-table nil)

(defun embark-collect--revert (&rest _)
"Revert function of `embark-collect-mode' buffers."
(tabulated-list-revert)
(run-hooks 'embark-collect-post-revert-hook))

(defun embark-collect--remove-zebra-stripes ()
"Remove highlighting of alternate rows."
(remove-overlays nil nil 'face 'embark-collect-zebra-highlight))

(defun embark-collect--add-zebra-stripes ()
"Highlight alternate rows with the `embark-collect-zebra-highlight' face."
(embark-collect--remove-zebra-stripes)
(save-excursion
(goto-char (point-min))
(when (overlays-at (point)) (forward-line))
(while (not (eobp))
(condition-case nil
(forward-button 1)
(user-error (goto-char (point-max))))
(unless (eobp)
(let ((pt (point)))
(condition-case nil
(forward-button 1)
(user-error (goto-char (point-max))))
(let ((stripe (make-overlay pt (point))))
(overlay-put stripe 'priority -100) ; below hl-line-mode's -50
(overlay-put stripe 'face 'embark-collect-zebra-highlight)))))))

(define-minor-mode embark-collect-zebra-minor-mode
"Minor mode to highlight alternate rows in an Embark Collect buffer.
This is specially useful to tell where multi-line entries begin and end."
:init-value nil
(if embark-collect-zebra-minor-mode
(progn
(add-hook 'embark-collect-post-revert-hook
#'embark-collect--add-zebra-stripes nil t)
(embark-collect--add-zebra-stripes))
(remove-hook 'embark-collect-post-revert-hook
#'embark-collect--add-zebra-stripes t)
(embark-collect--remove-zebra-stripes)))

(defun embark-collect--metadatum (type metadatum)
"Get METADATUM for current buffer's candidates.
For non-minibuffers, assume candidates are of given TYPE."
Expand Down Expand Up @@ -3019,17 +2958,14 @@ buffer has a unique name."
(with-current-buffer buffer
(setq tabulated-list-use-header-line nil ; default to no header
header-line-format nil
tabulated-list--header-string nil
revert-buffer-function #'embark-collect--revert)
tabulated-list--header-string nil)
(setq embark--rerun-function rerun)
(local-set-key [remap revert-buffer] #'embark-rerun-collect-or-export)
(when (memq embark--type embark-collect-zebra-types)
(embark-collect-zebra-minor-mode)))
(local-set-key [remap revert-buffer] #'embark-rerun-collect-or-export))

(let ((window (display-buffer buffer)))
(with-selected-window window
(run-mode-hooks)
(embark-collect--revert))
(tabulated-list-revert))
(set-window-dedicated-p window t)
buffer)))

Expand Down

0 comments on commit 74f6822

Please sign in to comment.