1 ;;; diff-hl.el --- VC diff fringe highlighting -*- lexical-binding: t -*-
3 ;; Author: Dmitry Gutov <dgutov@yandex.ru>
4 ;; URL: https://github.com/dgutov/diff-hl
7 ;; Package-Requires: ((smartrep "0.0.3"))
9 ;; This file is not part of GNU Emacs.
11 ;; This file is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; This file is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; `diff-hl-mode' provides IDE-like highlighting of `vc-diff' results
27 ;; on the left fringe of the current buffer.
29 ;; For full description, see README.md or the home page.
40 (require 'face-remap))
43 "VC diff fringe highlighting"
46 (defface diff-hl-insert
47 '((t :inherit diff-added))
48 "Face used to highlight inserted lines."
51 (defface diff-hl-delete
52 '((t :inherit diff-removed))
53 "Face used to highlight deleted lines."
56 (defface diff-hl-change
59 (((class color) (min-colors 88) (background light))
60 :background "#ddddff")
61 (((class color) (min-colors 88) (background dark))
62 :background "#333355"))
63 "Face used to highlight changed lines."
66 (defcustom diff-hl-draw-borders t
67 "Non-nil to draw borders around fringe indicators."
71 (defun diff-hl-define-bitmaps ()
72 (let* ((scale (if (and (boundp 'text-scale-mode-amount)
73 (plusp text-scale-mode-amount))
74 (expt text-scale-mode-step text-scale-mode-amount)
76 (h (round (* (frame-char-height) scale)))
77 (w (frame-parameter nil 'left-fringe))
78 (middle (make-vector h (expt 2 (1- w))))
79 (ones (1- (expt 2 w)))
80 (top (copy-sequence middle))
81 (bottom (copy-sequence middle))
82 (single (copy-sequence middle)))
84 (aset bottom (1- h) ones)
86 (aset single (1- h) ones)
87 (define-fringe-bitmap 'diff-hl-bmp-top top h w 'top)
88 (define-fringe-bitmap 'diff-hl-bmp-middle middle h w 'center)
89 (define-fringe-bitmap 'diff-hl-bmp-bottom bottom h w 'bottom)
90 (define-fringe-bitmap 'diff-hl-bmp-single single h w 'top)))
93 (define-fringe-bitmap 'diff-hl-bmp-empty [0] 1 1 'center)
94 (diff-hl-define-bitmaps))
96 (defvar diff-hl-spec-cache (make-hash-table :test 'equal))
98 (defun diff-hl-fringe-spec (type pos)
99 (let* ((key (cons type pos))
100 (val (gethash key diff-hl-spec-cache)))
102 (let* ((face-sym (intern (concat "diff-hl-" (symbol-name type))))
103 (bmp-sym (intern (concat "diff-hl-bmp-" (symbol-name pos)))))
104 (setq val (propertize " " 'display `((left-fringe ,bmp-sym ,face-sym))))
105 (puthash key val diff-hl-spec-cache)))
108 (defmacro diff-hl-with-diff-switches (body)
109 `(let ((vc-git-diff-switches nil)
110 (vc-hg-diff-switches nil)
111 (vc-diff-switches '("-U0"))
112 (vc-disable-async-diff t))
115 (defun diff-hl-changes ()
116 (let* ((buf-name " *diff-hl* ")
117 (file buffer-file-name)
118 (backend (vc-backend file))
120 (when (and backend (not (eq (vc-state file backend) 'up-to-date)))
121 (diff-hl-with-diff-switches
122 (vc-call-backend backend 'diff (list file) nil nil buf-name))
123 (with-current-buffer buf-name
124 (goto-char (point-min))
126 (diff-beginning-of-hunk t)
127 (while (looking-at diff-hunk-header-re-unified)
128 (let ((line (string-to-number (match-string 3)))
129 (len (let ((m (match-string 4)))
130 (if m (string-to-number m) 1)))
133 (let* ((inserts (diff-count-matches "^\\+" beg (point)))
134 (deletes (diff-count-matches "^-" beg (point)))
135 (type (cond ((zerop deletes) 'insert)
136 ((zerop inserts) 'delete)
138 (push (list line len type) res)))))))
141 (defun diff-hl-update ()
142 (let ((changes (diff-hl-changes))
144 (diff-hl-remove-overlays)
146 (goto-char (point-min))
148 (destructuring-bind (line len type) c
149 (when (eq type 'delete)
152 (forward-line (- line current-line))
153 (setq current-line line)
154 (let ((hunk-beg (point)))
156 (let ((o (make-overlay (point) (line-end-position))))
157 (overlay-put o 'diff-hl t)
158 (overlay-put o 'before-string
162 ((not diff-hl-draw-borders) 'empty)
163 ((and (= len 1) (= line current-line)) 'single)
165 ((= line current-line) 'top)
170 (let ((h (make-overlay hunk-beg (point)))
171 (hook '(diff-hl-overlay-modified)))
172 (overlay-put h 'diff-hl t)
173 (overlay-put h 'diff-hl-hunk t)
174 (overlay-put h 'modification-hooks hook)
175 (overlay-put h 'insert-in-front-hooks hook))))))))
177 (defun diff-hl-remove-overlays ()
178 (dolist (o (overlays-in (point-min) (point-max)))
179 (when (overlay-get o 'diff-hl) (delete-overlay o))))
181 (defun diff-hl-overlay-modified (ov after-p _beg _end &optional _length)
182 ;; Delete the overlay and all our overlays inside it.
185 (narrow-to-region (overlay-start ov) (overlay-end ov))
186 (diff-hl-remove-overlays))
187 (delete-overlay ov)))
189 (defvar diff-hl-timer nil)
191 (defun diff-hl-edit (_beg _end _len)
192 ;; DTRT when we've `undo'-ed the buffer into unmodified state.
193 (when undo-in-progress
195 (cancel-timer diff-hl-timer))
197 (run-with-idle-timer 0.01 nil #'diff-hl-after-undo (current-buffer)))))
199 (defun diff-hl-after-undo (buffer)
200 (with-current-buffer buffer
201 (unless (buffer-modified-p)
204 (defun diff-hl-diff-goto-hunk ()
205 "Run VC diff command and go to the line corresponding to current."
208 (let* ((line (line-number-at-pos))
209 (buffer (current-buffer)))
210 (vc-diff-internal t (vc-deduce-fileset) nil nil t)
211 (vc-exec-after `(if (eobp)
212 (with-current-buffer ,buffer (diff-hl-remove-overlays))
213 (diff-hl-diff-skip-to ,line)))))
215 (defun diff-hl-diff-skip-to (line)
216 "In `diff-mode', skip to the hunk and line corresponding to LINE
217 in the source file, or the last line of the hunk above it."
220 (while (and (looking-at diff-hunk-header-re-unified) (not found))
221 (let ((hunk-line (string-to-number (match-string 3)))
222 (len (let ((m (match-string 4)))
223 (if m (string-to-number m) 1))))
224 (if (> line (+ hunk-line len))
227 (if (< line hunk-line)
228 ;; Retreat to the previous hunk.
230 (let ((to-go (1+ (- line hunk-line))))
233 (unless (looking-at "^-")
234 (decf to-go))))))))))
236 (defun diff-hl-revert-hunk ()
237 "Revert the diff hunk with changes at or above the point."
240 (let ((diff-buffer (generate-new-buffer-name "*diff-hl*"))
241 (buffer (current-buffer))
242 (line (save-excursion
243 (unless (diff-hl-hunk-overlay-at (point))
244 (diff-hl-previous-hunk))
245 (line-number-at-pos)))
246 (fileset (vc-deduce-fileset)))
249 (vc-diff-internal nil fileset nil nil nil diff-buffer)
251 `(let (beg-line end-line)
253 (with-current-buffer ,buffer (diff-hl-remove-overlays))
254 (error "Buffer is up-to-date"))
255 (diff-hl-diff-skip-to ,line)
257 (while (looking-at "[-+]") (forward-line 1))
258 (setq end-line (line-number-at-pos (point)))
259 (unless (eobp) (diff-split-hunk)))
260 (unless (looking-at "[-+]") (forward-line -1))
261 (while (looking-at "[-+]") (forward-line -1))
262 (setq beg-line (line-number-at-pos (point)))
263 (unless (looking-at "@")
266 (let ((wbh (window-body-height)))
267 (if (>= wbh (- end-line beg-line))
268 (recenter (/ (+ wbh (- beg-line end-line) 2) 2))
270 (unless (yes-or-no-p (format "Revert current hunk in %s?"
272 (error "Revert canceled"))
273 (let ((diff-advance-after-apply-hunk nil))
275 (with-current-buffer ,buffer
277 (message "Hunk reverted"))))
278 (quit-windows-on diff-buffer))))
280 (defun diff-hl-hunk-overlay-at (pos)
281 (loop for o in (overlays-at pos)
282 when (overlay-get o 'diff-hl-hunk)
285 (defun diff-hl-next-hunk (&optional backward)
286 "Go to the beginning of the next hunk in the current buffer."
288 (let ((pos (save-excursion
290 (when (and backward (bolp) (not (eobp))) (forward-char))
291 (while (not (if backward (bobp) (eobp)))
292 (goto-char (if backward
293 (previous-overlay-change (point))
294 (next-overlay-change (point))))
295 (let ((o (diff-hl-hunk-overlay-at (point))))
296 (when (and o (if backward
297 (<= (overlay-end o) (1+ (point)))
298 (>= (overlay-start o) (point))))
299 (throw 'found (overlay-start o)))))))))
302 (error "No further hunks found"))))
304 (defun diff-hl-previous-hunk ()
305 "Go to the beginning of the previous hunk in the current buffer."
307 (diff-hl-next-hunk t))
309 (define-minor-mode diff-hl-mode
310 "Toggle display of VC diff indicators in the left fringe."
311 :lighter "" :keymap `(([remap vc-diff] . diff-hl-diff-goto-hunk)
312 (,(kbd "C-x v n") . diff-hl-revert-hunk)
313 (,(kbd "C-x v [") . diff-hl-previous-hunk)
314 (,(kbd "C-x v ]") . diff-hl-next-hunk))
317 (add-hook 'after-save-hook 'diff-hl-update nil t)
318 (add-hook 'after-change-functions 'diff-hl-edit nil t)
321 (add-hook 'find-file-hook 'diff-hl-update t t))
322 (add-hook 'vc-checkin-hook 'diff-hl-update nil t)
323 (add-hook 'after-revert-hook 'diff-hl-update nil t)
324 (add-hook 'text-scale-mode-hook 'diff-hl-define-bitmaps nil t))
325 (remove-hook 'after-save-hook 'diff-hl-update t)
326 (remove-hook 'after-change-functions 'diff-hl-edit t)
327 (remove-hook 'find-file-hook 'diff-hl-update t)
328 (remove-hook 'vc-checkin-hook 'diff-hl-update t)
329 (remove-hook 'after-revert-hook 'diff-hl-update t)
330 (remove-hook 'text-scale-mode-hook 'diff-hl-define-bitmaps t)
331 (diff-hl-remove-overlays)))
333 (when (require 'smartrep nil t)
335 (cl-labels ((scan (map)
337 (lambda (event binding)
340 (when (characterp event)
341 (push (cons (string event) binding) smart-keys))))
343 (scan diff-hl-mode-map)
344 (smartrep-define-key diff-hl-mode-map "C-x v" smart-keys))))
346 (defun diff-hl-dir-update ()
347 (dolist (pair (if (vc-dir-marked-files)
348 (vc-dir-marked-only-files-and-states)
349 (vc-dir-child-files-and-states)))
350 (when (eq 'up-to-date (cdr pair))
351 (let ((buffer (find-buffer-visiting (car pair))))
353 (with-current-buffer buffer
354 (diff-hl-remove-overlays)))))))
356 (define-minor-mode diff-hl-dir-mode
357 "Toggle `diff-hl-mode' integration in a `vc-dir-mode' buffer."
360 (add-hook 'vc-checkin-hook 'diff-hl-dir-update t t)
361 (remove-hook 'vc-checkin-hook 'diff-hl-dir-update t)))
364 (defun turn-on-diff-hl-mode ()
365 "Turn on `diff-hl-mode' or `diff-hl-dir-mode' in a buffer if appropriate."
366 (when (window-system) ;; No fringes in the console.
370 ((eq major-mode 'vc-dir-mode)
371 (diff-hl-dir-mode 1)))))
373 (defun diff-hl-global-mode-change ()
374 (unless global-diff-hl-mode
375 (dolist (buf (buffer-list))
376 (with-current-buffer buf
377 (when diff-hl-dir-mode
378 (diff-hl-dir-mode -1))))))
381 (define-globalized-minor-mode global-diff-hl-mode diff-hl-mode
382 turn-on-diff-hl-mode :after-hook (diff-hl-global-mode-change))
386 ;;; diff-hl.el ends here