/ diff-hl.el
diff-hl.el
1 ;;; diff-hl.el --- Highlight uncommitted changes using VC -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2012-2025 Free Software Foundation, Inc. 4 5 ;; Author: Dmitry Gutov <dmitry@gutov.dev> 6 ;; URL: https://github.com/dgutov/diff-hl 7 ;; Keywords: vc, diff 8 ;; Version: 1.10.0 9 ;; Package-Requires: ((cl-lib "0.2") (emacs "26.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 ;; `diff-hl-mode' highlights uncommitted changes on the side of the 29 ;; window (using the fringe, by default), allows you to jump between 30 ;; the hunks and revert them selectively. 31 32 ;; Provided commands: 33 ;; 34 ;; `diff-hl-diff-goto-hunk' C-x v = 35 ;; `diff-hl-revert-hunk' C-x v n 36 ;; `diff-hl-previous-hunk' C-x v [ 37 ;; `diff-hl-next-hunk' C-x v ] 38 ;; `diff-hl-show-hunk' C-x v * 39 ;; `diff-hl-stage-current-hunk' C-x v S 40 ;; `diff-hl-set-reference-rev' 41 ;; `diff-hl-reset-reference-rev' 42 ;; `diff-hl-unstage-file' 43 ;; 44 ;; The mode takes advantage of `smartrep' if it is installed. 45 ;; 46 ;; Alternatively, it integrates with `repeat-mode' (Emacs 28+). 47 48 ;; Add either of the following to your init file. 49 ;; 50 ;; To use it in all buffers: 51 ;; 52 ;; (global-diff-hl-mode) 53 ;; 54 ;; Only in `prog-mode' buffers, with `vc-dir' integration: 55 ;; 56 ;; (add-hook 'prog-mode-hook 'turn-on-diff-hl-mode) 57 ;; (add-hook 'vc-dir-mode-hook 'turn-on-diff-hl-mode) 58 59 ;;; Code: 60 61 (require 'fringe) 62 (require 'diff-mode) 63 (require 'vc) 64 (require 'vc-dir) 65 (require 'log-view) 66 67 (eval-when-compile 68 (require 'cl-lib) 69 (require 'vc-git) 70 (require 'vc-hg) 71 (require 'face-remap) 72 (require 'project)) 73 74 (defmacro static-if (condition then-form &rest else-forms) ; since Emacs 30.1 75 "A conditional compilation macro. 76 Evaluate CONDITION at macro-expansion time. If it is non-nil, 77 expand the macro to THEN-FORM. Otherwise expand it to ELSE-FORMS 78 enclosed in a `progn' form. ELSE-FORMS may be empty." 79 (declare (indent 2) 80 (debug (sexp sexp &rest sexp))) 81 (if (eval condition lexical-binding) 82 then-form 83 (cons 'progn else-forms))) 84 85 (defgroup diff-hl nil 86 "VC diff highlighting on the side of a window" 87 :group 'vc) 88 89 (defface diff-hl-insert 90 '((default :inherit diff-added) 91 (((class color)) :foreground "green4")) 92 "Face used to highlight inserted lines." 93 :group 'diff-hl) 94 95 (defface diff-hl-delete 96 '((default :inherit diff-removed) 97 (((class color)) :foreground "red3")) 98 "Face used to highlight deleted lines." 99 :group 'diff-hl) 100 101 (defface diff-hl-change 102 '((default :foreground "blue3") 103 (((class color) (min-colors 88) (background light)) 104 :background "#ddddff") 105 (((class color) (min-colors 88) (background dark)) 106 :background "#333355")) 107 "Face used to highlight changed lines." 108 :group 'diff-hl) 109 110 (defface diff-hl-reference-insert 111 '((default :inherit diff-hl-insert)) 112 "Face used to highlight lines inserted since reference rev." 113 :group 'diff-hl) 114 115 (defface diff-hl-reference-delete 116 '((default :inherit diff-hl-delete)) 117 "Face used to highlight lines deleted since reference rev." 118 :group 'diff-hl) 119 120 (defface diff-hl-reference-change 121 '((default :inherit diff-hl-change)) 122 "Face used to highlight lines changed since reference rev." 123 :group 'diff-hl) 124 125 (defcustom diff-hl-command-prefix (kbd "C-x v") 126 "The prefix for all `diff-hl' commands." 127 :group 'diff-hl 128 :type 'string) 129 130 (defcustom diff-hl-draw-borders t 131 "Non-nil to draw borders around fringe indicators." 132 :group 'diff-hl 133 :type 'boolean) 134 135 (defcustom diff-hl-disable-on-remote nil 136 "Non-nil will disable `diff-hl' in remote buffers." 137 :group 'diff-hl 138 :type 'boolean) 139 140 (defcustom diff-hl-ask-before-revert-hunk t 141 "Non-nil to ask for confirmation before revert a hunk." 142 :group 'diff-hl 143 :type 'boolean) 144 145 (defcustom diff-hl-fallback-to-margin t 146 "Non-nil to use margin instead of fringe on non-graphic displays. 147 148 This resizes the margin to 1 if it's not visible." 149 :group 'diff-hl 150 :type 'boolean) 151 152 (defcustom diff-hl-autohide-margin nil 153 "Non-nil to reset margin width to 0 when no indicators shown. 154 155 When you use it, it's recommended to verify first that other enabled 156 features don't use margin for their indicators." 157 :type 'boolean) 158 159 (defcustom diff-hl-highlight-function 'diff-hl-highlight-on-fringe 160 "Function to highlight the current line. Its arguments are 161 overlay, change type and position within a hunk." 162 :group 'diff-hl 163 :type 'function) 164 165 (defcustom diff-hl-highlight-reference-function 'diff-hl-highlight-on-fringe-flat 166 "Function to highlight the changes against the reference revision. 167 Its arguments are overlay, change type and position within a hunk." 168 :group 'diff-hl 169 :type 'function) 170 171 (defcustom diff-hl-fringe-flat-bmp 'diff-hl-bmp-empty 172 "The bitmap symbol to use in `diff-hl-highlight-on-fringe-flat'. 173 Some options are `diff-hl-bmp-empty', `diff-hl-bmp-i', or any of the 174 built-in bitmaps." 175 :group 'diff-hl 176 :type 'symbol) 177 178 (defcustom diff-hl-fringe-bmp-function 'diff-hl-fringe-bmp-from-pos 179 "Function to choose the fringe bitmap for a given change type 180 and position within a hunk. Should accept two arguments." 181 :group 'diff-hl 182 :type '(choice (const diff-hl-fringe-bmp-from-pos) 183 (const diff-hl-fringe-bmp-from-type) 184 function)) 185 186 (defcustom diff-hl-fringe-face-function 'diff-hl-fringe-face-from-type 187 "Function to choose the fringe face for a given change type 188 and position within a hunk. Should accept two arguments." 189 :group 'diff-hl 190 :type 'function) 191 192 (defcustom diff-hl-fringe-reference-face-function 'diff-hl-fringe-reference-face-from-type 193 "Function to choose the fringe face for a given change type 194 and position within a \"diff to reference\" hunk." 195 :group 'diff-hl 196 :type 'function) 197 198 (defcustom diff-hl-side 'left 199 "Which side to use for indicators." 200 :type '(choice (const left) 201 (const right)) 202 :initialize 'custom-initialize-default 203 :set (lambda (var value) 204 (let ((on (bound-and-true-p global-diff-hl-mode))) 205 (when on (global-diff-hl-mode -1)) 206 (set-default var value) 207 (when on (global-diff-hl-mode 1))))) 208 209 (defcustom diff-hl-bmp-max-width 16 210 "Maximum width of the fringe indicator bitmaps, in pixels. 211 The bitmap width is decided by comparing this value with the current width 212 of the fringe. When the fringe is hidden, this value is also used." 213 :type 'integer) 214 215 (defcustom diff-hl-highlight-revert-hunk-function 216 #'diff-hl-revert-narrow-to-hunk 217 "Function to emphasize the current hunk in `diff-hl-revert-hunk'. 218 The function is called at the beginning of the hunk and is passed 219 the end position as its only argument." 220 :type '(choice (const :tag "Do nothing" ignore) 221 (const :tag "Highlight the first column" 222 diff-hl-revert-highlight-first-column) 223 (const :tag "Narrow to the hunk" 224 diff-hl-revert-narrow-to-hunk))) 225 226 (defcustom diff-hl-global-modes '(not image-mode) 227 "Modes for which `diff-hl-mode' is automagically turned on. 228 This affects the behavior of `global-diff-hl-mode'. 229 If nil, no modes have `diff-hl-mode' automatically turned on. 230 If t, all modes have `diff-hl-mode' enabled. 231 If a list, it should be a list of `major-mode' symbol names for 232 which it should be automatically turned on. The sense of the list 233 is negated if it begins with `not'. As such, the default value 234 (not image-mode) 235 means that `diff-hl-mode' is turned on in all modes except for 236 `image-mode' buffers. Previously, `diff-hl-mode' caused worse 237 performance when viewing such files in certain conditions." 238 :type '(choice (const :tag "none" nil) 239 (const :tag "all" t) 240 (set :menu-tag "mode specific" :tag "modes" 241 :value (not) 242 (const :tag "Except" not) 243 (repeat :inline t (symbol :tag "mode")))) 244 :group 'diff-hl) 245 246 (defcustom diff-hl-show-staged-changes t 247 "Whether to include staged changes in the indicators. 248 Only affects Git, it's the only backend that has staging area. 249 250 When `diff-hl-highlight-reference-function' is non-nil, instead of being 251 hidden, the staged changes become part of the \"reference\" indicators." 252 :type 'boolean) 253 254 (defcustom diff-hl-goto-hunk-old-revisions nil 255 "When non-nil, `diff-hl-diff-goto-hunk' will always try to 256 navigate to the line in the diff that corresponds to the current 257 line in the file buffer (or as close as it can get to it). 258 259 When this variable is nil (default), `diff-hl-diff-goto-hunk' 260 only does that when called without the prefix argument, or when 261 the NEW revision is not specified (meaning, the diff is against 262 the current version of the file)." 263 :type 'boolean) 264 265 (defcustom diff-hl-update-async nil 266 "When non-nil, `diff-hl-update' will run asynchronously. 267 268 When the value is `thread', it will call the diff process in a Lisp thread. 269 270 Any other non-nil value will make the the diff process called 271 asynchronously in the main thread. 272 273 Note that the latter mechanism is only compatible with a recent Emacs 274 31+ (for built-in backends such as Git and Hg). Whereas using a thread can 275 help with older Emacs as well, but might crash in some configurations. 276 277 This feature makes Emacs more responsive with slower version control (VC) 278 backends and large projects. But it's disabled in remote buffers, since 279 current testing shows it doesn't work reliably over Tramp." 280 :type '(choice 281 (const :tag "Disabled" nil) 282 (const :tag "Simple async" t) 283 (const :tag "Thread" thread))) 284 285 ;; Threads are not reliable with remote files, yet. 286 (defcustom diff-hl-async-inhibit-functions (list #'diff-hl-with-editor-p 287 #'file-remote-p) 288 "Functions to call to check whether asychronous method should be disabled. 289 290 When `diff-hl-update-async' is non-nil, these functions are called in turn 291 and passed the value `default-directory'. 292 293 If any returns non-nil, `diff-hl-update' will run synchronously anyway." 294 :type '(repeat :tag "Predicate" function)) 295 296 (defvar diff-hl-reference-revision-projects-cache '() 297 "Alist of cached directory roots for per-project reference revisions. 298 Each element in this list has the form (DIR . REV). 299 DIR is the expanded name of the directory. 300 REV is the current reference revision.") 301 302 (defvar diff-hl-reference-revision nil 303 "Revision to diff against. nil means the most recent one. 304 305 It can be a relative expression as well, such as \"HEAD^\" with Git, or 306 \"-2\" with Mercurial.") 307 308 (put 'diff-hl-reference-revision 'safe-local-variable 309 (lambda (value) 310 (or (null value) (stringp value)))) 311 312 (defun diff-hl-define-bitmaps () 313 (let* ((scale (if (and (boundp 'text-scale-mode-amount) 314 (numberp text-scale-mode-amount)) 315 (expt text-scale-mode-step text-scale-mode-amount) 316 1)) 317 (spacing (or (and (display-graphic-p) (default-value 'line-spacing)) 0)) 318 (total-spacing (pcase spacing 319 ((pred numberp) spacing) 320 (`(,above . ,below) (+ above below)))) 321 (h (+ (ceiling (* (frame-char-height) scale)) 322 (if (floatp total-spacing) 323 (truncate (* (frame-char-height) total-spacing)) 324 total-spacing))) 325 (w (min (frame-parameter nil (intern (format "%s-fringe" diff-hl-side))) 326 diff-hl-bmp-max-width)) 327 (_ (when (zerop w) (setq w diff-hl-bmp-max-width))) 328 (middle (make-vector h (expt 2 (1- w)))) 329 (ones (1- (expt 2 w))) 330 (top (copy-sequence middle)) 331 (bottom (copy-sequence middle)) 332 (single (copy-sequence middle))) 333 (aset top 0 ones) 334 (aset bottom (1- h) ones) 335 (aset single 0 ones) 336 (aset single (1- h) ones) 337 (define-fringe-bitmap 'diff-hl-bmp-top top h w 'top) 338 (define-fringe-bitmap 'diff-hl-bmp-middle middle h w 'center) 339 (define-fringe-bitmap 'diff-hl-bmp-bottom bottom h w 'bottom) 340 (define-fringe-bitmap 'diff-hl-bmp-single single h w 'top) 341 (define-fringe-bitmap 'diff-hl-bmp-i [3 3 0 3 3 3 3 3 3 3] nil 2 'center) 342 (let* ((w2 (* (/ w 2) 2)) 343 ;; When fringes are disabled, it's easier to fix up the width, 344 ;; instead of doing nothing (#20). 345 (w2 (if (zerop w2) 2 w2)) 346 (delete-row (- (expt 2 (1- w2)) 2)) 347 (middle-pos (1- (/ w2 2))) 348 (middle-bit (expt 2 middle-pos)) 349 (insert-bmp (make-vector w2 (* 3 middle-bit)))) 350 (define-fringe-bitmap 'diff-hl-bmp-delete (make-vector 2 delete-row) w2 w2) 351 (aset insert-bmp 0 0) 352 (aset insert-bmp middle-pos delete-row) 353 (aset insert-bmp (1+ middle-pos) delete-row) 354 (aset insert-bmp (1- w2) 0) 355 (define-fringe-bitmap 'diff-hl-bmp-insert insert-bmp w2 w2) 356 ))) 357 358 (defun diff-hl-maybe-define-bitmaps () 359 (when (window-system) ;; No fringes in the console. 360 (unless (fringe-bitmap-p 'diff-hl-bmp-empty) 361 (diff-hl-define-bitmaps) 362 (define-fringe-bitmap 'diff-hl-bmp-empty [0] 1 1 'center)))) 363 364 (defun diff-hl-maybe-redefine-bitmaps () 365 (when (window-system) 366 (diff-hl-define-bitmaps))) 367 368 (defvar diff-hl-spec-cache (make-hash-table :test 'equal)) 369 370 (defun diff-hl-fringe-spec (type pos side) 371 (let* ((key (list type pos side 372 diff-hl-fringe-face-function 373 diff-hl-fringe-bmp-function)) 374 (val (gethash key diff-hl-spec-cache))) 375 (unless val 376 (let* ((face-sym (funcall diff-hl-fringe-face-function type pos)) 377 (bmp-sym (funcall diff-hl-fringe-bmp-function type pos))) 378 (setq val (propertize " " 'display `((,(intern (format "%s-fringe" side)) 379 ,bmp-sym ,face-sym)))) 380 (puthash key val diff-hl-spec-cache))) 381 val)) 382 383 (defun diff-hl-fringe-face-from-type (type _pos) 384 (intern (format "diff-hl-%s" type))) 385 386 (defun diff-hl-fringe-reference-face-from-type (type _pos) 387 (intern (format "diff-hl-reference-%s" type))) 388 389 (defun diff-hl-fringe-bmp-from-pos (_type pos) 390 (intern (format "diff-hl-bmp-%s" pos))) 391 392 (defun diff-hl-fringe-bmp-from-type (type _pos) 393 (cl-case type 394 (unknown 'question-mark) 395 (change 'exclamation-mark) 396 (ignored 'diff-hl-bmp-i) 397 (t (intern (format "diff-hl-bmp-%s" type))))) 398 399 (defmacro diff-hl-with-diff-switches (body) 400 `(progn 401 (defvar vc-svn-diff-switches) 402 (defvar vc-fossil-diff-switches) 403 (defvar vc-jj-diff-switches) 404 (let ((vc-git-diff-switches 405 ;; https://github.com/dgutov/diff-hl/issues/67 406 (cons "-U0" 407 ;; https://github.com/dgutov/diff-hl/issues/9 408 (and (boundp 'vc-git-diff-switches) 409 (listp vc-git-diff-switches) 410 (cl-remove-if-not 411 (lambda (arg) 412 (member arg '("--histogram" "--patience" "--minimal" "--textconv"))) 413 vc-git-diff-switches)))) 414 (vc-hg-diff-switches nil) 415 (vc-svn-diff-switches nil) 416 (vc-fossil-diff-switches '("-c" "0")) 417 (vc-jj-diff-switches '("--git" "--context=0")) 418 (vc-diff-switches '("-U0")) 419 ,@(when (boundp 'vc-disable-async-diff) 420 '((vc-disable-async-diff t)))) 421 ,body))) 422 423 (defun diff-hl-modified-p (state) 424 (or (memq state '(edited conflict)) 425 (and (eq state 'up-to-date) 426 ;; VC state is stale in after-revert-hook. 427 (or (static-if (boundp 'revert-buffer-in-progress) 428 ;; Emacs 31. 429 revert-buffer-in-progress 430 revert-buffer-in-progress-p) 431 ;; Diffing against an older revision. 432 diff-hl-reference-revision)))) 433 434 (declare-function vc-git-command "vc-git") 435 (declare-function vc-git--rev-parse "vc-git") 436 (declare-function vc-hg-command "vc-hg") 437 (declare-function vc-bzr-command "vc-bzr") 438 439 (defun diff-hl-changes-buffer (file backend &optional new-rev bufname) 440 (diff-hl-with-diff-switches 441 (diff-hl-diff-against-reference file backend (or bufname " *diff-hl* ") new-rev))) 442 443 (defun diff-hl-diff-against-reference (file backend buffer &optional new-rev) 444 (cond 445 ((and (not new-rev) 446 (not diff-hl-reference-revision) 447 (not diff-hl-show-staged-changes) 448 (eq backend 'Git)) 449 (apply #'vc-git-command buffer 450 (if (diff-hl--use-async-p) 'async 1) 451 (list file) 452 "diff-files" 453 (cons "-p" (vc-switches 'git 'diff)))) 454 ((eq new-rev 'git-index) 455 (apply #'vc-git-command buffer 456 (if (diff-hl--use-async-p) 'async 1) 457 (list file) 458 "diff-index" 459 (append 460 (vc-switches 'git 'diff) 461 (list "-p" "--cached" 462 (or diff-hl-reference-revision 463 (diff-hl-head-revision backend)) 464 "--")))) 465 (t 466 (condition-case err 467 (vc-call-backend backend 'diff (list file) 468 diff-hl-reference-revision 469 new-rev 470 buffer 471 (diff-hl--use-async-p)) 472 (error 473 ;; https://github.com/dgutov/diff-hl/issues/117 474 (when (string-match-p "\\`Failed (status 128)" (error-message-string err)) 475 (vc-call-backend backend 'diff (list file) 476 "4b825dc642cb6eb9a060e54bf8d69288fbee4904" 477 nil 478 buffer 479 (diff-hl--use-async-p))))))) 480 buffer) 481 482 (defun diff-hl-changes () 483 (let* ((file buffer-file-name) 484 (backend (vc-backend file)) 485 (hide-staged (and (eq backend 'Git) (not diff-hl-show-staged-changes)))) 486 (when backend 487 (let ((state (vc-state file backend)) 488 ;; Workaround for debbugs#78946 for the `thread' async update method. 489 ;; This is fiddly, but we basically allow the thread to start, while 490 ;; prohibiting the async process call inside. 491 ;; That still makes it partially async on macOS. 492 ;; Or just use "simple async" if your Emacs is new enough. 493 (diff-hl-update-async (or (and (eq diff-hl-update-async 'thread) 494 (not (eq window-system 'ns))) 495 (eq diff-hl-update-async t)))) 496 (cond 497 ((and 498 (not diff-hl-highlight-reference-function) 499 (diff-hl-modified-p state)) 500 `((:working . ,(diff-hl-changes-buffer file backend)))) 501 ((or 502 diff-hl-reference-revision 503 (diff-hl-modified-p state)) 504 (let* ((ref-changes 505 (and (or diff-hl-reference-revision 506 hide-staged) 507 (diff-hl-changes-buffer file backend 508 (if hide-staged 509 'git-index 510 (diff-hl-head-revision backend)) 511 " *diff-hl-reference* "))) 512 (diff-hl-reference-revision nil) 513 (work-changes (diff-hl-changes-buffer file backend))) 514 `((:reference . ,ref-changes) 515 (:working . ,work-changes)))) 516 ((eq state 'added) 517 `((:working . ,`((1 ,(line-number-at-pos (point-max)) 0 insert))))) 518 ((eq state 'removed) 519 `((:working . ,`((1 0 ,(line-number-at-pos (point-max)) delete)))))))))) 520 521 (defvar diff-hl-head-revision-alist '((Git . "HEAD") (Bzr . "last:1") (Hg . ".") 522 (JJ . "@-"))) 523 524 (defun diff-hl-head-revision (backend) 525 (or (assoc-default backend diff-hl-head-revision-alist) 526 ;; It's usually cached already (e.g. for mode-line). 527 ;; So this is basically an optimization for rare cases. 528 (vc-working-revision buffer-file-name backend))) 529 530 (defun diff-hl-adjust-changes (old new) 531 "Adjust changesets in OLD using changes in NEW. 532 The result alters the values inside the OLD changeset so that the line 533 numbers and insertion/deletion counts refer to the lines in the file 534 contents as they are (or would be) after applying the changes in NEW." 535 (let ((acc 0) 536 (ref old) 537 overlap) 538 (while (and new old) 539 (cond 540 ((<= (+ (nth 0 (car new)) (nth 2 (car new))) 541 (+ acc (nth 0 (car old)))) 542 ;; (A) NEW-END <= OLD-BEG 543 (cl-incf acc (- (nth 1 (car new)) (nth 2 (car new)))) 544 (setq new (cdr new))) 545 ((<= (+ acc (nth 0 (car old)) (nth 1 (car old))) 546 (nth 0 (car new))) 547 ;; (B) OLD-END <= NEW-BEG 548 (cl-incf (nth 0 (car old)) acc) 549 (setq old (cdr old))) 550 (t 551 ;; There is overlap. 552 (setq overlap 553 (- 554 (min 555 (+ (nth 0 (car new)) (nth 2 (car new))) 556 (+ acc (nth 0 (car old)) (nth 1 (car old)))) 557 (max 558 (nth 0 (car new)) 559 (+ acc (nth 0 (car old)))))) 560 (cl-decf (nth 1 (car old)) overlap) 561 ;; Add INSERTION amount to either before or inside. 562 (cl-incf (nth 563 (if (> (nth 0 (car new)) 564 (+ acc (nth 0 (car old)))) 565 1 0) 566 (car old)) 567 (- 568 (nth 1 (car new)) 569 (- (nth 2 (car new)) 570 overlap))) 571 ;; See which of the heads to pop. 572 (if (> (+ (nth 0 (car new)) (nth 1 (car new))) 573 (+ acc (nth 0 (car old)) (nth 1 (car old)))) 574 (progn 575 ;; Repetition of B (how to avoid dup?) 576 (cl-incf (nth 0 (car old)) acc) 577 (setq old (cdr old))) 578 ;; Repetition of A. 579 (cl-incf acc (- (nth 1 (car new)) (nth 2 (car new)))) 580 ;; But also decrease OLD-BEG by the same amount: it's added later. 581 (cl-decf (nth 0 (car old)) (- (nth 1 (car new)) (nth 2 (car new)))) 582 (setq new (cdr new)))))) 583 (while old 584 (cl-incf (nth 0 (car old)) acc) 585 (setq old (cdr old))) 586 ref)) 587 588 (defun diff-hl-changes-from-buffer (buf) 589 (with-current-buffer buf 590 (let (res) 591 (goto-char (point-min)) 592 (unless (eobp) 593 ;; TODO: When 27.1 is the minimum requirement, we can drop 594 ;; these bindings: that version, in addition to switching over 595 ;; called-interactively-p check, so refinement can't be 596 ;; triggered by code calling the navigation functions, only by 597 ;; direct interactive invocations. 598 (ignore-errors 599 (with-no-warnings 600 (let (diff-auto-refine-mode) 601 (diff-beginning-of-hunk t)))) 602 (while (looking-at diff-hunk-header-re-unified) 603 (let ((line (string-to-number (match-string 3))) 604 (beg (point))) 605 (with-no-warnings 606 (let (diff-auto-refine-mode) 607 (diff-end-of-hunk))) 608 (let* ((inserts (diff-count-matches "^\\+" beg (point))) 609 (deletes (diff-count-matches "^-" beg (point))) 610 (type (cond ((zerop deletes) 'insert) 611 ((zerop inserts) 'delete) 612 (t 'change)))) 613 (when (eq type 'delete) 614 (cl-incf line)) 615 (push (list line inserts deletes type) res))))) 616 (nreverse res)))) 617 618 (defun diff-hl--use-async-p () 619 (and diff-hl-update-async 620 (not 621 (run-hook-with-args-until-success 'diff-hl-async-inhibit-functions 622 default-directory)))) 623 624 (defvar diff-hl-timer nil) 625 626 (defun diff-hl-update () 627 "Updates the diff-hl overlay." 628 (setq diff-hl-timer nil) 629 (if (and (diff-hl--use-async-p) 630 (eq diff-hl-update-async 'thread)) 631 ;; TODO: debounce if a thread is already running. 632 (let ((buf (current-buffer)) 633 (temp-buffer 634 (if (< emacs-major-version 28) 635 (generate-new-buffer " *temp*") 636 (generate-new-buffer " *temp*" t)))) 637 ;; Switch buffer temporarily, to "unlock" it for other threads. 638 (with-current-buffer temp-buffer 639 (make-thread 640 (lambda () 641 (kill-buffer temp-buffer) 642 (when (buffer-live-p buf) 643 (set-buffer buf) 644 (diff-hl--update-safe))) 645 "diff-hl--update-safe"))) 646 (diff-hl--update))) 647 648 (defun diff-hl--update-buffer (buf) 649 (when (buffer-live-p buf) 650 (with-current-buffer buf 651 (diff-hl-update)))) 652 653 (defun diff-hl-with-editor-p (_dir) 654 (bound-and-true-p with-editor-mode)) 655 656 (defun diff-hl--update-safe () 657 "Updates the diff-hl overlay. It handles and logs when an error is signaled." 658 (condition-case-unless-debug err 659 (diff-hl--update) 660 (error 661 (message "An error occurred in diff-hl--update: %S" err) 662 nil))) 663 664 (defun diff-hl--update-overlays (changes reuse) 665 "Updates the diff-hl overlays based on CHANGES. 666 REUSE is a list of existing line overlays that can be used. 667 Return a list of line overlays used." 668 (let ((current-line 1) 669 ovls) 670 (save-excursion 671 (save-restriction 672 (widen) 673 (goto-char (point-min)) 674 (dolist (c changes) 675 (cl-destructuring-bind (line inserts _deletes type) c 676 (forward-line (- line current-line)) 677 (setq current-line line) 678 (let ((hunk-beg (point)) 679 (len (if (eq type 'delete) 1 inserts))) 680 (while (and reuse 681 (< (overlay-start (car reuse)) (point))) 682 (setq reuse (cdr reuse))) 683 (while (cl-plusp len) 684 (push 685 (diff-hl-add-highlighting 686 type 687 (cond 688 ((not diff-hl-draw-borders) 'empty) 689 ((and (= len 1) (= line current-line)) 'single) 690 ((= len 1) 'bottom) 691 ((= line current-line) 'top) 692 (t 'middle)) 693 (and reuse 694 (= (overlay-start (car reuse)) (point)) 695 (pop reuse))) 696 ovls) 697 (forward-line 1) 698 (cl-incf current-line) 699 (cl-decf len)) 700 (let ((h (make-overlay hunk-beg (point))) 701 (hook '(diff-hl-overlay-modified))) 702 (overlay-put h 'diff-hl t) 703 (overlay-put h 'diff-hl-hunk t) 704 (overlay-put h 'diff-hl-hunk-type type) 705 (overlay-put h 'modification-hooks hook) 706 (overlay-put h 'insert-in-front-hooks hook) 707 (overlay-put h 'insert-behind-hooks hook))))))) 708 (nreverse ovls))) 709 710 (defun diff-hl--no-query-on-exit (value) 711 (when-let* ((buf (and (stringp value) (get-buffer value))) 712 (proc (get-buffer-process buf))) 713 (set-process-query-on-exit-flag proc nil))) 714 715 (defun diff-hl--update () 716 (let* ((orig (current-buffer)) 717 (cc (diff-hl-changes)) 718 (working (assoc-default :working cc)) 719 (reference (assoc-default :reference cc))) 720 (diff-hl--no-query-on-exit working) 721 (diff-hl--no-query-on-exit reference) 722 (diff-hl--resolve 723 working 724 (lambda (changes) 725 (diff-hl--resolve 726 reference 727 (lambda (ref-changes) 728 (let ((ref-changes (diff-hl-adjust-changes ref-changes changes)) 729 reuse) 730 (with-current-buffer orig 731 (diff-hl-remove-overlays) 732 (let ((diff-hl-highlight-function 733 diff-hl-highlight-reference-function) 734 (diff-hl-fringe-face-function 735 diff-hl-fringe-reference-face-function)) 736 (setq reuse (diff-hl--update-overlays ref-changes nil))) 737 (diff-hl--update-overlays changes reuse) 738 (when (not (or changes ref-changes)) 739 (diff-hl--autohide-margin)))))))))) 740 741 (defun diff-hl--resolve (value-or-buffer cb) 742 (if (listp value-or-buffer) 743 (funcall cb value-or-buffer) 744 (static-if (fboundp 'vc-run-delayed-success) 745 ;; Emacs 31. 746 (with-current-buffer value-or-buffer 747 (vc-run-delayed-success 1 748 (funcall cb (diff-hl-changes-from-buffer (current-buffer))))) 749 (diff-hl--when-done value-or-buffer 750 #'diff-hl-changes-from-buffer 751 cb)))) 752 753 (defun diff-hl--when-done (buffer get-value callback &optional proc) 754 (let ((proc (or proc (get-buffer-process buffer)))) 755 (cond 756 ;; If there's no background process, just execute the code. 757 ((or (null proc) (eq (process-status proc) 'exit)) 758 ;; Make sure we've read the process's output before going further. 759 (when proc (accept-process-output proc)) 760 (when (get-buffer buffer) 761 (with-current-buffer buffer 762 (funcall callback (funcall get-value buffer))))) 763 ;; If process was deleted, we ignore it. 764 ((eq (process-status proc) 'signal)) 765 ;; If a process is running, set the sentinel. 766 ((eq (process-status proc) 'run) 767 (add-function 768 :after 769 (process-sentinel proc) 770 (lambda (proc _status) 771 ;; Delegate to the parent cond for decision logic. 772 (diff-hl--when-done buffer get-value callback proc)))) 773 ;; Maybe we should ignore all other states as well. 774 (t (error "Unexpected process state"))))) 775 776 (defun diff-hl--autohide-margin () 777 (let ((width-var (intern (format "%s-margin-width" diff-hl-side)))) 778 (when (and diff-hl-autohide-margin 779 (> (symbol-value width-var) 0)) 780 (if (eql (default-value width-var) 0) 781 (kill-local-variable width-var) 782 (set width-var 0)) 783 (dolist (win (get-buffer-window-list)) 784 (set-window-buffer win (current-buffer)))))) 785 786 (defun diff-hl-update-once () 787 ;; Ensure that the update happens once, after all major mode changes. 788 ;; That will keep the the local value of <side>-margin-width, if any. 789 (unless diff-hl-timer 790 (setq diff-hl-timer 791 (run-with-idle-timer 0 nil #'diff-hl--update-buffer (current-buffer))))) 792 793 (defun diff-hl-add-highlighting (type shape &optional ovl) 794 (let ((o (or ovl (make-overlay (point) (point))))) 795 (overlay-put o 'diff-hl t) 796 (funcall diff-hl-highlight-function o type shape) 797 o)) 798 799 (autoload 'diff-hl-highlight-on-margin "diff-hl-margin") 800 801 (defun diff-hl-highlight-on-fringe (ovl type shape) 802 (if (and diff-hl-fallback-to-margin 803 (not (display-graphic-p))) 804 (diff-hl-highlight-on-margin ovl type shape) 805 (overlay-put ovl 'before-string (diff-hl-fringe-spec type shape 806 diff-hl-side)))) 807 808 (defun diff-hl-highlight-on-fringe-flat (ovl type _shape) 809 (let ((diff-hl-fringe-bmp-function (lambda (&rest _s) diff-hl-fringe-flat-bmp))) 810 (diff-hl-highlight-on-fringe ovl type nil))) 811 812 (defun diff-hl-remove-overlays (&optional beg end) 813 (save-restriction 814 (widen) 815 (dolist (o (overlays-in (or beg (point-min)) (or end (point-max)))) 816 (when (overlay-get o 'diff-hl) (delete-overlay o))))) 817 818 (defun diff-hl-overlay-modified (ov after-p _beg _end &optional _length) 819 "Delete the hunk overlay and all our line overlays inside it." 820 (unless after-p 821 (when (overlay-buffer ov) 822 (diff-hl-remove-overlays (overlay-start ov) (overlay-end ov)) 823 (delete-overlay ov)))) 824 825 (defun diff-hl-edit (_beg _end _len) 826 "DTRT when we've `undo'-ne the buffer into unmodified state." 827 (when undo-in-progress 828 (when diff-hl-timer 829 (cancel-timer diff-hl-timer)) 830 (setq diff-hl-timer 831 (run-with-idle-timer 0.01 nil #'diff-hl-after-undo (current-buffer))))) 832 833 (defun diff-hl-after-undo (buffer) 834 (when (buffer-live-p buffer) 835 (with-current-buffer buffer 836 (unless (buffer-modified-p) 837 (diff-hl-update))))) 838 839 (defun diff-hl-diff-goto-hunk-1 (historic rev1) 840 (defvar vc-sentinel-movepoint) 841 (vc-buffer-sync) 842 (let* ((line (line-number-at-pos)) 843 (buffer (current-buffer)) 844 rev2) 845 (when historic 846 (let ((revs (diff-hl-diff-read-revisions rev1))) 847 (setq rev1 (car revs) 848 rev2 (cdr revs)))) 849 (vc-diff-internal 850 (if (boundp 'vc-allow-async-diff) 851 vc-allow-async-diff 852 t) 853 (vc-deduce-fileset) rev1 rev2 t) 854 (vc-run-delayed (if (< (line-number-at-pos (point-max)) 3) 855 (with-current-buffer buffer (diff-hl-update)) 856 (when (or (not rev2) diff-hl-goto-hunk-old-revisions) 857 (diff-hl-diff-skip-to line)) 858 (setq vc-sentinel-movepoint (point)))))) 859 860 (defun diff-hl-diff-goto-hunk (&optional historic) 861 "Run VC diff command and go to the corresponding line in diff. 862 With double prefix argument (C-u C-u), the diff is made against the 863 reference revision." 864 (interactive (list current-prefix-arg)) 865 (with-current-buffer (or (buffer-base-buffer) (current-buffer)) 866 (if (equal historic '(16)) 867 (diff-hl-diff-reference-goto-hunk) 868 (diff-hl-diff-goto-hunk-1 historic nil)))) 869 870 (defun diff-hl-diff-reference-goto-hunk () 871 "Run VC diff command against the reference and go to the corresponding line." 872 (interactive) 873 (with-current-buffer (or (buffer-base-buffer) (current-buffer)) 874 (diff-hl-diff-goto-hunk-1 nil diff-hl-reference-revision))) 875 876 (defun diff-hl-root-diff-reference-goto-hunk () 877 "Run VC diff command against the reference for the whole tree. 878 And if the current buffer is visiting a file, and it has changes, the diff 879 buffer will show the position corresponding to its current line." 880 (interactive) 881 (defvar vc-sentinel-movepoint) 882 (with-current-buffer (or (buffer-base-buffer) (current-buffer)) 883 (let ((backend (vc-deduce-backend)) 884 (default-directory default-directory) 885 rootdir fileset 886 relname) 887 (if backend 888 (setq rootdir (vc-call-backend backend 'root default-directory) 889 default-directory rootdir 890 fileset `(,backend (,rootdir)) 891 relname (if buffer-file-name (file-relative-name buffer-file-name 892 rootdir))) 893 (error "Directory is not version controlled")) 894 (setq fileset (or fileset (vc-deduce-fileset))) 895 (vc-buffer-sync-fileset fileset t) 896 (let* ((line (line-number-at-pos))) 897 (vc-diff-internal 898 (if (boundp 'vc-allow-async-diff) 899 vc-allow-async-diff 900 t) 901 fileset diff-hl-reference-revision nil t) 902 (vc-run-delayed (when relname 903 (diff-hl-diff-skip-to line relname) 904 (setq vc-sentinel-movepoint (point)))))))) 905 906 (defun diff-hl-diff-read-revisions (rev1-default) 907 (let* ((file buffer-file-name) 908 (files (list file)) 909 (backend (vc-backend file)) 910 (rev2-default nil)) 911 (cond 912 ;; if the file is not up-to-date, use working revision as older revision 913 ((not (vc-up-to-date-p file)) 914 (setq rev1-default 915 (or rev1-default 916 (vc-working-revision file)))) 917 ((not rev1-default) 918 (setq rev1-default (ignore-errors ;If `previous-revision' doesn't work. 919 (vc-call-backend backend 'previous-revision file 920 (vc-working-revision file)))) 921 (when (string= rev1-default "") (setq rev1-default nil)))) 922 ;; finally read the revisions 923 (let* ((rev1-prompt (if rev1-default 924 (concat "Older revision (default " 925 rev1-default "): ") 926 "Older revision: ")) 927 (rev2-prompt (concat "Newer revision (default " 928 (or rev2-default "current source") "): ")) 929 (rev1 (vc-read-revision rev1-prompt files backend rev1-default)) 930 (rev2 (vc-read-revision rev2-prompt files backend rev2-default))) 931 (when (string= rev1 "") (setq rev1 nil)) 932 (when (string= rev2 "") (setq rev2 nil)) 933 (cons rev1 rev2)))) 934 935 (defun diff-hl-diff-skip-to (line &optional filename) 936 "In `diff-mode', skip to the hunk and line corresponding to LINE 937 in the source file, or the last line of the hunk above it. 938 939 When passed FILENAME, ensure that the line is in the section belonging to 940 that file, if it's present." 941 (goto-char (point-min)) ; Counteract any similar behavior in diff-mode. 942 (let (found 943 (end-pos (point-max))) 944 (diff-hunk-next) 945 (when filename 946 (while (and (not (equal (diff-find-file-name nil t) 947 filename)) 948 (not (eobp))) 949 (diff-file-next)) 950 (if (not (eobp)) 951 ;; Found our file in the changed set. Ensure that we don't go past. 952 (setq end-pos (save-excursion 953 (diff-end-of-file) 954 (point))) 955 (goto-char (point-min)) 956 (setq line 0))) 957 (while (and (looking-at diff-hunk-header-re-unified) 958 (not found) 959 (< (point) end-pos)) 960 (let ((hunk-line (string-to-number (match-string 3))) 961 (len (let ((m (match-string 4))) 962 (if m (string-to-number m) 1)))) 963 (if (> line (+ hunk-line len)) 964 (diff-hunk-next) 965 (setq found t) 966 (if (< line hunk-line) 967 ;; Retreat to the previous hunk. 968 (forward-line -1) 969 (let ((to-go (1+ (- line hunk-line)))) 970 (while (cl-plusp to-go) 971 (forward-line 1) 972 (unless (looking-at "^[-\\]") 973 (cl-decf to-go)))))))) 974 (when (> (point) end-pos) 975 (diff-hunk-prev) 976 (diff-end-of-hunk)))) 977 978 (defface diff-hl-reverted-hunk-highlight 979 '((default :inverse-video t)) 980 "Face used to highlight the first column of the hunk to be reverted.") 981 982 (defun diff-hl-revert-highlight-first-column (end) 983 (re-search-forward "^[+-]") 984 (forward-line 0) 985 (setq end (diff-hl-split-away-changes 0)) 986 (let ((inhibit-read-only t)) 987 (save-excursion 988 (while (< (point) end) 989 (font-lock-prepend-text-property (point) (1+ (point)) 'font-lock-face 990 'diff-hl-reverted-hunk-highlight) 991 (forward-line 1))))) 992 993 (defun diff-hl-revert-narrow-to-hunk (end) 994 (narrow-to-region (point) end)) 995 996 (defun diff-hl-revert-hunk-1 () 997 (save-restriction 998 (widen) 999 (vc-buffer-sync) 1000 (let* ((diff-buffer (get-buffer-create 1001 (generate-new-buffer-name "*diff-hl-revert*"))) 1002 (buffer (current-buffer)) 1003 (diff-hl-update-async nil) 1004 (line (save-excursion 1005 (diff-hl-find-current-hunk) 1006 (line-number-at-pos))) 1007 (file buffer-file-name) 1008 (backend (vc-backend file))) 1009 (unwind-protect 1010 (progn 1011 (vc-setup-buffer diff-buffer) 1012 (with-current-buffer buffer 1013 ;; Ensure that the buffer-local variable value is applied. 1014 (diff-hl-diff-against-reference file backend diff-buffer)) 1015 (diff-mode) 1016 (setq-local diff-vc-backend backend) 1017 (setq-local diff-vc-revisions (list diff-hl-reference-revision nil)) 1018 (setq buffer-read-only t) 1019 (pop-to-buffer diff-buffer) 1020 (vc-run-delayed 1021 (vc-diff-finish diff-buffer nil) 1022 (let (beg-line end-line m-beg m-end) 1023 (when (eobp) 1024 (with-current-buffer buffer (diff-hl-remove-overlays)) 1025 (user-error "Buffer is up-to-date")) 1026 (with-no-warnings 1027 (let (diff-auto-refine-mode) 1028 (diff-hl-diff-skip-to line))) 1029 (setq m-end (diff-hl-split-away-changes 3)) 1030 (setq m-beg (point-marker)) 1031 (funcall diff-hl-highlight-revert-hunk-function m-end) 1032 (setq beg-line (line-number-at-pos m-beg) 1033 end-line (line-number-at-pos m-end)) 1034 (let ((wbh (window-body-height))) 1035 (if (>= wbh (- end-line beg-line)) 1036 (recenter (/ (+ wbh (- beg-line end-line) 2) 2)) 1037 (recenter 1))) 1038 (with-no-warnings 1039 (when diff-auto-refine-mode 1040 (diff-refine-hunk))) 1041 (if diff-hl-ask-before-revert-hunk 1042 (unless (yes-or-no-p (format "Revert current hunk in %s? " 1043 file)) 1044 (user-error "Revert canceled"))) 1045 (widen) 1046 (let ((diff-advance-after-apply-hunk nil)) 1047 (save-window-excursion 1048 (diff-apply-hunk t))) 1049 (with-current-buffer buffer 1050 (save-buffer)) 1051 (message "Hunk reverted")))) 1052 (quit-windows-on diff-buffer t))))) 1053 1054 (defun diff-hl-split-away-changes (max-context) 1055 "Split away the minimal hunk at point from the rest of the hunk. 1056 1057 The minimal hunk is the hunk a diff program would produce if 1058 asked for 0 lines of context. Add MAX-CONTEXT lines of context at 1059 most (stop when encounter another minimal hunk). 1060 1061 Move point to the beginning of the delineated hunk and return 1062 its end position." 1063 (let (end-marker) 1064 (save-excursion 1065 (while (looking-at "[-+\\]") (forward-line 1)) 1066 (dotimes (_i max-context) 1067 (unless (looking-at "@\\|[-+]") 1068 (forward-line 1))) 1069 (setq end-marker (point-marker)) 1070 (unless (or (eobp) 1071 (looking-at "@")) 1072 (diff-split-hunk))) 1073 (unless (looking-at "[-+]") (forward-line -1)) 1074 (while (looking-at "[-+\\]") (forward-line -1)) 1075 (dotimes (_i max-context) 1076 (unless (looking-at "@\\|[-+]") 1077 (forward-line -1))) 1078 (unless (looking-at "@") 1079 (forward-line 1) 1080 (diff-split-hunk) 1081 (forward-line -1)) 1082 end-marker)) 1083 1084 (defun diff-hl-revert-hunk () 1085 "Revert the diff hunk with changes at or above the point." 1086 (interactive) 1087 (with-current-buffer (or (buffer-base-buffer) (current-buffer)) 1088 (diff-hl-revert-hunk-1))) 1089 1090 (defun diff-hl-hunk-overlay-at (pos) 1091 (cl-loop for o in (overlays-in pos (1+ pos)) 1092 when (overlay-get o 'diff-hl-hunk) 1093 return o)) 1094 1095 (defun diff-hl-search-next-hunk (&optional backward point) 1096 "Search the next hunk in the current buffer, or previous if BACKWARD." 1097 (save-excursion 1098 (when point 1099 (goto-char point)) 1100 (catch 'found 1101 (while (not (if backward (bobp) (eobp))) 1102 (goto-char (if backward 1103 (previous-overlay-change (point)) 1104 (next-overlay-change (point)))) 1105 (let ((o (diff-hl-hunk-overlay-at (point)))) 1106 (when (and o (= (overlay-start o) (point))) 1107 (throw 'found o))))))) 1108 1109 (defun diff-hl-next-hunk (&optional backward) 1110 "Go to the beginning of the next hunk in the current buffer." 1111 (interactive) 1112 (let ((overlay (diff-hl-search-next-hunk backward))) 1113 (if overlay 1114 (goto-char (overlay-start overlay)) 1115 (user-error "No further hunks found")))) 1116 1117 (defun diff-hl-previous-hunk () 1118 "Go to the beginning of the previous hunk in the current buffer." 1119 (interactive) 1120 (diff-hl-next-hunk t)) 1121 1122 (defun diff-hl-find-current-hunk () 1123 (let (o) 1124 (cond 1125 ((diff-hl-hunk-overlay-at (point))) 1126 ((setq o (diff-hl-search-next-hunk t)) 1127 (goto-char (overlay-start o))) 1128 (t 1129 (diff-hl-next-hunk))))) 1130 1131 (defun diff-hl-mark-hunk () 1132 (interactive) 1133 (let ((hunk (diff-hl-hunk-overlay-at (point)))) 1134 (unless hunk 1135 (user-error "No hunk at point")) 1136 (goto-char (overlay-start hunk)) 1137 (push-mark (overlay-end hunk) nil t))) 1138 1139 (defun diff-hl--ensure-staging-supported () 1140 (let ((backend (vc-backend buffer-file-name))) 1141 (unless (eq backend 'Git) 1142 (user-error "Only Git supports staging; this file is controlled by %s" backend)))) 1143 1144 (defun diff-hl-stage-diff (orig-buffer) 1145 (let ((patchfile (make-nearby-temp-file "diff-hl-stage-patch")) 1146 success) 1147 (write-region (point-min) (point-max) patchfile 1148 nil 'silent) 1149 (unwind-protect 1150 (with-current-buffer orig-buffer 1151 (with-output-to-string 1152 (vc-git-command standard-output 0 1153 (file-local-name patchfile) 1154 "apply" "--cached" ) 1155 (setq success t))) 1156 (delete-file patchfile)) 1157 success)) 1158 1159 (defun diff-hl-stage-current-hunk () 1160 "Stage the hunk at or near point. 1161 1162 Only supported with Git." 1163 (interactive) 1164 (diff-hl--ensure-staging-supported) 1165 (diff-hl-find-current-hunk) 1166 (let* ((line (line-number-at-pos)) 1167 (file buffer-file-name) 1168 (dest-buffer (get-buffer-create " *diff-hl-stage*")) 1169 (orig-buffer (current-buffer)) 1170 ;; FIXME: If the file name has double quotes, these need to be quoted. 1171 (file-base (file-name-nondirectory file)) 1172 success) 1173 (with-current-buffer dest-buffer 1174 (let ((inhibit-read-only t)) 1175 (erase-buffer))) 1176 (let (diff-hl-reference-revision 1177 diff-hl-update-async) 1178 (diff-hl-diff-buffer-with-reference file dest-buffer nil 3)) 1179 (with-current-buffer dest-buffer 1180 (with-no-warnings 1181 (let (diff-auto-refine-mode) 1182 (diff-hl-diff-skip-to line))) 1183 (let ((inhibit-read-only t)) 1184 (diff-hl-split-away-changes 3) 1185 (save-excursion 1186 (diff-end-of-hunk) 1187 (delete-region (point) (point-max))) 1188 (diff-beginning-of-hunk) 1189 (delete-region (point-min) (point)) 1190 ;; diff-no-select creates a very ugly header; Git rejects it 1191 (insert (format "diff a/%s b/%s\n" file-base file-base)) 1192 (insert (format "--- a/%s\n" file-base)) 1193 (insert (format "+++ b/%s\n" file-base))) 1194 (setq success (diff-hl-stage-diff orig-buffer))) 1195 (when success 1196 (if diff-hl-show-staged-changes 1197 (message (concat "Hunk staged; customize `diff-hl-show-staged-changes'" 1198 " to highlight only unstaged changes")) 1199 (message "Hunk staged")) 1200 (unless diff-hl-show-staged-changes 1201 (diff-hl-update))))) 1202 1203 (defun diff-hl-unstage-file () 1204 "Unstage all changes in the current file. 1205 1206 Only supported with Git." 1207 (interactive) 1208 (unless buffer-file-name 1209 (user-error "No current file")) 1210 (diff-hl--ensure-staging-supported) 1211 (vc-git-command nil 0 buffer-file-name "reset") 1212 (message "Unstaged all") 1213 (unless diff-hl-show-staged-changes 1214 (diff-hl-update))) 1215 1216 (defun diff-hl-stage-dwim (&optional with-edit) 1217 "Stage the current hunk or choose the hunks to stage. 1218 When called with the prefix argument, invokes `diff-hl-stage-some'." 1219 (interactive "P") 1220 (if (or with-edit (region-active-p)) 1221 (call-interactively #'diff-hl-stage-some) 1222 (call-interactively #'diff-hl-stage-current-hunk))) 1223 1224 (defvar diff-hl-stage--orig nil) 1225 1226 (define-derived-mode diff-hl-stage-diff-mode diff-mode "Stage Diff" 1227 "Major mode for editing a diff buffer before staging. 1228 1229 \\[diff-hl-stage-commit]" 1230 (setq revert-buffer-function #'ignore)) 1231 1232 (define-key diff-hl-stage-diff-mode-map (kbd "C-c C-c") #'diff-hl-stage-finish) 1233 1234 (defun diff-hl-stage-some (&optional beg end) 1235 "Stage some or all of the current changes, interactively. 1236 Pops up a diff buffer that can be edited to choose the changes to stage." 1237 (interactive "r") 1238 (diff-hl--ensure-staging-supported) 1239 (let* ((line-beg (and beg (line-number-at-pos beg t))) 1240 (line-end (and end (line-number-at-pos end t))) 1241 (file buffer-file-name) 1242 (dest-buffer (get-buffer-create "*diff-hl-stage-some*")) 1243 (orig-buffer (current-buffer)) 1244 (diff-hl-update-async nil) 1245 ;; FIXME: If the file name has double quotes, these need to be quoted. 1246 (file-base (file-name-nondirectory file))) 1247 (with-current-buffer dest-buffer 1248 (let ((inhibit-read-only t)) 1249 (erase-buffer))) 1250 (let (diff-hl-reference-revision) 1251 (diff-hl-diff-buffer-with-reference file dest-buffer nil 3)) 1252 (with-current-buffer dest-buffer 1253 (let ((inhibit-read-only t)) 1254 (when end 1255 (with-no-warnings 1256 (let (diff-auto-refine-mode) 1257 (diff-hl-diff-skip-to line-end) 1258 (diff-hl-split-away-changes 3) 1259 (diff-end-of-hunk))) 1260 (delete-region (point) (point-max))) 1261 (if beg 1262 (with-no-warnings 1263 (let (diff-auto-refine-mode) 1264 (diff-hl-diff-skip-to line-beg) 1265 (diff-hl-split-away-changes 3) 1266 (diff-beginning-of-hunk))) 1267 (goto-char (point-min)) 1268 (forward-line 3)) 1269 (delete-region (point-min) (point)) 1270 ;; diff-no-select creates a very ugly header; Git rejects it 1271 (insert (format "diff a/%s b/%s\n" file-base file-base)) 1272 (insert (format "--- a/%s\n" file-base)) 1273 (insert (format "+++ b/%s\n" file-base))) 1274 (let ((diff-default-read-only t)) 1275 (diff-hl-stage-diff-mode)) 1276 (setq-local diff-hl-stage--orig orig-buffer)) 1277 (pop-to-buffer dest-buffer) 1278 (message "Press %s and %s to navigate, %s to split, %s to kill hunk, %s to undo, and %s to stage the diff after editing" 1279 (substitute-command-keys "\\`n'") 1280 (substitute-command-keys "\\`p'") 1281 (substitute-command-keys "\\[diff-split-hunk]") 1282 (substitute-command-keys "\\[diff-hunk-kill]") 1283 (substitute-command-keys "\\[diff-undo]") 1284 (substitute-command-keys "\\[diff-hl-stage-finish]")))) 1285 1286 (defun diff-hl-stage-finish () 1287 (interactive) 1288 (let ((count 0) 1289 (orig-buffer diff-hl-stage--orig)) 1290 (when (diff-hl-stage-diff orig-buffer) 1291 (save-excursion 1292 (goto-char (point-min)) 1293 (while (re-search-forward diff-hunk-header-re-unified nil t) 1294 (cl-incf count))) 1295 (message "Staged %d hunks" count) 1296 (bury-buffer) 1297 (unless diff-hl-show-staged-changes 1298 (with-current-buffer orig-buffer 1299 (diff-hl-update)))))) 1300 1301 (defvar diff-hl-command-map 1302 (let ((map (make-sparse-keymap))) 1303 (define-key map "n" 'diff-hl-revert-hunk) 1304 (define-key map "[" 'diff-hl-previous-hunk) 1305 (define-key map "]" 'diff-hl-next-hunk) 1306 (define-key map "*" 'diff-hl-show-hunk) 1307 (define-key map "{" 'diff-hl-show-hunk-previous) 1308 (define-key map "}" 'diff-hl-show-hunk-next) 1309 (define-key map "S" 'diff-hl-stage-dwim) 1310 map)) 1311 (fset 'diff-hl-command-map diff-hl-command-map) 1312 1313 (defvar diff-hl-lighter "" 1314 "Mode line lighter for Diff Hl. 1315 1316 The value of this variable is a mode line template as in 1317 `mode-line-format'.") 1318 1319 ;;;###autoload 1320 (define-minor-mode diff-hl-mode 1321 "Toggle VC diff highlighting." 1322 :lighter diff-hl-lighter 1323 :keymap `(([remap vc-diff] . diff-hl-diff-goto-hunk) 1324 (,diff-hl-command-prefix . diff-hl-command-map)) 1325 (if diff-hl-mode 1326 (progn 1327 (diff-hl-maybe-define-bitmaps) 1328 (add-hook 'after-save-hook 'diff-hl-update nil t) 1329 (add-hook 'after-change-functions 'diff-hl-edit nil t) 1330 (add-hook (if vc-mode 1331 ;; Defer until the end of this hook, so that its 1332 ;; elements can modify the update behavior. 1333 'diff-hl-mode-on-hook 1334 ;; If we're only opening the file now, 1335 ;; `vc-find-file-hook' likely hasn't run yet, so 1336 ;; let's wait until the state information is 1337 ;; saved, in order not to fetch it twice. 1338 'find-file-hook) 1339 'diff-hl-update-once t t) 1340 ;; Never removed because it acts globally. 1341 (add-hook 'vc-checkin-hook 'diff-hl-after-checkin) 1342 (add-hook 'after-revert-hook 'diff-hl-update-once nil t) 1343 ;; Magit does call `auto-revert-handler', but it usually 1344 ;; doesn't do much, because `buffer-stale--default-function' 1345 ;; doesn't care about changed VC state. 1346 ;; https://github.com/magit/magit/issues/603 1347 (add-hook 'magit-revert-buffer-hook 'diff-hl-update nil t) 1348 ;; Magit versions 2.0-2.3 don't do the above and call this 1349 ;; instead, but only when they don't call `revert-buffer': 1350 (add-hook 'magit-not-reverted-hook 'diff-hl-update nil t) 1351 (add-hook 'text-scale-mode-hook 'diff-hl-maybe-redefine-bitmaps nil t) 1352 (when-let* ((rev (cdr 1353 (cl-find-if 1354 (lambda (pair) (string-prefix-p (car pair) default-directory)) 1355 diff-hl-reference-revision-projects-cache)))) 1356 (setq-local diff-hl-reference-revision rev))) 1357 (remove-hook 'after-save-hook 'diff-hl-update t) 1358 (remove-hook 'after-change-functions 'diff-hl-edit t) 1359 (remove-hook 'find-file-hook 'diff-hl-update-once t) 1360 (remove-hook 'after-revert-hook 'diff-hl-update-once t) 1361 (remove-hook 'magit-revert-buffer-hook 'diff-hl-update t) 1362 (remove-hook 'magit-not-reverted-hook 'diff-hl-update t) 1363 (remove-hook 'text-scale-mode-hook 'diff-hl-maybe-redefine-bitmaps t) 1364 (diff-hl-remove-overlays) 1365 (diff-hl--autohide-margin) 1366 (kill-local-variable 'diff-hl-reference-revision))) 1367 1368 (defun diff-hl-after-checkin () 1369 (let ((fileset (vc-deduce-fileset t))) 1370 (dolist (file (nth 1 fileset)) 1371 (let ((buf (find-buffer-visiting file))) 1372 (when buf 1373 (with-current-buffer buf 1374 (when diff-hl-mode 1375 (diff-hl-update)))))))) 1376 1377 (defvar diff-hl-repeat-exceptions '(diff-hl-show-hunk 1378 diff-hl-show-hunk-previous 1379 diff-hl-show-hunk-next)) 1380 1381 (when (require 'smartrep nil t) 1382 (declare-function smartrep-define-key 'smartrep) 1383 (let (smart-keys) 1384 (cl-labels ((scan (map) 1385 (map-keymap 1386 (lambda (event binding) 1387 (if (consp binding) 1388 (scan binding) 1389 (when (and (characterp event) 1390 (not (memq binding diff-hl-repeat-exceptions))) 1391 (push (cons (string event) binding) smart-keys)))) 1392 map))) 1393 (scan diff-hl-command-map) 1394 (smartrep-define-key diff-hl-mode-map diff-hl-command-prefix smart-keys)))) 1395 1396 ;; Integrate with `repeat-mode' in Emacs 28 (https://debbugs.gnu.org/47566) 1397 ;; 1398 ;; While smartrep feels solid, it looks kinda abandoned. And the 1399 ;; chances of it being put into GNU ELPA are slim too. 1400 (map-keymap 1401 (lambda (_key cmd) 1402 (unless (memq cmd diff-hl-repeat-exceptions) 1403 (put cmd 'repeat-map 'diff-hl-command-map))) 1404 diff-hl-command-map) 1405 1406 (declare-function magit-toplevel "magit-git") 1407 (declare-function magit-git-items "magit-git") 1408 1409 (define-obsolete-function-alias 'diff-hl-magit-pre-refresh 'ignore "1.11.0") 1410 1411 (defun diff-hl-magit-post-refresh () 1412 (unless (and diff-hl-disable-on-remote 1413 (file-remote-p default-directory)) 1414 (let* ((topdir (magit-toplevel)) 1415 (modified-files 1416 (magit-git-items "diff-tree" "-z" "--name-only" "-r" "HEAD~" "HEAD")) 1417 (unmodified-states '(up-to-date ignored unregistered))) 1418 (dolist (buf (buffer-list)) 1419 (when (and (buffer-local-value 'diff-hl-mode buf) 1420 (not (buffer-modified-p buf)) 1421 ;; Solve the "cloned indirect buffer" problem 1422 ;; (diff-hl-mode could be non-nil there, even if 1423 ;; buffer-file-name is nil): 1424 (buffer-file-name buf) 1425 (file-in-directory-p (buffer-file-name buf) topdir) 1426 (file-exists-p (buffer-file-name buf))) 1427 (with-current-buffer buf 1428 (let* ((file buffer-file-name) 1429 (backend (vc-backend file))) 1430 (when backend 1431 (cond 1432 ((member file modified-files) 1433 (when (memq (vc-state file) unmodified-states) 1434 (vc-state-refresh file backend)) 1435 (diff-hl-update)) 1436 ((not (memq (vc-state file backend) unmodified-states)) 1437 (vc-state-refresh file backend) 1438 (diff-hl-update))))))))))) 1439 1440 (defun diff-hl-dir-update () 1441 (dolist (pair (if (vc-dir-marked-files) 1442 (vc-dir-marked-only-files-and-states) 1443 (vc-dir-child-files-and-states))) 1444 (when (eq 'up-to-date (cdr pair)) 1445 (let ((buffer (find-buffer-visiting (car pair)))) 1446 (when buffer 1447 (with-current-buffer buffer 1448 (diff-hl-remove-overlays))))))) 1449 1450 (define-minor-mode diff-hl-dir-mode 1451 "Toggle `diff-hl-mode' integration in a `vc-dir-mode' buffer." 1452 :lighter "" 1453 (if diff-hl-dir-mode 1454 (add-hook 'vc-checkin-hook 'diff-hl-dir-update t t) 1455 (remove-hook 'vc-checkin-hook 'diff-hl-dir-update t))) 1456 1457 (defun diff-hl-make-temp-file-name (file rev &optional manual) 1458 "Return a backup file name for REV or the current version of FILE. 1459 If MANUAL is non-nil it means that a name for backups created by 1460 the user should be returned." 1461 (let* ((auto-save-file-name-transforms 1462 `((".*" ,temporary-file-directory t))) 1463 (buffer-file-name file)) 1464 (expand-file-name 1465 (concat (make-auto-save-file-name) 1466 ".~" (subst-char-in-string 1467 ?/ ?_ rev) 1468 (unless manual ".") "~") 1469 temporary-file-directory))) 1470 1471 (defun diff-hl-create-revision (file revision) 1472 "Read REVISION of FILE into a buffer and return the buffer." 1473 (let ((automatic-backup (diff-hl-make-temp-file-name file revision)) 1474 (filebuf (get-file-buffer file)) 1475 (filename (diff-hl-make-temp-file-name file revision 'manual))) 1476 (unless (file-exists-p filename) 1477 (if (file-exists-p automatic-backup) 1478 (rename-file automatic-backup filename nil) 1479 (with-current-buffer filebuf 1480 (let ((coding-system-for-read 'no-conversion) 1481 (coding-system-for-write 'no-conversion)) 1482 (condition-case nil 1483 (with-temp-file filename 1484 (let ((outbuf (current-buffer))) 1485 ;; Change buffer to get local value of 1486 ;; vc-checkout-switches. 1487 (with-current-buffer filebuf 1488 (vc-call find-revision file revision outbuf)))) 1489 (error 1490 (when (file-exists-p filename) 1491 (delete-file filename)))))))) 1492 filename)) 1493 1494 (defun diff-hl-working-revision (file &optional backend) 1495 "Like vc-working-revision, but always up-to-date" 1496 (vc-file-setprop file 'vc-working-revision 1497 (vc-call-backend (or backend (vc-backend file)) 1498 'working-revision file))) 1499 1500 (declare-function diff-no-select "diff") 1501 1502 (defvar diff-hl-temporary-directory (if (and (eq system-type 'gnu/linux) 1503 (file-directory-p "/dev/shm/")) 1504 "/dev/shm/" 1505 temporary-file-directory)) 1506 1507 (defun diff-hl-diff-buffer-with-reference (file &optional dest-buffer backend context-lines) 1508 "Compute the diff between the current buffer contents and reference in BACKEND. 1509 The diffs are computed in the buffer DEST-BUFFER. This requires 1510 the `diff-program' to be in your `exec-path'. 1511 CONTEXT-LINES is the size of the unified diff context, defaults to 0." 1512 (require 'diff) 1513 (vc-ensure-vc-buffer) 1514 (save-current-buffer 1515 (let* ((dest-buffer (or dest-buffer "*diff-hl-diff-buffer-with-reference*")) 1516 (backend (or backend (vc-backend file))) 1517 (temporary-file-directory diff-hl-temporary-directory) 1518 (rev 1519 (if (and (eq backend 'Git) 1520 (not diff-hl-reference-revision) 1521 (not diff-hl-show-staged-changes)) 1522 (diff-hl-git-index-revision 1523 file 1524 (diff-hl-git-index-object-name file)) 1525 (diff-hl-create-revision 1526 file 1527 (or (diff-hl-resolved-revision 1528 backend 1529 (or diff-hl-reference-revision 1530 (assoc-default backend diff-hl-head-revision-alist))) 1531 (diff-hl-working-revision buffer-file-name backend))))) 1532 (switches (format "-U %d --strip-trailing-cr" (or context-lines 0)))) 1533 (diff-no-select rev (current-buffer) switches (not (diff-hl--use-async-p)) 1534 (get-buffer-create dest-buffer)) 1535 ;; Function `diff-sentinel' adds a summary line, but that seems fine. 1536 ;; In all commands which use exact text we call it synchronously. 1537 (get-buffer-create dest-buffer)))) 1538 1539 (declare-function vc-jj--process-lines "vc-jj") 1540 1541 (defun diff-hl-resolved-revision (backend revision) 1542 (cond 1543 ((eq backend 'Git) 1544 (vc-git--rev-parse revision)) 1545 ((eq backend 'Hg) 1546 (with-temp-buffer 1547 (vc-hg-command (current-buffer) 0 nil 1548 "identify" "-r" revision "-i") 1549 (goto-char (point-min)) 1550 (buffer-substring-no-properties (point) (line-end-position)))) 1551 ((eq backend 'Bzr) 1552 (with-temp-buffer 1553 (vc-bzr-command (current-buffer) 0 nil 1554 "log" "--log-format=template" 1555 "--template-str='{revno}'" 1556 "-r" revision) 1557 (goto-char (point-min)) 1558 (buffer-substring-no-properties (point) (line-end-position)))) 1559 ((eq backend 'JJ) 1560 (car (last (vc-jj--process-lines "log" "--no-graph" 1561 "-r" revision 1562 "-T" "change_id" "-n" "1")))) 1563 (t 1564 revision))) 1565 1566 ;; TODO: Cache based on .git/index's mtime, maybe. 1567 (defun diff-hl-git-index-object-name (file) 1568 (with-temp-buffer 1569 (vc-git-command (current-buffer) 0 file "ls-files" "-s") 1570 (and 1571 (goto-char (point-min)) 1572 (re-search-forward "^[0-9]+ \\([0-9a-f]+\\)" nil t) 1573 (match-string-no-properties 1)))) 1574 1575 (defun diff-hl-git-index-revision (file object-name) 1576 (let ((filename (diff-hl-make-temp-file-name file 1577 (concat ";" object-name) 1578 'manual)) 1579 (filebuf (get-file-buffer file))) 1580 (unless (file-exists-p filename) 1581 (with-current-buffer filebuf 1582 (let ((coding-system-for-read 'no-conversion) 1583 (coding-system-for-write 'no-conversion)) 1584 (condition-case nil 1585 (with-temp-file filename 1586 (let ((outbuf (current-buffer))) 1587 ;; Change buffer to be inside the repo. 1588 (with-current-buffer filebuf 1589 (vc-git-command outbuf 0 nil 1590 "cat-file" "blob" object-name)))) 1591 (error 1592 (when (file-exists-p filename) 1593 (delete-file filename))))))) 1594 filename)) 1595 1596 ;;;###autoload 1597 (defun turn-on-diff-hl-mode () 1598 "Turn on `diff-hl-mode' or `diff-hl-dir-mode' in a buffer if appropriate." 1599 (cond 1600 (buffer-file-name 1601 (unless (and diff-hl-disable-on-remote 1602 (file-remote-p buffer-file-name)) 1603 (diff-hl-mode 1))) 1604 ((eq major-mode 'vc-dir-mode) 1605 (diff-hl-dir-mode 1)))) 1606 1607 ;;;###autoload 1608 (defun diff-hl--global-turn-on () 1609 "Call `turn-on-diff-hl-mode' if the current major mode is applicable." 1610 (when (cond ((eq diff-hl-global-modes t) 1611 t) 1612 ((eq (car-safe diff-hl-global-modes) 'not) 1613 (not (memq major-mode (cdr diff-hl-global-modes)))) 1614 (t (memq major-mode diff-hl-global-modes))) 1615 (turn-on-diff-hl-mode))) 1616 1617 (declare-function vc-annotate-extract-revision-at-line "vc-annotate") 1618 (declare-function diff-hl-amend-mode "diff-hl-amend") 1619 1620 ;;;###autoload 1621 (defun diff-hl-set-reference-rev (rev) 1622 "Set the reference revision globally to REV. 1623 When called interactively, REV read with completion. 1624 1625 When called with a prefix argument, reset the global reference to the most 1626 recent one instead. With two prefix arguments, do the same and discard 1627 every per-project reference created by 1628 `diff-hl-set-reference-rev-in-project`. 1629 1630 The default value chosen using one of methods below: 1631 1632 - In a log view buffer, it uses the revision of current entry. 1633 Call `vc-print-log' or `vc-print-root-log' first to open a log 1634 view buffer. 1635 - In a VC annotate buffer, it uses the revision of current line. 1636 - In other situations, it uses the symbol at point. 1637 1638 Notice that this sets the reference revision globally, so in files from 1639 other repositories, `diff-hl-mode' will not highlight changes correctly, 1640 until you run `diff-hl-reset-reference-rev'. To set the reference on a 1641 per-project basis, see `diff-hl-set-reference-rev-in-project`. 1642 1643 Also notice that this will disable `diff-hl-amend-mode' in 1644 buffers that enables it, since `diff-hl-amend-mode' overrides its 1645 effect." 1646 (interactive 1647 (if current-prefix-arg current-prefix-arg 1648 (let* ((def (or (and (equal major-mode 'vc-annotate-mode) 1649 (car (vc-annotate-extract-revision-at-line))) 1650 (log-view-current-tag) 1651 (thing-at-point 'symbol t))) 1652 (prompt (if def 1653 (format "Reference revision (default %s): " def) 1654 "Reference revision: "))) 1655 (list (vc-read-revision prompt nil nil def))))) 1656 (unless rev 1657 (user-error "No reference revision specified")) 1658 (cond 1659 ((equal '(4) current-prefix-arg) 1660 ;; reset global value 1661 (diff-hl-reset-reference-rev)) 1662 ((equal '(16) current-prefix-arg) 1663 ;; reset global value and remove per-project value 1664 (diff-hl-reset-reference-rev '(4))) 1665 ;; change only global value 1666 (t (setq-default diff-hl-reference-revision rev) 1667 (unless current-prefix-arg 1668 (message "Set global reference revision to %s" rev)) 1669 (dolist (buf (buffer-list)) 1670 (with-current-buffer buf 1671 (when diff-hl-mode 1672 (when (bound-and-true-p diff-hl-amend-mode) 1673 (diff-hl-amend-mode -1)) 1674 (when (not (local-variable-p 'diff-hl-reference-revision)) 1675 (diff-hl-update)))))))) 1676 1677 ;;;###autoload 1678 (defun diff-hl-set-reference-rev-in-project (rev) 1679 "Set the reference revision in the current project to REV. 1680 When called interactively, REV read with completion. 1681 1682 When called with a prefix argument, reset to the global value instead. 1683 1684 The default value chosen using one of methods below: 1685 1686 - In a log view buffer, it uses the revision of current entry. 1687 Call `vc-print-log' or `vc-print-root-log' first to open a log 1688 view buffer. 1689 - In a VC annotate buffer, it uses the revision of current line. 1690 - In other situations, it uses the symbol at point. 1691 1692 Projects whose reference was set with this command are unaffected by 1693 subsequent changes to the global reference (see 1694 `diff-hl-set-reference-rev`). 1695 1696 Also notice that this will disable `diff-hl-amend-mode' in 1697 buffers that enables it, since `diff-hl-amend-mode' overrides its 1698 effect." 1699 (interactive 1700 (if current-prefix-arg current-prefix-arg 1701 (let* ((def (or (and (equal major-mode 'vc-annotate-mode) 1702 (car (vc-annotate-extract-revision-at-line))) 1703 (log-view-current-tag) 1704 (thing-at-point 'symbol t))) 1705 (prompt (if def 1706 (format "Reference revision (default %s): " def) 1707 "Reference revision: "))) 1708 (list (vc-read-revision prompt nil nil def))))) 1709 (unless rev 1710 (user-error "No reference revision specified")) 1711 (let* ((proj (project-current)) 1712 (name (project-name proj))) 1713 (cond 1714 ;; reset 1715 (current-prefix-arg 1716 (diff-hl-reset-reference-rev-in-project proj)) 1717 ;; set 1718 (t 1719 (diff-hl-set-reference-rev-in-project-internal rev proj) 1720 (message "Showing changes against %s (project %s)" rev name))))) 1721 1722 (defun diff-hl--project-root (proj) 1723 ;; Emacs 26 and 27 don't have `project-root'. 1724 (expand-file-name (static-if (>= emacs-major-version 28) 1725 (project-root proj) 1726 (project-roots proj)))) 1727 1728 (defun diff-hl-set-reference-rev-in-project-internal (rev proj) 1729 (let* ((root (diff-hl--project-root proj))) 1730 ;; newly opened files will share this value 1731 (setf (alist-get root diff-hl-reference-revision-projects-cache 1732 nil nil #'string-equal) 1733 rev) 1734 ;; update currently open files 1735 (dolist (buf (project-buffers proj)) 1736 (with-current-buffer buf 1737 (when diff-hl-mode 1738 (when (bound-and-true-p diff-hl-amend-mode) 1739 (diff-hl-amend-mode -1)) 1740 (setq-local diff-hl-reference-revision rev) 1741 (diff-hl-update)))))) 1742 1743 ;;;###autoload 1744 (defun diff-hl-reset-reference-rev (&optional arg) 1745 "Reset the reference revision globally to the most recent one. 1746 1747 When called with a prefix argument, do the same and discard every 1748 per-project reference created by `diff-hl-set-reference-rev-in-project'." 1749 (interactive "P") 1750 (setq-default diff-hl-reference-revision nil) 1751 (when arg 1752 ;; reset all cache 1753 (setq diff-hl-reference-revision-projects-cache nil)) 1754 (dolist (buf (buffer-list)) 1755 (with-current-buffer buf 1756 (when diff-hl-mode 1757 (when arg 1758 ;; reset value in buffers 1759 (kill-local-variable 'diff-hl-reference-revision)) 1760 (when (bound-and-true-p diff-hl-amend-mode) 1761 (diff-hl-amend-mode -1)) 1762 ;; Don't touch buffers with the local reference (set by 1763 ;; `diff-hl-set-reference-rev-in-project' ), when called without a 1764 ;; prefix. 1765 (unless (local-variable-p 'diff-hl-reference-revision) 1766 (diff-hl-update))))) 1767 (message "Reference revision reset globally to the most recent revision")) 1768 1769 (defun diff-hl-reset-reference-rev-in-project (&optional proj) 1770 "Reset the reference revision in the project PROJ to the 1771 global value. 1772 1773 PROJ defaults to the current project." 1774 (interactive) 1775 (when-let* ((proj (or proj (project-current)))) 1776 ;; reset cache for the project 1777 (setq diff-hl-reference-revision-projects-cache 1778 (assoc-delete-all (diff-hl--project-root proj) 1779 diff-hl-reference-revision-projects-cache 1780 #'string-equal)) 1781 ;; reset value in project buffers 1782 (dolist (buf (project-buffers proj)) 1783 (with-current-buffer buf 1784 (when diff-hl-mode 1785 (when (bound-and-true-p diff-hl-amend-mode) 1786 (diff-hl-amend-mode -1)) 1787 (kill-local-variable 'diff-hl-reference-revision) 1788 (diff-hl-update)))) 1789 (message "Reference revision reset to the global value (project %s)" 1790 (project-name proj)))) 1791 1792 ;;;###autoload 1793 (define-globalized-minor-mode global-diff-hl-mode diff-hl-mode 1794 diff-hl--global-turn-on :after-hook (diff-hl-global-mode-change)) 1795 1796 (defun diff-hl-global-mode-change () 1797 (unless global-diff-hl-mode 1798 (dolist (buf (buffer-list)) 1799 (with-current-buffer buf 1800 (when diff-hl-dir-mode 1801 (diff-hl-dir-mode -1)))))) 1802 1803 (provide 'diff-hl) 1804 1805 ;;; diff-hl.el ends here