code.delx.au - gnu-emacs-elpa/blob - packages/diff-hl/diff-hl.el

   1 ;;; diff-hl.el --- Highlight uncommitted changes using VC -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2012-2016  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.8.4
   9 ;; Package-Requires: ((cl-lib "0.2"))
  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 <http://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 ;;
  39 ;; The mode takes advantage of `smartrep' if it is installed.
  40
  41 ;; Add either of the following to your init file.
  42 ;;
  43 ;; To use it in all buffers:
  44 ;;
  45 ;; (global-diff-hl-mode)
  46 ;;
  47 ;; Only in `prog-mode' buffers, with `vc-dir' integration:
  48 ;;
  49 ;; (add-hook 'prog-mode-hook 'turn-on-diff-hl-mode)
  50 ;; (add-hook 'vc-dir-mode-hook 'turn-on-diff-hl-mode)
  51
  52 ;;; Code:
  53
  54 (require 'fringe)
  55 (require 'diff-mode)
  56 (require 'vc)
  57 (require 'vc-dir)
  58 (eval-when-compile
  59   (require 'cl-lib)
  60   (require 'vc-git)
  61   (require 'vc-hg)
  62   (require 'face-remap)
  63   (declare-function smartrep-define-key 'smartrep))
  64
  65 (defgroup diff-hl nil
  66   "VC diff highlighting on the side of a window"
  67   :group 'vc)
  68
  69 (defface diff-hl-insert
  70   '((default :inherit diff-added)
  71     (((class color)) :foreground "green4"))
  72   "Face used to highlight inserted lines."
  73   :group 'diff-hl)
  74
  75 (defface diff-hl-delete
  76   '((default :inherit diff-removed)
  77     (((class color)) :foreground "red3"))
  78   "Face used to highlight deleted lines."
  79   :group 'diff-hl)
  80
  81 (defface diff-hl-change
  82   '((default :foreground "blue3")
  83     (((class color) (min-colors 88) (background light))
  84      :background "#ddddff")
  85     (((class color) (min-colors 88) (background dark))
  86      :background "#333355"))
  87   "Face used to highlight changed lines."
  88   :group 'diff-hl)
  89
  90 (defcustom diff-hl-command-prefix (kbd "C-x v")
  91   "The prefix for all `diff-hl' commands."
  92   :group 'diff-hl
  93   :type 'string)
  94
  95 (defcustom diff-hl-draw-borders t
  96   "Non-nil to draw borders around fringe indicators."
  97   :group 'diff-hl
  98   :type 'boolean)
  99
 100 (defcustom diff-hl-highlight-function 'diff-hl-highlight-on-fringe
 101   "Function to highlight the current line. Its arguments are
 102   overlay, change type and position within a hunk."
 103   :group 'diff-hl
 104   :type 'function)
 105
 106 (defcustom diff-hl-fringe-bmp-function 'diff-hl-fringe-bmp-from-pos
 107   "Function to choose the fringe bitmap for a given change type
 108   and position within a hunk.  Should accept two arguments."
 109   :group 'diff-hl
 110   :type '(choice (const diff-hl-fringe-bmp-from-pos)
 111                  (const diff-hl-fringe-bmp-from-type)
 112                  function))
 113
 114 (defcustom diff-hl-fringe-face-function 'diff-hl-fringe-face-from-type
 115   "Function to choose the fringe face for a given change type
 116   and position within a hunk.  Should accept two arguments."
 117   :group 'diff-hl
 118   :type 'function)
 119
 120 (defcustom diff-hl-side 'left
 121   "Which side to use for indicators."
 122   :type '(choice (const left)
 123                  (const right))
 124   :set (lambda (var value)
 125          (let ((on (bound-and-true-p global-diff-hl-mode)))
 126            (when on (global-diff-hl-mode -1))
 127            (set-default var value)
 128            (when on (global-diff-hl-mode 1)))))
 129
 130 (defvar diff-hl-reference-revision nil
 131   "Revision to diff against.  nil means the most recent one.")
 132
 133 (defun diff-hl-define-bitmaps ()
 134   (let* ((scale (if (and (boundp 'text-scale-mode-amount)
 135                          (numberp text-scale-mode-amount))
 136                     (expt text-scale-mode-step text-scale-mode-amount)
 137                   1))
 138          (spacing (or (and (display-graphic-p) (default-value 'line-spacing)) 0))
 139          (h (+ (ceiling (* (frame-char-height) scale))
 140                (if (floatp spacing)
 141                    (truncate (* (frame-char-height) spacing))
 142                  spacing)))
 143          (w (min (frame-parameter nil (intern (format "%s-fringe" diff-hl-side)))
 144                  16))
 145          (middle (make-vector h (expt 2 (1- w))))
 146          (ones (1- (expt 2 w)))
 147          (top (copy-sequence middle))
 148          (bottom (copy-sequence middle))
 149          (single (copy-sequence middle)))
 150     (aset top 0 ones)
 151     (aset bottom (1- h) ones)
 152     (aset single 0 ones)
 153     (aset single (1- h) ones)
 154     (define-fringe-bitmap 'diff-hl-bmp-top top h w 'top)
 155     (define-fringe-bitmap 'diff-hl-bmp-middle middle h w 'center)
 156     (define-fringe-bitmap 'diff-hl-bmp-bottom bottom h w 'bottom)
 157     (define-fringe-bitmap 'diff-hl-bmp-single single h w 'top)
 158     (define-fringe-bitmap 'diff-hl-bmp-i [3 3 0 3 3 3 3 3 3 3] nil 2 'center)
 159     (let* ((w2 (* (/ w 2) 2))
 160            ;; When fringes are disabled, it's easier to fix up the width,
 161            ;; instead of doing nothing (#20).
 162            (w2 (if (zerop w2) 2 w2))
 163            (delete-row (- (expt 2 (1- w2)) 2))
 164            (middle-pos (1- (/ w2 2)))
 165            (middle-bit (expt 2 middle-pos))
 166            (insert-bmp (make-vector w2 (* 3 middle-bit))))
 167       (define-fringe-bitmap 'diff-hl-bmp-delete (make-vector 2 delete-row) w2 w2)
 168       (aset insert-bmp 0 0)
 169       (aset insert-bmp middle-pos delete-row)
 170       (aset insert-bmp (1+ middle-pos) delete-row)
 171       (aset insert-bmp (1- w2) 0)
 172       (define-fringe-bitmap 'diff-hl-bmp-insert insert-bmp w2 w2)
 173       )))
 174
 175 (defun diff-hl-maybe-define-bitmaps ()
 176   (when (window-system) ;; No fringes in the console.
 177     (unless (fringe-bitmap-p 'diff-hl-bmp-empty)
 178       (diff-hl-define-bitmaps)
 179       (define-fringe-bitmap 'diff-hl-bmp-empty [0] 1 1 'center))))
 180
 181 (defvar diff-hl-spec-cache (make-hash-table :test 'equal))
 182
 183 (defun diff-hl-fringe-spec (type pos side)
 184   (let* ((key (list type pos side
 185                     diff-hl-fringe-face-function
 186                     diff-hl-fringe-bmp-function))
 187          (val (gethash key diff-hl-spec-cache)))
 188     (unless val
 189       (let* ((face-sym (funcall diff-hl-fringe-face-function type pos))
 190              (bmp-sym (funcall diff-hl-fringe-bmp-function type pos)))
 191         (setq val (propertize " " 'display `((,(intern (format "%s-fringe" side))
 192                                               ,bmp-sym ,face-sym))))
 193         (puthash key val diff-hl-spec-cache)))
 194     val))
 195
 196 (defun diff-hl-fringe-face-from-type (type _pos)
 197   (intern (format "diff-hl-%s" type)))
 198
 199 (defun diff-hl-fringe-bmp-from-pos (_type pos)
 200   (intern (format "diff-hl-bmp-%s" pos)))
 201
 202 (defun diff-hl-fringe-bmp-from-type (type _pos)
 203   (cl-case type
 204     (unknown 'question-mark)
 205     (change 'exclamation-mark)
 206     (ignored 'diff-hl-bmp-i)
 207     (t (intern (format "diff-hl-bmp-%s" type)))))
 208
 209 (defvar vc-svn-diff-switches)
 210
 211 (defmacro diff-hl-with-diff-switches (body)
 212   `(let ((vc-git-diff-switches
 213           ;; https://github.com/dgutov/diff-hl/issues/67
 214           (cons "-U0"
 215                 ;; https://github.com/dgutov/diff-hl/issues/9
 216                 (and (boundp 'vc-git-diff-switches)
 217                      (listp vc-git-diff-switches)
 218                      (cl-remove-if-not
 219                       (lambda (arg)
 220                         (member arg '("--histogram" "--patience" "--minimal")))
 221                       vc-git-diff-switches))))
 222          (vc-hg-diff-switches nil)
 223          (vc-svn-diff-switches nil)
 224          (vc-diff-switches '("-U0"))
 225          ,@(when (boundp 'vc-disable-async-diff)
 226              '((vc-disable-async-diff t))))
 227      ,body))
 228
 229 (defun diff-hl-modified-p (state)
 230   (or (eq state 'edited)
 231       (and (eq state 'up-to-date)
 232            ;; VC state is stale in after-revert-hook.
 233            (or revert-buffer-in-progress-p
 234                ;; Diffing against an older revision.
 235                diff-hl-reference-revision))))
 236
 237 (defun diff-hl-changes-buffer (file backend)
 238   (let ((buf-name " *diff-hl* "))
 239     (diff-hl-with-diff-switches
 240      (vc-call-backend backend 'diff (list file)
 241                       diff-hl-reference-revision nil
 242                       buf-name))
 243     buf-name))
 244
 245 (defun diff-hl-changes ()
 246   (let* ((file buffer-file-name)
 247          (backend (vc-backend file)))
 248     (when backend
 249       (let ((state (vc-state file backend)))
 250         (cond
 251          ((diff-hl-modified-p state)
 252           (let* (diff-auto-refine-mode res)
 253             (with-current-buffer (diff-hl-changes-buffer file backend)
 254               (goto-char (point-min))
 255               (unless (eobp)
 256                 (ignore-errors
 257                   (diff-beginning-of-hunk t))
 258                 (while (looking-at diff-hunk-header-re-unified)
 259                   (let ((line (string-to-number (match-string 3)))
 260                         (len (let ((m (match-string 4)))
 261                                (if m (string-to-number m) 1)))
 262                         (beg (point)))
 263                     (diff-end-of-hunk)
 264                     (let* ((inserts (diff-count-matches "^\\+" beg (point)))
 265                            (deletes (diff-count-matches "^-" beg (point)))
 266                            (type (cond ((zerop deletes) 'insert)
 267                                        ((zerop inserts) 'delete)
 268                                        (t 'change))))
 269                       (when (eq type 'delete)
 270                         (setq len 1)
 271                         (cl-incf line))
 272                       (push (list line len type) res))))))
 273             (nreverse res)))
 274          ((eq state 'added)
 275           `((1 ,(line-number-at-pos (point-max)) insert)))
 276          ((eq state 'removed)
 277           `((1 ,(line-number-at-pos (point-max)) delete))))))))
 278
 279 (defun diff-hl-update ()
 280   (let ((changes (diff-hl-changes))
 281         (current-line 1))
 282     (diff-hl-remove-overlays)
 283     (save-excursion
 284       (save-restriction
 285         (widen)
 286         (goto-char (point-min))
 287         (dolist (c changes)
 288           (cl-destructuring-bind (line len type) c
 289             (forward-line (- line current-line))
 290             (setq current-line line)
 291             (let ((hunk-beg (point)))
 292               (while (cl-plusp len)
 293                 (diff-hl-add-highlighting
 294                  type
 295                  (cond
 296                   ((not diff-hl-draw-borders) 'empty)
 297                   ((and (= len 1) (= line current-line)) 'single)
 298                   ((= len 1) 'bottom)
 299                   ((= line current-line) 'top)
 300                   (t 'middle)))
 301                 (forward-line 1)
 302                 (cl-incf current-line)
 303                 (cl-decf len))
 304               (let ((h (make-overlay hunk-beg (point)))
 305                     (hook '(diff-hl-overlay-modified)))
 306                 (overlay-put h 'diff-hl t)
 307                 (overlay-put h 'diff-hl-hunk t)
 308                 (overlay-put h 'modification-hooks hook)
 309                 (overlay-put h 'insert-in-front-hooks hook)
 310                 (overlay-put h 'insert-behind-hooks hook)))))))))
 311
 312 (defun diff-hl-add-highlighting (type shape)
 313   (let ((o (make-overlay (point) (point))))
 314     (overlay-put o 'diff-hl t)
 315     (funcall diff-hl-highlight-function o type shape)
 316     o))
 317
 318 (defun diff-hl-highlight-on-fringe (ovl type shape)
 319   (overlay-put ovl 'before-string (diff-hl-fringe-spec type shape
 320                                                        diff-hl-side)))
 321
 322 (defun diff-hl-remove-overlays (&optional beg end)
 323   (save-restriction
 324     (widen)
 325     (dolist (o (overlays-in (or beg (point-min)) (or end (point-max))))
 326       (when (overlay-get o 'diff-hl) (delete-overlay o)))))
 327
 328 (defun diff-hl-overlay-modified (ov after-p _beg _end &optional _length)
 329   "Delete the hunk overlay and all our line overlays inside it."
 330   (unless after-p
 331     (when (overlay-buffer ov)
 332       (diff-hl-remove-overlays (overlay-start ov) (overlay-end ov))
 333       (delete-overlay ov))))
 334
 335 (defvar diff-hl-timer nil)
 336
 337 (defun diff-hl-edit (_beg _end _len)
 338   "DTRT when we've `undo'-ne the buffer into unmodified state."
 339   (when undo-in-progress
 340     (when diff-hl-timer
 341       (cancel-timer diff-hl-timer))
 342     (setq diff-hl-timer
 343           (run-with-idle-timer 0.01 nil #'diff-hl-after-undo (current-buffer)))))
 344
 345 (defun diff-hl-after-undo (buffer)
 346   (with-current-buffer buffer
 347     (unless (buffer-modified-p)
 348       (diff-hl-update))))
 349
 350 (defun diff-hl-diff-goto-hunk ()
 351   "Run VC diff command and go to the line corresponding to the current."
 352   (interactive)
 353   (vc-buffer-sync)
 354   (let* ((line (line-number-at-pos))
 355          (buffer (current-buffer)))
 356     (vc-diff-internal t (vc-deduce-fileset) diff-hl-reference-revision nil t)
 357     (vc-exec-after `(if (< (line-number-at-pos (point-max)) 3)
 358                         (with-current-buffer ,buffer (diff-hl-remove-overlays))
 359                       (diff-hl-diff-skip-to ,line)
 360                       (setq vc-sentinel-movepoint (point))))))
 361
 362 (defun diff-hl-diff-skip-to (line)
 363   "In `diff-mode', skip to the hunk and line corresponding to LINE
 364 in the source file, or the last line of the hunk above it."
 365   (diff-hunk-next)
 366   (let (found)
 367     (while (and (looking-at diff-hunk-header-re-unified) (not found))
 368       (let ((hunk-line (string-to-number (match-string 3)))
 369             (len (let ((m (match-string 4)))
 370                    (if m (string-to-number m) 1))))
 371         (if (> line (+ hunk-line len))
 372             (diff-hunk-next)
 373           (setq found t)
 374           (if (< line hunk-line)
 375               ;; Retreat to the previous hunk.
 376               (forward-line -1)
 377             (let ((to-go (1+ (- line hunk-line))))
 378               (while (cl-plusp to-go)
 379                 (forward-line 1)
 380                 (unless (looking-at "^-")
 381                   (cl-decf to-go))))))))))
 382
 383 (defun diff-hl-revert-hunk ()
 384   "Revert the diff hunk with changes at or above the point."
 385   (interactive)
 386   (vc-buffer-sync)
 387   (let ((diff-buffer (generate-new-buffer-name "*diff-hl*"))
 388         (buffer (current-buffer))
 389         (line (save-excursion
 390                 (unless (diff-hl-hunk-overlay-at (point))
 391                   (diff-hl-previous-hunk))
 392                 (line-number-at-pos)))
 393         (fileset (vc-deduce-fileset)))
 394     (unwind-protect
 395         (progn
 396           (vc-diff-internal nil fileset diff-hl-reference-revision nil
 397                             nil diff-buffer)
 398           (vc-exec-after
 399            `(let (beg-line end-line)
 400               (when (eobp)
 401                 (with-current-buffer ,buffer (diff-hl-remove-overlays))
 402                 (error "Buffer is up-to-date"))
 403               (let (diff-auto-refine-mode)
 404                 (diff-hl-diff-skip-to ,line))
 405               (save-excursion
 406                 (while (looking-at "[-+]") (forward-line 1))
 407                 (setq end-line (line-number-at-pos (point)))
 408                 (unless (eobp) (diff-split-hunk)))
 409               (unless (looking-at "[-+]") (forward-line -1))
 410               (while (looking-at "[-+]") (forward-line -1))
 411               (setq beg-line (line-number-at-pos (point)))
 412               (unless (looking-at "@")
 413                 (forward-line 1)
 414                 (diff-split-hunk))
 415               (let ((wbh (window-body-height)))
 416                 (if (>= wbh (- end-line beg-line))
 417                     (recenter (/ (+ wbh (- beg-line end-line) 2) 2))
 418                   (recenter 1)))
 419               (when diff-auto-refine-mode
 420                 (diff-refine-hunk))
 421               (unless (yes-or-no-p (format "Revert current hunk in %s?"
 422                                            ,(cl-caadr fileset)))
 423                 (error "Revert canceled"))
 424               (let ((diff-advance-after-apply-hunk nil))
 425                 (diff-apply-hunk t))
 426               (with-current-buffer ,buffer
 427                 (save-buffer))
 428               (message "Hunk reverted"))))
 429       (quit-windows-on diff-buffer t))))
 430
 431 (defun diff-hl-hunk-overlay-at (pos)
 432   (cl-loop for o in (overlays-in pos (1+ pos))
 433            when (overlay-get o 'diff-hl-hunk)
 434            return o))
 435
 436 (defun diff-hl-next-hunk (&optional backward)
 437   "Go to the beginning of the next hunk in the current buffer."
 438   (interactive)
 439   (let ((pos (save-excursion
 440                (catch 'found
 441                  (while (not (if backward (bobp) (eobp)))
 442                    (goto-char (if backward
 443                                   (previous-overlay-change (point))
 444                                 (next-overlay-change (point))))
 445                    (let ((o (diff-hl-hunk-overlay-at (point))))
 446                      (when (and o (= (overlay-start o) (point)))
 447                        (throw 'found (overlay-start o)))))))))
 448     (if pos
 449         (goto-char pos)
 450       (error "No further hunks found"))))
 451
 452 (defun diff-hl-previous-hunk ()
 453   "Go to the beginning of the previous hunk in the current buffer."
 454   (interactive)
 455   (diff-hl-next-hunk t))
 456
 457 (defun diff-hl-mark-hunk ()
 458   (interactive)
 459   (let ((hunk (diff-hl-hunk-overlay-at (point))))
 460     (unless hunk
 461       (error "No hunk at point"))
 462     (goto-char (overlay-start hunk))
 463     (push-mark (overlay-end hunk) nil t)))
 464
 465 (defvar diff-hl-command-map
 466   (let ((map (make-sparse-keymap)))
 467     (define-key map "n" 'diff-hl-revert-hunk)
 468     (define-key map "[" 'diff-hl-previous-hunk)
 469     (define-key map "]" 'diff-hl-next-hunk)
 470     map))
 471 (fset 'diff-hl-command-map diff-hl-command-map)
 472
 473 ;;;###autoload
 474 (define-minor-mode diff-hl-mode
 475   "Toggle VC diff highlighting."
 476   :lighter "" :keymap `(([remap vc-diff] . diff-hl-diff-goto-hunk)
 477                         (,diff-hl-command-prefix . diff-hl-command-map))
 478   (if diff-hl-mode
 479       (progn
 480         (diff-hl-maybe-define-bitmaps)
 481         (add-hook 'after-save-hook 'diff-hl-update nil t)
 482         (add-hook 'after-change-functions 'diff-hl-edit nil t)
 483         (add-hook (if vc-mode
 484                       ;; Defer until the end of this hook, so that its
 485                       ;; elements can modify the update behavior.
 486                       'diff-hl-mode-on-hook
 487                     ;; If we're only opening the file now,
 488                     ;; `vc-find-file-hook' likely hasn't run yet, so
 489                     ;; let's wait until the state information is
 490                     ;; saved, in order not to fetch it twice.
 491                     'find-file-hook)
 492                   'diff-hl-update t t)
 493         (add-hook 'vc-checkin-hook 'diff-hl-update nil t)
 494         (add-hook 'after-revert-hook 'diff-hl-update nil t)
 495         ;; Magit does call `auto-revert-handler', but it usually
 496         ;; doesn't do much, because `buffer-stale--default-function'
 497         ;; doesn't care about changed VC state.
 498         ;; https://github.com/magit/magit/issues/603
 499         (add-hook 'magit-revert-buffer-hook 'diff-hl-update nil t)
 500         ;; Magit versions 2.0-2.3 don't do the above and call this
 501         ;; instead, but only when they dosn't call `revert-buffer':
 502         (add-hook 'magit-not-reverted-hook 'diff-hl-update nil t)
 503         (add-hook 'auto-revert-mode-hook 'diff-hl-update nil t)
 504         (add-hook 'text-scale-mode-hook 'diff-hl-define-bitmaps nil t))
 505     (remove-hook 'after-save-hook 'diff-hl-update t)
 506     (remove-hook 'after-change-functions 'diff-hl-edit t)
 507     (remove-hook 'find-file-hook 'diff-hl-update t)
 508     (remove-hook 'vc-checkin-hook 'diff-hl-update t)
 509     (remove-hook 'after-revert-hook 'diff-hl-update t)
 510     (remove-hook 'magit-revert-buffer-hook 'diff-hl-update t)
 511     (remove-hook 'magit-not-reverted-hook 'diff-hl-update t)
 512     (remove-hook 'auto-revert-mode-hook 'diff-hl-update t)
 513     (remove-hook 'text-scale-mode-hook 'diff-hl-define-bitmaps t)
 514     (diff-hl-remove-overlays)))
 515
 516 (when (require 'smartrep nil t)
 517   (let (smart-keys)
 518     (cl-labels ((scan (map)
 519                       (map-keymap
 520                        (lambda (event binding)
 521                          (if (consp binding)
 522                              (scan binding)
 523                            (when (characterp event)
 524                              (push (cons (string event) binding) smart-keys))))
 525                        map)))
 526       (scan diff-hl-command-map)
 527       (smartrep-define-key diff-hl-mode-map diff-hl-command-prefix smart-keys))))
 528
 529 (declare-function magit-toplevel "magit-git")
 530 (declare-function magit-unstaged-files "magit-git")
 531
 532 (defun diff-hl-magit-post-refresh ()
 533   (let* ((topdir (magit-toplevel))
 534          (modified-files
 535           (mapcar (lambda (file) (expand-file-name file topdir))
 536                   (magit-unstaged-files t)))
 537          (unmodified-states '(up-to-date ignored unregistered)))
 538     (dolist (buf (buffer-list))
 539       (when (and (buffer-local-value 'diff-hl-mode buf)
 540                  (not (buffer-modified-p buf))
 541                  (file-in-directory-p (buffer-file-name buf) topdir))
 542         (with-current-buffer buf
 543           (let* ((file buffer-file-name)
 544                  (backend (vc-backend file)))
 545             (when backend
 546               (cond
 547                ((member file modified-files)
 548                 (when (memq (vc-state file) unmodified-states)
 549                   (vc-state-refresh file backend))
 550                 (diff-hl-update))
 551                ((not (memq (vc-state file backend) unmodified-states))
 552                 (vc-state-refresh file backend)
 553                 (diff-hl-update))))))))))
 554
 555 (defun diff-hl-dir-update ()
 556   (dolist (pair (if (vc-dir-marked-files)
 557                     (vc-dir-marked-only-files-and-states)
 558                   (vc-dir-child-files-and-states)))
 559     (when (eq 'up-to-date (cdr pair))
 560       (let ((buffer (find-buffer-visiting (car pair))))
 561         (when buffer
 562           (with-current-buffer buffer
 563             (diff-hl-remove-overlays)))))))
 564
 565 (define-minor-mode diff-hl-dir-mode
 566   "Toggle `diff-hl-mode' integration in a `vc-dir-mode' buffer."
 567   :lighter ""
 568   (if diff-hl-dir-mode
 569       (add-hook 'vc-checkin-hook 'diff-hl-dir-update t t)
 570     (remove-hook 'vc-checkin-hook 'diff-hl-dir-update t)))
 571
 572 ;;;###autoload
 573 (defun turn-on-diff-hl-mode ()
 574   "Turn on `diff-hl-mode' or `diff-hl-dir-mode' in a buffer if appropriate."
 575   (cond
 576    (buffer-file-name
 577     (diff-hl-mode 1))
 578    ((eq major-mode 'vc-dir-mode)
 579     (diff-hl-dir-mode 1))))
 580
 581 ;;;###autoload
 582 (define-globalized-minor-mode global-diff-hl-mode diff-hl-mode
 583   turn-on-diff-hl-mode :after-hook (diff-hl-global-mode-change))
 584
 585 (defun diff-hl-global-mode-change ()
 586   (unless global-diff-hl-mode
 587     (dolist (buf (buffer-list))
 588       (with-current-buffer buf
 589         (when diff-hl-dir-mode
 590           (diff-hl-dir-mode -1))))))
 591
 592 (provide 'diff-hl)
 593
 594 ;;; diff-hl.el ends here