From 551a5be45c4eecbe340e21762e783fb2d4c2cf6b Mon Sep 17 00:00:00 2001 From: Thierry Pouplier Date: Tue, 11 Aug 2026 11:08:46 -0400 Subject: [PATCH] feat: add hermes-preview.el - inline diff preview/apply for elisp edits --- doom/.config/doom/lisp/hermes-preview.el | 297 +++++++++++++++++++++++ 1 file changed, 297 insertions(+) create mode 100644 doom/.config/doom/lisp/hermes-preview.el diff --git a/doom/.config/doom/lisp/hermes-preview.el b/doom/.config/doom/lisp/hermes-preview.el new file mode 100644 index 0000000..40bddc9 --- /dev/null +++ b/doom/.config/doom/lisp/hermes-preview.el @@ -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