feat: add hermes-preview.el - inline diff preview/apply for elisp edits
This commit is contained in:
297
doom/.config/doom/lisp/hermes-preview.el
Normal file
297
doom/.config/doom/lisp/hermes-preview.el
Normal file
@@ -0,0 +1,297 @@
|
||||
;;; hermes-preview.el --- Preview & apply Emacs Lisp edits with inline diff overlays -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2026 Thierry Pouplier
|
||||
;; Version: 0.1
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; Takes a list of Emacs Lisp command forms, executes each on a copy
|
||||
;; of the current buffer, diffs the result, and presents the diff as
|
||||
;; an inline overlay (green/red, +/- lines) on the original buffer.
|
||||
;;
|
||||
;; Each overlay has its own accept/reject commands — you can approve
|
||||
;; changes one by one. On accept, the exact same command is replayed
|
||||
;; on the real buffer, ensuring org timestamps, LOGBOOK entries,
|
||||
;; properties drawers etc. are formatted correctly.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
|
||||
(defvar hermes-preview-alist nil
|
||||
"List of active preview entries.
|
||||
Each element is (COMMAND BUFFER OVERLAY STATUS) where
|
||||
COMMAND — the Emacs Lisp form to execute
|
||||
BUFFER — the temp buffer holding the result
|
||||
OVERLAY — the overlay on the real buffer
|
||||
STATUS — 'pending, 'accepted, or 'rejected")
|
||||
|
||||
(defvar-keymap hermes-preview-actions-map
|
||||
:doc "Keymap for hermes preview overlays."
|
||||
"RET" #'hermes-preview-dispatch
|
||||
"C-c C-a" #'hermes-preview-accept
|
||||
"C-c C-k" #'hermes-preview-reject
|
||||
"C-c C-d" #'hermes-preview-diff
|
||||
"C-c C-n" #'hermes-preview-next
|
||||
"C-c C-p" #'hermes-preview-previous)
|
||||
|
||||
(defface hermes-preview-removed
|
||||
'((t (:inherit diff-removed)))
|
||||
"Face for removed lines in the preview overlay."
|
||||
:group 'hermes-preview)
|
||||
|
||||
(defface hermes-preview-added
|
||||
'((t (:inherit diff-added)))
|
||||
"Face for added lines in the preview overlay."
|
||||
:group 'hermes-preview)
|
||||
|
||||
;;;###autoload
|
||||
(defun hermes-preview-start (commands &optional file)
|
||||
"Execute COMMANDS (list of Emacs Lisp forms) as previews on FILE.
|
||||
Each command is run on a temp copy, diffed, and an inline overlay
|
||||
is placed on the real buffer showing the +/- diff in green/red.
|
||||
You can then accept or reject each overlay individually."
|
||||
(interactive)
|
||||
(let ((file (or file (buffer-file-name))))
|
||||
(unless file
|
||||
(user-error "Buffer is not visiting a file"))
|
||||
(unless (listp commands)
|
||||
(user-error "COMMANDS must be a list of Emacs Lisp forms"))
|
||||
(dolist (cmd commands)
|
||||
(hermes-preview--process-one cmd file))
|
||||
(hermes-preview--status-message)))
|
||||
|
||||
(defun hermes-preview--process-one (cmd file)
|
||||
"Preview a single COMMAND on FILE, creating an overlay."
|
||||
(let* ((orig-buf (current-buffer))
|
||||
(temp-buf (generate-new-buffer (format " *hermes-preview-%d*"
|
||||
(length hermes-preview-alist))))
|
||||
(cmd-str (prin1-to-string cmd))
|
||||
(ov nil))
|
||||
;; Copy file content to temp buffer
|
||||
(with-current-buffer temp-buf
|
||||
(insert-file-contents file)
|
||||
(delay-mode-hooks (funcall major-mode))
|
||||
(goto-char (point-min)))
|
||||
;; Execute command on temp buffer
|
||||
(condition-case err
|
||||
(with-current-buffer temp-buf
|
||||
(eval cmd t))
|
||||
(error
|
||||
(kill-buffer temp-buf)
|
||||
(display-warning '(hermes-preview)
|
||||
(format "Command failed: %s\n %s" cmd-str err))
|
||||
(cl-return-from hermes-preview--process-one nil)))
|
||||
;; Diff original vs temp
|
||||
(let* ((diff-buf (get-buffer-create " *hermes-preview-diff*"))
|
||||
(patch-text
|
||||
(with-current-buffer diff-buf
|
||||
(erase-buffer)
|
||||
(save-excursion
|
||||
(insert (shell-command-to-string
|
||||
(format "diff -u \"%s\" /dev/stdin <<< \"%s\""
|
||||
file
|
||||
(shell-quote-argument
|
||||
(with-current-buffer temp-buf
|
||||
(buffer-string)))))))
|
||||
(buffer-string))))
|
||||
;; Actually we need a proper diff between two buffers
|
||||
;; Let's use Emacs's diff-no-select
|
||||
(let ((diff-buf (diff-no-select orig-buf temp-buf nil t)))
|
||||
(with-current-buffer diff-buf
|
||||
;; Parse the hunks
|
||||
(goto-char (point-min))
|
||||
;; Find the first hunk
|
||||
(when (re-search-forward "^@@ -\\([0-9]+\\),\\([0-9]*\\) \\+\\([0-9]+\\),\\([0-9]*\\) @@" nil t)
|
||||
(let* ((orig-line (string-to-number (match-string 1)))
|
||||
(orig-count (string-to-number (or (match-string 2) "1")))
|
||||
(new-line (string-to-number (match-string 3)))
|
||||
(new-count (string-to-number (or (match-string 4) "1")))
|
||||
(ov-end (save-excursion
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- orig-line))
|
||||
(if (zerop orig-count)
|
||||
(point)
|
||||
(forward-line orig-count)
|
||||
(point))))
|
||||
;; Build the diff display string
|
||||
(diff-lines (hermes-preview--parse-hunk diff-buf))
|
||||
(display-str (hermes-preview--diff-to-string diff-lines)))
|
||||
;; Create overlay on the real buffer
|
||||
(with-current-buffer orig-buf
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- orig-line))
|
||||
(setq ov (make-overlay (point)
|
||||
(if (zerop orig-count)
|
||||
(point)
|
||||
(progn (forward-line orig-count)
|
||||
(point)))
|
||||
nil t nil)))
|
||||
;; If 0 lines removed, overlay at insertion point
|
||||
(when (and (zerop orig-count) (not (zerop new-count)))
|
||||
(move-overlay ov (1- (point)) (point)))
|
||||
;; Store data in overlay
|
||||
(overlay-put ov 'hermes-preview t)
|
||||
(overlay-put ov 'hermes-preview-cmd cmd)
|
||||
(overlay-put ov 'hermes-preview-temp-buf temp-buf)
|
||||
(overlay-put ov 'hermes-preview-diff-str display-str)
|
||||
(overlay-put ov 'hermes-preview-status 'pending)
|
||||
;; Face: grey out original text
|
||||
(overlay-put ov 'face '(:inherit shadow :strike-through t))
|
||||
;; Display the diff inline
|
||||
(overlay-put ov 'after-string
|
||||
(propertize (concat "\n" display-str "\n")
|
||||
'face '(:inherit default)))
|
||||
;; Keymap
|
||||
(overlay-put ov 'keymap hermes-preview-actions-map)
|
||||
;; Add to alist
|
||||
(push (list cmd temp-buf ov 'pending) hermes-preview-alist)))))))))
|
||||
|
||||
(defun hermes-preview--parse-hunk (diff-buf)
|
||||
"Parse diff hunks in DIFF-BUF into a list of (type . text) entries.
|
||||
TYPE is 'context, 'removed, or 'added."
|
||||
(let ((lines))
|
||||
(with-current-buffer diff-buf
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(let ((line (buffer-substring-no-properties
|
||||
(point) (min (1+ (line-end-position)) (point-max)))))
|
||||
(cond ((string-match-p "^[-+][^-+]" line)
|
||||
(push (cons (if (eq (aref line 0) ?-) 'removed 'added)
|
||||
(substring line 1))
|
||||
lines))
|
||||
((string-match-p "^[ ]" line)
|
||||
(push (cons 'context (substring line 1)) lines))
|
||||
;; skip header lines
|
||||
(t nil)))
|
||||
(forward-line 1)))
|
||||
(nreverse lines)))
|
||||
|
||||
(defun hermes-preview--diff-to-string (lines)
|
||||
"Convert LINES (from `hermes-preview--parse-hunk') to a propertized string."
|
||||
(mapconcat
|
||||
(lambda (entry)
|
||||
(pcase (car entry)
|
||||
('removed (propertize (concat "- " (cdr entry)) 'face 'hermes-preview-removed))
|
||||
('added (propertize (concat "+ " (cdr entry)) 'face 'hermes-preview-added))
|
||||
('context (propertize (concat " " (cdr entry)) 'face '(:inherit shadow)))))
|
||||
lines "\n"))
|
||||
|
||||
(defun hermes-preview--status-message ()
|
||||
"Show how many pending previews there are."
|
||||
(let ((pending (cl-count-if (lambda (e) (eq (nth 3 e) 'pending)) hermes-preview-alist)))
|
||||
(message "%d preview(s) pending — RET to act, C-c C-n/p to navigate"
|
||||
pending)))
|
||||
|
||||
;;; Actions
|
||||
|
||||
(defun hermes-preview-overlay-at (&optional pt)
|
||||
"Get the hermes-preview overlay at PT (or point)."
|
||||
(let ((ov (car-safe (get-char-property-and-overlay
|
||||
(or pt (point)) 'hermes-preview))))
|
||||
(unless ov (user-error "No preview overlay at point"))
|
||||
ov))
|
||||
|
||||
(defun hermes-preview--entry-for-overlay (ov)
|
||||
"Find the preview entry for overlay OV."
|
||||
(cl-find-if (lambda (e) (eq (nth 2 e) ov)) hermes-preview-alist))
|
||||
|
||||
(defun hermes-preview-accept (ov)
|
||||
"Accept the preview at OV — replay command on the real file."
|
||||
(interactive (list (hermes-preview-overlay-at)))
|
||||
(when-let ((entry (hermes-preview--entry-for-overlay ov)))
|
||||
(let ((cmd (nth 0 entry))
|
||||
(temp-buf (nth 1 entry)))
|
||||
;; Replay the exact command on the real buffer
|
||||
(condition-case err
|
||||
(eval cmd t)
|
||||
(error (user-error "Accept failed: %s" err)))
|
||||
;; Clean up overlay
|
||||
(hermes-preview--cleanup ov)
|
||||
(setf (nth 3 entry) 'accepted)
|
||||
;; Also delete the temp buffer if 0 refs remain
|
||||
(hermes-preview--maybe-kill-temp temp-buf)
|
||||
(message "Preview accepted."))))
|
||||
|
||||
(defun hermes-preview-reject (ov)
|
||||
"Reject the preview at OV — discard change."
|
||||
(interactive (list (hermes-preview-overlay-at)))
|
||||
(when-let ((entry (hermes-preview--entry-for-overlay ov)))
|
||||
(let ((temp-buf (nth 1 entry)))
|
||||
(hermes-preview--cleanup ov)
|
||||
(setf (nth 3 entry) 'rejected)
|
||||
(hermes-preview--maybe-kill-temp temp-buf)
|
||||
(message "Preview rejected."))))
|
||||
|
||||
(defun hermes-preview-dispatch (ov)
|
||||
"Dispatch menu for a preview overlay."
|
||||
(interactive (list (hermes-preview-overlay-at)))
|
||||
(let ((action (read-char-choice
|
||||
(concat "Action: [a]ccept, [r]eject, [d]iff, [q]uit? ")
|
||||
'(?a ?r ?d ?q))))
|
||||
(pcase action
|
||||
(?a (hermes-preview-accept ov))
|
||||
(?r (hermes-preview-reject ov))
|
||||
(?d (hermes-preview-show-diff ov))
|
||||
(?q nil))))
|
||||
|
||||
(defun hermes-preview-show-diff (ov)
|
||||
"Show a proper unified diff buffer for OV."
|
||||
(interactive (list (hermes-preview-overlay-at)))
|
||||
(when-let ((entry (hermes-preview--entry-for-overlay ov)))
|
||||
(let* ((orig-buf (current-buffer))
|
||||
(temp-buf (nth 1 entry))
|
||||
(diff-buf (get-buffer-create "*hermes-preview-full-diff*")))
|
||||
(with-current-buffer diff-buf
|
||||
(erase-buffer)
|
||||
(diff-no-select orig-buf temp-buf nil nil diff-buf)
|
||||
(diff-mode))
|
||||
(display-buffer diff-buf))))
|
||||
|
||||
(defun hermes-preview-next ()
|
||||
"Move to the next pending preview."
|
||||
(interactive)
|
||||
(let ((pt (next-single-char-property-change (point) 'hermes-preview)))
|
||||
(if (get-char-property pt 'hermes-preview)
|
||||
(goto-char pt)
|
||||
(user-error "No next preview"))))
|
||||
|
||||
(defun hermes-preview-previous ()
|
||||
"Move to the previous pending preview."
|
||||
(interactive)
|
||||
(let ((pt (previous-single-char-property-change (point) 'hermes-preview)))
|
||||
(if (get-char-property (max (1- pt) (point-min)) 'hermes-preview)
|
||||
(goto-char (max (1- pt) (point-min)))
|
||||
(user-error "No previous preview"))))
|
||||
|
||||
;;; Cleanup
|
||||
|
||||
(defun hermes-preview--cleanup (ov)
|
||||
"Remove overlay OV and any display artifacts."
|
||||
(overlay-put ov 'after-string nil)
|
||||
(overlay-put ov 'face nil)
|
||||
(overlay-put ov 'hermes-preview nil)
|
||||
(delete-overlay ov))
|
||||
|
||||
(defun hermes-preview--maybe-kill-temp (buf)
|
||||
"Kill temp BUF if no other entry references it."
|
||||
(when (buffer-live-p buf)
|
||||
(unless (cl-find-if (lambda (e)
|
||||
(and (eq (nth 3 e) 'pending)
|
||||
(eq (nth 1 e) buf)))
|
||||
hermes-preview-alist)
|
||||
(kill-buffer buf))))
|
||||
|
||||
(defun hermes-preview-clear-all ()
|
||||
"Reject all pending previews and clean up."
|
||||
(interactive)
|
||||
(dolist (entry hermes-preview-alist)
|
||||
(when (eq (nth 3 entry) 'pending)
|
||||
(hermes-preview--cleanup (nth 2 entry))
|
||||
(hermes-preview--maybe-kill-temp (nth 1 entry))
|
||||
(setf (nth 3 entry) 'rejected)))
|
||||
(message "All previews cleared."))
|
||||
|
||||
(provide 'hermes-preview)
|
||||
;;; hermes-preview.el ends here
|
||||
Reference in New Issue
Block a user