;;; vundo-diff.el --- buffer diff for vundo -*- lexical-binding: t; -*- ;; Copyright (C) 2023 Free Software Foundation, Inc. ;; ;; Author: JD Smith ;; Maintainer: Yuan Fu ;; URL: https://github.com/casouri/vundo ;; Version: 0.1 ;; Package-Requires: ((emacs "28.1")) ;; ;; This file is part of GNU Emacs. ;; ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; Commentary: ;; vundo-diff provides simple on-demand diff between arbitrary undo ;; states in the vundo tree. ;;; Code: (require 'vundo) (require 'diff) (require 'diff-mode) (eval-when-compile (require 'cl-lib)) (defcustom vundo-diff-quit t "If non-nil, bury the `vundo-diff' window when vundo is quit. If set to \\='kill, the diff buffer will also be killed." :group 'vundo :type '(choice (const :tag "Do not quit" nil) (const :tag "Quit window" t) (const :tag "Quit window and kill buffer" kill))) (defface vundo-diff-highlight '((((background light)) . (:inherit vundo-highlight :foreground "DodgerBlue4")) (((background dark)) . (:inherit vundo-highlight :foreground "DodgerBlue1"))) "Face for nodes marked for diff in the undo tree." :group 'vundo) (defvar-local vundo-diff--marked-node nil) (defvar-local vundo-diff--highlight-overlay nil "Overlay used to highlight the diff-marked node.") (defun vundo-diff--cleanup-diff-buffer (orig-name buf current from to) "Update diff headers in BUF. Headers are updated to indicate the diff in the contents of buffer named ORIG-NAME, between nodes FROM and TO, and given the CURRENT node." (let ((inhibit-read-only t) (info (cl-loop for x in (list from to) for idx = (vundo-m-idx x) for ts = (vundo--node-timestamp vundo--prev-mod-list x) for stat = (if (eq x current) "Current" (if vundo-diff--marked-node "Marked" "Parent")) collect (list (format "[%d]" idx) (format "<%s> [mod %d] (%s)" orig-name idx stat) (when (consp ts) (format-time-string "%F %r" ts))))) lim) (with-current-buffer buf (vundo-diff-mode) (goto-char (point-min)) (insert (propertize "vundo-diff: " 'font-lock-face 'diff-header) (propertize orig-name 'font-lock-face '(diff-file-header diff-header)) "\n") (let* ((change-files (cl-loop for (name fullname ts) in info for pat in '("---" "+++") if (re-search-forward (rx-to-string `(and bol ,pat (+ blank) (group (group (+ (not (any ?\n ?\t)))) (* nonl)) eol)) nil t) collect (cons (match-string-no-properties 2) name) and do (unless lim (setq lim (match-beginning 0))) (replace-match (if ts (concat fullname "\t" ts) fullname) t t nil 1)))) (when (eq (length change-files) 2) (goto-char (point-min)) (dolist (c change-files) ; change the file names in the diff (when (search-forward (car c) lim t) (replace-match (cdr c)))))) (run-hooks 'vundo-diff-setup-hook)))) ;;;###autoload (defun vundo-diff-mark (&optional node) "Mark NODE for vundo diff. NODE defaults to the current node." (interactive) (let* ((mod-list vundo--prev-mod-list) (node (or node (vundo--current-node mod-list)))) (setq vundo-diff--marked-node node) (unless vundo-diff--highlight-overlay (setq vundo-diff--highlight-overlay (make-overlay (1- (vundo-m-point node)) (vundo-m-point node))) (overlay-put vundo-diff--highlight-overlay 'display (vundo--translate "●")) (overlay-put vundo-diff--highlight-overlay 'face 'vundo-diff-highlight) (overlay-put vundo-diff--highlight-overlay 'priority 1)) (move-overlay vundo-diff--highlight-overlay (1- (vundo-m-point node)) (vundo-m-point node)))) ;;;###autoload (defun vundo-diff-unmark () "Unmark the node marked for vundo diff." (interactive) (when vundo-diff--marked-node (setq vundo-diff--marked-node nil) (when vundo-diff--highlight-overlay (delete-overlay vundo-diff--highlight-overlay) (setq vundo-diff--highlight-overlay nil)))) (defun vundo-diff--quit () "Quit the `vundo-diff' window and possibly kill buffer." (let* ((buf (get-buffer (concat "*vundo-diff-" (buffer-name) "*"))) (win (and buf (get-buffer-window buf))) (kill (eq vundo-diff-quit 'kill))) (if win (quit-window kill win) (when (and buf kill) (kill-buffer buf)))) (remove-hook 'vundo-post-exit-hook #'vundo-diff--quit)) (defun vundo-diff--node-valid-p (node mod-list) "Return non-nil if NODE belongs to MOD-LIST." (and node (let ((idx (vundo-m-idx node))) (and (integerp idx) (<= 0 idx) (< idx (length mod-list)) (eq (aref mod-list idx) node))))) ;;;###autoload (defun vundo-diff () "Perform diff between marked and current buffer state. Displays in a separate diff buffer with name based on the original buffer name." (interactive) ;; We can’t add this hook locally, because the hook runs in the ;; original buffer. (add-hook 'vundo-post-exit-hook #'vundo-diff--quit 0) (vundo--check-for-command (let* ((orig vundo--orig-buffer) (oname (buffer-name orig)) (current (vundo--current-node vundo--prev-mod-list)) (marked (if (vundo-diff--node-valid-p vundo-diff--marked-node vundo--prev-mod-list) vundo-diff--marked-node (vundo-diff-unmark) (and current (vundo-m-parent current)))) swapped mrkbuf) (if (or (not current) (not marked) (eq current marked)) (message "vundo diff not available.") (setq swapped (> (vundo-m-idx marked) (vundo-m-idx current))) (setq mrkbuf (get-buffer-create (make-temp-name (concat oname "-vundo-diff-marked")))) (unwind-protect (progn (vundo--move-to-node current marked orig vundo--prev-mod-list) (with-current-buffer mrkbuf (insert-buffer-substring-no-properties orig)) (vundo--refresh-buffer orig (current-buffer) 'incremental) (vundo--move-to-node marked current orig vundo--prev-mod-list) (vundo--trim-undo-list orig current vundo--prev-mod-list) (vundo--refresh-buffer orig (current-buffer) 'incremental) (let* ((diff-use-labels nil) ; We let our cleanup handle this. (a (if swapped current marked)) (b (if swapped marked current)) (abuf (if swapped orig mrkbuf)) (bbuf (if swapped mrkbuf orig)) (dbuf (diff-no-select abuf bbuf nil t (get-buffer-create (concat "*vundo-diff-" oname "*"))))) (vundo-diff--cleanup-diff-buffer oname dbuf current a b) (display-buffer dbuf))) (kill-buffer mrkbuf)))))) (defconst vundo-diff-font-lock-keywords `((,(rx bol (or "---" "+++") (* nonl) "[mod " (group (+ num)) ?\] (+ blank) ?\((group (or "Parent" "Current")) ?\)) (1 'diff-index t) (2 'vundo-highlight t)) (,(rx bol (or "---" "+++") (* nonl) "[mod " (group (+ num)) ?\] (+ blank) ?\((group "Marked") ?\)) (1 'diff-index t) (2 'vundo-diff-highlight t))) "Additional font-lock keyword to fontify Parent/Current/Marked.") (define-derived-mode vundo-diff-mode diff-mode "Vundo Diff" :syntax-table nil :abbrev-table nil (setcar font-lock-defaults (append diff-font-lock-keywords vundo-diff-font-lock-keywords))) (provide 'vundo-diff) ;;; vundo-diff.el ends here ;; Local Variables: ;; indent-tabs-mode: nil ;; End: