Add 2012 to FSF copyright years for Emacs files (do not merge to trunk)
[bpt/emacs.git] / lisp / vc-dir.el
CommitLineData
74d0991f
DN
1;;; vc-dir.el --- Directory status display under VC
2
49f70d46 3;; Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012
74d0991f
DN
4;; Free Software Foundation, Inc.
5
6;; Author: Dan Nicolaescu <dann@ics.uci.edu>
7;; Keywords: tools
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs 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.
15
16;; GNU Emacs 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.
20
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/>.
23
24;;; Credits:
25
26;; The original VC directory status implementation was based on dired.
27;; This implementation was inspired by PCL-CVS.
28;; Many people contributed comments, ideas and code to this
29;; implementation. These include:
a1fc8acb 30;;
74d0991f
DN
31;; Alexandre Julliard <julliard@winehq.org>
32;; Stefan Monnier <monnier@iro.umontreal.ca>
33;; Tom Tromey <tromey@redhat.com>
34
35;;; Commentary:
a1fc8acb 36;;
74d0991f
DN
37
38;;; Todo: see vc.el.
39
40(require 'vc-hooks)
41(require 'vc)
50925e72 42(require 'tool-bar)
74d0991f
DN
43(require 'ewoc)
44
45;;; Code:
46(eval-when-compile
47 (require 'cl))
48
49(defcustom vc-dir-mode-hook nil
50 "Normal hook run by `vc-dir-mode'.
51See `run-hooks'."
52 :type 'hook
53 :group 'vc)
54
55;; Used to store information for the files displayed in the directory buffer.
56;; Each item displayed corresponds to one of these defstructs.
57(defstruct (vc-dir-fileinfo
58 (:copier nil)
59 (:type list) ;So we can use `member' on lists of FIs.
60 (:constructor
61 ;; We could define it as an alias for `list'.
62 vc-dir-create-fileinfo (name state &optional extra marked directory))
63 (:conc-name vc-dir-fileinfo->))
64 name ;Keep it as first, for `member'.
65 state
c4c0a44b 66 ;; For storing backend specific information.
74d0991f
DN
67 extra
68 marked
69 ;; To keep track of not updated files during a global refresh
70 needs-update
71 ;; To distinguish files and directories.
72 directory)
73
74d0991f 74(defvar vc-ewoc nil)
c4c0a44b 75
74d0991f
DN
76(defvar vc-dir-process-buffer nil
77 "The buffer used for the asynchronous call that computes status.")
78
c4c0a44b
DN
79(defvar vc-dir-backend nil
80 "The backend used by the current *vc-dir* buffer.")
81
74d0991f
DN
82(defun vc-dir-move-to-goal-column ()
83 ;; Used to keep the cursor on the file name column.
84 (beginning-of-line)
85 (unless (eolp)
13ad7457 86 ;; Must be in sync with vc-default-dir-printer.
74d0991f
DN
87 (forward-char 25)))
88
c4c0a44b 89(defun vc-dir-prepare-status-buffer (bname dir backend &optional create-new)
74d0991f 90 "Find a buffer named BNAME showing DIR, or create a new one."
4714a481 91 (setq dir (file-name-as-directory (expand-file-name dir)))
dcbbecd4
SM
92 (let* ;; Look for another buffer name BNAME visiting the same directory.
93 ((buf (save-excursion
94 (unless create-new
95 (dolist (buffer vc-dir-buffers)
96 (when (buffer-live-p buffer)
97 (set-buffer buffer)
98 (when (and (derived-mode-p 'vc-dir-mode)
99 (eq vc-dir-backend backend)
100 (string= default-directory dir))
101 (return buffer))))))))
74d0991f
DN
102 (or buf
103 ;; Create a new buffer named BNAME.
1dfae2a2
JB
104 ;; We pass a filename to create-file-buffer because it is what
105 ;; the function expects, and also what uniquify needs (if active)
106 (with-current-buffer (create-file-buffer (expand-file-name bname dir))
74d0991f
DN
107 (cd dir)
108 (vc-setup-buffer (current-buffer))
109 ;; Reset the vc-parent-buffer-name so that it does not appear
110 ;; in the mode-line.
111 (setq vc-parent-buffer-name nil)
112 (current-buffer)))))
113
114(defvar vc-dir-menu-map
115 (let ((map (make-sparse-keymap "VC-dir")))
116 (define-key map [quit]
117 '(menu-item "Quit" quit-window
118 :help "Quit"))
119 (define-key map [kill]
120 '(menu-item "Kill Update Command" vc-dir-kill-dir-status-process
121 :enable (vc-dir-busy)
122 :help "Kill the command that updates the directory buffer"))
123 (define-key map [refresh]
c4c0a44b 124 '(menu-item "Refresh" revert-buffer
74d0991f
DN
125 :enable (not (vc-dir-busy))
126 :help "Refresh the contents of the directory buffer"))
c4c0a44b
DN
127 (define-key map [remup]
128 '(menu-item "Hide up-to-date" vc-dir-hide-up-to-date
129 :help "Hide up-to-date items from display"))
74d0991f
DN
130 ;; Movement.
131 (define-key map [sepmv] '("--"))
132 (define-key map [next-line]
133 '(menu-item "Next line" vc-dir-next-line
134 :help "Go to the next line" :keys "n"))
135 (define-key map [previous-line]
136 '(menu-item "Previous line" vc-dir-previous-line
137 :help "Go to the previous line"))
138 ;; Marking.
139 (define-key map [sepmrk] '("--"))
140 (define-key map [unmark-all]
141 '(menu-item "Unmark All" vc-dir-unmark-all-files
142 :help "Unmark all files that are in the same state as the current file\
143\nWith prefix argument unmark all files"))
144 (define-key map [unmark-previous]
145 '(menu-item "Unmark previous " vc-dir-unmark-file-up
146 :help "Move to the previous line and unmark the file"))
147
148 (define-key map [mark-all]
149 '(menu-item "Mark All" vc-dir-mark-all-files
150 :help "Mark all files that are in the same state as the current file\
151\nWith prefix argument mark all files"))
152 (define-key map [unmark]
153 '(menu-item "Unmark" vc-dir-unmark
154 :help "Unmark the current file or all files in the region"))
155
156 (define-key map [mark]
157 '(menu-item "Mark" vc-dir-mark
158 :help "Mark the current file or all files in the region"))
159
160 (define-key map [sepopn] '("--"))
f8b4aa41 161 (define-key map [qr]
ba7e37c8 162 '(menu-item "Query Replace in Files..." vc-dir-query-replace-regexp
f8b4aa41 163 :help "Replace a string in the marked files"))
834d998e 164 (define-key map [se]
ba7e37c8 165 '(menu-item "Search Files..." vc-dir-search
834d998e 166 :help "Search a regexp in the marked files"))
ba7e37c8
DN
167 (define-key map [ires]
168 '(menu-item "Isearch Regexp Files..." vc-dir-isearch-regexp
169 :help "Incremental search a regexp in the marked files"))
170 (define-key map [ise]
171 '(menu-item "Isearch Files..." vc-dir-isearch
172 :help "Incremental search a string in the marked files"))
74d0991f
DN
173 (define-key map [open-other]
174 '(menu-item "Open in other window" vc-dir-find-file-other-window
175 :help "Find the file on the current line, in another window"))
176 (define-key map [open]
177 '(menu-item "Open file" vc-dir-find-file
178 :help "Find the file on the current line"))
c4c0a44b
DN
179 (define-key map [sepvcdet] '("--"))
180 ;; FIXME: This needs a key binding. And maybe a better name
181 ;; ("Insert" like PCL-CVS uses does not sound that great either)...
182 (define-key map [ins]
183 '(menu-item "Show File" vc-dir-show-fileentry
184 :help "Show a file in the VC status listing even though it might be up to date"))
185 (define-key map [annotate]
186 '(menu-item "Annotate" vc-annotate
187 :help "Display the edit history of the current file using colors"))
188 (define-key map [diff]
189 '(menu-item "Compare with Base Version" vc-diff
190 :help "Compare file set with the base version"))
98cfec0d
CY
191 (define-key map [logo]
192 '(menu-item "Show Outgoing Log" vc-log-outgoing
193 :help "Show a log of changes that will be sent with a push operation"))
194 (define-key map [logi]
195 '(menu-item "Show Incoming Log" vc-log-incoming
196 :help "Show a log of changes that will be received with a pull operation"))
c4c0a44b 197 (define-key map [log]
98cfec0d
CY
198 '(menu-item "Show history" vc-print-log
199 :help "List the change log of the current file set in a window"))
200 (define-key map [rlog]
201 '(menu-item "Show Top of the Tree History " vc-print-root-log
202 :help "List the change log for the current tree in a window"))
c4c0a44b
DN
203 ;; VC commands.
204 (define-key map [sepvccmd] '("--"))
205 (define-key map [update]
206 '(menu-item "Update to latest version" vc-update
207 :help "Update the current fileset's files to their tip revisions"))
208 (define-key map [revert]
209 '(menu-item "Revert to base version" vc-revert
210 :help "Revert working copies of the selected fileset to their repository contents."))
211 (define-key map [next-action]
212 ;; FIXME: This really really really needs a better name!
213 ;; And a key binding too.
214 '(menu-item "Check In/Out" vc-next-action
215 :help "Do the next logical version control operation on the current fileset"))
216 (define-key map [register]
217 '(menu-item "Register" vc-register
218 :help "Register file set into the version control system"))
74d0991f 219 map)
426bf359 220 "Menu for VC dir.")
74d0991f 221
c4c0a44b
DN
222;; VC backends can use this to add mode-specific menu items to
223;; vc-dir-menu-map.
74d0991f
DN
224(defun vc-dir-menu-map-filter (orig-binding)
225 (when (and (symbolp orig-binding) (fboundp orig-binding))
226 (setq orig-binding (indirect-function orig-binding)))
227 (let ((ext-binding
c4c0a44b
DN
228 (when (derived-mode-p 'vc-dir-mode)
229 (vc-call-backend vc-dir-backend 'extra-status-menu))))
74d0991f
DN
230 (if (null ext-binding)
231 orig-binding
232 (append orig-binding
233 '("----")
234 ext-binding))))
235
236(defvar vc-dir-mode-map
f8b4aa41 237 (let ((map (make-sparse-keymap)))
c4c0a44b
DN
238 ;; VC commands
239 (define-key map "v" 'vc-next-action) ;; C-x v v
240 (define-key map "=" 'vc-diff) ;; C-x v =
241 (define-key map "i" 'vc-register) ;; C-x v i
242 (define-key map "+" 'vc-update) ;; C-x v +
243 (define-key map "l" 'vc-print-log) ;; C-x v l
244 ;; More confusing than helpful, probably
db18c5fd
SS
245 ;;(define-key map "R" 'vc-revert) ;; u is taken by vc-dir-unmark.
246 ;;(define-key map "A" 'vc-annotate) ;; g is taken by revert-buffer
247 ;; bound by `special-mode'.
74d0991f
DN
248 ;; Marking.
249 (define-key map "m" 'vc-dir-mark)
250 (define-key map "M" 'vc-dir-mark-all-files)
251 (define-key map "u" 'vc-dir-unmark)
252 (define-key map "U" 'vc-dir-unmark-all-files)
253 (define-key map "\C-?" 'vc-dir-unmark-file-up)
254 (define-key map "\M-\C-?" 'vc-dir-unmark-all-files)
255 ;; Movement.
256 (define-key map "n" 'vc-dir-next-line)
257 (define-key map " " 'vc-dir-next-line)
258 (define-key map "\t" 'vc-dir-next-directory)
259 (define-key map "p" 'vc-dir-previous-line)
260 (define-key map [backtab] 'vc-dir-previous-directory)
261 ;;; Rebind paragraph-movement commands.
262 (define-key map "\M-}" 'vc-dir-next-directory)
263 (define-key map "\M-{" 'vc-dir-previous-directory)
264 (define-key map [C-down] 'vc-dir-next-directory)
265 (define-key map [C-up] 'vc-dir-previous-directory)
266 ;; The remainder.
267 (define-key map "f" 'vc-dir-find-file)
268 (define-key map "\C-m" 'vc-dir-find-file)
269 (define-key map "o" 'vc-dir-find-file-other-window)
74d0991f
DN
270 (define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process)
271 (define-key map [down-mouse-3] 'vc-dir-menu)
272 (define-key map [mouse-2] 'vc-dir-toggle-mark)
d03b3d23 273 (define-key map [follow-link] 'mouse-face)
c4c0a44b 274 (define-key map "x" 'vc-dir-hide-up-to-date)
98cfec0d 275 (define-key map [?\C-k] 'vc-dir-kill-line)
834d998e 276 (define-key map "S" 'vc-dir-search) ;; FIXME: Maybe use A like dired?
f8b4aa41 277 (define-key map "Q" 'vc-dir-query-replace-regexp)
ba7e37c8
DN
278 (define-key map (kbd "M-s a C-s") 'vc-dir-isearch)
279 (define-key map (kbd "M-s a M-C-s") 'vc-dir-isearch-regexp)
74d0991f
DN
280
281 ;; Hook up the menu.
282 (define-key map [menu-bar vc-dir-mode]
283 `(menu-item
c4c0a44b
DN
284 ;; VC backends can use this to add mode-specific menu items to
285 ;; vc-dir-menu-map.
74d0991f
DN
286 "VC-dir" ,vc-dir-menu-map :filter vc-dir-menu-map-filter))
287 map)
288 "Keymap for directory buffer.")
289
7995501c 290(defmacro vc-dir-at-event (event &rest body)
426bf359
JB
291 "Evaluate BODY with point located at event-start of EVENT.
292If BODY uses EVENT, it should be a variable,
74d0991f 293 otherwise it will be evaluated twice."
7995501c 294 (let ((posn (make-symbol "vc-dir-at-event-posn")))
5da5a66f
SS
295 `(save-excursion
296 (unless (equal ,event '(tool-bar))
297 (let ((,posn (event-start ,event)))
298 (set-buffer (window-buffer (posn-window ,posn)))
299 (goto-char (posn-point ,posn))))
300 ,@body)))
74d0991f
DN
301
302(defun vc-dir-menu (e)
db18c5fd 303 "Popup the VC dir menu."
74d0991f 304 (interactive "e")
7995501c 305 (vc-dir-at-event e (popup-menu vc-dir-menu-map e)))
74d0991f
DN
306
307(defvar vc-dir-tool-bar-map
308 (let ((map (make-sparse-keymap)))
309 (tool-bar-local-item-from-menu 'vc-dir-find-file "open"
310 map vc-dir-mode-map)
311 (tool-bar-local-item "bookmark_add"
312 'vc-dir-toggle-mark 'vc-dir-toggle-mark map
313 :help "Toggle mark on current item")
314 (tool-bar-local-item-from-menu 'vc-dir-previous-line "left-arrow"
315 map vc-dir-mode-map
316 :rtl "right-arrow")
317 (tool-bar-local-item-from-menu 'vc-dir-next-line "right-arrow"
318 map vc-dir-mode-map
319 :rtl "left-arrow")
320 (tool-bar-local-item-from-menu 'vc-print-log "info"
321 map vc-dir-mode-map)
c4c0a44b 322 (tool-bar-local-item-from-menu 'revert-buffer "refresh"
74d0991f
DN
323 map vc-dir-mode-map)
324 (tool-bar-local-item-from-menu 'nonincremental-search-forward
325 "search" map)
f8b4aa41
DN
326 (tool-bar-local-item-from-menu 'vc-dir-query-replace-regexp
327 "search-replace" map vc-dir-mode-map)
74d0991f
DN
328 (tool-bar-local-item-from-menu 'vc-dir-kill-dir-status-process "cancel"
329 map vc-dir-mode-map)
330 (tool-bar-local-item-from-menu 'quit-window "exit"
331 map vc-dir-mode-map)
332 map))
333
334(defun vc-dir-node-directory (node)
335 ;; Compute the directory for NODE.
b4dc7d98 336 ;; If it's a directory node, get it from the node.
74d0991f
DN
337 (let ((data (ewoc-data node)))
338 (or (vc-dir-fileinfo->directory data)
339 ;; Otherwise compute it from the file name.
340 (file-name-directory
b8e54362
DN
341 (directory-file-name
342 (expand-file-name
343 (vc-dir-fileinfo->name data)))))))
74d0991f
DN
344
345(defun vc-dir-update (entries buffer &optional noinsert)
346 "Update BUFFER's ewoc from the list of ENTRIES.
347If NOINSERT, ignore elements on ENTRIES which are not in the ewoc."
348 ;; Add ENTRIES to the vc-dir buffer BUFFER.
349 (with-current-buffer buffer
350 ;; Insert the entries sorted by name into the ewoc.
351 ;; We assume the ewoc is sorted too, which should be the
352 ;; case if we always add entries with vc-dir-update.
353 (setq entries
354 ;; Sort: first files and then subdirectories.
355 ;; XXX: this is VERY inefficient, it computes the directory
356 ;; names too many times
357 (sort entries
358 (lambda (entry1 entry2)
b8e54362
DN
359 (let ((dir1 (file-name-directory
360 (directory-file-name (expand-file-name (car entry1)))))
361 (dir2 (file-name-directory
362 (directory-file-name (expand-file-name (car entry2))))))
74d0991f
DN
363 (cond
364 ((string< dir1 dir2) t)
365 ((not (string= dir1 dir2)) nil)
366 ((string< (car entry1) (car entry2))))))))
367 ;; Insert directory entries in the right places.
368 (let ((entry (car entries))
02ffe8e3 369 (node (ewoc-nth vc-ewoc 0))
dbe82b27 370 (to-remove nil)
02ffe8e3 371 (dotname (file-relative-name default-directory)))
74d0991f
DN
372 ;; Insert . if it is not present.
373 (unless node
02ffe8e3
DN
374 (ewoc-enter-last
375 vc-ewoc (vc-dir-create-fileinfo
dcbbecd4 376 dotname nil nil nil default-directory))
74d0991f 377 (setq node (ewoc-nth vc-ewoc 0)))
a1fc8acb 378
74d0991f
DN
379 (while (and entry node)
380 (let* ((entryfile (car entry))
b8e54362
DN
381 (entrydir (file-name-directory (directory-file-name
382 (expand-file-name entryfile))))
74d0991f
DN
383 (nodedir (vc-dir-node-directory node)))
384 (cond
385 ;; First try to find the directory.
386 ((string-lessp nodedir entrydir)
387 (setq node (ewoc-next vc-ewoc node)))
388 ((string-equal nodedir entrydir)
389 ;; Found the directory, find the place for the file name.
390 (let ((nodefile (vc-dir-fileinfo->name (ewoc-data node))))
391 (cond
02ffe8e3
DN
392 ((string= nodefile dotname)
393 (setq node (ewoc-next vc-ewoc node)))
74d0991f
DN
394 ((string-lessp nodefile entryfile)
395 (setq node (ewoc-next vc-ewoc node)))
396 ((string-equal nodefile entryfile)
dbe82b27
DN
397 (if (nth 1 entry)
398 (progn
399 (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
400 (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
401 (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
402 (ewoc-invalidate vc-ewoc node))
403 ;; If the state is nil, the file does not exist
404 ;; anymore, so remember the entry so we can remove
405 ;; it after we are done inserting all ENTRIES.
406 (push node to-remove))
a1fc8acb 407 (setq entries (cdr entries))
74d0991f
DN
408 (setq entry (car entries))
409 (setq node (ewoc-next vc-ewoc node)))
410 (t
d0cb23ca
DN
411 (unless noinsert
412 (ewoc-enter-before vc-ewoc node
413 (apply 'vc-dir-create-fileinfo entry)))
74d0991f
DN
414 (setq entries (cdr entries))
415 (setq entry (car entries))))))
416 (t
d0cb23ca
DN
417 (unless noinsert
418 ;; We might need to insert a directory node if the
419 ;; previous node was in a different directory.
420 (let* ((rd (file-relative-name entrydir))
421 (prev-node (ewoc-prev vc-ewoc node))
422 (prev-dir (vc-dir-node-directory prev-node)))
423 (unless (string-equal entrydir prev-dir)
424 (ewoc-enter-before
425 vc-ewoc node (vc-dir-create-fileinfo rd nil nil nil entrydir))))
426 ;; Now insert the node itself.
427 (ewoc-enter-before vc-ewoc node
428 (apply 'vc-dir-create-fileinfo entry)))
74d0991f
DN
429 (setq entries (cdr entries) entry (car entries))))))
430 ;; We're past the last node, all remaining entries go to the end.
431 (unless (or node noinsert)
432 (let ((lastdir (vc-dir-node-directory (ewoc-nth vc-ewoc -1))))
433 (dolist (entry entries)
b8e54362
DN
434 (let ((entrydir (file-name-directory
435 (directory-file-name (expand-file-name (car entry))))))
74d0991f
DN
436 ;; Insert a directory node if needed.
437 (unless (string-equal lastdir entrydir)
438 (setq lastdir entrydir)
439 (let ((rd (file-relative-name entrydir)))
440 (ewoc-enter-last
441 vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir))))
442 ;; Now insert the node itself.
443 (ewoc-enter-last vc-ewoc
dbe82b27
DN
444 (apply 'vc-dir-create-fileinfo entry))))))
445 (when to-remove
446 (let ((inhibit-read-only t))
447 (apply 'ewoc-delete vc-ewoc (nreverse to-remove)))))))
74d0991f
DN
448
449(defun vc-dir-busy ()
450 (and (buffer-live-p vc-dir-process-buffer)
451 (get-buffer-process vc-dir-process-buffer)))
452
453(defun vc-dir-kill-dir-status-process ()
454 "Kill the temporary buffer and associated process."
455 (interactive)
456 (when (buffer-live-p vc-dir-process-buffer)
457 (let ((proc (get-buffer-process vc-dir-process-buffer)))
458 (when proc (delete-process proc))
459 (setq vc-dir-process-buffer nil)
460 (setq mode-line-process nil))))
461
462(defun vc-dir-kill-query ()
463 ;; Make sure that when the status buffer is killed the update
464 ;; process running in background is also killed.
465 (if (vc-dir-busy)
466 (when (y-or-n-p "Status update process running, really kill status buffer? ")
467 (vc-dir-kill-dir-status-process)
468 t)
469 t))
470
471(defun vc-dir-next-line (arg)
472 "Go to the next line.
473If a prefix argument is given, move by that many lines."
474 (interactive "p")
475 (with-no-warnings
476 (ewoc-goto-next vc-ewoc arg)
477 (vc-dir-move-to-goal-column)))
478
479(defun vc-dir-previous-line (arg)
480 "Go to the previous line.
481If a prefix argument is given, move by that many lines."
482 (interactive "p")
483 (ewoc-goto-prev vc-ewoc arg)
484 (vc-dir-move-to-goal-column))
485
486(defun vc-dir-next-directory ()
487 "Go to the next directory."
488 (interactive)
489 (let ((orig (point)))
490 (if
491 (catch 'foundit
492 (while t
493 (let* ((next (ewoc-next vc-ewoc (ewoc-locate vc-ewoc))))
494 (cond ((not next)
495 (throw 'foundit t))
496 (t
497 (progn
498 (ewoc-goto-node vc-ewoc next)
499 (vc-dir-move-to-goal-column)
500 (if (vc-dir-fileinfo->directory (ewoc-data next))
501 (throw 'foundit nil))))))))
502 (goto-char orig))))
503
504(defun vc-dir-previous-directory ()
505 "Go to the previous directory."
506 (interactive)
507 (let ((orig (point)))
508 (if
509 (catch 'foundit
510 (while t
511 (let* ((prev (ewoc-prev vc-ewoc (ewoc-locate vc-ewoc))))
512 (cond ((not prev)
513 (throw 'foundit t))
514 (t
515 (progn
516 (ewoc-goto-node vc-ewoc prev)
517 (vc-dir-move-to-goal-column)
518 (if (vc-dir-fileinfo->directory (ewoc-data prev))
519 (throw 'foundit nil))))))))
520 (goto-char orig))))
521
522(defun vc-dir-mark-unmark (mark-unmark-function)
523 (if (use-region-p)
524 (let ((firstl (line-number-at-pos (region-beginning)))
525 (lastl (line-number-at-pos (region-end))))
526 (save-excursion
527 (goto-char (region-beginning))
528 (while (<= (line-number-at-pos) lastl)
529 (funcall mark-unmark-function))))
530 (funcall mark-unmark-function)))
531
74d0991f
DN
532(defun vc-dir-parent-marked-p (arg)
533 ;; Return nil if none of the parent directories of arg is marked.
534 (let* ((argdir (vc-dir-node-directory arg))
535 (arglen (length argdir))
536 (crt arg)
537 data dir)
538 ;; Go through the predecessors, checking if any directory that is
539 ;; a parent is marked.
540 (while (setq crt (ewoc-prev vc-ewoc crt))
541 (setq data (ewoc-data crt))
542 (setq dir (vc-dir-node-directory crt))
543 (when (and (vc-dir-fileinfo->directory data)
544 (vc-string-prefix-p dir argdir))
545 (when (vc-dir-fileinfo->marked data)
546 (error "Cannot mark `%s', parent directory `%s' marked"
547 (vc-dir-fileinfo->name (ewoc-data arg))
548 (vc-dir-fileinfo->name data)))))
549 nil))
550
551(defun vc-dir-children-marked-p (arg)
552 ;; Return nil if none of the children of arg is marked.
553 (let* ((argdir-re (concat "\\`" (regexp-quote (vc-dir-node-directory arg))))
554 (is-child t)
555 (crt arg)
556 data dir)
557 (while (and is-child (setq crt (ewoc-next vc-ewoc crt)))
558 (setq data (ewoc-data crt))
559 (setq dir (vc-dir-node-directory crt))
560 (if (string-match argdir-re dir)
561 (when (vc-dir-fileinfo->marked data)
562 (error "Cannot mark `%s', child `%s' marked"
563 (vc-dir-fileinfo->name (ewoc-data arg))
564 (vc-dir-fileinfo->name data)))
565 ;; We are done, we got to an entry that is not a child of `arg'.
566 (setq is-child nil)))
567 nil))
568
569(defun vc-dir-mark-file (&optional arg)
570 ;; Mark ARG or the current file and move to the next line.
571 (let* ((crt (or arg (ewoc-locate vc-ewoc)))
572 (file (ewoc-data crt))
573 (isdir (vc-dir-fileinfo->directory file)))
574 (when (or (and isdir (not (vc-dir-children-marked-p crt)))
575 (and (not isdir) (not (vc-dir-parent-marked-p crt))))
576 (setf (vc-dir-fileinfo->marked file) t)
577 (ewoc-invalidate vc-ewoc crt)
578 (unless (or arg (mouse-event-p last-command-event))
579 (vc-dir-next-line 1)))))
580
581(defun vc-dir-mark ()
582 "Mark the current file or all files in the region.
583If the region is active, mark all the files in the region.
584Otherwise mark the file on the current line and move to the next
585line."
586 (interactive)
587 (vc-dir-mark-unmark 'vc-dir-mark-file))
588
589(defun vc-dir-mark-all-files (arg)
590 "Mark all files with the same state as the current one.
591With a prefix argument mark all files.
592If the current entry is a directory, mark all child files.
593
594The commands operate on files that are on the same state.
595This command is intended to make it easy to select all files that
596share the same state."
597 (interactive "P")
598 (if arg
599 ;; Mark all files.
600 (progn
601 ;; First check that no directory is marked, we can't mark
602 ;; files in that case.
603 (ewoc-map
604 (lambda (filearg)
605 (when (and (vc-dir-fileinfo->directory filearg)
606 (vc-dir-fileinfo->marked filearg))
607 (error "Cannot mark all files, directory `%s' marked"
608 (vc-dir-fileinfo->name filearg))))
609 vc-ewoc)
610 (ewoc-map
611 (lambda (filearg)
612 (unless (vc-dir-fileinfo->marked filearg)
613 (setf (vc-dir-fileinfo->marked filearg) t)
614 t))
615 vc-ewoc))
616 (let ((data (ewoc-data (ewoc-locate vc-ewoc))))
617 (if (vc-dir-fileinfo->directory data)
618 ;; It's a directory, mark child files.
619 (let ((crt (ewoc-locate vc-ewoc)))
620 (unless (vc-dir-children-marked-p crt)
621 (while (setq crt (ewoc-next vc-ewoc crt))
622 (let ((crt-data (ewoc-data crt)))
623 (unless (vc-dir-fileinfo->directory crt-data)
624 (setf (vc-dir-fileinfo->marked crt-data) t)
625 (ewoc-invalidate vc-ewoc crt))))))
626 ;; It's a file
627 (let ((state (vc-dir-fileinfo->state data))
628 (crt (ewoc-nth vc-ewoc 0)))
629 (while crt
630 (let ((crt-data (ewoc-data crt)))
631 (when (and (not (vc-dir-fileinfo->marked crt-data))
632 (eq (vc-dir-fileinfo->state crt-data) state)
633 (not (vc-dir-fileinfo->directory crt-data)))
634 (vc-dir-mark-file crt)))
635 (setq crt (ewoc-next vc-ewoc crt))))))))
636
637(defun vc-dir-unmark-file ()
638 ;; Unmark the current file and move to the next line.
639 (let* ((crt (ewoc-locate vc-ewoc))
640 (file (ewoc-data crt)))
641 (setf (vc-dir-fileinfo->marked file) nil)
642 (ewoc-invalidate vc-ewoc crt)
643 (unless (mouse-event-p last-command-event)
644 (vc-dir-next-line 1))))
645
646(defun vc-dir-unmark ()
647 "Unmark the current file or all files in the region.
648If the region is active, unmark all the files in the region.
649Otherwise mark the file on the current line and move to the next
650line."
651 (interactive)
652 (vc-dir-mark-unmark 'vc-dir-unmark-file))
653
654(defun vc-dir-unmark-file-up ()
655 "Move to the previous line and unmark the file."
656 (interactive)
657 ;; If we're on the first line, we won't move up, but we will still
658 ;; remove the mark. This seems a bit odd but it is what buffer-menu
659 ;; does.
660 (let* ((prev (ewoc-goto-prev vc-ewoc 1))
661 (file (ewoc-data prev)))
662 (setf (vc-dir-fileinfo->marked file) nil)
663 (ewoc-invalidate vc-ewoc prev)
664 (vc-dir-move-to-goal-column)))
665
666(defun vc-dir-unmark-all-files (arg)
667 "Unmark all files with the same state as the current one.
668With a prefix argument unmark all files.
669If the current entry is a directory, unmark all the child files.
670
671The commands operate on files that are on the same state.
672This command is intended to make it easy to deselect all files
673that share the same state."
674 (interactive "P")
675 (if arg
676 (ewoc-map
677 (lambda (filearg)
678 (when (vc-dir-fileinfo->marked filearg)
679 (setf (vc-dir-fileinfo->marked filearg) nil)
680 t))
681 vc-ewoc)
682 (let* ((crt (ewoc-locate vc-ewoc))
683 (data (ewoc-data crt)))
684 (if (vc-dir-fileinfo->directory data)
685 ;; It's a directory, unmark child files.
686 (while (setq crt (ewoc-next vc-ewoc crt))
687 (let ((crt-data (ewoc-data crt)))
688 (unless (vc-dir-fileinfo->directory crt-data)
689 (setf (vc-dir-fileinfo->marked crt-data) nil)
690 (ewoc-invalidate vc-ewoc crt))))
691 ;; It's a file
692 (let ((crt-state (vc-dir-fileinfo->state (ewoc-data crt))))
693 (ewoc-map
694 (lambda (filearg)
695 (when (and (vc-dir-fileinfo->marked filearg)
696 (eq (vc-dir-fileinfo->state filearg) crt-state))
697 (setf (vc-dir-fileinfo->marked filearg) nil)
698 t))
699 vc-ewoc))))))
700
701(defun vc-dir-toggle-mark-file ()
702 (let* ((crt (ewoc-locate vc-ewoc))
703 (file (ewoc-data crt)))
704 (if (vc-dir-fileinfo->marked file)
705 (vc-dir-unmark-file)
706 (vc-dir-mark-file))))
707
708(defun vc-dir-toggle-mark (e)
709 (interactive "e")
7995501c 710 (vc-dir-at-event e (vc-dir-mark-unmark 'vc-dir-toggle-mark-file)))
74d0991f
DN
711
712(defun vc-dir-delete-file ()
713 "Delete the marked files, or the current file if no marks."
714 (interactive)
715 (mapc 'vc-delete-file (or (vc-dir-marked-files)
716 (list (vc-dir-current-file)))))
717
718(defun vc-dir-find-file ()
719 "Find the file on the current line."
720 (interactive)
721 (find-file (vc-dir-current-file)))
722
f8d5a47f 723(defun vc-dir-find-file-other-window (&optional event)
74d0991f 724 "Find the file on the current line, in another window."
f8d5a47f
NR
725 (interactive (list last-nonmenu-event))
726 (if event (posn-set-point (event-end event)))
74d0991f
DN
727 (find-file-other-window (vc-dir-current-file)))
728
ba7e37c8
DN
729(defun vc-dir-isearch ()
730 "Search for a string through all marked buffers using Isearch."
731 (interactive)
732 (multi-isearch-files
733 (mapcar 'car (vc-dir-marked-only-files-and-states))))
734
735(defun vc-dir-isearch-regexp ()
736 "Search for a regexp through all marked buffers using Isearch."
737 (interactive)
738 (multi-isearch-files-regexp
739 (mapcar 'car (vc-dir-marked-only-files-and-states))))
740
834d998e
DN
741(defun vc-dir-search (regexp)
742 "Search through all marked files for a match for REGEXP.
743For marked directories, use the files displayed from those directories.
744Stops when a match is found.
745To continue searching for next match, use command \\[tags-loop-continue]."
746 (interactive "sSearch marked files (regexp): ")
747 (tags-search regexp '(mapcar 'car (vc-dir-marked-only-files-and-states))))
748
f8b4aa41
DN
749(defun vc-dir-query-replace-regexp (from to &optional delimited)
750 "Do `query-replace-regexp' of FROM with TO, on all marked files.
751If a directory is marked, then use the files displayed for that directory.
752Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
753If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
754with the command \\[tags-loop-continue]."
5eae900e 755 ;; FIXME: this is almost a copy of `dired-do-query-replace-regexp'. This
f8b4aa41
DN
756 ;; should probably be made generic and used in both places instead of
757 ;; duplicating it here.
758 (interactive
759 (let ((common
760 (query-replace-read-args
761 "Query replace regexp in marked files" t t)))
762 (list (nth 0 common) (nth 1 common) (nth 2 common))))
763 (dolist (file (mapcar 'car (vc-dir-marked-only-files-and-states)))
764 (let ((buffer (get-file-buffer file)))
765 (if (and buffer (with-current-buffer buffer
766 buffer-read-only))
767 (error "File `%s' is visited read-only" file))))
768 (tags-query-replace from to delimited
769 '(mapcar 'car (vc-dir-marked-only-files-and-states))))
770
74d0991f
DN
771(defun vc-dir-current-file ()
772 (let ((node (ewoc-locate vc-ewoc)))
773 (unless node
774 (error "No file available"))
775 (expand-file-name (vc-dir-fileinfo->name (ewoc-data node)))))
776
777(defun vc-dir-marked-files ()
778 "Return the list of marked files."
779 (mapcar
780 (lambda (elem) (expand-file-name (vc-dir-fileinfo->name elem)))
781 (ewoc-collect vc-ewoc 'vc-dir-fileinfo->marked)))
782
2913a58d
DN
783(defun vc-dir-marked-only-files-and-states ()
784 "Return the list of conses (FILE . STATE) for the marked files.
785For marked directories return the corresponding conses for the
786child files."
74d0991f
DN
787 (let ((crt (ewoc-nth vc-ewoc 0))
788 result)
789 (while crt
790 (let ((crt-data (ewoc-data crt)))
791 (if (vc-dir-fileinfo->marked crt-data)
2913a58d 792 ;; FIXME: use vc-dir-child-files-and-states here instead of duplicating it.
74d0991f
DN
793 (if (vc-dir-fileinfo->directory crt-data)
794 (let* ((dir (vc-dir-fileinfo->directory crt-data))
795 (dirlen (length dir))
796 data)
797 (while
798 (and (setq crt (ewoc-next vc-ewoc crt))
799 (vc-string-prefix-p dir
800 (progn
801 (setq data (ewoc-data crt))
802 (vc-dir-node-directory crt))))
803 (unless (vc-dir-fileinfo->directory data)
a1fc8acb 804 (push
2913a58d
DN
805 (cons (expand-file-name (vc-dir-fileinfo->name data))
806 (vc-dir-fileinfo->state data))
807 result))))
808 (push (cons (expand-file-name (vc-dir-fileinfo->name crt-data))
809 (vc-dir-fileinfo->state crt-data))
810 result)
74d0991f
DN
811 (setq crt (ewoc-next vc-ewoc crt)))
812 (setq crt (ewoc-next vc-ewoc crt)))))
9c6c6d1f 813 (nreverse result)))
74d0991f 814
2913a58d
DN
815(defun vc-dir-child-files-and-states ()
816 "Return the list of conses (FILE . STATE) for child files of the current entry if it's a directory.
817If it is a file, return the corresponding cons for the file itself."
74d0991f
DN
818 (let* ((crt (ewoc-locate vc-ewoc))
819 (crt-data (ewoc-data crt))
820 result)
821 (if (vc-dir-fileinfo->directory crt-data)
822 (let* ((dir (vc-dir-fileinfo->directory crt-data))
823 (dirlen (length dir))
824 data)
825 (while
826 (and (setq crt (ewoc-next vc-ewoc crt))
827 (vc-string-prefix-p dir (progn
828 (setq data (ewoc-data crt))
829 (vc-dir-node-directory crt))))
830 (unless (vc-dir-fileinfo->directory data)
a1fc8acb 831 (push
2913a58d
DN
832 (cons (expand-file-name (vc-dir-fileinfo->name data))
833 (vc-dir-fileinfo->state data))
834 result))))
a1fc8acb 835 (push
2913a58d
DN
836 (cons (expand-file-name (vc-dir-fileinfo->name crt-data))
837 (vc-dir-fileinfo->state crt-data)) result))
9c6c6d1f 838 (nreverse result)))
74d0991f 839
d923f4ac
DN
840(defun vc-dir-recompute-file-state (fname def-dir)
841 (let* ((file-short (file-relative-name fname def-dir))
776f7a5f
DN
842 (remove-me-when-CVS-works
843 (when (eq vc-dir-backend 'CVS)
844 ;; FIXME: Warning: UGLY HACK. The CVS backend caches the state
845 ;; info, this forces the backend to update it.
276db9eb 846 (vc-call-backend vc-dir-backend 'registered fname)))
d923f4ac
DN
847 (state (vc-call-backend vc-dir-backend 'state fname))
848 (extra (vc-call-backend vc-dir-backend
849 'status-fileinfo-extra fname)))
850 (list file-short state extra)))
851
852(defun vc-dir-find-child-files (dirname)
853 ;; Give a DIRNAME string return the list of all child files shown in
854 ;; the current *vc-dir* buffer.
855 (let ((crt (ewoc-nth vc-ewoc 0))
856 children
857 dname)
858 ;; Find DIR
859 (while (and crt (not (vc-string-prefix-p
860 dirname (vc-dir-node-directory crt))))
861 (setq crt (ewoc-next vc-ewoc crt)))
862 (while (and crt (vc-string-prefix-p
863 dirname
864 (setq dname (vc-dir-node-directory crt))))
865 (let ((data (ewoc-data crt)))
866 (unless (vc-dir-fileinfo->directory data)
867 (push (expand-file-name (vc-dir-fileinfo->name data)) children)))
868 (setq crt (ewoc-next vc-ewoc crt)))
869 children))
870
871(defun vc-dir-resync-directory-files (dirname)
872 ;; Update the entries for all the child files of DIRNAME shown in
873 ;; the current *vc-dir* buffer.
874 (let ((files (vc-dir-find-child-files dirname))
dcbbecd4 875 (ddir default-directory)
d923f4ac
DN
876 fileentries)
877 (when files
878 (dolist (crt files)
879 (push (vc-dir-recompute-file-state crt ddir)
880 fileentries))
881 (vc-dir-update fileentries (current-buffer)))))
882
74d0991f 883(defun vc-dir-resynch-file (&optional fname)
426bf359 884 "Update the entries for FNAME in any directory buffers that list it."
d923f4ac 885 (let ((file (or fname (expand-file-name buffer-file-name)))
dcbbecd4
SM
886 (drop '()))
887 (save-current-buffer
888 ;; look for a vc-dir buffer that might show this file.
889 (dolist (status-buf vc-dir-buffers)
890 (if (not (buffer-live-p status-buf))
891 (push status-buf drop)
892 (set-buffer status-buf)
893 (if (not (derived-mode-p 'vc-dir-mode))
894 (push status-buf drop)
895 (let ((ddir default-directory))
896 (when (vc-string-prefix-p ddir file)
897 (if (file-directory-p file)
4d0bbcb6
DN
898 (progn
899 (vc-dir-resync-directory-files file)
900 (ewoc-set-hf vc-ewoc
901 (vc-dir-headers vc-dir-backend default-directory) ""))
d0cb23ca
DN
902 (let* ((complete-state (vc-dir-recompute-file-state file ddir))
903 (state (cadr complete-state)))
dcbbecd4 904 (vc-dir-update
d0cb23ca
DN
905 (list complete-state)
906 status-buf (or (not state)
907 (eq state 'up-to-date)))))))))))
dcbbecd4
SM
908 ;; Remove out-of-date entries from vc-dir-buffers.
909 (dolist (b drop) (setq vc-dir-buffers (delq b vc-dir-buffers)))))
74d0991f 910
c4c0a44b
DN
911(defvar use-vc-backend) ;; dynamically bound
912
913(define-derived-mode vc-dir-mode special-mode "VC dir"
db18c5fd 914 "Major mode for VC directory buffers.
74d0991f 915Marking/Unmarking key bindings and actions:
ae42a852
DN
916m - mark a file/directory
917 - if the region is active, mark all the files in region.
74d0991f
DN
918 Restrictions: - a file cannot be marked if any parent directory is marked
919 - a directory cannot be marked if any child file or
920 directory is marked
ae42a852
DN
921u - unmark a file/directory
922 - if the region is active, unmark all the files in region.
74d0991f
DN
923M - if the cursor is on a file: mark all the files with the same state as
924 the current file
925 - if the cursor is on a directory: mark all child files
926 - with a prefix argument: mark all files
927U - if the cursor is on a file: unmark all the files with the same state
928 as the current file
929 - if the cursor is on a directory: unmark all child files
930 - with a prefix argument: unmark all files
ae42a852 931mouse-2 - toggles the mark state
74d0991f 932
db18c5fd 933VC commands
ae42a852
DN
934VC commands in the `C-x v' prefix can be used.
935VC commands act on the marked entries. If nothing is marked, VC
936commands act on the current entry.
db18c5fd
SS
937
938Search & Replace
939S - searches the marked files
940Q - does a query replace on the marked files
941M-s a C-s - does an isearch on the marked files
49c2119d 942M-s a C-M-s - does a regexp isearch on the marked files
db18c5fd
SS
943If nothing is marked, these commands act on the current entry.
944When a directory is current or marked, the Search & Replace
ae42a852
DN
945commands act on the child files of that directory that are displayed in
946the *vc-dir* buffer.
74d0991f
DN
947
948\\{vc-dir-mode-map}"
c4c0a44b 949 (set (make-local-variable 'vc-dir-backend) use-vc-backend)
74d0991f 950 (setq buffer-read-only t)
c4c0a44b
DN
951 (when (boundp 'tool-bar-map)
952 (set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map))
74d0991f
DN
953 (let ((buffer-read-only nil))
954 (erase-buffer)
955 (set (make-local-variable 'vc-dir-process-buffer) nil)
13ad7457 956 (set (make-local-variable 'vc-ewoc) (ewoc-create #'vc-dir-printer))
c4c0a44b
DN
957 (set (make-local-variable 'revert-buffer-function)
958 'vc-dir-revert-buffer-function)
1dfae2a2 959 (setq list-buffers-directory (expand-file-name "*vc-dir*" default-directory))
dcbbecd4 960 (add-to-list 'vc-dir-buffers (current-buffer))
74d0991f
DN
961 ;; Make sure that if the directory buffer is killed, the update
962 ;; process running in the background is also killed.
963 (add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t)
c4c0a44b 964 (vc-dir-refresh)))
74d0991f
DN
965
966(defun vc-dir-headers (backend dir)
967 "Display the headers in the *VC dir* buffer.
13ad7457 968It calls the `dir-extra-headers' backend method to display backend
74d0991f
DN
969specific headers."
970 (concat
a7200025 971 ;; First layout the common headers.
74d0991f
DN
972 (propertize "VC backend : " 'face 'font-lock-type-face)
973 (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face)
974 (propertize "Working dir: " 'face 'font-lock-type-face)
98cfec0d
CY
975 (propertize (format "%s\n" (abbreviate-file-name dir))
976 'face 'font-lock-variable-name-face)
a7200025
DN
977 ;; Then the backend specific ones.
978 (vc-call-backend backend 'dir-extra-headers dir)
979 "\n"))
74d0991f
DN
980
981(defun vc-dir-refresh-files (files default-state)
982 "Refresh some files in the *VC-dir* buffer."
983 (let ((def-dir default-directory)
984 (backend vc-dir-backend))
985 (vc-set-mode-line-busy-indicator)
986 ;; Call the `dir-status-file' backend function.
987 ;; `dir-status-file' is supposed to be asynchronous.
988 ;; It should compute the results, and then call the function
989 ;; passed as an argument in order to update the vc-dir buffer
990 ;; with the results.
991 (unless (buffer-live-p vc-dir-process-buffer)
992 (setq vc-dir-process-buffer
993 (generate-new-buffer (format " *VC-%s* tmp status" backend))))
994 (lexical-let ((buffer (current-buffer)))
995 (with-current-buffer vc-dir-process-buffer
996 (cd def-dir)
997 (erase-buffer)
998 (vc-call-backend
999 backend 'dir-status-files def-dir files default-state
1000 (lambda (entries &optional more-to-come)
1001 ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
1002 ;; If MORE-TO-COME is true, then more updates will come from
1003 ;; the asynchronous process.
1004 (with-current-buffer buffer
1005 (vc-dir-update entries buffer)
1006 (unless more-to-come
1007 (setq mode-line-process nil)
1008 ;; Remove the ones that haven't been updated at all.
1009 ;; Those not-updated are those whose state is nil because the
1010 ;; file/dir doesn't exist and isn't versioned.
1011 (ewoc-filter vc-ewoc
1012 (lambda (info)
1013 ;; The state for directory entries might
1014 ;; have been changed to 'up-to-date,
1015 ;; reset it, othewise it will be removed when doing 'x'
1016 ;; next time.
1017 ;; FIXME: There should be a more elegant way to do this.
1018 (when (and (vc-dir-fileinfo->directory info)
1019 (eq (vc-dir-fileinfo->state info)
1020 'up-to-date))
1021 (setf (vc-dir-fileinfo->state info) nil))
1022
1023 (not (vc-dir-fileinfo->needs-update info))))))))))))
1024
c4c0a44b
DN
1025(defun vc-dir-revert-buffer-function (&optional ignore-auto noconfirm)
1026 (vc-dir-refresh))
1027
74d0991f
DN
1028(defun vc-dir-refresh ()
1029 "Refresh the contents of the *VC-dir* buffer.
1030Throw an error if another update process is in progress."
1031 (interactive)
1032 (if (vc-dir-busy)
1033 (error "Another update process is in progress, cannot run two at a time")
1034 (let ((def-dir default-directory)
1035 (backend vc-dir-backend))
1036 (vc-set-mode-line-busy-indicator)
1037 ;; Call the `dir-status' backend function.
1038 ;; `dir-status' is supposed to be asynchronous.
1039 ;; It should compute the results, and then call the function
1040 ;; passed as an argument in order to update the vc-dir buffer
1041 ;; with the results.
1042
1043 ;; Create a buffer that can be used by `dir-status' and call
1044 ;; `dir-status' with this buffer as the current buffer. Use
1045 ;; `vc-dir-process-buffer' to remember this buffer, so that
1046 ;; it can be used later to kill the update process in case it
1047 ;; takes too long.
1048 (unless (buffer-live-p vc-dir-process-buffer)
1049 (setq vc-dir-process-buffer
1050 (generate-new-buffer (format " *VC-%s* tmp status" backend))))
29ce30b3
DN
1051 ;; set the needs-update flag on all non-directory entries
1052 (ewoc-map (lambda (info)
1053 (unless (vc-dir-fileinfo->directory info)
1054 (setf (vc-dir-fileinfo->needs-update info) t) nil))
74d0991f
DN
1055 vc-ewoc)
1056 (lexical-let ((buffer (current-buffer)))
1057 (with-current-buffer vc-dir-process-buffer
1058 (cd def-dir)
1059 (erase-buffer)
1060 (vc-call-backend
1061 backend 'dir-status def-dir
1062 (lambda (entries &optional more-to-come)
1063 ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
1064 ;; If MORE-TO-COME is true, then more updates will come from
1065 ;; the asynchronous process.
1066 (with-current-buffer buffer
1067 (vc-dir-update entries buffer)
1068 (unless more-to-come
1069 (let ((remaining
1070 (ewoc-collect
1071 vc-ewoc 'vc-dir-fileinfo->needs-update)))
1072 (if remaining
1073 (vc-dir-refresh-files
1074 (mapcar 'vc-dir-fileinfo->name remaining)
1075 'up-to-date)
7aaf911c
DN
1076 (setq mode-line-process nil)))))))))
1077 (ewoc-set-hf vc-ewoc (vc-dir-headers backend def-dir) ""))))
74d0991f
DN
1078
1079(defun vc-dir-show-fileentry (file)
1080 "Insert an entry for a specific file into the current *VC-dir* listing.
1081This is typically used if the file is up-to-date (or has been added
1082outside of VC) and one wants to do some operation on it."
1083 (interactive "fShow file: ")
1084 (vc-dir-update (list (list (file-relative-name file) (vc-state file))) (current-buffer)))
1085
1086(defun vc-dir-hide-up-to-date ()
1087 "Hide up-to-date items from display."
1088 (interactive)
f731e2f9
DN
1089 (let ((crt (ewoc-nth vc-ewoc -1))
1090 (first (ewoc-nth vc-ewoc 0)))
1091 ;; Go over from the last item to the first and remove the
1092 ;; up-to-date files and directories with no child files.
1093 (while (not (eq crt first))
1094 (let* ((data (ewoc-data crt))
1095 (dir (vc-dir-fileinfo->directory data))
1096 (next (ewoc-next vc-ewoc crt))
1097 (prev (ewoc-prev vc-ewoc crt))
1098 ;; ewoc-delete does not work without this...
1099 (inhibit-read-only t))
1100 (when (or
1101 ;; Remove directories with no child files.
1102 (and dir
1103 (or
1104 ;; Nothing follows this directory.
1105 (not next)
1106 ;; Next item is a directory.
1107 (vc-dir-fileinfo->directory (ewoc-data next))))
1108 ;; Remove files in the up-to-date state.
1109 (eq (vc-dir-fileinfo->state data) 'up-to-date))
1110 (ewoc-delete vc-ewoc crt))
1111 (setq crt prev)))))
74d0991f 1112
98cfec0d
CY
1113(defun vc-dir-kill-line ()
1114 "Remove the current line from display."
1115 (interactive)
1116 (let ((crt (ewoc-locate vc-ewoc))
1117 (inhibit-read-only t))
1118 (ewoc-delete vc-ewoc crt)))
1119
13ad7457
DN
1120(defun vc-dir-printer (fileentry)
1121 (vc-call-backend vc-dir-backend 'dir-printer fileentry))
74d0991f 1122
2913a58d
DN
1123(defun vc-dir-deduce-fileset (&optional state-model-only-files)
1124 (let ((marked (vc-dir-marked-files))
1125 files
1126 only-files-list
1127 state
1128 model)
1129 (if marked
1130 (progn
1131 (setq files marked)
1132 (when state-model-only-files
1133 (setq only-files-list (vc-dir-marked-only-files-and-states))))
1134 (let ((crt (vc-dir-current-file)))
1135 (setq files (list crt))
a1fc8acb 1136 (when state-model-only-files
2913a58d
DN
1137 (setq only-files-list (vc-dir-child-files-and-states)))))
1138
1139 (when state-model-only-files
1140 (setq state (cdar only-files-list))
1141 ;; Check that all files are in a consistent state, since we use that
1142 ;; state to decide which operation to perform.
1143 (dolist (crt (cdr only-files-list))
1144 (unless (vc-compatible-state (cdr crt) state)
2bc9f1df 1145 (error "When applying VC operations to multiple files, the files are required\nto be in similar VC states.\n%s in state %s clashes with %s in state %s"
2913a58d
DN
1146 (car crt) (cdr crt) (caar only-files-list) state)))
1147 (setq only-files-list (mapcar 'car only-files-list))
1148 (when (and state (not (eq state 'unregistered)))
1149 (setq model (vc-checkout-model vc-dir-backend only-files-list))))
1150 (list vc-dir-backend files only-files-list state model)))
1151
74d0991f 1152;;;###autoload
b861de91 1153(defun vc-dir (dir &optional backend)
2399e875
RS
1154 "Show the VC status for \"interesting\" files in and below DIR.
1155This allows you to mark files and perform VC operations on them.
1156The list omits files which are up to date, with no changes in your copy
1157or the repository, if there is nothing in particular to say about them.
1158
1159Preparing the list of file status takes time; when the buffer
1160first appears, it has only the first few lines of summary information.
1161The file lines appear later.
1162
b861de91 1163Optional second argument BACKEND specifies the VC backend to use.
2399e875
RS
1164Interactively, a prefix argument means to ask for the backend.
1165
1166These are the commands available for use in the file status buffer:
1167
35639eb4 1168\\{vc-dir-mode-map}"
2399e875 1169
c4c0a44b
DN
1170 (interactive
1171 (list
9b9b7655
SS
1172 ;; When you hit C-x v d in a visited VC file,
1173 ;; the *vc-dir* buffer visits the directory under its truename;
1174 ;; therefore it makes sense to always do that.
1175 ;; Otherwise if you do C-x v d -> C-x C-f -> C-c v d
1176 ;; you may get a new *vc-dir* buffer, different from the original
1177 (file-truename (read-file-name "VC status for directory: "
1178 default-directory default-directory t
1179 nil #'file-directory-p))
c4c0a44b
DN
1180 (if current-prefix-arg
1181 (intern
1182 (completing-read
1183 "Use VC backend: "
b861de91
AS
1184 (mapcar (lambda (b) (list (symbol-name b)))
1185 vc-handled-backends)
1186 nil t nil nil)))))
1187 (unless backend
1188 (setq backend (vc-responsible-backend dir)))
98cfec0d
CY
1189 (let (pop-up-windows) ; based on cvs-examine; bug#6204
1190 (pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir backend)))
c4c0a44b 1191 (if (derived-mode-p 'vc-dir-mode)
74d0991f 1192 (vc-dir-refresh)
c4c0a44b
DN
1193 ;; FIXME: find a better way to pass the backend to `vc-dir-mode'.
1194 (let ((use-vc-backend backend))
1195 (vc-dir-mode))))
74d0991f 1196
13ad7457 1197(defun vc-default-dir-extra-headers (backend dir)
74d0991f
DN
1198 ;; Be loud by default to remind people to add code to display
1199 ;; backend specific headers.
1200 ;; XXX: change this to return nil before the release.
1201 (concat
1202 (propertize "Extra : " 'face 'font-lock-type-face)
1203 (propertize "Please add backend specific headers here. It's easy!"
1204 'face 'font-lock-warning-face)))
1205
c7f9e440 1206(defvar vc-dir-filename-mouse-map
f8d5a47f
NR
1207 (let ((map (make-sparse-keymap)))
1208 (define-key map [mouse-2] 'vc-dir-find-file-other-window)
1209 map)
1210 "Local keymap for visiting a file.")
1211
13ad7457 1212(defun vc-default-dir-printer (backend fileentry)
74d0991f
DN
1213 "Pretty print FILEENTRY."
1214 ;; If you change the layout here, change vc-dir-move-to-goal-column.
c7f9e440
DN
1215 ;; VC backends can implement backend specific versions of this
1216 ;; function. Changes here might need to be reflected in the
1217 ;; vc-BACKEND-dir-printer functions.
74d0991f 1218 (let* ((isdir (vc-dir-fileinfo->directory fileentry))
c4c0a44b 1219 (state (if isdir "" (vc-dir-fileinfo->state fileentry)))
74d0991f 1220 (filename (vc-dir-fileinfo->name fileentry)))
74d0991f
DN
1221 (insert
1222 (propertize
1223 (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? ))
1224 'face 'font-lock-type-face)
1225 " "
1226 (propertize
1227 (format "%-20s" state)
1228 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
1229 ((memq state '(missing conflict)) 'font-lock-warning-face)
1230 (t 'font-lock-variable-name-face))
1231 'mouse-face 'highlight)
1232 " "
1233 (propertize
1234 (format "%s" filename)
c4c0a44b
DN
1235 'face
1236 (if isdir 'font-lock-comment-delimiter-face 'font-lock-function-name-face)
1237 'help-echo
a1fc8acb
JB
1238 (if isdir
1239 "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
c4c0a44b 1240 "File\nmouse-3: Pop-up menu")
f8d5a47f 1241 'mouse-face 'highlight
c7f9e440 1242 'keymap vc-dir-filename-mouse-map))))
74d0991f
DN
1243
1244(defun vc-default-extra-status-menu (backend)
1245 nil)
1246
1247(defun vc-default-status-fileinfo-extra (backend file)
1248 "Default absence of extra information returned for a file."
1249 nil)
1250
1251(provide 'vc-dir)
1252
81c5ac7e 1253;; arch-tag: 0274a2e3-e8e9-4b1a-a73c-e8b9129d5d15
74d0991f 1254;;; vc-dir.el ends here