Add esy/consult-push-button

diff --git a/.emacs.d/esy.org b/.emacs.d/esy.org
index fb96d1fde715167e42f40001a92d34364fdd31d2..979c9d54f508d9b91178c2ac0cd3b9d52428bfc4 100644 (file)
--- a/.emacs.d/esy.org
+++ b/.emacs.d/esy.org
@@ -57,7 +57,6 @@ is shown below:
 For more information about Emacs run time measurement, see [[info:elisp#Processor Run
  Time][elisp#Processor Run Time]].
 
-
 * Elisp Header
 :PROPERTIES:
 :CUSTOM_ID: header
@@ -127,7 +126,7 @@ For further information about Elisp headers, see [[info:elisp#Library
                '("melpa" . "http://melpa.org/packages/"))
 
   (setq package-selected-packages
-        '(academic-phrases avy alert
+        '(academic-phrases avy ace-window alert
           all-the-icons all-the-icons-completion anzu
           auctex-latexmk beacon benchmark-init browse-at-remote
           browse-kill-ring cape corfu command-log-mode dabbrev define-word
@@ -260,7 +259,6 @@ For a list of available frame parameters, see [[info:elisp#Frame Parameters][eli
     (require 'lin)
     (require 'which-key)
     (require 'whitespace-cleanup-mode)
-    (require 'beacon)
     (setq beacon-color "magenta"
           show-paren-context-when-offscreen t)
     (add-to-list 'lin-mode-hooks 'package-menu-mode-hook)
@@ -381,7 +379,6 @@ refiling directly into deeper headings as well.
   (defun esy/org-fill-custom-ids-in-buffer ()
     "Visit headers in the current buffer and set CUSTOM_ID for each."
     (interactive)
-    (require 'beacon)
     (org-global-cycle 1)
     (message "Filled %d CUSTOM_ID properties."
              (length (remove nil
@@ -802,6 +799,7 @@ refiling directly into deeper headings as well.
     (global-set-key [remap ns-print-buffer] #'move-dup-duplicate-up)
     (global-set-key (kbd "M-p") #'move-dup-move-lines-up)
     (global-set-key (kbd "M-n") #'move-dup-move-lines-down)
+    (global-set-key (kbd "M-o") #'esy/consult-push-button)
     (global-set-key (kbd "C-,") #'backward-delete-char)
     (global-set-key (kbd "C-.") #'embark-act)
     (global-set-key (kbd "C-;") #'avy-goto-char-timer)
@@ -1291,6 +1289,75 @@ Add the timezones of places of interest to the list of clocks shown by
     (add-to-list 'zoneinfo-style-world-list '("Europe/Amsterdam" "Amsterdam")))
 #+end_src
 
+** Push a button in the current buffer with completions    
+  :PROPERTIES:
+  :CUSTOM_ID: consult-push-button
+  :CreatedAt: <2022-05-14 Sat>
+  :CapturedAt: 
+  :CapturedAs: Emacs configuration fragment
+  :END:
+
+#+begin_src emacs-lisp
+  (defun esy/preview-button (action candidate)
+    "If ACTION is `preview', preview CANDIDATE."
+    (when (eq action 'preview)
+      (let ((pos (cdr candidate)))
+        (unless (= (goto-char pos) (point))
+          (widen)
+          (goto-char pos))
+        (recenter)
+        (beacon-blink))))
+
+  (defun esy/buttons (&optional buffer)
+    "Return an alist of buttons in BUFFER."
+    (let ((buf (or buffer (current-buffer))))
+      (with-current-buffer buf
+        (let ((button (next-button (point-min))))
+          (let ((index 1)
+                (buttons nil))
+            (while button
+              (setq buttons
+                    (cons `(,(concat (truncate-string-to-width (button-label button)
+                                                               64 nil ?\s t)
+                                     " "
+                                     (propertize (format "[%d]" index) 'invisible t))
+                            .
+                            ,(button-start button))
+                          buttons))
+              (setq index (1+ index))
+              (setq button (next-button (button-end button))))
+            (reverse buttons))))))
+
+  (defun esy/consult-push-button ()
+    "Choose a button in the current buffer with `consult--read' and push it."
+    (interactive)
+    (require 'consult)
+    (save-excursion
+      (if-let ((buf (current-buffer))
+               (table (esy/buttons)))
+          (push-button (cdr (consult--read
+                             table
+                             :state #'esy/preview-button
+                             :prompt "Button: "
+                             :require-match t
+                             :category 'button
+                             :lookup #'consult--lookup-cons
+                             :annotate
+                             (lambda (key)
+                               (with-current-buffer buf
+                                 (let* ((button (button-at
+                                                 (cdr
+                                                  (assoc key table))))
+                                        (type (button-type button))
+                                        (action (button-get button 'action)))
+                                   (if type
+                                       (format "%32S #'%S" type action)
+                                     (when action (format "#'%S" action))))))
+                             :sort nil)))
+        (user-error "No buttons found in current buffer"))))
+
+#+end_src
+
 * Elisp Footer
 :PROPERTIES:
 :CUSTOM_ID: footer