1 ;;; diff-hl-dired.el --- Highlight changed files in Dired -*- lexical-binding: t -*-
3 ;; This file is not part of GNU Emacs.
5 ;; This file is free software: you can redistribute it and/or modify
6 ;; it under the terms of the GNU General Public License as published by
7 ;; the Free Software Foundation, either version 3 of the License, or
8 ;; (at your option) any later version.
10 ;; This file is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;; GNU General Public License for more details.
15 ;; You should have received a copy of the GNU General Public License
16 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
20 ;; To enable in all Dired buffers, add this to your init file:
22 ;; (add-hook 'dired-mode-hook 'diff-hl-dired-mode)
29 (define-minor-mode diff-hl-dired-mode
30 "Toggle VC diff fringe highlighting in a Dired buffer."
32 (if diff-hl-dired-mode
34 (set (make-local-variable 'diff-hl-dired-process-buffer) nil)
35 (add-hook 'dired-after-readin-hook 'diff-hl-dired-update nil t))
36 (remove-hook 'dired-after-readin-hook 'diff-hl-dired-update t)
37 (diff-hl-dired-clear)))
39 (defvar diff-hl-dired-process-buffer nil)
41 (defun diff-hl-dired-update ()
42 "Highlight the Dired buffer."
43 (let ((backend (ignore-errors (vc-responsible-backend default-directory)))
44 (def-dir default-directory)
45 (buffer (current-buffer))
46 dirs-alist files-alist)
49 (if (buffer-live-p diff-hl-dired-process-buffer)
50 (let ((proc (get-buffer-process diff-hl-dired-process-buffer)))
51 (when proc (kill-process proc)))
52 (setq diff-hl-dired-process-buffer
53 (generate-new-buffer " *diff-hl-dired* tmp status")))
54 (with-current-buffer diff-hl-dired-process-buffer
55 (setq default-directory (expand-file-name def-dir))
58 backend 'dir-status def-dir
59 (lambda (entries &optional more-to-come)
60 (with-current-buffer buffer
61 (dolist (entry entries)
62 (cl-destructuring-bind (file state &rest) entry
63 (let ((type (plist-get
64 '(edited change added insert removed delete
67 (if (string-match "\\`\\([^/]+\\)/" file)
68 (let* ((dir (match-string 1 file))
69 (value (cdr (assoc dir dirs-alist))))
70 (unless (eq value type)
72 (push (cons dir type) dirs-alist)
73 (setcdr (assoc dir dirs-alist) 'change))))
74 (push (cons file type) files-alist))
75 ;; Process's finished, time to use the results.
76 (unless (get-buffer-process diff-hl-dired-process-buffer)
77 (diff-hl-dired-highlight-items (append dirs-alist
81 (defun diff-hl-dired-highlight-items (alist)
82 "Highlight ALIST containing (FILE . TYPE) elements."
84 (let ((file (car pair))
87 (goto-char (point-min))
88 (when (and type (dired-goto-file-1
89 file (expand-file-name file) nil))
91 (diff-hl-add-highlighting type 'middle))))))
93 (defalias 'diff-hl-dired-clear 'diff-hl-remove-overlays)
95 (provide 'diff-hl-dired)
97 ;;; diff-hl-dired.el ends here