diff-hl.el (43766B)
1 ;;; diff-hl.el --- Highlight uncommitted changes using VC -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2012-2023 Free Software Foundation, Inc. 4 5 ;; Author: Dmitry Gutov <dgutov@yandex.ru> 6 ;; URL: https://github.com/dgutov/diff-hl 7 ;; Keywords: vc, diff 8 ;; Version: 1.9.2 9 ;; Package-Requires: ((cl-lib "0.2") (emacs "25.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 (declare-function smartrep-define-key 'smartrep)) 73 74 (defgroup diff-hl nil 75 "VC diff highlighting on the side of a window" 76 :group 'vc) 77 78 (defface diff-hl-insert 79 '((default :inherit diff-added) 80 (((class color)) :foreground "green4")) 81 "Face used to highlight inserted lines." 82 :group 'diff-hl) 83 84 (defface diff-hl-delete 85 '((default :inherit diff-removed) 86 (((class color)) :foreground "red3")) 87 "Face used to highlight deleted lines." 88 :group 'diff-hl) 89 90 (defface diff-hl-change 91 '((default :foreground "blue3") 92 (((class color) (min-colors 88) (background light)) 93 :background "#ddddff") 94 (((class color) (min-colors 88) (background dark)) 95 :background "#333355")) 96 "Face used to highlight changed lines." 97 :group 'diff-hl) 98 99 (defcustom diff-hl-command-prefix (kbd "C-x v") 100 "The prefix for all `diff-hl' commands." 101 :group 'diff-hl 102 :type 'string) 103 104 (defcustom diff-hl-draw-borders t 105 "Non-nil to draw borders around fringe indicators." 106 :group 'diff-hl 107 :type 'boolean) 108 109 (defcustom diff-hl-disable-on-remote nil 110 "Non-nil will disable `diff-hl' in remote buffers." 111 :group 'diff-hl 112 :type 'boolean) 113 114 (defcustom diff-hl-ask-before-revert-hunk t 115 "Non-nil to ask for confirmation before revert a hunk." 116 :group 'diff-hl 117 :type 'boolean) 118 119 (defcustom diff-hl-highlight-function 'diff-hl-highlight-on-fringe 120 "Function to highlight the current line. Its arguments are 121 overlay, change type and position within a hunk." 122 :group 'diff-hl 123 :type 'function) 124 125 (defcustom diff-hl-fringe-bmp-function 'diff-hl-fringe-bmp-from-pos 126 "Function to choose the fringe bitmap for a given change type 127 and position within a hunk. Should accept two arguments." 128 :group 'diff-hl 129 :type '(choice (const diff-hl-fringe-bmp-from-pos) 130 (const diff-hl-fringe-bmp-from-type) 131 function)) 132 133 (defcustom diff-hl-fringe-face-function 'diff-hl-fringe-face-from-type 134 "Function to choose the fringe face for a given change type 135 and position within a hunk. Should accept two arguments." 136 :group 'diff-hl 137 :type 'function) 138 139 (defcustom diff-hl-side 'left 140 "Which side to use for indicators." 141 :type '(choice (const left) 142 (const right)) 143 :initialize 'custom-initialize-default 144 :set (lambda (var value) 145 (let ((on (bound-and-true-p global-diff-hl-mode))) 146 (when on (global-diff-hl-mode -1)) 147 (set-default var value) 148 (when on (global-diff-hl-mode 1))))) 149 150 (defcustom diff-hl-highlight-revert-hunk-function 151 #'diff-hl-revert-narrow-to-hunk 152 "Function to emphasize the current hunk in `diff-hl-revert-hunk'. 153 The function is called at the beginning of the hunk and is passed 154 the end position as its only argument." 155 :type '(choice (const :tag "Do nothing" ignore) 156 (const :tag "Highlight the first column" 157 diff-hl-revert-highlight-first-column) 158 (const :tag "Narrow to the hunk" 159 diff-hl-revert-narrow-to-hunk))) 160 161 (defcustom diff-hl-global-modes '(not image-mode) 162 "Modes for which `diff-hl-mode' is automagically turned on. 163 This affects the behavior of `global-diff-hl-mode'. 164 If nil, no modes have `diff-hl-mode' automatically turned on. 165 If t, all modes have `diff-hl-mode' enabled. 166 If a list, it should be a list of `major-mode' symbol names for 167 which it should be automatically turned on. The sense of the list 168 is negated if it begins with `not'. As such, the default value 169 (not image-mode) 170 means that `diff-hl-mode' is turned on in all modes except for 171 `image-mode' buffers. Previously, `diff-hl-mode' caused worse 172 performance when viewing such files in certain conditions." 173 :type '(choice (const :tag "none" nil) 174 (const :tag "all" t) 175 (set :menu-tag "mode specific" :tag "modes" 176 :value (not) 177 (const :tag "Except" not) 178 (repeat :inline t (symbol :tag "mode")))) 179 :group 'diff-hl) 180 181 (defcustom diff-hl-show-staged-changes t 182 "Whether to include staged changes in the indicators. 183 Only affects Git, it's the only backend that has staging area." 184 :type 'boolean) 185 186 (defcustom diff-hl-goto-hunk-old-revisions nil 187 "When non-nil, `diff-hl-diff-goto-hunk' will always try to 188 navigate to the line in the diff that corresponds to the current 189 line in the file buffer (or as close as it can get to it). 190 191 When this variable is nil (default), `diff-hl-diff-goto-hunk' 192 only does that when called without the prefix argument, or when 193 the NEW revision is not specified (meaning, the diff is against 194 the current version of the file)." 195 :type 'boolean) 196 197 (defvar diff-hl-reference-revision nil 198 "Revision to diff against. nil means the most recent one.") 199 200 (defun diff-hl-define-bitmaps () 201 (let* ((scale (if (and (boundp 'text-scale-mode-amount) 202 (numberp text-scale-mode-amount)) 203 (expt text-scale-mode-step text-scale-mode-amount) 204 1)) 205 (spacing (or (and (display-graphic-p) (default-value 'line-spacing)) 0)) 206 (h (+ (ceiling (* (frame-char-height) scale)) 207 (if (floatp spacing) 208 (truncate (* (frame-char-height) spacing)) 209 spacing))) 210 (w (min (frame-parameter nil (intern (format "%s-fringe" diff-hl-side))) 211 16)) 212 (_ (when (zerop w) (setq w 16))) 213 (middle (make-vector h (expt 2 (1- w)))) 214 (ones (1- (expt 2 w))) 215 (top (copy-sequence middle)) 216 (bottom (copy-sequence middle)) 217 (single (copy-sequence middle))) 218 (aset top 0 ones) 219 (aset bottom (1- h) ones) 220 (aset single 0 ones) 221 (aset single (1- h) ones) 222 (define-fringe-bitmap 'diff-hl-bmp-top top h w 'top) 223 (define-fringe-bitmap 'diff-hl-bmp-middle middle h w 'center) 224 (define-fringe-bitmap 'diff-hl-bmp-bottom bottom h w 'bottom) 225 (define-fringe-bitmap 'diff-hl-bmp-single single h w 'top) 226 (define-fringe-bitmap 'diff-hl-bmp-i [3 3 0 3 3 3 3 3 3 3] nil 2 'center) 227 (let* ((w2 (* (/ w 2) 2)) 228 ;; When fringes are disabled, it's easier to fix up the width, 229 ;; instead of doing nothing (#20). 230 (w2 (if (zerop w2) 2 w2)) 231 (delete-row (- (expt 2 (1- w2)) 2)) 232 (middle-pos (1- (/ w2 2))) 233 (middle-bit (expt 2 middle-pos)) 234 (insert-bmp (make-vector w2 (* 3 middle-bit)))) 235 (define-fringe-bitmap 'diff-hl-bmp-delete (make-vector 2 delete-row) w2 w2) 236 (aset insert-bmp 0 0) 237 (aset insert-bmp middle-pos delete-row) 238 (aset insert-bmp (1+ middle-pos) delete-row) 239 (aset insert-bmp (1- w2) 0) 240 (define-fringe-bitmap 'diff-hl-bmp-insert insert-bmp w2 w2) 241 ))) 242 243 (defun diff-hl-maybe-define-bitmaps () 244 (when (window-system) ;; No fringes in the console. 245 (unless (fringe-bitmap-p 'diff-hl-bmp-empty) 246 (diff-hl-define-bitmaps) 247 (define-fringe-bitmap 'diff-hl-bmp-empty [0] 1 1 'center)))) 248 249 (defun diff-hl-maybe-redefine-bitmaps () 250 (when (window-system) 251 (diff-hl-define-bitmaps))) 252 253 (defvar diff-hl-spec-cache (make-hash-table :test 'equal)) 254 255 (defun diff-hl-fringe-spec (type pos side) 256 (let* ((key (list type pos side 257 diff-hl-fringe-face-function 258 diff-hl-fringe-bmp-function)) 259 (val (gethash key diff-hl-spec-cache))) 260 (unless val 261 (let* ((face-sym (funcall diff-hl-fringe-face-function type pos)) 262 (bmp-sym (funcall diff-hl-fringe-bmp-function type pos))) 263 (setq val (propertize " " 'display `((,(intern (format "%s-fringe" side)) 264 ,bmp-sym ,face-sym)))) 265 (puthash key val diff-hl-spec-cache))) 266 val)) 267 268 (defun diff-hl-fringe-face-from-type (type _pos) 269 (intern (format "diff-hl-%s" type))) 270 271 (defun diff-hl-fringe-bmp-from-pos (_type pos) 272 (intern (format "diff-hl-bmp-%s" pos))) 273 274 (defun diff-hl-fringe-bmp-from-type (type _pos) 275 (cl-case type 276 (unknown 'question-mark) 277 (change 'exclamation-mark) 278 (ignored 'diff-hl-bmp-i) 279 (t (intern (format "diff-hl-bmp-%s" type))))) 280 281 (defvar vc-svn-diff-switches) 282 (defvar vc-fossil-diff-switches) 283 284 (defmacro diff-hl-with-diff-switches (body) 285 `(let ((vc-git-diff-switches 286 ;; https://github.com/dgutov/diff-hl/issues/67 287 (cons "-U0" 288 ;; https://github.com/dgutov/diff-hl/issues/9 289 (and (boundp 'vc-git-diff-switches) 290 (listp vc-git-diff-switches) 291 (cl-remove-if-not 292 (lambda (arg) 293 (member arg '("--histogram" "--patience" "--minimal"))) 294 vc-git-diff-switches)))) 295 (vc-hg-diff-switches nil) 296 (vc-svn-diff-switches nil) 297 (vc-fossil-diff-switches '("-c" "0")) 298 (vc-diff-switches '("-U0")) 299 ,@(when (boundp 'vc-disable-async-diff) 300 '((vc-disable-async-diff t)))) 301 ,body)) 302 303 (defun diff-hl-modified-p (state) 304 (or (memq state '(edited conflict)) 305 (and (eq state 'up-to-date) 306 ;; VC state is stale in after-revert-hook. 307 (or revert-buffer-in-progress-p 308 ;; Diffing against an older revision. 309 diff-hl-reference-revision)))) 310 311 (declare-function vc-git-command "vc-git") 312 313 (defun diff-hl-changes-buffer (file backend) 314 (diff-hl-with-diff-switches 315 (diff-hl-diff-against-reference file backend " *diff-hl* "))) 316 317 (defun diff-hl-diff-against-reference (file backend buffer) 318 (if (and (eq backend 'Git) 319 (not diff-hl-reference-revision) 320 (not diff-hl-show-staged-changes)) 321 (apply #'vc-git-command buffer 1 322 (list file) 323 "diff-files" 324 (cons "-p" (vc-switches 'git 'diff))) 325 (condition-case err 326 (vc-call-backend backend 'diff (list file) 327 diff-hl-reference-revision nil 328 buffer) 329 (error 330 ;; https://github.com/dgutov/diff-hl/issues/117 331 (when (string-match-p "\\`Failed (status 128)" (error-message-string err)) 332 (vc-call-backend backend 'diff (list file) 333 "4b825dc642cb6eb9a060e54bf8d69288fbee4904" 334 nil 335 buffer))))) 336 buffer) 337 338 (defun diff-hl-changes () 339 (let* ((file buffer-file-name) 340 (backend (vc-backend file))) 341 (when backend 342 (let ((state (vc-state file backend))) 343 (cond 344 ((diff-hl-modified-p state) 345 (diff-hl-changes-from-buffer 346 (diff-hl-changes-buffer file backend))) 347 ((eq state 'added) 348 `((1 ,(line-number-at-pos (point-max)) insert))) 349 ((eq state 'removed) 350 `((1 ,(line-number-at-pos (point-max)) delete)))))))) 351 352 (defun diff-hl-changes-from-buffer (buf) 353 (with-current-buffer buf 354 (let (res) 355 (goto-char (point-min)) 356 (unless (eobp) 357 ;; TODO: When 27.1 is the minimum requirement, we can drop 358 ;; these bindings: that version, in addition to switching over 359 ;; to the diff-refine var, also added the 360 ;; called-interactively-p check, so refinement can't be 361 ;; triggered by code calling the navigation functions, only by 362 ;; direct interactive invocations. 363 (ignore-errors 364 (with-no-warnings 365 (let (diff-auto-refine-mode) 366 (diff-beginning-of-hunk t)))) 367 (while (looking-at diff-hunk-header-re-unified) 368 (let ((line (string-to-number (match-string 3))) 369 (len (let ((m (match-string 4))) 370 (if m (string-to-number m) 1))) 371 (beg (point))) 372 (with-no-warnings 373 (let (diff-auto-refine-mode) 374 (diff-end-of-hunk))) 375 (let* ((inserts (diff-count-matches "^\\+" beg (point))) 376 (deletes (diff-count-matches "^-" beg (point))) 377 (type (cond ((zerop deletes) 'insert) 378 ((zerop inserts) 'delete) 379 (t 'change)))) 380 (when (eq type 'delete) 381 (setq len 1) 382 (cl-incf line)) 383 (push (list line len type) res))))) 384 (nreverse res)))) 385 386 (defun diff-hl-update () 387 (let ((changes (diff-hl-changes)) 388 (current-line 1)) 389 (diff-hl-remove-overlays) 390 (save-excursion 391 (save-restriction 392 (widen) 393 (goto-char (point-min)) 394 (dolist (c changes) 395 (cl-destructuring-bind (line len type) c 396 (forward-line (- line current-line)) 397 (setq current-line line) 398 (let ((hunk-beg (point))) 399 (while (cl-plusp len) 400 (diff-hl-add-highlighting 401 type 402 (cond 403 ((not diff-hl-draw-borders) 'empty) 404 ((and (= len 1) (= line current-line)) 'single) 405 ((= len 1) 'bottom) 406 ((= line current-line) 'top) 407 (t 'middle))) 408 (forward-line 1) 409 (cl-incf current-line) 410 (cl-decf len)) 411 (let ((h (make-overlay hunk-beg (point))) 412 (hook '(diff-hl-overlay-modified))) 413 (overlay-put h 'diff-hl t) 414 (overlay-put h 'diff-hl-hunk t) 415 (overlay-put h 'diff-hl-hunk-type type) 416 (overlay-put h 'modification-hooks hook) 417 (overlay-put h 'insert-in-front-hooks hook) 418 (overlay-put h 'insert-behind-hooks hook))))))))) 419 420 (defvar-local diff-hl--modified-tick nil) 421 422 (put 'diff-hl--modified-tick 'permanent-local t) 423 424 (defun diff-hl-update-once () 425 (unless (equal diff-hl--modified-tick (buffer-chars-modified-tick)) 426 (diff-hl-update) 427 (setq diff-hl--modified-tick (buffer-chars-modified-tick)))) 428 429 (defun diff-hl-add-highlighting (type shape) 430 (let ((o (make-overlay (point) (point)))) 431 (overlay-put o 'diff-hl t) 432 (funcall diff-hl-highlight-function o type shape) 433 o)) 434 435 (defun diff-hl-highlight-on-fringe (ovl type shape) 436 (overlay-put ovl 'before-string (diff-hl-fringe-spec type shape 437 diff-hl-side))) 438 439 (defun diff-hl-remove-overlays (&optional beg end) 440 (save-restriction 441 (widen) 442 (dolist (o (overlays-in (or beg (point-min)) (or end (point-max)))) 443 (when (overlay-get o 'diff-hl) (delete-overlay o))))) 444 445 (defun diff-hl-overlay-modified (ov after-p _beg _end &optional _length) 446 "Delete the hunk overlay and all our line overlays inside it." 447 (unless after-p 448 (when (overlay-buffer ov) 449 (diff-hl-remove-overlays (overlay-start ov) (overlay-end ov)) 450 (delete-overlay ov)))) 451 452 (defvar diff-hl-timer nil) 453 454 (defun diff-hl-edit (_beg _end _len) 455 "DTRT when we've `undo'-ne the buffer into unmodified state." 456 (when undo-in-progress 457 (when diff-hl-timer 458 (cancel-timer diff-hl-timer)) 459 (setq diff-hl-timer 460 (run-with-idle-timer 0.01 nil #'diff-hl-after-undo (current-buffer))))) 461 462 (defun diff-hl-after-undo (buffer) 463 (with-current-buffer buffer 464 (unless (buffer-modified-p) 465 (diff-hl-update)))) 466 467 (defun diff-hl-after-revert () 468 (defvar revert-buffer-preserve-modes) 469 (when revert-buffer-preserve-modes 470 (diff-hl-update))) 471 472 (defun diff-hl-diff-goto-hunk-1 (historic) 473 (defvar vc-sentinel-movepoint) 474 (vc-buffer-sync) 475 (let* ((line (line-number-at-pos)) 476 (buffer (current-buffer)) 477 (rev1 diff-hl-reference-revision) 478 rev2) 479 (when historic 480 (let ((revs (diff-hl-diff-read-revisions rev1))) 481 (setq rev1 (car revs) 482 rev2 (cdr revs)))) 483 (vc-diff-internal t (vc-deduce-fileset) rev1 rev2 t) 484 (vc-run-delayed (if (< (line-number-at-pos (point-max)) 3) 485 (with-current-buffer buffer (diff-hl-remove-overlays)) 486 (when (or (not rev2) diff-hl-goto-hunk-old-revisions) 487 (diff-hl-diff-skip-to line)) 488 (setq vc-sentinel-movepoint (point)))))) 489 490 (defun diff-hl-diff-goto-hunk (&optional historic) 491 "Run VC diff command and go to the line corresponding to the current." 492 (interactive (list current-prefix-arg)) 493 (with-current-buffer (or (buffer-base-buffer) (current-buffer)) 494 (diff-hl-diff-goto-hunk-1 historic))) 495 496 (defun diff-hl-diff-read-revisions (rev1-default) 497 (let* ((file buffer-file-name) 498 (files (list file)) 499 (backend (vc-backend file)) 500 (rev2-default nil)) 501 (cond 502 ;; if the file is not up-to-date, use working revision as older revision 503 ((not (vc-up-to-date-p file)) 504 (setq rev1-default 505 (or rev1-default 506 (vc-working-revision file)))) 507 ((not rev1-default) 508 (setq rev1-default (ignore-errors ;If `previous-revision' doesn't work. 509 (vc-call-backend backend 'previous-revision file 510 (vc-working-revision file)))) 511 (when (string= rev1-default "") (setq rev1-default nil)))) 512 ;; finally read the revisions 513 (let* ((rev1-prompt (if rev1-default 514 (concat "Older revision (default " 515 rev1-default "): ") 516 "Older revision: ")) 517 (rev2-prompt (concat "Newer revision (default " 518 (or rev2-default "current source") "): ")) 519 (rev1 (vc-read-revision rev1-prompt files backend rev1-default)) 520 (rev2 (vc-read-revision rev2-prompt files backend rev2-default))) 521 (when (string= rev1 "") (setq rev1 nil)) 522 (when (string= rev2 "") (setq rev2 nil)) 523 (cons rev1 rev2)))) 524 525 (defun diff-hl-diff-skip-to (line) 526 "In `diff-mode', skip to the hunk and line corresponding to LINE 527 in the source file, or the last line of the hunk above it." 528 (goto-char (point-min)) ; Counteract any similar behavior in diff-mode. 529 (diff-hunk-next) 530 (let (found) 531 (while (and (looking-at diff-hunk-header-re-unified) (not found)) 532 (let ((hunk-line (string-to-number (match-string 3))) 533 (len (let ((m (match-string 4))) 534 (if m (string-to-number m) 1)))) 535 (if (> line (+ hunk-line len)) 536 (diff-hunk-next) 537 (setq found t) 538 (if (< line hunk-line) 539 ;; Retreat to the previous hunk. 540 (forward-line -1) 541 (let ((to-go (1+ (- line hunk-line)))) 542 (while (cl-plusp to-go) 543 (forward-line 1) 544 (unless (looking-at "^-") 545 (cl-decf to-go)))))))))) 546 547 (defface diff-hl-reverted-hunk-highlight 548 '((default :inverse-video t)) 549 "Face used to highlight the first column of the hunk to be reverted.") 550 551 (defun diff-hl-revert-highlight-first-column (end) 552 (re-search-forward "^[+-]") 553 (forward-line 0) 554 (setq end (diff-hl-split-away-changes 0)) 555 (let ((inhibit-read-only t)) 556 (save-excursion 557 (while (< (point) end) 558 (font-lock-prepend-text-property (point) (1+ (point)) 'font-lock-face 559 'diff-hl-reverted-hunk-highlight) 560 (forward-line 1))))) 561 562 (defun diff-hl-revert-narrow-to-hunk (end) 563 (narrow-to-region (point) end)) 564 565 (defun diff-hl-revert-hunk-1 () 566 (save-restriction 567 (widen) 568 (vc-buffer-sync) 569 (let* ((diff-buffer (get-buffer-create 570 (generate-new-buffer-name "*diff-hl*"))) 571 (buffer (current-buffer)) 572 (line (save-excursion 573 (diff-hl-find-current-hunk) 574 (line-number-at-pos))) 575 (file buffer-file-name) 576 (backend (vc-backend file))) 577 (unwind-protect 578 (progn 579 (vc-setup-buffer diff-buffer) 580 (diff-hl-diff-against-reference file backend diff-buffer) 581 (set-buffer diff-buffer) 582 (diff-mode) 583 (setq-local diff-vc-backend backend) 584 (setq-local diff-vc-revisions (list diff-hl-reference-revision nil)) 585 (setq buffer-read-only t) 586 (pop-to-buffer diff-buffer) 587 (vc-run-delayed 588 (vc-diff-finish diff-buffer nil) 589 (let (beg-line end-line m-beg m-end) 590 (when (eobp) 591 (with-current-buffer buffer (diff-hl-remove-overlays)) 592 (user-error "Buffer is up-to-date")) 593 (with-no-warnings 594 (let (diff-auto-refine-mode) 595 (diff-hl-diff-skip-to line))) 596 (setq m-end (diff-hl-split-away-changes 3)) 597 (setq m-beg (point-marker)) 598 (funcall diff-hl-highlight-revert-hunk-function m-end) 599 (setq beg-line (line-number-at-pos m-beg) 600 end-line (line-number-at-pos m-end)) 601 (let ((wbh (window-body-height))) 602 (if (>= wbh (- end-line beg-line)) 603 (recenter (/ (+ wbh (- beg-line end-line) 2) 2)) 604 (recenter 1))) 605 (with-no-warnings 606 (when diff-auto-refine-mode 607 (diff-refine-hunk))) 608 (if diff-hl-ask-before-revert-hunk 609 (unless (yes-or-no-p (format "Revert current hunk in %s? " 610 file)) 611 (user-error "Revert canceled"))) 612 (let ((diff-advance-after-apply-hunk nil)) 613 (save-window-excursion 614 (diff-apply-hunk t))) 615 (with-current-buffer buffer 616 (save-buffer)) 617 (message "Hunk reverted")))) 618 (quit-windows-on diff-buffer t))))) 619 620 (defun diff-hl-split-away-changes (max-context) 621 "Split away the minimal hunk at point from the rest of the hunk. 622 623 The minimal hunk is the hunk a diff program would produce if 624 asked for 0 lines of context. Add MAX-CONTEXT lines of context at 625 most (stop when encounter another minimal hunk). 626 627 Move point to the beginning of the delineated hunk and return 628 its end position." 629 (let (end-marker) 630 (save-excursion 631 (while (looking-at "[-+]") (forward-line 1)) 632 (dotimes (_i max-context) 633 (unless (looking-at "@\\|[-+]") 634 (forward-line 1))) 635 (setq end-marker (point-marker)) 636 (unless (or (eobp) 637 (looking-at "@")) 638 (diff-split-hunk))) 639 (unless (looking-at "[-+]") (forward-line -1)) 640 (while (looking-at "[-+]") (forward-line -1)) 641 (dotimes (_i max-context) 642 (unless (looking-at "@\\|[-+]") 643 (forward-line -1))) 644 (unless (looking-at "@") 645 (forward-line 1) 646 (diff-split-hunk)) 647 end-marker)) 648 649 (defun diff-hl-revert-hunk () 650 "Revert the diff hunk with changes at or above the point." 651 (interactive) 652 (with-current-buffer (or (buffer-base-buffer) (current-buffer)) 653 (diff-hl-revert-hunk-1))) 654 655 (defun diff-hl-hunk-overlay-at (pos) 656 (cl-loop for o in (overlays-in pos (1+ pos)) 657 when (overlay-get o 'diff-hl-hunk) 658 return o)) 659 660 (defun diff-hl-search-next-hunk (&optional backward point) 661 "Search the next hunk in the current buffer, or previous if BACKWARD." 662 (save-excursion 663 (when point 664 (goto-char point)) 665 (catch 'found 666 (while (not (if backward (bobp) (eobp))) 667 (goto-char (if backward 668 (previous-overlay-change (point)) 669 (next-overlay-change (point)))) 670 (let ((o (diff-hl-hunk-overlay-at (point)))) 671 (when (and o (= (overlay-start o) (point))) 672 (throw 'found o))))))) 673 674 (defun diff-hl-next-hunk (&optional backward) 675 "Go to the beginning of the next hunk in the current buffer." 676 (interactive) 677 (let ((overlay (diff-hl-search-next-hunk backward))) 678 (if overlay 679 (goto-char (overlay-start overlay)) 680 (user-error "No further hunks found")))) 681 682 (defun diff-hl-previous-hunk () 683 "Go to the beginning of the previous hunk in the current buffer." 684 (interactive) 685 (diff-hl-next-hunk t)) 686 687 (defun diff-hl-find-current-hunk () 688 (let (o) 689 (cond 690 ((diff-hl-hunk-overlay-at (point))) 691 ((setq o (diff-hl-search-next-hunk t)) 692 (goto-char (overlay-start o))) 693 (t 694 (diff-hl-next-hunk))))) 695 696 (defun diff-hl-mark-hunk () 697 (interactive) 698 (let ((hunk (diff-hl-hunk-overlay-at (point)))) 699 (unless hunk 700 (user-error "No hunk at point")) 701 (goto-char (overlay-start hunk)) 702 (push-mark (overlay-end hunk) nil t))) 703 704 (defun diff-hl--ensure-staging-supported () 705 (let ((backend (vc-backend buffer-file-name))) 706 (unless (eq backend 'Git) 707 (user-error "Only Git supports staging; this file is controlled by %s" backend)))) 708 709 (defun diff-hl-stage-current-hunk () 710 "Stage the hunk at or near point. 711 712 Only supported with Git." 713 (interactive) 714 (diff-hl--ensure-staging-supported) 715 (diff-hl-find-current-hunk) 716 (let* ((line (line-number-at-pos)) 717 (file buffer-file-name) 718 (dest-buffer (get-buffer-create " *diff-hl-stage*")) 719 (orig-buffer (current-buffer)) 720 (file-base (shell-quote-argument (file-name-nondirectory file))) 721 success) 722 (with-current-buffer dest-buffer 723 (let ((inhibit-read-only t)) 724 (erase-buffer))) 725 (diff-hl-diff-buffer-with-reference file dest-buffer nil 3) 726 (with-current-buffer dest-buffer 727 (with-no-warnings 728 (let (diff-auto-refine-mode) 729 (diff-hl-diff-skip-to line))) 730 (let ((inhibit-read-only t)) 731 (diff-hl-split-away-changes 3) 732 (save-excursion 733 (diff-end-of-hunk) 734 (delete-region (point) (point-max))) 735 (diff-beginning-of-hunk) 736 (delete-region (point-min) (point)) 737 ;; diff-no-select creates a very ugly header; Git rejects it 738 (insert (format "diff a/%s b/%s\n" file-base file-base)) 739 (insert (format "--- a/%s\n" file-base)) 740 (insert (format "+++ b/%s\n" file-base))) 741 (let ((patchfile (make-temp-file "diff-hl-stage-patch"))) 742 (write-region (point-min) (point-max) patchfile 743 nil 'silent) 744 (unwind-protect 745 (with-current-buffer orig-buffer 746 (with-output-to-string 747 (vc-git-command standard-output 0 748 patchfile 749 "apply" "--cached" )) 750 (setq success t)) 751 (delete-file patchfile)))) 752 (when success 753 (if diff-hl-show-staged-changes 754 (message (concat "Hunk staged; customize `diff-hl-show-staged-changes'" 755 " to highlight only unstages changes")) 756 (message "Hunk staged")) 757 (unless diff-hl-show-staged-changes 758 (diff-hl-update))))) 759 760 (defun diff-hl-unstage-file () 761 "Unstage all changes in the current file. 762 763 Only supported with Git." 764 (interactive) 765 (unless buffer-file-name 766 (user-error "No current file")) 767 (diff-hl--ensure-staging-supported) 768 (vc-git-command nil 0 buffer-file-name "reset") 769 (message "Unstaged all") 770 (unless diff-hl-show-staged-changes 771 (diff-hl-update))) 772 773 (defvar diff-hl-command-map 774 (let ((map (make-sparse-keymap))) 775 (define-key map "n" 'diff-hl-revert-hunk) 776 (define-key map "[" 'diff-hl-previous-hunk) 777 (define-key map "]" 'diff-hl-next-hunk) 778 (define-key map "*" 'diff-hl-show-hunk) 779 (define-key map "{" 'diff-hl-show-hunk-previous) 780 (define-key map "}" 'diff-hl-show-hunk-next) 781 (define-key map "S" 'diff-hl-stage-current-hunk) 782 map)) 783 (fset 'diff-hl-command-map diff-hl-command-map) 784 785 (defvar diff-hl-lighter "" 786 "Mode line lighter for Diff Hl. 787 788 The value of this variable is a mode line template as in 789 `mode-line-format'.") 790 791 ;;;###autoload 792 (define-minor-mode diff-hl-mode 793 "Toggle VC diff highlighting." 794 :lighter diff-hl-lighter 795 :keymap `(([remap vc-diff] . diff-hl-diff-goto-hunk) 796 (,diff-hl-command-prefix . diff-hl-command-map)) 797 (if diff-hl-mode 798 (progn 799 (diff-hl-maybe-define-bitmaps) 800 (add-hook 'after-save-hook 'diff-hl-update nil t) 801 (add-hook 'after-change-functions 'diff-hl-edit nil t) 802 (add-hook (if vc-mode 803 ;; Defer until the end of this hook, so that its 804 ;; elements can modify the update behavior. 805 'diff-hl-mode-on-hook 806 ;; If we're only opening the file now, 807 ;; `vc-find-file-hook' likely hasn't run yet, so 808 ;; let's wait until the state information is 809 ;; saved, in order not to fetch it twice. 810 'find-file-hook) 811 'diff-hl-update-once t t) 812 ;; Never removed because it acts globally. 813 (add-hook 'vc-checkin-hook 'diff-hl-after-checkin) 814 (add-hook 'after-revert-hook 'diff-hl-after-revert nil t) 815 ;; Magit does call `auto-revert-handler', but it usually 816 ;; doesn't do much, because `buffer-stale--default-function' 817 ;; doesn't care about changed VC state. 818 ;; https://github.com/magit/magit/issues/603 819 (add-hook 'magit-revert-buffer-hook 'diff-hl-update nil t) 820 ;; Magit versions 2.0-2.3 don't do the above and call this 821 ;; instead, but only when they don't call `revert-buffer': 822 (add-hook 'magit-not-reverted-hook 'diff-hl-update nil t) 823 (add-hook 'text-scale-mode-hook 'diff-hl-maybe-redefine-bitmaps nil t)) 824 (remove-hook 'after-save-hook 'diff-hl-update t) 825 (remove-hook 'after-change-functions 'diff-hl-edit t) 826 (remove-hook 'find-file-hook 'diff-hl-update t) 827 (remove-hook 'after-revert-hook 'diff-hl-update t) 828 (remove-hook 'magit-revert-buffer-hook 'diff-hl-update t) 829 (remove-hook 'magit-not-reverted-hook 'diff-hl-update t) 830 (remove-hook 'text-scale-mode-hook 'diff-hl-maybe-redefine-bitmaps t) 831 (diff-hl-remove-overlays))) 832 833 (defun diff-hl-after-checkin () 834 (let ((fileset (vc-deduce-fileset t))) 835 (dolist (file (nth 1 fileset)) 836 (let ((buf (find-buffer-visiting file))) 837 (when buf 838 (with-current-buffer buf 839 (when diff-hl-mode 840 (diff-hl-update)))))))) 841 842 (defvar diff-hl-repeat-exceptions '(diff-hl-show-hunk 843 diff-hl-show-hunk-previous 844 diff-hl-show-hunk-next)) 845 846 (when (require 'smartrep nil t) 847 (let (smart-keys) 848 (cl-labels ((scan (map) 849 (map-keymap 850 (lambda (event binding) 851 (if (consp binding) 852 (scan binding) 853 (when (and (characterp event) 854 (not (memq binding diff-hl-repeat-exceptions))) 855 (push (cons (string event) binding) smart-keys)))) 856 map))) 857 (scan diff-hl-command-map) 858 (smartrep-define-key diff-hl-mode-map diff-hl-command-prefix smart-keys)))) 859 860 ;; Integrate with `repeat-mode' in Emacs 28 (https://debbugs.gnu.org/47566) 861 ;; 862 ;; While smartrep feels solid, it looks kinda abandoned. And the 863 ;; chances of it being put into GNU ELPA are slim too. 864 (map-keymap 865 (lambda (_key cmd) 866 (unless (memq cmd diff-hl-repeat-exceptions) 867 (put cmd 'repeat-map 'diff-hl-command-map))) 868 diff-hl-command-map) 869 870 (declare-function magit-toplevel "magit-git") 871 (declare-function magit-unstaged-files "magit-git") 872 873 (defvar diff-hl--magit-unstaged-files nil) 874 875 (defun diff-hl-magit-pre-refresh () 876 (unless (and diff-hl-disable-on-remote 877 (file-remote-p default-directory)) 878 (setq diff-hl--magit-unstaged-files (magit-unstaged-files t)))) 879 880 (defun diff-hl-magit-post-refresh () 881 (unless (and diff-hl-disable-on-remote 882 (file-remote-p default-directory)) 883 (let* ((topdir (magit-toplevel)) 884 (modified-files 885 (mapcar (lambda (file) (expand-file-name file topdir)) 886 (delete-consecutive-dups 887 (sort 888 (nconc (magit-unstaged-files t) 889 diff-hl--magit-unstaged-files) 890 #'string<)))) 891 (unmodified-states '(up-to-date ignored unregistered))) 892 (setq diff-hl--magit-unstaged-files nil) 893 (dolist (buf (buffer-list)) 894 (when (and (buffer-local-value 'diff-hl-mode buf) 895 (not (buffer-modified-p buf)) 896 ;; Solve the "cloned indirect buffer" problem 897 ;; (diff-hl-mode could be non-nil there, even if 898 ;; buffer-file-name is nil): 899 (buffer-file-name buf) 900 (file-in-directory-p (buffer-file-name buf) topdir) 901 (file-exists-p (buffer-file-name buf))) 902 (with-current-buffer buf 903 (let* ((file buffer-file-name) 904 (backend (vc-backend file))) 905 (when backend 906 (cond 907 ((member file modified-files) 908 (when (memq (vc-state file) unmodified-states) 909 (vc-state-refresh file backend)) 910 (diff-hl-update)) 911 ((not (memq (vc-state file backend) unmodified-states)) 912 (vc-state-refresh file backend) 913 (diff-hl-update))))))))))) 914 915 (defun diff-hl-dir-update () 916 (dolist (pair (if (vc-dir-marked-files) 917 (vc-dir-marked-only-files-and-states) 918 (vc-dir-child-files-and-states))) 919 (when (eq 'up-to-date (cdr pair)) 920 (let ((buffer (find-buffer-visiting (car pair)))) 921 (when buffer 922 (with-current-buffer buffer 923 (diff-hl-remove-overlays))))))) 924 925 (define-minor-mode diff-hl-dir-mode 926 "Toggle `diff-hl-mode' integration in a `vc-dir-mode' buffer." 927 :lighter "" 928 (if diff-hl-dir-mode 929 (add-hook 'vc-checkin-hook 'diff-hl-dir-update t t) 930 (remove-hook 'vc-checkin-hook 'diff-hl-dir-update t))) 931 932 (defun diff-hl-make-temp-file-name (file rev &optional manual) 933 "Return a backup file name for REV or the current version of FILE. 934 If MANUAL is non-nil it means that a name for backups created by 935 the user should be returned." 936 (let* ((auto-save-file-name-transforms 937 `((".*" ,temporary-file-directory t))) 938 (buffer-file-name file)) 939 (expand-file-name 940 (concat (make-auto-save-file-name) 941 ".~" (subst-char-in-string 942 ?/ ?_ rev) 943 (unless manual ".") "~") 944 temporary-file-directory))) 945 946 (defun diff-hl-create-revision (file revision) 947 "Read REVISION of FILE into a buffer and return the buffer." 948 (let ((automatic-backup (diff-hl-make-temp-file-name file revision)) 949 (filebuf (get-file-buffer file)) 950 (filename (diff-hl-make-temp-file-name file revision 'manual))) 951 (unless (file-exists-p filename) 952 (if (file-exists-p automatic-backup) 953 (rename-file automatic-backup filename nil) 954 (with-current-buffer filebuf 955 (let ((coding-system-for-read 'no-conversion) 956 (coding-system-for-write 'no-conversion)) 957 (condition-case nil 958 (with-temp-file filename 959 (let ((outbuf (current-buffer))) 960 ;; Change buffer to get local value of 961 ;; vc-checkout-switches. 962 (with-current-buffer filebuf 963 (vc-call find-revision file revision outbuf)))) 964 (error 965 (when (file-exists-p filename) 966 (delete-file filename)))))))) 967 filename)) 968 969 (defun diff-hl-working-revision (file &optional backend) 970 "Like vc-working-revision, but always up-to-date" 971 (vc-file-setprop file 'vc-working-revision 972 (vc-call-backend (or backend (vc-backend file)) 973 'working-revision file))) 974 975 (declare-function diff-no-select "diff") 976 977 (defun diff-hl-diff-buffer-with-reference (file &optional dest-buffer backend context-lines) 978 "Compute the diff between the current buffer contents and reference in BACKEND. 979 The diffs are computed in the buffer DEST-BUFFER. This requires 980 the `diff-program' to be in your `exec-path'. 981 CONTEXT-LINES is the size of the unified diff context, defaults to 0." 982 (require 'diff) 983 (vc-ensure-vc-buffer) 984 (save-current-buffer 985 (let* ((dest-buffer (or dest-buffer "*diff-hl-diff-buffer-with-reference*")) 986 (backend (or backend (vc-backend file))) 987 (temporary-file-directory 988 (if (file-directory-p "/dev/shm/") 989 "/dev/shm/" 990 temporary-file-directory)) 991 (rev 992 (if (and (eq backend 'Git) 993 (not diff-hl-reference-revision) 994 (not diff-hl-show-staged-changes)) 995 (diff-hl-git-index-revision 996 file 997 (diff-hl-git-index-object-name file)) 998 (diff-hl-create-revision 999 file 1000 (or diff-hl-reference-revision 1001 (diff-hl-working-revision file backend))))) 1002 (switches (format "-U %d --strip-trailing-cr" (or context-lines 0)))) 1003 (diff-no-select rev (current-buffer) switches 'noasync 1004 (get-buffer-create dest-buffer)) 1005 (with-current-buffer dest-buffer 1006 (let ((inhibit-read-only t)) 1007 ;; Function `diff-sentinel' adds a final line, so remove it 1008 (delete-matching-lines "^Diff finished.*"))) 1009 (get-buffer-create dest-buffer)))) 1010 1011 ;; TODO: Cache based on .git/index's mtime, maybe. 1012 (defun diff-hl-git-index-object-name (file) 1013 (with-temp-buffer 1014 (vc-git-command (current-buffer) 0 file "ls-files" "-s") 1015 (and 1016 (goto-char (point-min)) 1017 (re-search-forward "^[0-9]+ \\([0-9a-f]+\\)") 1018 (match-string-no-properties 1)))) 1019 1020 (defun diff-hl-git-index-revision (file object-name) 1021 (let ((filename (diff-hl-make-temp-file-name file 1022 (concat ":" object-name) 1023 'manual)) 1024 (filebuf (get-file-buffer file))) 1025 (unless (file-exists-p filename) 1026 (with-current-buffer filebuf 1027 (let ((coding-system-for-read 'no-conversion) 1028 (coding-system-for-write 'no-conversion)) 1029 (condition-case nil 1030 (with-temp-file filename 1031 (let ((outbuf (current-buffer))) 1032 ;; Change buffer to be inside the repo. 1033 (with-current-buffer filebuf 1034 (vc-git-command outbuf 0 nil 1035 "cat-file" "blob" object-name)))) 1036 (error 1037 (when (file-exists-p filename) 1038 (delete-file filename))))))) 1039 filename)) 1040 1041 ;;;###autoload 1042 (defun turn-on-diff-hl-mode () 1043 "Turn on `diff-hl-mode' or `diff-hl-dir-mode' in a buffer if appropriate." 1044 (cond 1045 (buffer-file-name 1046 (unless (and diff-hl-disable-on-remote 1047 (file-remote-p buffer-file-name)) 1048 (diff-hl-mode 1))) 1049 ((eq major-mode 'vc-dir-mode) 1050 (diff-hl-dir-mode 1)))) 1051 1052 ;;;###autoload 1053 (defun diff-hl--global-turn-on () 1054 "Call `turn-on-diff-hl-mode' if the current major mode is applicable." 1055 (when (cond ((eq diff-hl-global-modes t) 1056 t) 1057 ((eq (car-safe diff-hl-global-modes) 'not) 1058 (not (memq major-mode (cdr diff-hl-global-modes)))) 1059 (t (memq major-mode diff-hl-global-modes))) 1060 (turn-on-diff-hl-mode))) 1061 1062 (declare-function vc-annotate-extract-revision-at-line "vc-annotate") 1063 (declare-function diff-hl-amend-mode "diff-hl-amend") 1064 1065 ;;;###autoload 1066 (defun diff-hl-set-reference-rev (rev) 1067 "Set the reference revision globally to REV. 1068 When called interactively, REV read with completion. 1069 1070 The default value chosen using one of methods below: 1071 1072 - In a log view buffer, it uses the revision of current entry. 1073 Call `vc-print-log' or `vc-print-root-log' first to open a log 1074 view buffer. 1075 - In a VC annotate buffer, it uses the revision of current line. 1076 - In other situations, it uses the symbol at point. 1077 1078 Notice that this sets the reference revision globally, so in 1079 files from other repositories, `diff-hl-mode' will not highlight 1080 changes correctly, until you run `diff-hl-reset-reference-rev'. 1081 1082 Also notice that this will disable `diff-hl-amend-mode' in 1083 buffers that enables it, since `diff-hl-amend-mode' overrides its 1084 effect." 1085 (interactive 1086 (let* ((def (or (and (equal major-mode 'vc-annotate-mode) 1087 (car (vc-annotate-extract-revision-at-line))) 1088 (log-view-current-tag) 1089 (thing-at-point 'symbol t))) 1090 (prompt (if def 1091 (format "Reference revision (default %s): " def) 1092 "Reference revision: "))) 1093 (list (vc-read-revision prompt nil nil def)))) 1094 (if rev 1095 (message "Set reference revision to %s" rev) 1096 (user-error "No reference revision specified")) 1097 (setq diff-hl-reference-revision rev) 1098 (dolist (buf (buffer-list)) 1099 (with-current-buffer buf 1100 (when diff-hl-mode 1101 (when (bound-and-true-p diff-hl-amend-mode) 1102 (diff-hl-amend-mode -1)) 1103 (diff-hl-update))))) 1104 1105 ;;;###autoload 1106 (defun diff-hl-reset-reference-rev () 1107 "Reset the reference revision globally to the most recent one." 1108 (interactive) 1109 (setq diff-hl-reference-revision nil) 1110 (dolist (buf (buffer-list)) 1111 (with-current-buffer buf 1112 (when diff-hl-mode 1113 (diff-hl-update))))) 1114 1115 ;;;###autoload 1116 (define-globalized-minor-mode global-diff-hl-mode diff-hl-mode 1117 diff-hl--global-turn-on :after-hook (diff-hl-global-mode-change)) 1118 1119 (defun diff-hl-global-mode-change () 1120 (unless global-diff-hl-mode 1121 (dolist (buf (buffer-list)) 1122 (with-current-buffer buf 1123 (when diff-hl-dir-mode 1124 (diff-hl-dir-mode -1)))))) 1125 1126 (provide 'diff-hl) 1127 1128 ;;; diff-hl.el ends here