From d5ed2ad575746fe8fa1f55badcecf3357d3e4a51 Mon Sep 17 00:00:00 2001
From: jao <jao@gnu.org>
Date: Wed, 28 Jul 2021 02:20:50 +0100
Subject: embark: tweaks to my old vindicator

---
 completion.org | 66 ++++++++++++++++++++++++++++++++--------------------------
 1 file changed, 36 insertions(+), 30 deletions(-)

(limited to 'completion.org')

diff --git a/completion.org b/completion.org
index 0cf1c2a..098a12c 100644
--- a/completion.org
+++ b/completion.org
@@ -268,19 +268,19 @@
           (require 'embark-consult)))
     (require 'embark)
     #+end_src
-*** embark action indicator
+*** action indicator
     #+begin_src emacs-lisp
       (defvar jao-embark--actions-buffer "*Embark Actions*")
 
-      (defvar jao-embark--default-display
-        `((,(regexp-quote jao-embark--actions-buffer)
-           (display-buffer-at-bottom)
-           (window-parameters (mode-line-format . none))
-           (window-height . fit-window-to-buffer))))
+      (add-to-list 'display-buffer-alist
+                   `(,(regexp-quote jao-embark--actions-buffer)
+                     (display-buffer-at-bottom)
+                     (window-parameters (mode-line-format . none))
+                     (window-height . fit-window-to-buffer)))
 
-      (setq jao-embark--excluded
-            '(embark-collect-snapshot embark-collect-live embark-export
-              embark-keymap-help embark-become embark-isearch nil))
+      (defvar jao-embark--excluded
+        '(embark-collect-snapshot embark-collect-live embark-export
+          embark-keymap-help embark-become embark-isearch nil))
 
       (defun jao-embark--key-str (k)
         (if (numberp k) (single-key-description k) (key-description k)))
@@ -295,6 +295,7 @@
                 ((memq c jao-embark--excluded) descs)
                 ((symbolp c)
                  (let* ((desc (jao-embark--key-str k))
+                        (prefix (when prefix (concat prefix " ")))
                         (desc (format "%s%s" (or prefix "") desc))
                         (doc (car (split-string
                                    (or (ignore-errors (documentation c)) "")
@@ -302,44 +303,49 @@
                         (fun (symbol-name c)))
                    (cons (max (length desc) (car descs))
                          (cons (max (length fun) (cadr descs))
-                               (cons (list desc fun doc) (cddr descs))))))
-                (t (message "i've skipped %S" x) descs))))
+                               (cons (list desc fun doc) (cddr descs)))))))))
 
       (defun jao-embark--keymap-descs (k prefix)
         (seq-reduce `(lambda (descs x) (jao-embark--bind-desc descs x ,prefix))
                     (cdr (keymap-canonicalize k)) '(0 0)))
 
       (defun jao-embark--dstr (d)
-        (let ((s (cadr d))) (if (string-prefix-p "embark" s) "" s)))
-
-      (defun jao-embark--show-keymap (keymap target other)
+        (let ((s (cadr d)))
+          (if (string-match-p "^\\(embark\\|consult\\)" s) "" s)))
+
+      (defun jao-embark--format-desc (fmt desc)
+        (format fmt
+                (propertize (cadr desc) 'face 'embark-verbose-indicator-title)
+                (propertize (car desc) 'face 'embark-keybinding)
+                (propertize (caddr desc)
+                            'face 'embark-verbose-indicator-documentation)))
+
+      (defun jao-embark--format-targets (targets)
+        (let* ((cexp (format "%s" (cdar targets)))
+               (cexp (replace-regexp-in-string "\n *" " " cexp))
+               (other (format "%s" (mapcar #'car (cdr targets))))
+               (other (propertize other 'face 'embark-verbose-indicator-shadowed)))
+          (format "Action for %s '%s' %s" (caar targets) cexp other)))
+
+      (defun jao-embark--indicator (keymap targets)
         (with-current-buffer (get-buffer-create jao-embark--actions-buffer)
           (read-only-mode -1)
-          (setq-local cursor-type nil)
+          (setq-local cursor-type nil truncate-lines t)
           (delete-region (point-min) (point-max))
           (let* ((descs (jao-embark--keymap-descs keymap ""))
                  (fmt (format "%%-%ds  %%-%ds   %%s\n" (cadr descs) (car descs))))
-            (seq-each (lambda (desc)
-                        (insert (format fmt
-                                        (propertize (cadr desc) 'face 'jao-themes-f00)
-                                        (propertize (car desc) 'face 'embark-keybinding)
-                                        (propertize (caddr desc) 'face 'italic))))
+            (seq-each (lambda (desc) (insert (jao-embark--format-desc fmt desc)))
                       (seq-sort-by 'jao-embark--dstr 'string-greaterp (cddr descs))))
-          (if target
-              (insert (format "\nAction for %s '%s'" (car target) (cdr target)))
-            (delete-char -1))
+          (insert "\n" (jao-embark--format-targets targets))
           (read-only-mode 1)
-          (let ((display-buffer-alist
-                 (append display-buffer-alist jao-embark--default-display)))
-            (pop-to-buffer (current-buffer) nil t))
+          (save-excursion (pop-to-buffer (current-buffer) nil t))
           (lambda ()
             (embark-kill-buffer-and-window jao-embark--actions-buffer)
-            (when (or (bound-and-true-p selectrum-is-active)
-                      (bound-and-true-p current-minibuffer-command))
+            (when (bound-and-true-p current-minibuffer-command)
               (select-window (minibuffer-window))))))
 
-      (setq embark-action-indicator  #'jao-embark--show-keymap
-            embark-become-indicator embark-action-indicator)
+      (setq embark-indicator #'jao-embark--indicator)
+      (setq embark-indicator #'embark-verbose-indicator)
 
     #+end_src
 *** org targets
-- 
cgit v1.2.3