X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/545941781e3a4cc853fbcc1e35d5d6ac0f316c41..e0f8fe106187ffa1f1034b7fb3b72c10f9010c6c:/diff-hl-dired.el diff --git a/diff-hl-dired.el b/diff-hl-dired.el index e27a3087f..663d2938f 100644 --- a/diff-hl-dired.el +++ b/diff-hl-dired.el @@ -1,13 +1,15 @@ ;;; diff-hl-dired.el --- Highlight changed files in Dired -*- lexical-binding: t -*- -;; This file is not part of GNU Emacs. +;; Copyright (C) 2012-2015 Free Software Foundation, Inc. -;; This file is free software: you can redistribute it and/or modify +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This file is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. @@ -20,24 +22,61 @@ ;; To enable in all Dired buffers, add this to your init file: ;; ;; (add-hook 'dired-mode-hook 'diff-hl-dired-mode) +;; +;; or +;; +;; (add-hook 'dired-mode-hook 'diff-hl-dired-mode-unless-remote) +;; +;; to do it only in local Dired buffers. ;;; Code: (require 'diff-hl) +(require 'dired) + +(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 dired-ignored)) + "Face used to highlight unregistered files.") + +(defface diff-hl-dired-ignored + '((default :inherit dired-ignored)) + "Face used to highlight unregistered files.") + +(defcustom diff-hl-dired-extra-indicators t + "Non-nil to indicate ignored files." + :group 'diff-hl + :type 'boolean) ;;;###autoload (define-minor-mode diff-hl-dired-mode - "Toggle VC diff fringe highlighting in a Dired buffer." + "Toggle VC diff highlighting on the side of a Dired window." :lighter "" (if diff-hl-dired-mode (progn + (diff-hl-maybe-define-bitmaps) (set (make-local-variable 'diff-hl-dired-process-buffer) nil) (add-hook 'dired-after-readin-hook 'diff-hl-dired-update nil t)) (remove-hook 'dired-after-readin-hook 'diff-hl-dired-update t) (diff-hl-dired-clear))) -(defvar diff-hl-dired-process-buffer nil) - (defun diff-hl-dired-update () "Highlight the Dired buffer." (let ((backend (ignore-errors (vc-responsible-backend default-directory))) @@ -54,30 +93,56 @@ (with-current-buffer diff-hl-dired-process-buffer (setq default-directory (expand-file-name def-dir)) (erase-buffer) - (vc-call-backend - backend 'dir-status def-dir + (diff-hl-dired-status-files + backend def-dir + (when diff-hl-dired-extra-indicators + (cl-loop for file in (directory-files def-dir) + unless (member file '("." ".." ".hg")) + collect file)) (lambda (entries &optional more-to-come) - (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))))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (dolist (entry entries) + (cl-destructuring-bind (file state &rest r) entry + ;; Work around http://debbugs.gnu.org/18605 + (setq file (replace-regexp-in-string "\\` " "" file)) + (let ((type (plist-get + '(edited change added insert removed delete + unregistered unknown ignored ignored) + state))) + (if (string-match "\\`\\([^/]+\\)/" file) + (let* ((dir (match-string 1 file)) + (value (cdr (assoc dir dirs-alist)))) + (unless (eq value type) + (cond + ((eq type 'up-to-date)) + ((null value) + (push (cons dir type) dirs-alist)) + ((not (eq type 'ignored)) + (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)))))) ))))) +(defun diff-hl-dired-status-files (backend dir files update-function) + "Using version control BACKEND, return list of (FILE STATE EXTRA) entries +for DIR containing FILES. Call UPDATE-FUNCTION as entries are added." + (if (version< "25" emacs-version) + (vc-call-backend backend 'dir-status-files dir files update-function) + (vc-call-backend backend 'dir-status-files dir files nil update-function))) + +(when (version< emacs-version "24.4.51.5") + ;; Work around http://debbugs.gnu.org/19386 + (defadvice vc-git-dir-status-goto-stage (around + diff-hl-dired-skip-up-to-date + (stage files update-function) + activate) + (when (eq stage 'ls-files-up-to-date) + (setq stage 'diff-index)) + ad-do-it)) + (defun diff-hl-dired-highlight-items (alist) "Highlight ALIST containing (FILE . TYPE) elements." (dolist (pair alist) @@ -87,11 +152,22 @@ (goto-char (point-min)) (when (and type (dired-goto-file-1 file (expand-file-name file) nil)) - (forward-line 0) - (diff-hl-add-highlighting type 'single)))))) + (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) +;;;###autoload +(defun diff-hl-dired-mode-unless-remote () + (unless (file-remote-p default-directory) + (diff-hl-dired-mode))) + (provide 'diff-hl-dired) ;;; diff-hl-dired.el ends here