vundo-diff.el (8425B)
1 ;;; vundo-diff.el --- buffer diff for vundo -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2023 Free Software Foundation, Inc. 4 ;; 5 ;; Author: JD Smith <jdtsmith@gmail.com> 6 ;; Maintainer: Yuan Fu <casouri@gmail.com> 7 ;; URL: https://github.com/casouri/vundo 8 ;; Version: 0.1 9 ;; Package-Requires: ((emacs "28.1")) 10 ;; 11 ;; This file is part of GNU Emacs. 12 ;; 13 ;; GNU Emacs is free software: you can redistribute it and/or modify 14 ;; it under the terms of the GNU General Public License as published by 15 ;; the Free Software Foundation, either version 3 of the License, or 16 ;; (at your option) any later version. 17 ;; 18 ;; GNU Emacs is distributed in the hope that it will be useful, 19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 ;; GNU General Public License for more details. 22 ;; 23 ;; You should have received a copy of the GNU General Public License 24 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 25 26 ;;; Commentary: 27 28 ;; vundo-diff provides simple on-demand diff between arbitray undo 29 ;; states in the vundo tree. 30 31 ;;; Code: 32 (require 'vundo) 33 (require 'diff) 34 (require 'diff-mode) 35 (eval-when-compile (require 'cl-lib)) 36 37 (defcustom vundo-diff-quit t 38 "If non-nil, bury the `vundo-diff' window when vundo is quit. 39 If set to \\='kill, the diff buffer will also be killed." 40 :group 'vundo 41 :type '(choice (const :tag "Do not quit" nil) 42 (const :tag "Quit window" t) 43 (const :tag "Quit window and kill buffer" kill))) 44 45 (defface vundo-diff-highlight 46 '((((background light)) . 47 (:inherit vundo-highlight :foreground "DodgerBlue4")) 48 (((background dark)) . 49 (:inherit vundo-highlight :foreground "DodgerBlue1"))) 50 "Face for nodes marked for diff in the undo tree.") 51 52 (defvar-local vundo-diff--marked-node nil) 53 (defvar-local vundo-diff--highlight-overlay nil 54 "Overlay used to highlight the selected node.") 55 56 (defun vundo-diff--cleanup-diff-buffer (orig-name buf current from to) 57 "Update diff headers in BUF. 58 Headers are updated to indicate the diff in the contents of 59 buffer named ORIG-NAME, between nodes FROM and TO, and given the 60 CURRENT node." 61 (let ((inhibit-read-only t) 62 (info (cl-loop for x in (list from to) 63 for idx = (vundo-m-idx x) 64 for ts = (vundo--node-timestamp vundo--prev-mod-list x) 65 for stat = (if (eq x current) "Current" 66 (if vundo-diff--marked-node "Marked" "Parent")) 67 collect 68 (list (format "[%d]" idx) 69 (format "<%s> [mod %d] (%s)" orig-name idx stat) 70 (when (consp ts) (format-time-string "%F %r" ts))))) 71 lim) 72 (with-current-buffer buf 73 (vundo-diff-mode) 74 (goto-char (point-min)) 75 (insert (propertize "vundo-diff: " 'font-lock-face 'diff-header) 76 (propertize orig-name 'font-lock-face 77 '(diff-file-header diff-header)) 78 "\n") 79 (let* ((change-files 80 (cl-loop for (name fullname ts) in info 81 for pat in '("---" "+++") 82 if (re-search-forward 83 (rx-to-string `(and bol ,pat (+ blank) 84 (group (group (+ (not (any ?\n ?\t)))) 85 (* nonl)) 86 eol)) 87 nil t) 88 collect (cons (match-string-no-properties 2) name) 89 and do 90 (unless lim (setq lim (match-beginning 0))) 91 (replace-match 92 (if ts (concat fullname "\t" ts) fullname) 93 t t nil 1)))) 94 (when (eq (length change-files) 2) 95 (goto-char (point-min)) 96 (dolist (c change-files) ; change the file names in the diff 97 (when (search-forward (car c) lim t) 98 (replace-match (cdr c)))))) 99 100 (run-hooks 'vundo-diff-setup-hook)))) 101 102 ;;;###autoload 103 (defun vundo-diff-mark (&optional node) 104 "Mark NODE for vundo diff. 105 NODE defaults to the current node." 106 (interactive) 107 (let* ((mod-list vundo--prev-mod-list) 108 (node (or node (vundo--current-node mod-list)))) 109 (setq vundo-diff--marked-node node) 110 (unless vundo-diff--highlight-overlay 111 (setq vundo-diff--highlight-overlay 112 (make-overlay (1- (vundo-m-point node)) (vundo-m-point node))) 113 (overlay-put vundo-diff--highlight-overlay 114 'display (vundo--translate "●")) 115 (overlay-put vundo-diff--highlight-overlay 116 'face 'vundo-diff-highlight) 117 (overlay-put vundo-diff--highlight-overlay 'priority 1)) 118 (move-overlay vundo-diff--highlight-overlay 119 (1- (vundo-m-point node)) 120 (vundo-m-point node)))) 121 122 ;;;###autoload 123 (defun vundo-diff-unmark () 124 "Unmark the node marked for vundo diff." 125 (interactive) 126 (when vundo-diff--marked-node 127 (setq vundo-diff--marked-node nil) 128 (when vundo-diff--highlight-overlay 129 (delete-overlay vundo-diff--highlight-overlay) 130 (setq vundo-diff--highlight-overlay nil)))) 131 132 (defun vundo-diff--quit () 133 "Quit the `vundo-diff' window and possibly kill buffer." 134 (let* ((buf (get-buffer (concat "*vundo-diff-" (buffer-name) "*"))) 135 (win (and buf (get-buffer-window buf))) 136 (kill (eq vundo-diff-quit 'kill))) 137 (if win (quit-window kill win) 138 (when (and buf kill) (kill-buffer buf))))) 139 140 ;;;###autoload 141 (defun vundo-diff () 142 "Perform diff between marked and current buffer state. 143 Displays in a separate diff buffer with name based on 144 the original buffer name." 145 (interactive) 146 ;; We can’t add this hook locally, because the hook runs in the 147 ;; original buffer. 148 (add-hook 'vundo-post-exit-hook #'vundo-diff--quit 0) 149 (let* ((orig vundo--orig-buffer) 150 (oname (buffer-name orig)) 151 (current (vundo--current-node vundo--prev-mod-list)) 152 (marked (or vundo-diff--marked-node (vundo-m-parent current))) 153 swapped 154 mrkbuf) 155 (if (or (not current) (not marked) (eq current marked)) 156 (message "vundo diff not available.") 157 (setq swapped (> (vundo-m-idx marked) (vundo-m-idx current))) 158 (setq mrkbuf (get-buffer-create 159 (make-temp-name (concat oname "-vundo-diff-marked")))) 160 (unwind-protect 161 (progn 162 (vundo--check-for-command 163 (vundo--move-to-node current marked orig vundo--prev-mod-list) 164 (with-current-buffer mrkbuf 165 (insert-buffer-substring-no-properties orig)) 166 (vundo--refresh-buffer orig (current-buffer) 'incremental) 167 (vundo--move-to-node marked current orig vundo--prev-mod-list) 168 (vundo--trim-undo-list orig current vundo--prev-mod-list) 169 (vundo--refresh-buffer orig (current-buffer) 'incremental)) 170 (let* ((diff-use-labels nil) ; We let our cleanup handle this. 171 (a (if swapped current marked)) 172 (b (if swapped marked current)) 173 (abuf (if swapped orig mrkbuf)) 174 (bbuf (if swapped mrkbuf orig)) 175 (dbuf (diff-no-select 176 abuf bbuf nil t 177 (get-buffer-create 178 (concat "*vundo-diff-" oname "*"))))) 179 (vundo-diff--cleanup-diff-buffer oname dbuf current a b) 180 (display-buffer dbuf))) 181 (kill-buffer mrkbuf))))) 182 183 (defconst vundo-diff-font-lock-keywords 184 `((,(rx bol (or "---" "+++") (* nonl) "[mod " (group (+ num)) ?\] 185 (+ ?\s) ?\((group (or "Parent" "Current")) ?\)) 186 (1 'diff-index t) 187 (2 'vundo-highlight t)) 188 (,(rx bol (or "---" "+++") (* nonl) "[mod " (group (+ num)) ?\] 189 (+ ?\s) ?\((group "Marked") ?\)) 190 (1 'diff-index t) 191 (2 'vundo-diff-highlight t))) 192 "Additional font-lock keyword to fontify Parent/Current/Marked.") 193 194 (define-derived-mode vundo-diff-mode diff-mode "Vundo Diff" 195 :syntax-table nil 196 :abbrev-table nil 197 (setcar font-lock-defaults 198 (append diff-font-lock-keywords vundo-diff-font-lock-keywords))) 199 200 (provide 'vundo-diff) 201 202 ;;; vundo-diff.el ends here 203 204 ;; Local Variables: 205 ;; indent-tabs-mode: nil 206 ;; End: