code.delx.au - gnu-emacs-elpa/blob - 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.3
   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 (listp vc-git-diff-switches)
 217                      (cl-remove-if-not
 218                       (lambda (arg)
 219                         (member arg '("--histogram" "--patience" "--minimal")))
 220                       vc-git-diff-switches))))
 221          (vc-hg-diff-switches nil)
 222          (vc-svn-diff-switches nil)
 223          (vc-diff-switches '("-U0"))
 224          ,@(when (boundp 'vc-disable-async-diff)
 225              '((vc-disable-async-diff t))))
 226      ,body))
 227
 228 (defun diff-hl-modified-p (state)
 229   (or (eq state 'edited)
 230       (and (eq state 'up-to-date)
 231            ;; VC state is stale in after-revert-hook.
 232            (or revert-buffer-in-progress-p
 233                ;; Diffing against an older revision.
 234                diff-hl-reference-revision))))
 235
 236 (defun diff-hl-changes-buffer (file backend)
 237   (let ((buf-name " *diff-hl* "))
 238     (diff-hl-with-diff-switches
 239      (vc-call-backend backend 'diff (list file)
 240                       diff-hl-reference-revision nil
 241                       buf-name))
 242     buf-name))
 243
 244 (defun diff-hl-changes ()
 245   (let* ((file buffer-file-name)
 246          (backend (vc-backend file)))
 247     (when backend
 248       (let ((state (vc-state file backend)))
 249         (cond
 250          ((diff-hl-modified-p state)
 251           (let* (diff-auto-refine-mode res)
 252             (with-current-buffer (diff-hl-changes-buffer file backend)
 253               (goto-char (point-min))
 254               (unless (eobp)
 255                 (ignore-errors
 256                   (diff-beginning-of-hunk t))
 257                 (while (looking-at diff-hunk-header-re-unified)
 258                   (let ((line (string-to-number (match-string 3)))
 259                         (len (let ((m (match-string 4)))
 260                                (if m (string-to-number m) 1)))
 261                         (beg (point)))
 262                     (diff-end-of-hunk)
 263                     (let* ((inserts (diff-count-matches "^\\+" beg (point)))
 264                            (deletes (diff-count-matches "^-" beg (point)))
 265                            (type (cond ((zerop deletes) 'insert)
 266                                        ((zerop inserts) 'delete)
 267                                        (t 'change))))
 268                       (when (eq type 'delete)
 269                         (setq len 1)
 270                         (cl-incf line))
 271                       (push (list line len type) res))))))
 272             (nreverse res)))
 273          ((eq state 'added)
 274           `((1 ,(line-number-at-pos (point-max)) insert)))
 275          ((eq state 'removed)
 276           `((1 ,(line-number-at-pos (point-max)) delete))))))))
 277
 278 (defun diff-hl-update ()
 279   (let ((changes (diff-hl-changes))
 280         (current-line 1))
 281     (diff-hl-remove-overlays)
 282     (save-excursion
 283       (save-restriction
 284         (widen)
 285         (goto-char (point-min))
 286         (dolist (c changes)
 287           (cl-destructuring-bind (line len type) c
 288             (forward-line (- line current-line))
 289             (setq current-line line)
 290             (let ((hunk-beg (point)))
 291               (while (cl-plusp len)
 292                 (diff-hl-add-highlighting
 293                  type
 294                  (cond
 295                   ((not diff-hl-draw-borders) 'empty)
 296                   ((and (= len 1) (= line current-line)) 'single)
 297                   ((= len 1) 'bottom)
 298                   ((= line current-line) 'top)
 299                   (t 'middle)))
 300                 (forward-line 1)
 301                 (cl-incf current-line)
 302                 (cl-decf len))
 303               (let ((h (make-overlay hunk-beg (point)))
 304                     (hook '(diff-hl-overlay-modified)))
 305                 (overlay-put h 'diff-hl t)
 306                 (overlay-put h 'diff-hl-hunk t)
 307                 (overlay-put h 'modification-hooks hook)
 308                 (overlay-put h 'insert-in-front-hooks hook)
 309                 (overlay-put h 'insert-behind-hooks hook)))))))))
 310
 311 (defun diff-hl-add-highlighting (type shape)
 312   (let ((o (make-overlay (point) (point))))
 313     (overlay-put o 'diff-hl t)
 314     (funcall diff-hl-highlight-function o type shape)
 315     o))
 316
 317 (defun diff-hl-highlight-on-fringe (ovl type shape)
 318   (overlay-put ovl 'before-string (diff-hl-fringe-spec type shape
 319                                                        diff-hl-side)))
 320
 321 (defun diff-hl-remove-overlays (&optional beg end)
 322   (save-restriction
 323     (widen)
 324     (dolist (o (overlays-in (or beg (point-min)) (or end (point-max))))
 325       (when (overlay-get o 'diff-hl) (delete-overlay o)))))
 326
 327 (defun diff-hl-overlay-modified (ov after-p _beg _end &optional _length)
 328   "Delete the hunk overlay and all our line overlays inside it."
 329   (unless after-p
 330     (when (overlay-buffer ov)
 331       (diff-hl-remove-overlays (overlay-start ov) (overlay-end ov))
 332       (delete-overlay ov))))
 333
 334 (defvar diff-hl-timer nil)
 335
 336 (defun diff-hl-edit (_beg _end _len)
 337   "DTRT when we've `undo'-ne the buffer into unmodified state."
 338   (when undo-in-progress
 339     (when diff-hl-timer
 340       (cancel-timer diff-hl-timer))
 341     (setq diff-hl-timer
 342           (run-with-idle-timer 0.01 nil #'diff-hl-after-undo (current-buffer)))))
 343
 344 (defun diff-hl-after-undo (buffer)
 345   (with-current-buffer buffer
 346     (unless (buffer-modified-p)
 347       (diff-hl-update))))
 348
 349 (defun diff-hl-diff-goto-hunk ()
 350   "Run VC diff command and go to the line corresponding to the current."
 351   (interactive)
 352   (vc-buffer-sync)
 353   (let* ((line (line-number-at-pos))
 354          (buffer (current-buffer)))
 355     (vc-diff-internal t (vc-deduce-fileset) diff-hl-reference-revision nil t)
 356     (vc-exec-after `(if (< (line-number-at-pos (point-max)) 3)
 357                         (with-current-buffer ,buffer (diff-hl-remove-overlays))
 358                       (diff-hl-diff-skip-to ,line)
 359                       (setq vc-sentinel-movepoint (point))))))
 360
 361 (defun diff-hl-diff-skip-to (line)
 362   "In `diff-mode', skip to the hunk and line corresponding to LINE
 363 in the source file, or the last line of the hunk above it."
 364   (diff-hunk-next)
 365   (let (found)
 366     (while (and (looking-at diff-hunk-header-re-unified) (not found))
 367       (let ((hunk-line (string-to-number (match-string 3)))
 368             (len (let ((m (match-string 4)))
 369                    (if m (string-to-number m) 1))))
 370         (if (> line (+ hunk-line len))
 371             (diff-hunk-next)
 372           (setq found t)
 373           (if (< line hunk-line)
 374               ;; Retreat to the previous hunk.
 375               (forward-line -1)
 376             (let ((to-go (1+ (- line hunk-line))))
 377               (while (cl-plusp to-go)
 378                 (forward-line 1)
 379                 (unless (looking-at "^-")
 380                   (cl-decf to-go))))))))))
 381
 382 (defun diff-hl-revert-hunk ()
 383   "Revert the diff hunk with changes at or above the point."
 384   (interactive)
 385   (vc-buffer-sync)
 386   (let ((diff-buffer (generate-new-buffer-name "*diff-hl*"))
 387         (buffer (current-buffer))
 388         (line (save-excursion
 389                 (unless (diff-hl-hunk-overlay-at (point))
 390                   (diff-hl-previous-hunk))
 391                 (line-number-at-pos)))
 392         (fileset (vc-deduce-fileset)))
 393     (unwind-protect
 394         (progn
 395           (vc-diff-internal nil fileset diff-hl-reference-revision nil
 396                             nil diff-buffer)
 397           (vc-exec-after
 398            `(let (beg-line end-line)
 399               (when (eobp)
 400                 (with-current-buffer ,buffer (diff-hl-remove-overlays))
 401                 (error "Buffer is up-to-date"))
 402               (let (diff-auto-refine-mode)
 403                 (diff-hl-diff-skip-to ,line))
 404               (save-excursion
 405                 (while (looking-at "[-+]") (forward-line 1))
 406                 (setq end-line (line-number-at-pos (point)))
 407                 (unless (eobp) (diff-split-hunk)))
 408               (unless (looking-at "[-+]") (forward-line -1))
 409               (while (looking-at "[-+]") (forward-line -1))
 410               (setq beg-line (line-number-at-pos (point)))
 411               (unless (looking-at "@")
 412                 (forward-line 1)
 413                 (diff-split-hunk))
 414               (let ((wbh (window-body-height)))
 415                 (if (>= wbh (- end-line beg-line))
 416                     (recenter (/ (+ wbh (- beg-line end-line) 2) 2))
 417                   (recenter 1)))
 418               (when diff-auto-refine-mode
 419                 (diff-refine-hunk))
 420               (unless (yes-or-no-p (format "Revert current hunk in %s?"
 421                                            ,(cl-caadr fileset)))
 422                 (error "Revert canceled"))
 423               (let ((diff-advance-after-apply-hunk nil))
 424                 (diff-apply-hunk t))
 425               (with-current-buffer ,buffer
 426                 (save-buffer))
 427               (message "Hunk reverted"))))
 428       (quit-windows-on diff-buffer t))))
 429
 430 (defun diff-hl-hunk-overlay-at (pos)
 431   (cl-loop for o in (overlays-in pos (1+ pos))
 432            when (overlay-get o 'diff-hl-hunk)
 433            return o))
 434
 435 (defun diff-hl-next-hunk (&optional backward)
 436   "Go to the beginning of the next hunk in the current buffer."
 437   (interactive)
 438   (let ((pos (save-excursion
 439                (catch 'found
 440                  (while (not (if backward (bobp) (eobp)))
 441                    (goto-char (if backward
 442                                   (previous-overlay-change (point))
 443                                 (next-overlay-change (point))))
 444                    (let ((o (diff-hl-hunk-overlay-at (point))))
 445                      (when (and o (= (overlay-start o) (point)))
 446                        (throw 'found (overlay-start o)))))))))
 447     (if pos
 448         (goto-char pos)
 449       (error "No further hunks found"))))
 450
 451 (defun diff-hl-previous-hunk ()
 452   "Go to the beginning of the previous hunk in the current buffer."
 453   (interactive)
 454   (diff-hl-next-hunk t))
 455
 456 (defun diff-hl-mark-hunk ()
 457   (interactive)
 458   (let ((hunk (diff-hl-hunk-overlay-at (point))))
 459     (unless hunk
 460       (error "No hunk at point"))
 461     (goto-char (overlay-start hunk))
 462     (push-mark (overlay-end hunk) nil t)))
 463
 464 (defvar diff-hl-command-map
 465   (let ((map (make-sparse-keymap)))
 466     (define-key map "n" 'diff-hl-revert-hunk)
 467     (define-key map "[" 'diff-hl-previous-hunk)
 468     (define-key map "]" 'diff-hl-next-hunk)
 469     map))
 470 (fset 'diff-hl-command-map diff-hl-command-map)
 471
 472 ;;;###autoload
 473 (define-minor-mode diff-hl-mode
 474   "Toggle VC diff highlighting."
 475   :lighter "" :keymap `(([remap vc-diff] . diff-hl-diff-goto-hunk)
 476                         (,diff-hl-command-prefix . diff-hl-command-map))
 477   (if diff-hl-mode
 478       (progn
 479         (diff-hl-maybe-define-bitmaps)
 480         (add-hook 'after-save-hook 'diff-hl-update nil t)
 481         (add-hook 'after-change-functions 'diff-hl-edit nil t)
 482         (add-hook (if vc-mode
 483                       ;; Defer until the end of this hook, so that its
 484                       ;; elements can modify the update behavior.
 485                       'diff-hl-mode-on-hook
 486                     ;; If we're only opening the file now,
 487                     ;; `vc-find-file-hook' likely hasn't run yet, so
 488                     ;; let's wait until the state information is
 489                     ;; saved, in order not to fetch it twice.
 490                     'find-file-hook)
 491                   'diff-hl-update t t)
 492         (add-hook 'vc-checkin-hook 'diff-hl-update nil t)
 493         (add-hook 'after-revert-hook 'diff-hl-update nil t)
 494         ;; Magit does call `auto-revert-handler', but it usually
 495         ;; doesn't do much, because `buffer-stale--default-function'
 496         ;; doesn't care about changed VC state.
 497         ;; https://github.com/magit/magit/issues/603
 498         (add-hook 'magit-revert-buffer-hook 'diff-hl-update nil t)
 499         ;; Magit versions 2.0-2.3 don't do the above and call this
 500         ;; instead, but only when they dosn't call `revert-buffer':
 501         (add-hook 'magit-not-reverted-hook 'diff-hl-update nil t)
 502         (add-hook 'auto-revert-mode-hook 'diff-hl-update nil t)
 503         (add-hook 'text-scale-mode-hook 'diff-hl-define-bitmaps nil t))
 504     (remove-hook 'after-save-hook 'diff-hl-update t)
 505     (remove-hook 'after-change-functions 'diff-hl-edit t)
 506     (remove-hook 'find-file-hook 'diff-hl-update t)
 507     (remove-hook 'vc-checkin-hook 'diff-hl-update t)
 508     (remove-hook 'after-revert-hook 'diff-hl-update t)
 509     (remove-hook 'magit-revert-buffer-hook 'diff-hl-update t)
 510     (remove-hook 'magit-not-reverted-hook 'diff-hl-update t)
 511     (remove-hook 'auto-revert-mode-hook 'diff-hl-update t)
 512     (remove-hook 'text-scale-mode-hook 'diff-hl-define-bitmaps t)
 513     (diff-hl-remove-overlays)))
 514
 515 (when (require 'smartrep nil t)
 516   (let (smart-keys)
 517     (cl-labels ((scan (map)
 518                       (map-keymap
 519                        (lambda (event binding)
 520                          (if (consp binding)
 521                              (scan binding)
 522                            (when (characterp event)
 523                              (push (cons (string event) binding) smart-keys))))
 524                        map)))
 525       (scan diff-hl-command-map)
 526       (smartrep-define-key diff-hl-mode-map diff-hl-command-prefix smart-keys))))
 527
 528 (declare-function magit-toplevel "magit-git")
 529 (declare-function magit-unstaged-files "magit-git")
 530
 531 (defun diff-hl-magit-post-refresh ()
 532   (let* ((topdir (magit-toplevel))
 533          (modified-files
 534           (mapcar (lambda (file) (expand-file-name file topdir))
 535                   (magit-unstaged-files t)))
 536          (unmodified-states '(up-to-date ignored unregistered)))
 537     (dolist (buf (buffer-list))
 538       (when (and (buffer-local-value 'diff-hl-mode buf)
 539                  (not (buffer-modified-p buf))
 540                  (file-in-directory-p (buffer-file-name buf) topdir))
 541         (with-current-buffer buf
 542           (let* ((file buffer-file-name)
 543                  (backend (vc-backend file)))
 544             (when backend
 545               (cond
 546                ((member file modified-files)
 547                 (when (memq (vc-state file) unmodified-states)
 548                   (vc-state-refresh file backend))
 549                 (diff-hl-update))
 550                ((not (memq (vc-state file backend) unmodified-states))
 551                 (vc-state-refresh file backend)
 552                 (diff-hl-update))))))))))
 553
 554 (defun diff-hl-dir-update ()
 555   (dolist (pair (if (vc-dir-marked-files)
 556                     (vc-dir-marked-only-files-and-states)
 557                   (vc-dir-child-files-and-states)))
 558     (when (eq 'up-to-date (cdr pair))
 559       (let ((buffer (find-buffer-visiting (car pair))))
 560         (when buffer
 561           (with-current-buffer buffer
 562             (diff-hl-remove-overlays)))))))
 563
 564 (define-minor-mode diff-hl-dir-mode
 565   "Toggle `diff-hl-mode' integration in a `vc-dir-mode' buffer."
 566   :lighter ""
 567   (if diff-hl-dir-mode
 568       (add-hook 'vc-checkin-hook 'diff-hl-dir-update t t)
 569     (remove-hook 'vc-checkin-hook 'diff-hl-dir-update t)))
 570
 571 ;;;###autoload
 572 (defun turn-on-diff-hl-mode ()
 573   "Turn on `diff-hl-mode' or `diff-hl-dir-mode' in a buffer if appropriate."
 574   (cond
 575    (buffer-file-name
 576     (diff-hl-mode 1))
 577    ((eq major-mode 'vc-dir-mode)
 578     (diff-hl-dir-mode 1))))
 579
 580 ;;;###autoload
 581 (define-globalized-minor-mode global-diff-hl-mode diff-hl-mode
 582   turn-on-diff-hl-mode :after-hook (diff-hl-global-mode-change))
 583
 584 (defun diff-hl-global-mode-change ()
 585   (unless global-diff-hl-mode
 586     (dolist (buf (buffer-list))
 587       (with-current-buffer buf
 588         (when diff-hl-dir-mode
 589           (diff-hl-dir-mode -1))))))
 590
 591 (provide 'diff-hl)
 592
 593 ;;; diff-hl.el ends here