From d5ed2ad575746fe8fa1f55badcecf3357d3e4a51 Mon Sep 17 00:00:00 2001 From: jao 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(-) 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