Merge pull request #30 from sunesimonsen/master

[gnu-emacs-elpa] / diff-hl-dired.el

diff --git a/diff-hl-dired.el b/diff-hl-dired.el
index a94be03066d0a9fe4b069a69b5cb638c6ca3c91a..d603bf17f869155a5e845bd517bb455ab2c6ff90 100644 (file)
--- a/diff-hl-dired.el
+++ b/diff-hl-dired.el
@@ -1,6 +1,6 @@
 ;;; diff-hl-dired.el --- Highlight changed files in Dired -*- lexical-binding: t -*-
 
-;; Copyright (C) 2012-2013  Free Software Foundation, Inc.
+;; Copyright (C) 2012-2014  Free Software Foundation, Inc.
 
 ;; This file is part of GNU Emacs.
 
@@ -29,6 +29,30 @@
 
 (defvar diff-hl-dired-process-buffer nil)
 
+(defgroup diff-hl-dired nil
+  "VC diff highlighting on the side of a Dired window."
+  :group 'diff-hl)
+
+(defface diff-hl-dired-insert
+  '((default :inherit diff-hl-insert))
+  "Face used to highlight added files.")
+
+(defface diff-hl-dired-delete
+  '((default :inherit diff-hl-delete))
+  "Face used to highlight directories with deleted files.")
+
+(defface diff-hl-dired-change
+  '((default :inherit diff-hl-change))
+  "Face used to highlight changed files.")
+
+(defface diff-hl-dired-unknown
+  '((default :inherit diff-header))
+  "Face used to highlight unregistered files.")
+
+(defface diff-hl-dired-ignored
+  '((default :inherit shadow))
+  "Face used to highlight unregistered files.")
+
 ;;;###autoload
 (define-minor-mode diff-hl-dired-mode
   "Toggle VC diff highlighting on the side of a Dired window."
@@ -59,27 +83,53 @@
         (erase-buffer)
         (vc-call-backend
          backend 'dir-status def-dir
-         (lambda (entries &optional _more-to-come)
+         (lambda (entries &optional more-to-come)
+           (when (buffer-live-p buffer)
+             (with-current-buffer buffer
+               (dolist (entry entries)
+                 (cl-destructuring-bind (file state &rest) entry
+                   (let ((type (plist-get
+                                '(edited change added insert removed delete
+                                         unregistered unknown)
+                                state)))
+                     (if (string-match "\\`\\([^/]+\\)/" file)
+                         (let* ((dir (match-string 1 file))
+                                (value (cdr (assoc dir dirs-alist))))
+                           (unless (eq value type)
+                             (if (null value)
+                                 (push (cons dir type) dirs-alist)
+                               (setcdr (assoc dir dirs-alist) 'change))))
+                       (push (cons file type) files-alist)))))
+               (unless more-to-come
+                 (diff-hl-dired-highlight-items (append dirs-alist
+                                                        files-alist))
+                 (diff-hl-dired-update-ignores backend def-dir)))))
+         )))))
+
+(defun diff-hl-dired-update-ignores (backend def-dir)
+  (let ((buffer (current-buffer))
+        entries-alist)
+    (with-current-buffer diff-hl-dired-process-buffer
+      (erase-buffer)
+      (vc-call-backend
+       backend 'dir-status-files def-dir
+       (cl-loop for file in (directory-files def-dir)
+                unless (member file '("." ".."))
+                collect file)
+       nil
+       (lambda (entries &optional more-to-come)
+         (when (buffer-live-p buffer)
            (with-current-buffer buffer
              (dolist (entry entries)
                (cl-destructuring-bind (file state &rest) entry
-                 (let ((type (plist-get
-                              '(edited change added insert removed delete
-                                unregistered unknown)
-                              state)))
-                   (if (string-match "\\`\\([^/]+\\)/" file)
-                       (let* ((dir (match-string 1 file))
-                              (value (cdr (assoc dir dirs-alist))))
-                         (unless (eq value type)
-                           (if (null value)
-                               (push (cons dir type) dirs-alist)
-                             (setcdr (assoc dir dirs-alist) 'change))))
-                     (push (cons file type) files-alist)))))
-             ;; Process's finished, time to use the results.
-             (unless (get-buffer-process diff-hl-dired-process-buffer)
-               (diff-hl-dired-highlight-items (append dirs-alist
-                                                      files-alist)))))
-         )))))
+                 ;; Work around http://debbugs.gnu.org/18605
+                 (setq file (replace-regexp-in-string "\\` " "" file))
+                 (when (eq state 'ignored)
+                   (push (cons (directory-file-name file)
+                               'ignored) entries-alist))))
+             (unless more-to-come
+               (diff-hl-dired-highlight-items entries-alist)))))
+       ))))
 
 (defun diff-hl-dired-highlight-items (alist)
   "Highlight ALIST containing (FILE . TYPE) elements."
@@ -91,10 +141,14 @@
         (when (and type (dired-goto-file-1
                          file (expand-file-name file) nil))
           (let* ((diff-hl-fringe-bmp-function 'diff-hl-fringe-bmp-from-type)
+                 (diff-hl-fringe-face-function 'diff-hl-dired-face-from-type)
                  (o (diff-hl-add-highlighting type 'single)))
             (overlay-put o 'modification-hooks '(diff-hl-overlay-modified))
             ))))))
 
+(defun diff-hl-dired-face-from-type (type _pos)
+  (intern (format "diff-hl-dired-%s" type)))
+
 (defalias 'diff-hl-dired-clear 'diff-hl-remove-overlays)
 
 (provide 'diff-hl-dired)