Skip to content

Commit 73e0e62

Browse files
rynffollrynffoll
committed
diff-hl-dired: Handle nested file paths
- Support multi-level nested paths in VC status (e.g. a/b/c.txt) - Debounce concurrent VC process calls with state machine (nil/running/pending) - Move diff-hl-dired-clear to diff-hl-dired-highlight-items to avoid flicker - Pass basename and full path to dired-goto-file-1 for nested entries
1 parent bb9af85 commit 73e0e62

1 file changed

Lines changed: 88 additions & 46 deletions

File tree

‎diff-hl-dired.el‎

Lines changed: 88 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,18 @@
3737

3838
(defvar diff-hl-dired-process-buffer nil)
3939

40+
(defvar diff-hl-dired--status nil
41+
"Status of the VC dir-status operation.
42+
43+
State transitions (no concurrent requests):
44+
nil - (request) -> running -- start VC dir-status-files
45+
running - (done) -> nil -- VC finished
46+
47+
State transitions (concurrent requests):
48+
running - (request) -> pending -- VC busy, queue retry
49+
pending - (request) -> pending -- already queued, ignore
50+
pending - (done) -> nil -- VC finished, schedule retry")
51+
4052
(defgroup diff-hl-dired nil
4153
"VC diff highlighting on the side of a Dired window."
4254
:group 'diff-hl)
@@ -59,7 +71,7 @@
5971

6072
(defface diff-hl-dired-ignored
6173
'((default :inherit dired-ignored))
62-
"Face used to highlight unregistered files.")
74+
"Face used to highlight ignored files.")
6375

6476
(defcustom diff-hl-dired-extra-indicators t
6577
"Non-nil to indicate ignored files."
@@ -86,6 +98,7 @@ status indicators."
8698
(progn
8799
(diff-hl-maybe-define-bitmaps)
88100
(set (make-local-variable 'diff-hl-dired-process-buffer) nil)
101+
(set (make-local-variable 'diff-hl-dired--status) nil)
89102
(add-hook 'dired-after-readin-hook 'diff-hl-dired-update nil t))
90103
(remove-hook 'dired-after-readin-hook 'diff-hl-dired-update t)
91104
(diff-hl-dired-clear)))
@@ -95,66 +108,95 @@ status indicators."
95108
(let ((backend (ignore-errors (vc-responsible-backend default-directory)))
96109
(def-dir default-directory)
97110
(buffer (current-buffer))
111+
(state-to-type '( edited change
112+
added insert
113+
removed delete
114+
unregistered unknown
115+
ignored ignored))
98116
dirs-alist files-alist)
99117
(when (and backend (not (memq backend diff-hl-dired-ignored-backends)))
100-
(diff-hl-dired-clear)
101-
(if (buffer-live-p diff-hl-dired-process-buffer)
102-
(let ((proc (get-buffer-process diff-hl-dired-process-buffer)))
103-
(when proc (kill-process proc)))
104-
(setq diff-hl-dired-process-buffer
105-
(generate-new-buffer " *diff-hl-dired* tmp status")))
106-
(with-current-buffer diff-hl-dired-process-buffer
107-
(setq default-directory (expand-file-name def-dir))
108-
(erase-buffer)
109-
(diff-hl-dired-status-files
110-
backend def-dir
111-
(when diff-hl-dired-extra-indicators
112-
(cl-loop for file in (directory-files def-dir)
113-
unless (member file '("." ".." ".hg"))
114-
collect file))
115-
(lambda (entries &optional more-to-come)
116-
(when (buffer-live-p buffer)
117-
(with-current-buffer buffer
118-
(dolist (entry entries)
119-
(cl-destructuring-bind (file state &rest r) entry
120-
;; Work around http://debbugs.gnu.org/18605
121-
(setq file (replace-regexp-in-string "\\` " "" file))
122-
(let ((type (plist-get
123-
'( edited change added insert removed delete
124-
unregistered unknown ignored ignored)
125-
state)))
126-
(if (string-match "\\`\\([^/]+\\)/" file)
127-
(let* ((dir (match-string 1 file))
128-
(value (cdr (assoc dir dirs-alist))))
129-
(unless (eq value type)
130-
(cond
131-
((eq state 'up-to-date))
132-
((null value)
133-
(push (cons dir type) dirs-alist))
134-
((not (eq type 'ignored))
135-
(setcdr (assoc dir dirs-alist) 'change)))))
136-
(push (cons file type) files-alist)))))
137-
(unless more-to-come
138-
(diff-hl-dired-highlight-items
139-
(append dirs-alist files-alist))))
140-
(unless more-to-come
141-
(kill-buffer diff-hl-dired-process-buffer))))
118+
(pcase diff-hl-dired--status
119+
;; running -> pending
120+
('running (setq diff-hl-dired--status 'pending))
121+
;; pending -> pending, already queued, ignore
122+
('pending nil)
123+
;; nil -> running
124+
(_
125+
(setq diff-hl-dired--status 'running)
126+
(unless (buffer-live-p diff-hl-dired-process-buffer)
127+
(setq diff-hl-dired-process-buffer
128+
(generate-new-buffer " *diff-hl-dired* tmp status")))
129+
(with-current-buffer diff-hl-dired-process-buffer
130+
(setq default-directory (expand-file-name def-dir))
131+
(erase-buffer)
132+
(let ((files
133+
(when diff-hl-dired-extra-indicators
134+
(cl-loop for file in (directory-files def-dir)
135+
unless (member file '("." ".." ".hg"))
136+
collect file)))
137+
(update-fn
138+
(lambda (entries &optional more-to-come)
139+
(when (buffer-live-p buffer)
140+
(with-current-buffer buffer
141+
(dolist (entry entries)
142+
(cl-destructuring-bind (file state &rest r) entry
143+
;; Work around http://debbugs.gnu.org/18605
144+
(setq file (replace-regexp-in-string "\\` " "" file))
145+
(let ((type (plist-get state-to-type state))
146+
(dirs (cl-loop with pos = 0
147+
while (string-match "/" file pos)
148+
do (setq pos (match-end 0))
149+
collect (substring file 0 (1- pos)))))
150+
(dolist (dir dirs)
151+
(let ((value (cdr (assoc dir dirs-alist))))
152+
(cond
153+
((eq value type)) ;; skip
154+
((eq state 'up-to-date)) ;; skip
155+
((null value)
156+
(push (cons dir type) dirs-alist))
157+
((not (eq type 'ignored))
158+
(setcdr (assoc dir dirs-alist) 'change)))))
159+
(push (cons file type) files-alist)
160+
)))
161+
(unless more-to-come
162+
(diff-hl-dired-highlight-items
163+
(append dirs-alist files-alist))
164+
(pcase diff-hl-dired--status
165+
;; running -> nil
166+
('running
167+
(setq diff-hl-dired--status nil))
168+
;; pending -> nil, schedule retry
169+
('pending
170+
(setq diff-hl-dired--status nil)
171+
(run-at-time 0 nil
172+
(lambda ()
173+
(when (buffer-live-p buffer)
174+
(with-current-buffer buffer
175+
(diff-hl-dired-update))))))))))
176+
(unless more-to-come
177+
(kill-buffer diff-hl-dired-process-buffer)))))
178+
(diff-hl-dired-status-files backend def-dir files update-fn)))
142179
)))))
143180

144181
(defun diff-hl-dired-status-files (backend dir files update-function)
145182
"Using version control BACKEND, return list of (FILE STATE EXTRA) entries
146183
for DIR containing FILES. Call UPDATE-FUNCTION as entries are added."
147-
(vc-call-backend backend 'dir-status-files dir files update-function))
184+
(vc-call-backend backend 'dir-status-files
185+
dir files update-function))
148186

149187
(defun diff-hl-dired-highlight-items (alist)
150188
"Highlight ALIST containing (FILE . TYPE) elements."
189+
;; clear overlays right before drawing to avoid flicker
190+
(diff-hl-dired-clear)
151191
(dolist (pair alist)
152192
(let ((file (car pair))
153193
(type (cdr pair)))
154194
(save-excursion
155195
(goto-char (point-min))
156-
(when (and type (dired-goto-file-1
157-
file (expand-file-name file) nil))
196+
(when (and type
197+
(dired-goto-file-1
198+
(file-name-nondirectory file) ;; basename
199+
(expand-file-name file) nil))
158200
(let* ((diff-hl-fringe-bmp-function diff-hl-dired-fringe-bmp-function)
159201
(diff-hl-fringe-face-function 'diff-hl-dired-face-from-type)
160202
(o (diff-hl-add-highlighting type 'single)))

0 commit comments

Comments
 (0)