aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDan Nicolaescu2008-06-22 19:04:22 +0000
committerDan Nicolaescu2008-06-22 19:04:22 +0000
commit74d0991fc5eadcc805f3ed7e62686310c0ad5b79 (patch)
treebf807f677dac71e88ca0c7a2abe0b9b666ad29cf
parentf439c140ace6b9e780e6f35821336767584ea1b0 (diff)
downloademacs-74d0991fc5eadcc805f3ed7e62686310c0ad5b79.tar.gz
emacs-74d0991fc5eadcc805f3ed7e62686310c0ad5b79.zip
* vc.el:
* vc-hooks.el: * vc-dispatcher.el: Move vc-dir variables and functions ... * vc-dir.el: ... here. New file. * Makefile.in (ELCFILES): Add vc-dir.elc.
-rw-r--r--lisp/ChangeLog6
-rw-r--r--lisp/Makefile.in1
-rw-r--r--lisp/vc-dir.el1049
-rw-r--r--lisp/vc-dispatcher.el868
-rw-r--r--lisp/vc-hooks.el2
-rw-r--r--lisp/vc.el269
6 files changed, 1127 insertions, 1068 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 691ef655a39..67aecdf5475 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,11 @@
12008-06-22 Dan Nicolaescu <dann@ics.uci.edu> 12008-06-22 Dan Nicolaescu <dann@ics.uci.edu>
2 2
3 * vc.el:
4 * vc-hooks.el:
5 * vc-dispatcher.el: Move vc-dir variables and functions ...
6 * vc-dir.el: ... here. New file.
7 * Makefile.in (ELCFILES): Add vc-dir.elc.
8
3 * vc.el: Move vc-annotate variables and functions ... 9 * vc.el: Move vc-annotate variables and functions ...
4 * vc-annotate.el: ... here. New file. 10 * vc-annotate.el: ... here. New file.
5 * Makefile.in (ELCFILES): Add vc-annotate.elc. 11 * Makefile.in (ELCFILES): Add vc-annotate.elc.
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 9d00747c01e..752e61388e8 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -1214,6 +1214,7 @@ ELCFILES = \
1214 $(lisp)/vc-bzr.elc \ 1214 $(lisp)/vc-bzr.elc \
1215 $(lisp)/vc-cvs.elc \ 1215 $(lisp)/vc-cvs.elc \
1216 $(lisp)/vc-dav.elc \ 1216 $(lisp)/vc-dav.elc \
1217 $(lisp)/vc-dir.elc \
1217 $(lisp)/vc-dispatcher.elc \ 1218 $(lisp)/vc-dispatcher.elc \
1218 $(lisp)/vc-git.elc \ 1219 $(lisp)/vc-git.elc \
1219 $(lisp)/vc-hg.elc \ 1220 $(lisp)/vc-hg.elc \
diff --git a/lisp/vc-dir.el b/lisp/vc-dir.el
new file mode 100644
index 00000000000..917ba9ce744
--- /dev/null
+++ b/lisp/vc-dir.el
@@ -0,0 +1,1049 @@
1;;; vc-dir.el --- Directory status display under VC
2
3;; Copyright (C) 2007, 2008
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:
30;;
31;; Alexandre Julliard <julliard@winehq.org>
32;; Stefan Monnier <monnier@iro.umontreal.ca>
33;; Tom Tromey <tromey@redhat.com>
34
35;;; Commentary:
36;;
37
38;;; Todo: see vc.el.
39
40(require 'vc-hooks)
41(require 'vc)
42(require 'ewoc)
43
44;;; Code:
45(eval-when-compile
46 (require 'cl))
47
48(defcustom vc-dir-mode-hook nil
49 "Normal hook run by `vc-dir-mode'.
50See `run-hooks'."
51 :type 'hook
52 :group 'vc)
53
54;; Used to store information for the files displayed in the directory buffer.
55;; Each item displayed corresponds to one of these defstructs.
56(defstruct (vc-dir-fileinfo
57 (:copier nil)
58 (:type list) ;So we can use `member' on lists of FIs.
59 (:constructor
60 ;; We could define it as an alias for `list'.
61 vc-dir-create-fileinfo (name state &optional extra marked directory))
62 (:conc-name vc-dir-fileinfo->))
63 name ;Keep it as first, for `member'.
64 state
65 ;; For storing client-mode specific information.
66 extra
67 marked
68 ;; To keep track of not updated files during a global refresh
69 needs-update
70 ;; To distinguish files and directories.
71 directory)
72
73;; Used to describe a dispatcher client mode.
74(defstruct (vc-client-object
75 (:copier nil)
76 (:constructor
77 vc-create-client-object (name
78 headers
79 file-to-info
80 file-to-state
81 file-to-extra
82 updater
83 extra-menu))
84 (:conc-name vc-client-object->))
85 name
86 headers
87 file-to-info
88 file-to-state
89 file-to-extra
90 updater
91 extra-menu)
92
93(defvar vc-ewoc nil)
94(defvar vc-dir-process-buffer nil
95 "The buffer used for the asynchronous call that computes status.")
96
97(defun vc-dir-move-to-goal-column ()
98 ;; Used to keep the cursor on the file name column.
99 (beginning-of-line)
100 (unless (eolp)
101 ;; Must be in sync with vc-default-status-printer.
102 (forward-char 25)))
103
104(defun vc-dir-prepare-status-buffer (bname dir &optional create-new)
105 "Find a buffer named BNAME showing DIR, or create a new one."
106 (setq dir (expand-file-name dir))
107 (let*
108 ;; Look for another buffer name BNAME visiting the same directory.
109 ((buf (save-excursion
110 (unless create-new
111 (dolist (buffer (buffer-list))
112 (set-buffer buffer)
113 (when (and (vc-dispatcher-browsing)
114 (string= (expand-file-name default-directory) dir))
115 (return buffer)))))))
116 (or buf
117 ;; Create a new buffer named BNAME.
118 (with-current-buffer (create-file-buffer bname)
119 (cd dir)
120 (vc-setup-buffer (current-buffer))
121 ;; Reset the vc-parent-buffer-name so that it does not appear
122 ;; in the mode-line.
123 (setq vc-parent-buffer-name nil)
124 (current-buffer)))))
125
126(defvar vc-dir-menu-map
127 (let ((map (make-sparse-keymap "VC-dir")))
128 (define-key map [quit]
129 '(menu-item "Quit" quit-window
130 :help "Quit"))
131 (define-key map [kill]
132 '(menu-item "Kill Update Command" vc-dir-kill-dir-status-process
133 :enable (vc-dir-busy)
134 :help "Kill the command that updates the directory buffer"))
135 (define-key map [refresh]
136 '(menu-item "Refresh" vc-dir-refresh
137 :enable (not (vc-dir-busy))
138 :help "Refresh the contents of the directory buffer"))
139 ;; Movement.
140 (define-key map [sepmv] '("--"))
141 (define-key map [next-line]
142 '(menu-item "Next line" vc-dir-next-line
143 :help "Go to the next line" :keys "n"))
144 (define-key map [previous-line]
145 '(menu-item "Previous line" vc-dir-previous-line
146 :help "Go to the previous line"))
147 ;; Marking.
148 (define-key map [sepmrk] '("--"))
149 (define-key map [unmark-all]
150 '(menu-item "Unmark All" vc-dir-unmark-all-files
151 :help "Unmark all files that are in the same state as the current file\
152\nWith prefix argument unmark all files"))
153 (define-key map [unmark-previous]
154 '(menu-item "Unmark previous " vc-dir-unmark-file-up
155 :help "Move to the previous line and unmark the file"))
156
157 (define-key map [mark-all]
158 '(menu-item "Mark All" vc-dir-mark-all-files
159 :help "Mark all files that are in the same state as the current file\
160\nWith prefix argument mark all files"))
161 (define-key map [unmark]
162 '(menu-item "Unmark" vc-dir-unmark
163 :help "Unmark the current file or all files in the region"))
164
165 (define-key map [mark]
166 '(menu-item "Mark" vc-dir-mark
167 :help "Mark the current file or all files in the region"))
168
169 (define-key map [sepopn] '("--"))
170 (define-key map [open-other]
171 '(menu-item "Open in other window" vc-dir-find-file-other-window
172 :help "Find the file on the current line, in another window"))
173 (define-key map [open]
174 '(menu-item "Open file" vc-dir-find-file
175 :help "Find the file on the current line"))
176 map)
177 "Menu for dispatcher status")
178
179(defvar vc-client-mode)
180
181;; This is used so that client modes can add mode-specific menu
182;; items to vc-dir-menu-map.
183(defun vc-dir-menu-map-filter (orig-binding)
184 (when (and (symbolp orig-binding) (fboundp orig-binding))
185 (setq orig-binding (indirect-function orig-binding)))
186 (let ((ext-binding
187 ;; This may be executed at load-time for tool-bar-local-item-from-menu
188 ;; but at that time vc-client-mode is not known (or even bound) yet.
189 (when (and (boundp 'vc-client-mode) vc-client-mode)
190 (funcall (vc-client-object->extra-menu vc-client-mode)))))
191 (if (null ext-binding)
192 orig-binding
193 (append orig-binding
194 '("----")
195 ext-binding))))
196
197(defvar vc-dir-mode-map
198 (let ((map (make-keymap)))
199 (suppress-keymap map)
200 ;; Marking.
201 (define-key map "m" 'vc-dir-mark)
202 (define-key map "M" 'vc-dir-mark-all-files)
203 (define-key map "u" 'vc-dir-unmark)
204 (define-key map "U" 'vc-dir-unmark-all-files)
205 (define-key map "\C-?" 'vc-dir-unmark-file-up)
206 (define-key map "\M-\C-?" 'vc-dir-unmark-all-files)
207 ;; Movement.
208 (define-key map "n" 'vc-dir-next-line)
209 (define-key map " " 'vc-dir-next-line)
210 (define-key map "\t" 'vc-dir-next-directory)
211 (define-key map "p" 'vc-dir-previous-line)
212 (define-key map [backtab] 'vc-dir-previous-directory)
213 ;;; Rebind paragraph-movement commands.
214 (define-key map "\M-}" 'vc-dir-next-directory)
215 (define-key map "\M-{" 'vc-dir-previous-directory)
216 (define-key map [C-down] 'vc-dir-next-directory)
217 (define-key map [C-up] 'vc-dir-previous-directory)
218 ;; The remainder.
219 (define-key map "f" 'vc-dir-find-file)
220 (define-key map "\C-m" 'vc-dir-find-file)
221 (define-key map "o" 'vc-dir-find-file-other-window)
222 (define-key map "q" 'quit-window)
223 (define-key map "g" 'vc-dir-refresh)
224 (define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process)
225 (define-key map [down-mouse-3] 'vc-dir-menu)
226 (define-key map [mouse-2] 'vc-dir-toggle-mark)
227
228 ;; Hook up the menu.
229 (define-key map [menu-bar vc-dir-mode]
230 `(menu-item
231 ;; This is used so that client modes can add mode-specific
232 ;; menu items to vc-dir-menu-map.
233 "VC-dir" ,vc-dir-menu-map :filter vc-dir-menu-map-filter))
234 map)
235 "Keymap for directory buffer.")
236
237(defmacro vc-at-event (event &rest body)
238 "Evaluate `body' with point located at event-start of `event'.
239If `body' uses `event', it should be a variable,
240 otherwise it will be evaluated twice."
241 (let ((posn (make-symbol "vc-at-event-posn")))
242 `(let ((,posn (event-start ,event)))
243 (save-excursion
244 (set-buffer (window-buffer (posn-window ,posn)))
245 (goto-char (posn-point ,posn))
246 ,@body))))
247
248(defun vc-dir-menu (e)
249 "Popup the dispatcher status menu."
250 (interactive "e")
251 (vc-at-event e (popup-menu vc-dir-menu-map e)))
252
253(defvar vc-dir-tool-bar-map
254 (let ((map (make-sparse-keymap)))
255 (tool-bar-local-item-from-menu 'vc-dir-find-file "open"
256 map vc-dir-mode-map)
257 (tool-bar-local-item "bookmark_add"
258 'vc-dir-toggle-mark 'vc-dir-toggle-mark map
259 :help "Toggle mark on current item")
260 (tool-bar-local-item-from-menu 'vc-dir-previous-line "left-arrow"
261 map vc-dir-mode-map
262 :rtl "right-arrow")
263 (tool-bar-local-item-from-menu 'vc-dir-next-line "right-arrow"
264 map vc-dir-mode-map
265 :rtl "left-arrow")
266 (tool-bar-local-item-from-menu 'vc-print-log "info"
267 map vc-dir-mode-map)
268 (tool-bar-local-item-from-menu 'vc-dir-refresh "refresh"
269 map vc-dir-mode-map)
270 (tool-bar-local-item-from-menu 'nonincremental-search-forward
271 "search" map)
272 (tool-bar-local-item-from-menu 'vc-dir-kill-dir-status-process "cancel"
273 map vc-dir-mode-map)
274 (tool-bar-local-item-from-menu 'quit-window "exit"
275 map vc-dir-mode-map)
276 map))
277
278(defun vc-dir-node-directory (node)
279 ;; Compute the directory for NODE.
280 ;; If it's a directory node, get it from the the node.
281 (let ((data (ewoc-data node)))
282 (or (vc-dir-fileinfo->directory data)
283 ;; Otherwise compute it from the file name.
284 (file-name-directory
285 (expand-file-name
286 (vc-dir-fileinfo->name data))))))
287
288(defun vc-dir-update (entries buffer &optional noinsert)
289 "Update BUFFER's ewoc from the list of ENTRIES.
290If NOINSERT, ignore elements on ENTRIES which are not in the ewoc."
291 ;; Add ENTRIES to the vc-dir buffer BUFFER.
292 (with-current-buffer buffer
293 ;; Insert the entries sorted by name into the ewoc.
294 ;; We assume the ewoc is sorted too, which should be the
295 ;; case if we always add entries with vc-dir-update.
296 (setq entries
297 ;; Sort: first files and then subdirectories.
298 ;; XXX: this is VERY inefficient, it computes the directory
299 ;; names too many times
300 (sort entries
301 (lambda (entry1 entry2)
302 (let ((dir1 (file-name-directory (expand-file-name (car entry1))))
303 (dir2 (file-name-directory (expand-file-name (car entry2)))))
304 (cond
305 ((string< dir1 dir2) t)
306 ((not (string= dir1 dir2)) nil)
307 ((string< (car entry1) (car entry2))))))))
308 ;; Insert directory entries in the right places.
309 (let ((entry (car entries))
310 (node (ewoc-nth vc-ewoc 0)))
311 ;; Insert . if it is not present.
312 (unless node
313 (let ((rd (file-relative-name default-directory)))
314 (ewoc-enter-last
315 vc-ewoc (vc-dir-create-fileinfo
316 rd nil nil nil (expand-file-name default-directory))))
317 (setq node (ewoc-nth vc-ewoc 0)))
318
319 (while (and entry node)
320 (let* ((entryfile (car entry))
321 (entrydir (file-name-directory (expand-file-name entryfile)))
322 (nodedir (vc-dir-node-directory node)))
323 (cond
324 ;; First try to find the directory.
325 ((string-lessp nodedir entrydir)
326 (setq node (ewoc-next vc-ewoc node)))
327 ((string-equal nodedir entrydir)
328 ;; Found the directory, find the place for the file name.
329 (let ((nodefile (vc-dir-fileinfo->name (ewoc-data node))))
330 (cond
331 ((string-lessp nodefile entryfile)
332 (setq node (ewoc-next vc-ewoc node)))
333 ((string-equal nodefile entryfile)
334 (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
335 (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
336 (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
337 (ewoc-invalidate vc-ewoc node)
338 (setq entries (cdr entries))
339 (setq entry (car entries))
340 (setq node (ewoc-next vc-ewoc node)))
341 (t
342 (ewoc-enter-before vc-ewoc node
343 (apply 'vc-dir-create-fileinfo entry))
344 (setq entries (cdr entries))
345 (setq entry (car entries))))))
346 (t
347 ;; We might need to insert a directory node if the
348 ;; previous node was in a different directory.
349 (let* ((rd (file-relative-name entrydir))
350 (prev-node (ewoc-prev vc-ewoc node))
351 (prev-dir (vc-dir-node-directory prev-node)))
352 (unless (string-equal entrydir prev-dir)
353 (ewoc-enter-before
354 vc-ewoc node (vc-dir-create-fileinfo rd nil nil nil entrydir))))
355 ;; Now insert the node itself.
356 (ewoc-enter-before vc-ewoc node
357 (apply 'vc-dir-create-fileinfo entry))
358 (setq entries (cdr entries) entry (car entries))))))
359 ;; We're past the last node, all remaining entries go to the end.
360 (unless (or node noinsert)
361 (let ((lastdir (vc-dir-node-directory (ewoc-nth vc-ewoc -1))))
362 (dolist (entry entries)
363 (let ((entrydir (file-name-directory (expand-file-name (car entry)))))
364 ;; Insert a directory node if needed.
365 (unless (string-equal lastdir entrydir)
366 (setq lastdir entrydir)
367 (let ((rd (file-relative-name entrydir)))
368 (ewoc-enter-last
369 vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir))))
370 ;; Now insert the node itself.
371 (ewoc-enter-last vc-ewoc
372 (apply 'vc-dir-create-fileinfo entry)))))))))
373
374(defun vc-dir-busy ()
375 (and (buffer-live-p vc-dir-process-buffer)
376 (get-buffer-process vc-dir-process-buffer)))
377
378(defun vc-dir-kill-dir-status-process ()
379 "Kill the temporary buffer and associated process."
380 (interactive)
381 (when (buffer-live-p vc-dir-process-buffer)
382 (let ((proc (get-buffer-process vc-dir-process-buffer)))
383 (when proc (delete-process proc))
384 (setq vc-dir-process-buffer nil)
385 (setq mode-line-process nil))))
386
387(defun vc-dir-kill-query ()
388 ;; Make sure that when the status buffer is killed the update
389 ;; process running in background is also killed.
390 (if (vc-dir-busy)
391 (when (y-or-n-p "Status update process running, really kill status buffer? ")
392 (vc-dir-kill-dir-status-process)
393 t)
394 t))
395
396(defun vc-dir-next-line (arg)
397 "Go to the next line.
398If a prefix argument is given, move by that many lines."
399 (interactive "p")
400 (with-no-warnings
401 (ewoc-goto-next vc-ewoc arg)
402 (vc-dir-move-to-goal-column)))
403
404(defun vc-dir-previous-line (arg)
405 "Go to the previous line.
406If a prefix argument is given, move by that many lines."
407 (interactive "p")
408 (ewoc-goto-prev vc-ewoc arg)
409 (vc-dir-move-to-goal-column))
410
411(defun vc-dir-next-directory ()
412 "Go to the next directory."
413 (interactive)
414 (let ((orig (point)))
415 (if
416 (catch 'foundit
417 (while t
418 (let* ((next (ewoc-next vc-ewoc (ewoc-locate vc-ewoc))))
419 (cond ((not next)
420 (throw 'foundit t))
421 (t
422 (progn
423 (ewoc-goto-node vc-ewoc next)
424 (vc-dir-move-to-goal-column)
425 (if (vc-dir-fileinfo->directory (ewoc-data next))
426 (throw 'foundit nil))))))))
427 (goto-char orig))))
428
429(defun vc-dir-previous-directory ()
430 "Go to the previous directory."
431 (interactive)
432 (let ((orig (point)))
433 (if
434 (catch 'foundit
435 (while t
436 (let* ((prev (ewoc-prev vc-ewoc (ewoc-locate vc-ewoc))))
437 (cond ((not prev)
438 (throw 'foundit t))
439 (t
440 (progn
441 (ewoc-goto-node vc-ewoc prev)
442 (vc-dir-move-to-goal-column)
443 (if (vc-dir-fileinfo->directory (ewoc-data prev))
444 (throw 'foundit nil))))))))
445 (goto-char orig))))
446
447(defun vc-dir-mark-unmark (mark-unmark-function)
448 (if (use-region-p)
449 (let ((firstl (line-number-at-pos (region-beginning)))
450 (lastl (line-number-at-pos (region-end))))
451 (save-excursion
452 (goto-char (region-beginning))
453 (while (<= (line-number-at-pos) lastl)
454 (funcall mark-unmark-function))))
455 (funcall mark-unmark-function)))
456
457(defun vc-string-prefix-p (prefix string)
458 (let ((lpref (length prefix)))
459 (and (>= (length string) lpref)
460 (eq t (compare-strings prefix nil nil string nil lpref)))))
461
462(defun vc-dir-parent-marked-p (arg)
463 ;; Return nil if none of the parent directories of arg is marked.
464 (let* ((argdir (vc-dir-node-directory arg))
465 (arglen (length argdir))
466 (crt arg)
467 data dir)
468 ;; Go through the predecessors, checking if any directory that is
469 ;; a parent is marked.
470 (while (setq crt (ewoc-prev vc-ewoc crt))
471 (setq data (ewoc-data crt))
472 (setq dir (vc-dir-node-directory crt))
473 (when (and (vc-dir-fileinfo->directory data)
474 (vc-string-prefix-p dir argdir))
475 (when (vc-dir-fileinfo->marked data)
476 (error "Cannot mark `%s', parent directory `%s' marked"
477 (vc-dir-fileinfo->name (ewoc-data arg))
478 (vc-dir-fileinfo->name data)))))
479 nil))
480
481(defun vc-dir-children-marked-p (arg)
482 ;; Return nil if none of the children of arg is marked.
483 (let* ((argdir-re (concat "\\`" (regexp-quote (vc-dir-node-directory arg))))
484 (is-child t)
485 (crt arg)
486 data dir)
487 (while (and is-child (setq crt (ewoc-next vc-ewoc crt)))
488 (setq data (ewoc-data crt))
489 (setq dir (vc-dir-node-directory crt))
490 (if (string-match argdir-re dir)
491 (when (vc-dir-fileinfo->marked data)
492 (error "Cannot mark `%s', child `%s' marked"
493 (vc-dir-fileinfo->name (ewoc-data arg))
494 (vc-dir-fileinfo->name data)))
495 ;; We are done, we got to an entry that is not a child of `arg'.
496 (setq is-child nil)))
497 nil))
498
499(defun vc-dir-mark-file (&optional arg)
500 ;; Mark ARG or the current file and move to the next line.
501 (let* ((crt (or arg (ewoc-locate vc-ewoc)))
502 (file (ewoc-data crt))
503 (isdir (vc-dir-fileinfo->directory file)))
504 (when (or (and isdir (not (vc-dir-children-marked-p crt)))
505 (and (not isdir) (not (vc-dir-parent-marked-p crt))))
506 (setf (vc-dir-fileinfo->marked file) t)
507 (ewoc-invalidate vc-ewoc crt)
508 (unless (or arg (mouse-event-p last-command-event))
509 (vc-dir-next-line 1)))))
510
511(defun vc-dir-mark ()
512 "Mark the current file or all files in the region.
513If the region is active, mark all the files in the region.
514Otherwise mark the file on the current line and move to the next
515line."
516 (interactive)
517 (vc-dir-mark-unmark 'vc-dir-mark-file))
518
519(defun vc-dir-mark-all-files (arg)
520 "Mark all files with the same state as the current one.
521With a prefix argument mark all files.
522If the current entry is a directory, mark all child files.
523
524The commands operate on files that are on the same state.
525This command is intended to make it easy to select all files that
526share the same state."
527 (interactive "P")
528 (if arg
529 ;; Mark all files.
530 (progn
531 ;; First check that no directory is marked, we can't mark
532 ;; files in that case.
533 (ewoc-map
534 (lambda (filearg)
535 (when (and (vc-dir-fileinfo->directory filearg)
536 (vc-dir-fileinfo->marked filearg))
537 (error "Cannot mark all files, directory `%s' marked"
538 (vc-dir-fileinfo->name filearg))))
539 vc-ewoc)
540 (ewoc-map
541 (lambda (filearg)
542 (unless (vc-dir-fileinfo->marked filearg)
543 (setf (vc-dir-fileinfo->marked filearg) t)
544 t))
545 vc-ewoc))
546 (let ((data (ewoc-data (ewoc-locate vc-ewoc))))
547 (if (vc-dir-fileinfo->directory data)
548 ;; It's a directory, mark child files.
549 (let ((crt (ewoc-locate vc-ewoc)))
550 (unless (vc-dir-children-marked-p crt)
551 (while (setq crt (ewoc-next vc-ewoc crt))
552 (let ((crt-data (ewoc-data crt)))
553 (unless (vc-dir-fileinfo->directory crt-data)
554 (setf (vc-dir-fileinfo->marked crt-data) t)
555 (ewoc-invalidate vc-ewoc crt))))))
556 ;; It's a file
557 (let ((state (vc-dir-fileinfo->state data))
558 (crt (ewoc-nth vc-ewoc 0)))
559 (while crt
560 (let ((crt-data (ewoc-data crt)))
561 (when (and (not (vc-dir-fileinfo->marked crt-data))
562 (eq (vc-dir-fileinfo->state crt-data) state)
563 (not (vc-dir-fileinfo->directory crt-data)))
564 (vc-dir-mark-file crt)))
565 (setq crt (ewoc-next vc-ewoc crt))))))))
566
567(defun vc-dir-unmark-file ()
568 ;; Unmark the current file and move to the next line.
569 (let* ((crt (ewoc-locate vc-ewoc))
570 (file (ewoc-data crt)))
571 (setf (vc-dir-fileinfo->marked file) nil)
572 (ewoc-invalidate vc-ewoc crt)
573 (unless (mouse-event-p last-command-event)
574 (vc-dir-next-line 1))))
575
576(defun vc-dir-unmark ()
577 "Unmark the current file or all files in the region.
578If the region is active, unmark all the files in the region.
579Otherwise mark the file on the current line and move to the next
580line."
581 (interactive)
582 (vc-dir-mark-unmark 'vc-dir-unmark-file))
583
584(defun vc-dir-unmark-file-up ()
585 "Move to the previous line and unmark the file."
586 (interactive)
587 ;; If we're on the first line, we won't move up, but we will still
588 ;; remove the mark. This seems a bit odd but it is what buffer-menu
589 ;; does.
590 (let* ((prev (ewoc-goto-prev vc-ewoc 1))
591 (file (ewoc-data prev)))
592 (setf (vc-dir-fileinfo->marked file) nil)
593 (ewoc-invalidate vc-ewoc prev)
594 (vc-dir-move-to-goal-column)))
595
596(defun vc-dir-unmark-all-files (arg)
597 "Unmark all files with the same state as the current one.
598With a prefix argument unmark all files.
599If the current entry is a directory, unmark all the child files.
600
601The commands operate on files that are on the same state.
602This command is intended to make it easy to deselect all files
603that share the same state."
604 (interactive "P")
605 (if arg
606 (ewoc-map
607 (lambda (filearg)
608 (when (vc-dir-fileinfo->marked filearg)
609 (setf (vc-dir-fileinfo->marked filearg) nil)
610 t))
611 vc-ewoc)
612 (let* ((crt (ewoc-locate vc-ewoc))
613 (data (ewoc-data crt)))
614 (if (vc-dir-fileinfo->directory data)
615 ;; It's a directory, unmark child files.
616 (while (setq crt (ewoc-next vc-ewoc crt))
617 (let ((crt-data (ewoc-data crt)))
618 (unless (vc-dir-fileinfo->directory crt-data)
619 (setf (vc-dir-fileinfo->marked crt-data) nil)
620 (ewoc-invalidate vc-ewoc crt))))
621 ;; It's a file
622 (let ((crt-state (vc-dir-fileinfo->state (ewoc-data crt))))
623 (ewoc-map
624 (lambda (filearg)
625 (when (and (vc-dir-fileinfo->marked filearg)
626 (eq (vc-dir-fileinfo->state filearg) crt-state))
627 (setf (vc-dir-fileinfo->marked filearg) nil)
628 t))
629 vc-ewoc))))))
630
631(defun vc-dir-toggle-mark-file ()
632 (let* ((crt (ewoc-locate vc-ewoc))
633 (file (ewoc-data crt)))
634 (if (vc-dir-fileinfo->marked file)
635 (vc-dir-unmark-file)
636 (vc-dir-mark-file))))
637
638(defun vc-dir-toggle-mark (e)
639 (interactive "e")
640 (vc-at-event e (vc-dir-mark-unmark 'vc-dir-toggle-mark-file)))
641
642(defun vc-dir-delete-file ()
643 "Delete the marked files, or the current file if no marks."
644 (interactive)
645 (mapc 'vc-delete-file (or (vc-dir-marked-files)
646 (list (vc-dir-current-file)))))
647
648(defun vc-dir-find-file ()
649 "Find the file on the current line."
650 (interactive)
651 (find-file (vc-dir-current-file)))
652
653(defun vc-dir-find-file-other-window ()
654 "Find the file on the current line, in another window."
655 (interactive)
656 (find-file-other-window (vc-dir-current-file)))
657
658(defun vc-dir-current-file ()
659 (let ((node (ewoc-locate vc-ewoc)))
660 (unless node
661 (error "No file available"))
662 (expand-file-name (vc-dir-fileinfo->name (ewoc-data node)))))
663
664(defun vc-dir-marked-files ()
665 "Return the list of marked files."
666 (mapcar
667 (lambda (elem) (expand-file-name (vc-dir-fileinfo->name elem)))
668 (ewoc-collect vc-ewoc 'vc-dir-fileinfo->marked)))
669
670(defun vc-dir-marked-only-files ()
671 "Return the list of marked files, for marked directories return child files."
672 (let ((crt (ewoc-nth vc-ewoc 0))
673 result)
674 (while crt
675 (let ((crt-data (ewoc-data crt)))
676 (if (vc-dir-fileinfo->marked crt-data)
677 ;; FIXME: use vc-dir-child-files here instead of duplicating it.
678 (if (vc-dir-fileinfo->directory crt-data)
679 (let* ((dir (vc-dir-fileinfo->directory crt-data))
680 (dirlen (length dir))
681 data)
682 (while
683 (and (setq crt (ewoc-next vc-ewoc crt))
684 (vc-string-prefix-p dir
685 (progn
686 (setq data (ewoc-data crt))
687 (vc-dir-node-directory crt))))
688 (unless (vc-dir-fileinfo->directory data)
689 (push (expand-file-name (vc-dir-fileinfo->name data)) result))))
690 (push (expand-file-name (vc-dir-fileinfo->name crt-data)) result)
691 (setq crt (ewoc-next vc-ewoc crt)))
692 (setq crt (ewoc-next vc-ewoc crt)))))
693 result))
694
695(defun vc-dir-child-files ()
696 "Return the list of child files for the current entry if it's a directory.
697If it is a file, return the file itself."
698 (let* ((crt (ewoc-locate vc-ewoc))
699 (crt-data (ewoc-data crt))
700 result)
701 (if (vc-dir-fileinfo->directory crt-data)
702 (let* ((dir (vc-dir-fileinfo->directory crt-data))
703 (dirlen (length dir))
704 data)
705 (while
706 (and (setq crt (ewoc-next vc-ewoc crt))
707 (vc-string-prefix-p dir (progn
708 (setq data (ewoc-data crt))
709 (vc-dir-node-directory crt))))
710 (unless (vc-dir-fileinfo->directory data)
711 (push (expand-file-name (vc-dir-fileinfo->name data)) result))))
712 (push (expand-file-name (vc-dir-fileinfo->name crt-data)) result))
713 result))
714
715(defun vc-dir-resynch-file (&optional fname)
716 "Update the entries for FILE in any directory buffers that list it."
717 (let ((file (or fname (expand-file-name buffer-file-name))))
718 (if (file-directory-p file)
719 ;; FIXME: Maybe this should never happen?
720 ;; FIXME: But it is useful to update the state of a directory
721 ;; (more precisely the files in the directory) after some VC
722 ;; operations.
723 nil
724 (let ((found-vc-dir-buf nil))
725 (save-excursion
726 (dolist (status-buf (buffer-list))
727 (set-buffer status-buf)
728 ;; look for a vc-dir buffer that might show this file.
729 (when (derived-mode-p 'vc-dir-mode)
730 (setq found-vc-dir-buf t)
731 (let ((ddir (expand-file-name default-directory)))
732 (when (vc-string-prefix-p ddir file)
733 (let*
734 ;; FIXME: Any reason we don't use file-relative-name?
735 ((file-short (substring file (length ddir)))
736 (state (funcall (vc-client-object->file-to-state
737 vc-client-mode)
738 file))
739 (extra (funcall (vc-client-object->file-to-extra
740 vc-client-mode)
741 file))
742 (entry
743 (list file-short state extra)))
744 (vc-dir-update (list entry) status-buf))))))
745 ;; We didn't find any vc-dir buffers, remove the hook, it is
746 ;; not needed.
747 (unless found-vc-dir-buf
748 (remove-hook 'after-save-hook 'vc-dir-resynch-file)))))))
749
750(defun vc-dir-mode (client-object)
751 "Major mode for dispatcher directory buffers.
752Marking/Unmarking key bindings and actions:
753m - marks a file/directory or if the region is active, mark all the files
754 in region.
755 Restrictions: - a file cannot be marked if any parent directory is marked
756 - a directory cannot be marked if any child file or
757 directory is marked
758u - marks a file/directory or if the region is active, unmark all the files
759 in region.
760M - if the cursor is on a file: mark all the files with the same state as
761 the current file
762 - if the cursor is on a directory: mark all child files
763 - with a prefix argument: mark all files
764U - if the cursor is on a file: unmark all the files with the same state
765 as the current file
766 - if the cursor is on a directory: unmark all child files
767 - with a prefix argument: unmark all files
768
769
770\\{vc-dir-mode-map}"
771 (setq mode-name (vc-client-object->name client-object))
772 (setq major-mode 'vc-dir-mode)
773 (setq buffer-read-only t)
774 (use-local-map vc-dir-mode-map)
775 (if (boundp 'tool-bar-map)
776 (set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map))
777 (set (make-local-variable 'vc-client-mode) client-object)
778 (let ((buffer-read-only nil))
779 (erase-buffer)
780 (set (make-local-variable 'vc-dir-process-buffer) nil)
781 (set (make-local-variable 'vc-ewoc)
782 (ewoc-create (vc-client-object->file-to-info client-object)
783 (vc-client-object->headers client-object)))
784 (add-hook 'after-save-hook 'vc-dir-resynch-file)
785 ;; Make sure that if the directory buffer is killed, the update
786 ;; process running in the background is also killed.
787 (add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t)
788 (funcall (vc-client-object->updater client-object)))
789 (run-hooks 'vc-dir-mode-hook))
790
791(put 'vc-dir-mode 'mode-class 'special)
792
793(defvar vc-dir-backend nil
794 "The backend used by the current *vc-dir* buffer.")
795
796(defun vc-dir-headers (backend dir)
797 "Display the headers in the *VC dir* buffer.
798It calls the `status-extra-headers' backend method to display backend
799specific headers."
800 (concat
801 (propertize "VC backend : " 'face 'font-lock-type-face)
802 (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face)
803 (propertize "Working dir: " 'face 'font-lock-type-face)
804 (propertize (format "%s\n" dir) 'face 'font-lock-variable-name-face)
805 (vc-call-backend backend 'status-extra-headers dir)
806 "\n"))
807
808(defun vc-dir-refresh-files (files default-state)
809 "Refresh some files in the *VC-dir* buffer."
810 (let ((def-dir default-directory)
811 (backend vc-dir-backend))
812 (vc-set-mode-line-busy-indicator)
813 ;; Call the `dir-status-file' backend function.
814 ;; `dir-status-file' is supposed to be asynchronous.
815 ;; It should compute the results, and then call the function
816 ;; passed as an argument in order to update the vc-dir buffer
817 ;; with the results.
818 (unless (buffer-live-p vc-dir-process-buffer)
819 (setq vc-dir-process-buffer
820 (generate-new-buffer (format " *VC-%s* tmp status" backend))))
821 (lexical-let ((buffer (current-buffer)))
822 (with-current-buffer vc-dir-process-buffer
823 (cd def-dir)
824 (erase-buffer)
825 (vc-call-backend
826 backend 'dir-status-files def-dir files default-state
827 (lambda (entries &optional more-to-come)
828 ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
829 ;; If MORE-TO-COME is true, then more updates will come from
830 ;; the asynchronous process.
831 (with-current-buffer buffer
832 (vc-dir-update entries buffer)
833 (unless more-to-come
834 (setq mode-line-process nil)
835 ;; Remove the ones that haven't been updated at all.
836 ;; Those not-updated are those whose state is nil because the
837 ;; file/dir doesn't exist and isn't versioned.
838 (ewoc-filter vc-ewoc
839 (lambda (info)
840 ;; The state for directory entries might
841 ;; have been changed to 'up-to-date,
842 ;; reset it, othewise it will be removed when doing 'x'
843 ;; next time.
844 ;; FIXME: There should be a more elegant way to do this.
845 (when (and (vc-dir-fileinfo->directory info)
846 (eq (vc-dir-fileinfo->state info)
847 'up-to-date))
848 (setf (vc-dir-fileinfo->state info) nil))
849
850 (not (vc-dir-fileinfo->needs-update info))))))))))))
851
852(defun vc-dir-refresh ()
853 "Refresh the contents of the *VC-dir* buffer.
854Throw an error if another update process is in progress."
855 (interactive)
856 (if (vc-dir-busy)
857 (error "Another update process is in progress, cannot run two at a time")
858 (let ((def-dir default-directory)
859 (backend vc-dir-backend))
860 (vc-set-mode-line-busy-indicator)
861 ;; Call the `dir-status' backend function.
862 ;; `dir-status' is supposed to be asynchronous.
863 ;; It should compute the results, and then call the function
864 ;; passed as an argument in order to update the vc-dir buffer
865 ;; with the results.
866
867 ;; Create a buffer that can be used by `dir-status' and call
868 ;; `dir-status' with this buffer as the current buffer. Use
869 ;; `vc-dir-process-buffer' to remember this buffer, so that
870 ;; it can be used later to kill the update process in case it
871 ;; takes too long.
872 (unless (buffer-live-p vc-dir-process-buffer)
873 (setq vc-dir-process-buffer
874 (generate-new-buffer (format " *VC-%s* tmp status" backend))))
875 ;; set the needs-update flag on all entries
876 (ewoc-map (lambda (info) (setf (vc-dir-fileinfo->needs-update info) t) nil)
877 vc-ewoc)
878 (lexical-let ((buffer (current-buffer)))
879 (with-current-buffer vc-dir-process-buffer
880 (cd def-dir)
881 (erase-buffer)
882 (vc-call-backend
883 backend 'dir-status def-dir
884 (lambda (entries &optional more-to-come)
885 ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
886 ;; If MORE-TO-COME is true, then more updates will come from
887 ;; the asynchronous process.
888 (with-current-buffer buffer
889 (vc-dir-update entries buffer)
890 (unless more-to-come
891 (let ((remaining
892 (ewoc-collect
893 vc-ewoc 'vc-dir-fileinfo->needs-update)))
894 (if remaining
895 (vc-dir-refresh-files
896 (mapcar 'vc-dir-fileinfo->name remaining)
897 'up-to-date)
898 (setq mode-line-process nil))))))))))))
899
900(defun vc-dir-show-fileentry (file)
901 "Insert an entry for a specific file into the current *VC-dir* listing.
902This is typically used if the file is up-to-date (or has been added
903outside of VC) and one wants to do some operation on it."
904 (interactive "fShow file: ")
905 (vc-dir-update (list (list (file-relative-name file) (vc-state file))) (current-buffer)))
906
907(defun vc-dir-hide-up-to-date ()
908 "Hide up-to-date items from display."
909 (interactive)
910 (ewoc-filter
911 vc-ewoc
912 (lambda (crt) (not (eq (vc-dir-fileinfo->state crt) 'up-to-date)))))
913
914;; FIXME: Replace these with a more efficient dispatch
915
916(defun vc-generic-status-printer (fileentry)
917 (vc-call-backend vc-dir-backend 'status-printer fileentry))
918
919(defun vc-generic-state (file)
920 (vc-call-backend vc-dir-backend 'state file))
921
922(defun vc-generic-status-fileinfo-extra (file)
923 (vc-call-backend vc-dir-backend 'status-fileinfo-extra file))
924
925(defun vc-dir-extra-menu ()
926 (vc-call-backend vc-dir-backend 'extra-status-menu))
927
928(defun vc-make-backend-object (file-or-dir)
929 "Create the backend capability object needed by vc-dispatcher."
930 (vc-create-client-object
931 "VC dir"
932 (vc-dir-headers vc-dir-backend file-or-dir)
933 #'vc-generic-status-printer
934 #'vc-generic-state
935 #'vc-generic-status-fileinfo-extra
936 #'vc-dir-refresh
937 #'vc-dir-extra-menu))
938
939;;;###autoload
940(defun vc-dir (dir)
941 "Show the VC status for DIR."
942 (interactive "DVC status for directory: ")
943 (pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir))
944 (if (and (derived-mode-p 'vc-dir-mode) (boundp 'client-object))
945 (vc-dir-refresh)
946 ;; Otherwise, initialize a new view using the dispatcher layer
947 (progn
948 (set (make-local-variable 'vc-dir-backend) (vc-responsible-backend dir))
949 ;; Build a capability object and hand it to the dispatcher initializer
950 (vc-dir-mode (vc-make-backend-object dir))
951 ;; FIXME: Make a derived-mode instead.
952 ;; Add VC-specific keybindings
953 (let ((map (current-local-map)))
954 (define-key map "v" 'vc-next-action) ;; C-x v v
955 (define-key map "=" 'vc-diff) ;; C-x v =
956 (define-key map "i" 'vc-register) ;; C-x v i
957 (define-key map "+" 'vc-update) ;; C-x v +
958 (define-key map "l" 'vc-print-log) ;; C-x v l
959 ;; More confusing than helpful, probably
960 ;(define-key map "R" 'vc-revert) ;; u is taken by dispatcher unmark.
961 ;(define-key map "A" 'vc-annotate) ;; g is taken by dispatcher refresh
962 (define-key map "x" 'vc-dir-hide-up-to-date))
963 )
964 ;; FIXME: Needs to alter a buffer-local map, otherwise clients may clash
965 (let ((map vc-dir-menu-map))
966 ;; VC info details
967 (define-key map [sepvcdet] '("--"))
968 (define-key map [remup]
969 '(menu-item "Hide up-to-date" vc-dir-hide-up-to-date
970 :help "Hide up-to-date items from display"))
971 ;; FIXME: This needs a key binding. And maybe a better name
972 ;; ("Insert" like PCL-CVS uses does not sound that great either)...
973 (define-key map [ins]
974 '(menu-item "Show File" vc-dir-show-fileentry
975 :help "Show a file in the VC status listing even though it might be up to date"))
976 (define-key map [annotate]
977 '(menu-item "Annotate" vc-annotate
978 :help "Display the edit history of the current file using colors"))
979 (define-key map [diff]
980 '(menu-item "Compare with Base Version" vc-diff
981 :help "Compare file set with the base version"))
982 (define-key map [log]
983 '(menu-item "Show history" vc-print-log
984 :help "List the change log of the current file set in a window"))
985 ;; VC commands.
986 (define-key map [sepvccmd] '("--"))
987 (define-key map [update]
988 '(menu-item "Update to latest version" vc-update
989 :help "Update the current fileset's files to their tip revisions"))
990 (define-key map [revert]
991 '(menu-item "Revert to base version" vc-revert
992 :help "Revert working copies of the selected fileset to their repository contents."))
993 (define-key map [next-action]
994 ;; FIXME: This really really really needs a better name!
995 ;; And a key binding too.
996 '(menu-item "Check In/Out" vc-next-action
997 :help "Do the next logical version control operation on the current fileset"))
998 (define-key map [register]
999 '(menu-item "Register" vc-dir-register
1000 :help "Register file set into the version control system"))
1001 )))
1002
1003(defun vc-default-status-extra-headers (backend dir)
1004 ;; Be loud by default to remind people to add code to display
1005 ;; backend specific headers.
1006 ;; XXX: change this to return nil before the release.
1007 (concat
1008 (propertize "Extra : " 'face 'font-lock-type-face)
1009 (propertize "Please add backend specific headers here. It's easy!"
1010 'face 'font-lock-warning-face)))
1011
1012(defun vc-default-status-printer (backend fileentry)
1013 "Pretty print FILEENTRY."
1014 ;; If you change the layout here, change vc-dir-move-to-goal-column.
1015 (let* ((isdir (vc-dir-fileinfo->directory fileentry))
1016 (state (if isdir 'DIRECTORY (vc-dir-fileinfo->state fileentry)))
1017 (filename (vc-dir-fileinfo->name fileentry)))
1018 ;; FIXME: Backends that want to print the state in a different way
1019 ;; can do it by defining the `status-printer' function. Using
1020 ;; `prettify-state-info' adds two extra vc-calls per item, which
1021 ;; is too expensive.
1022 ;;(prettified (if isdir state (vc-call-backend backend 'prettify-state-info filename))))
1023 (insert
1024 (propertize
1025 (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? ))
1026 'face 'font-lock-type-face)
1027 " "
1028 (propertize
1029 (format "%-20s" state)
1030 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
1031 ((memq state '(missing conflict)) 'font-lock-warning-face)
1032 (t 'font-lock-variable-name-face))
1033 'mouse-face 'highlight)
1034 " "
1035 (propertize
1036 (format "%s" filename)
1037 'face 'font-lock-function-name-face
1038 'mouse-face 'highlight))))
1039
1040(defun vc-default-extra-status-menu (backend)
1041 nil)
1042
1043(defun vc-default-status-fileinfo-extra (backend file)
1044 "Default absence of extra information returned for a file."
1045 nil)
1046
1047(provide 'vc-dir)
1048
1049;;; vc-dir.el ends here
diff --git a/lisp/vc-dispatcher.el b/lisp/vc-dispatcher.el
index c21be117f18..6a91ac343d5 100644
--- a/lisp/vc-dispatcher.el
+++ b/lisp/vc-dispatcher.el
@@ -107,23 +107,8 @@
107 107
108;; To do: 108;; To do:
109;; 109;;
110;; - vc-dir-kill-dir-status-process should not be specific to dir-status,
111;; it should work for other async commands done through vc-do-command
112;; as well,
113;;
114;; - log buffers need font-locking. 110;; - log buffers need font-locking.
115;; 111;;
116;; - vc-dir needs mouse bindings.
117;;
118;; - vc-dir toolbar needs more icons.
119;;
120;; - vc-dir-menu-map-filter hook call needs to be moved to vc.el.
121;;
122
123(require 'ewoc)
124
125(eval-when-compile
126 (require 'cl))
127 112
128;; General customization 113;; General customization
129(defcustom vc-logentry-check-hook nil 114(defcustom vc-logentry-check-hook nil
@@ -157,7 +142,6 @@ preserve the setting."
157(defvar vc-log-after-operation-hook nil) 142(defvar vc-log-after-operation-hook nil)
158(defvar vc-log-fileset) 143(defvar vc-log-fileset)
159(defvar vc-log-extra) 144(defvar vc-log-extra)
160(defvar vc-client-mode)
161 145
162;; In a log entry buffer, this is a local variable 146;; In a log entry buffer, this is a local variable
163;; that points to the buffer for which it was made 147;; that points to the buffer for which it was made
@@ -495,6 +479,8 @@ editing!"
495 (run-hook-with-args 'mode-line-hook buffer-file-name)) 479 (run-hook-with-args 'mode-line-hook buffer-file-name))
496 (kill-buffer (current-buffer))))) 480 (kill-buffer (current-buffer)))))
497 481
482(declare-function vc-dir-resynch-file "vc-dir" (&optional fname))
483
498(defun vc-resynch-buffer (file &optional keep noquery) 484(defun vc-resynch-buffer (file &optional keep noquery)
499 "If FILE is currently visited, resynch its buffer." 485 "If FILE is currently visited, resynch its buffer."
500 (if (string= buffer-file-name file) 486 (if (string= buffer-file-name file)
@@ -573,6 +559,8 @@ for `vc-log-after-operation-hook'."
573 (message "%s Type C-c C-c when done" msg) 559 (message "%s Type C-c C-c when done" msg)
574 (vc-finish-logentry (eq comment t))))) 560 (vc-finish-logentry (eq comment t)))))
575 561
562(declare-function vc-dir-move-to-goal-column "vc-dir" ())
563
576(defun vc-finish-logentry (&optional nocomment) 564(defun vc-finish-logentry (&optional nocomment)
577 "Complete the operation implied by the current log entry. 565 "Complete the operation implied by the current log entry.
578Use the contents of the current buffer as a check-in or registration 566Use the contents of the current buffer as a check-in or registration
@@ -622,806 +610,62 @@ the buffer contents as a comment."
622 (vc-dir-move-to-goal-column)) 610 (vc-dir-move-to-goal-column))
623 (run-hooks after-hook 'vc-finish-logentry-hook))) 611 (run-hooks after-hook 'vc-finish-logentry-hook)))
624 612
625;; The ewoc-based vc-directory implementation
626
627(defcustom vc-dir-mode-hook nil
628 "Normal hook run by `vc-dir-mode'.
629See `run-hooks'."
630 :type 'hook
631 :group 'vc)
632
633;; Used to store information for the files displayed in the directory buffer.
634;; Each item displayed corresponds to one of these defstructs.
635(defstruct (vc-dir-fileinfo
636 (:copier nil)
637 (:type list) ;So we can use `member' on lists of FIs.
638 (:constructor
639 ;; We could define it as an alias for `list'.
640 vc-dir-create-fileinfo (name state &optional extra marked directory))
641 (:conc-name vc-dir-fileinfo->))
642 name ;Keep it as first, for `member'.
643 state
644 ;; For storing client-mode specific information.
645 extra
646 marked
647 ;; To keep track of not updated files during a global refresh
648 needs-update
649 ;; To distinguish files and directories.
650 directory)
651
652;; Used to describe a dispatcher client mode.
653(defstruct (vc-client-object
654 (:copier nil)
655 (:constructor
656 vc-create-client-object (name
657 headers
658 file-to-info
659 file-to-state
660 file-to-extra
661 updater
662 extra-menu))
663 (:conc-name vc-client-object->))
664 name
665 headers
666 file-to-info
667 file-to-state
668 file-to-extra
669 updater
670 extra-menu)
671
672(defvar vc-ewoc nil)
673(defvar vc-dir-process-buffer nil
674 "The buffer used for the asynchronous call that computes status.")
675
676(defun vc-dir-move-to-goal-column ()
677 ;; Used to keep the cursor on the file name column.
678 (beginning-of-line)
679 (unless (eolp)
680 ;; Must be in sync with vc-default-status-printer.
681 (forward-char 25)))
682
683(defun vc-dir-prepare-status-buffer (bname dir &optional create-new)
684 "Find a buffer named BNAME showing DIR, or create a new one."
685 (setq dir (expand-file-name dir))
686 (let*
687 ;; Look for another buffer name BNAME visiting the same directory.
688 ((buf (save-excursion
689 (unless create-new
690 (dolist (buffer (buffer-list))
691 (set-buffer buffer)
692 (when (and (vc-dispatcher-browsing)
693 (string= (expand-file-name default-directory) dir))
694 (return buffer)))))))
695 (or buf
696 ;; Create a new buffer named BNAME.
697 (with-current-buffer (create-file-buffer bname)
698 (cd dir)
699 (vc-setup-buffer (current-buffer))
700 ;; Reset the vc-parent-buffer-name so that it does not appear
701 ;; in the mode-line.
702 (setq vc-parent-buffer-name nil)
703 (current-buffer)))))
704
705(defvar vc-dir-menu-map
706 (let ((map (make-sparse-keymap "VC-dir")))
707 (define-key map [quit]
708 '(menu-item "Quit" quit-window
709 :help "Quit"))
710 (define-key map [kill]
711 '(menu-item "Kill Update Command" vc-dir-kill-dir-status-process
712 :enable (vc-dir-busy)
713 :help "Kill the command that updates the directory buffer"))
714 (define-key map [refresh]
715 '(menu-item "Refresh" vc-dir-refresh
716 :enable (not (vc-dir-busy))
717 :help "Refresh the contents of the directory buffer"))
718 ;; Movement.
719 (define-key map [sepmv] '("--"))
720 (define-key map [next-line]
721 '(menu-item "Next line" vc-dir-next-line
722 :help "Go to the next line" :keys "n"))
723 (define-key map [previous-line]
724 '(menu-item "Previous line" vc-dir-previous-line
725 :help "Go to the previous line"))
726 ;; Marking.
727 (define-key map [sepmrk] '("--"))
728 (define-key map [unmark-all]
729 '(menu-item "Unmark All" vc-dir-unmark-all-files
730 :help "Unmark all files that are in the same state as the current file\
731\nWith prefix argument unmark all files"))
732 (define-key map [unmark-previous]
733 '(menu-item "Unmark previous " vc-dir-unmark-file-up
734 :help "Move to the previous line and unmark the file"))
735
736 (define-key map [mark-all]
737 '(menu-item "Mark All" vc-dir-mark-all-files
738 :help "Mark all files that are in the same state as the current file\
739\nWith prefix argument mark all files"))
740 (define-key map [unmark]
741 '(menu-item "Unmark" vc-dir-unmark
742 :help "Unmark the current file or all files in the region"))
743
744 (define-key map [mark]
745 '(menu-item "Mark" vc-dir-mark
746 :help "Mark the current file or all files in the region"))
747
748 (define-key map [sepopn] '("--"))
749 (define-key map [open-other]
750 '(menu-item "Open in other window" vc-dir-find-file-other-window
751 :help "Find the file on the current line, in another window"))
752 (define-key map [open]
753 '(menu-item "Open file" vc-dir-find-file
754 :help "Find the file on the current line"))
755 map)
756 "Menu for dispatcher status")
757
758;; This is used so that client modes can add mode-specific menu
759;; items to vc-dir-menu-map.
760(defun vc-dir-menu-map-filter (orig-binding)
761 (when (and (symbolp orig-binding) (fboundp orig-binding))
762 (setq orig-binding (indirect-function orig-binding)))
763 (let ((ext-binding
764 ;; This may be executed at load-time for tool-bar-local-item-from-menu
765 ;; but at that time vc-client-mode is not known (or even bound) yet.
766 (when (and (boundp 'vc-client-mode) vc-client-mode)
767 (funcall (vc-client-object->extra-menu vc-client-mode)))))
768 (if (null ext-binding)
769 orig-binding
770 (append orig-binding
771 '("----")
772 ext-binding))))
773
774(defvar vc-dir-mode-map
775 (let ((map (make-keymap)))
776 (suppress-keymap map)
777 ;; Marking.
778 (define-key map "m" 'vc-dir-mark)
779 (define-key map "M" 'vc-dir-mark-all-files)
780 (define-key map "u" 'vc-dir-unmark)
781 (define-key map "U" 'vc-dir-unmark-all-files)
782 (define-key map "\C-?" 'vc-dir-unmark-file-up)
783 (define-key map "\M-\C-?" 'vc-dir-unmark-all-files)
784 ;; Movement.
785 (define-key map "n" 'vc-dir-next-line)
786 (define-key map " " 'vc-dir-next-line)
787 (define-key map "\t" 'vc-dir-next-directory)
788 (define-key map "p" 'vc-dir-previous-line)
789 (define-key map [backtab] 'vc-dir-previous-directory)
790 ;;; Rebind paragraph-movement commands.
791 (define-key map "\M-}" 'vc-dir-next-directory)
792 (define-key map "\M-{" 'vc-dir-previous-directory)
793 (define-key map [C-down] 'vc-dir-next-directory)
794 (define-key map [C-up] 'vc-dir-previous-directory)
795 ;; The remainder.
796 (define-key map "f" 'vc-dir-find-file)
797 (define-key map "\C-m" 'vc-dir-find-file)
798 (define-key map "o" 'vc-dir-find-file-other-window)
799 (define-key map "q" 'quit-window)
800 (define-key map "g" 'vc-dir-refresh)
801 (define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process)
802 (define-key map [down-mouse-3] 'vc-dir-menu)
803 (define-key map [mouse-2] 'vc-dir-toggle-mark)
804
805 ;; Hook up the menu.
806 (define-key map [menu-bar vc-dir-mode]
807 `(menu-item
808 ;; This is used so that client modes can add mode-specific
809 ;; menu items to vc-dir-menu-map.
810 "VC-dir" ,vc-dir-menu-map :filter vc-dir-menu-map-filter))
811 map)
812 "Keymap for directory buffer.")
813
814(defmacro vc-at-event (event &rest body)
815 "Evaluate `body' with point located at event-start of `event'.
816If `body' uses `event', it should be a variable,
817 otherwise it will be evaluated twice."
818 (let ((posn (make-symbol "vc-at-event-posn")))
819 `(let ((,posn (event-start ,event)))
820 (save-excursion
821 (set-buffer (window-buffer (posn-window ,posn)))
822 (goto-char (posn-point ,posn))
823 ,@body))))
824
825(defun vc-dir-menu (e)
826 "Popup the dispatcher status menu."
827 (interactive "e")
828 (vc-at-event e (popup-menu vc-dir-menu-map e)))
829
830(defvar vc-dir-tool-bar-map
831 (let ((map (make-sparse-keymap)))
832 (tool-bar-local-item-from-menu 'vc-dir-find-file "open"
833 map vc-dir-mode-map)
834 (tool-bar-local-item "bookmark_add"
835 'vc-dir-toggle-mark 'vc-dir-toggle-mark map
836 :help "Toggle mark on current item")
837 (tool-bar-local-item-from-menu 'vc-dir-previous-line "left-arrow"
838 map vc-dir-mode-map
839 :rtl "right-arrow")
840 (tool-bar-local-item-from-menu 'vc-dir-next-line "right-arrow"
841 map vc-dir-mode-map
842 :rtl "left-arrow")
843 (tool-bar-local-item-from-menu 'vc-print-log "info"
844 map vc-dir-mode-map)
845 (tool-bar-local-item-from-menu 'vc-dir-refresh "refresh"
846 map vc-dir-mode-map)
847 (tool-bar-local-item-from-menu 'nonincremental-search-forward
848 "search" map)
849 (tool-bar-local-item-from-menu 'vc-dir-kill-dir-status-process "cancel"
850 map vc-dir-mode-map)
851 (tool-bar-local-item-from-menu 'quit-window "exit"
852 map vc-dir-mode-map)
853 map))
854
855(defun vc-dir-node-directory (node)
856 ;; Compute the directory for NODE.
857 ;; If it's a directory node, get it from the the node.
858 (let ((data (ewoc-data node)))
859 (or (vc-dir-fileinfo->directory data)
860 ;; Otherwise compute it from the file name.
861 (file-name-directory
862 (expand-file-name
863 (vc-dir-fileinfo->name data))))))
864
865(defun vc-dir-update (entries buffer &optional noinsert)
866 "Update BUFFER's ewoc from the list of ENTRIES.
867If NOINSERT, ignore elements on ENTRIES which are not in the ewoc."
868 ;; Add ENTRIES to the vc-dir buffer BUFFER.
869 (with-current-buffer buffer
870 ;; Insert the entries sorted by name into the ewoc.
871 ;; We assume the ewoc is sorted too, which should be the
872 ;; case if we always add entries with vc-dir-update.
873 (setq entries
874 ;; Sort: first files and then subdirectories.
875 ;; XXX: this is VERY inefficient, it computes the directory
876 ;; names too many times
877 (sort entries
878 (lambda (entry1 entry2)
879 (let ((dir1 (file-name-directory (expand-file-name (car entry1))))
880 (dir2 (file-name-directory (expand-file-name (car entry2)))))
881 (cond
882 ((string< dir1 dir2) t)
883 ((not (string= dir1 dir2)) nil)
884 ((string< (car entry1) (car entry2))))))))
885 ;; Insert directory entries in the right places.
886 (let ((entry (car entries))
887 (node (ewoc-nth vc-ewoc 0)))
888 ;; Insert . if it is not present.
889 (unless node
890 (let ((rd (file-relative-name default-directory)))
891 (ewoc-enter-last
892 vc-ewoc (vc-dir-create-fileinfo
893 rd nil nil nil (expand-file-name default-directory))))
894 (setq node (ewoc-nth vc-ewoc 0)))
895
896 (while (and entry node)
897 (let* ((entryfile (car entry))
898 (entrydir (file-name-directory (expand-file-name entryfile)))
899 (nodedir (vc-dir-node-directory node)))
900 (cond
901 ;; First try to find the directory.
902 ((string-lessp nodedir entrydir)
903 (setq node (ewoc-next vc-ewoc node)))
904 ((string-equal nodedir entrydir)
905 ;; Found the directory, find the place for the file name.
906 (let ((nodefile (vc-dir-fileinfo->name (ewoc-data node))))
907 (cond
908 ((string-lessp nodefile entryfile)
909 (setq node (ewoc-next vc-ewoc node)))
910 ((string-equal nodefile entryfile)
911 (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
912 (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
913 (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
914 (ewoc-invalidate vc-ewoc node)
915 (setq entries (cdr entries))
916 (setq entry (car entries))
917 (setq node (ewoc-next vc-ewoc node)))
918 (t
919 (ewoc-enter-before vc-ewoc node
920 (apply 'vc-dir-create-fileinfo entry))
921 (setq entries (cdr entries))
922 (setq entry (car entries))))))
923 (t
924 ;; We might need to insert a directory node if the
925 ;; previous node was in a different directory.
926 (let* ((rd (file-relative-name entrydir))
927 (prev-node (ewoc-prev vc-ewoc node))
928 (prev-dir (vc-dir-node-directory prev-node)))
929 (unless (string-equal entrydir prev-dir)
930 (ewoc-enter-before
931 vc-ewoc node (vc-dir-create-fileinfo rd nil nil nil entrydir))))
932 ;; Now insert the node itself.
933 (ewoc-enter-before vc-ewoc node
934 (apply 'vc-dir-create-fileinfo entry))
935 (setq entries (cdr entries) entry (car entries))))))
936 ;; We're past the last node, all remaining entries go to the end.
937 (unless (or node noinsert)
938 (let ((lastdir (vc-dir-node-directory (ewoc-nth vc-ewoc -1))))
939 (dolist (entry entries)
940 (let ((entrydir (file-name-directory (expand-file-name (car entry)))))
941 ;; Insert a directory node if needed.
942 (unless (string-equal lastdir entrydir)
943 (setq lastdir entrydir)
944 (let ((rd (file-relative-name entrydir)))
945 (ewoc-enter-last
946 vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir))))
947 ;; Now insert the node itself.
948 (ewoc-enter-last vc-ewoc
949 (apply 'vc-dir-create-fileinfo entry)))))))))
950
951(defun vc-dir-busy ()
952 (and (buffer-live-p vc-dir-process-buffer)
953 (get-buffer-process vc-dir-process-buffer)))
954
955(defun vc-dir-kill-dir-status-process ()
956 "Kill the temporary buffer and associated process."
957 (interactive)
958 (when (buffer-live-p vc-dir-process-buffer)
959 (let ((proc (get-buffer-process vc-dir-process-buffer)))
960 (when proc (delete-process proc))
961 (setq vc-dir-process-buffer nil)
962 (setq mode-line-process nil))))
963
964(defun vc-dir-kill-query ()
965 ;; Make sure that when the status buffer is killed the update
966 ;; process running in background is also killed.
967 (if (vc-dir-busy)
968 (when (y-or-n-p "Status update process running, really kill status buffer?")
969 (vc-dir-kill-dir-status-process)
970 t)
971 t))
972
973(defun vc-dir-next-line (arg)
974 "Go to the next line.
975If a prefix argument is given, move by that many lines."
976 (interactive "p")
977 (with-no-warnings
978 (ewoc-goto-next vc-ewoc arg)
979 (vc-dir-move-to-goal-column)))
980
981(defun vc-dir-previous-line (arg)
982 "Go to the previous line.
983If a prefix argument is given, move by that many lines."
984 (interactive "p")
985 (ewoc-goto-prev vc-ewoc arg)
986 (vc-dir-move-to-goal-column))
987
988(defun vc-dir-next-directory ()
989 "Go to the next directory."
990 (interactive)
991 (let ((orig (point)))
992 (if
993 (catch 'foundit
994 (while t
995 (let* ((next (ewoc-next vc-ewoc (ewoc-locate vc-ewoc))))
996 (cond ((not next)
997 (throw 'foundit t))
998 (t
999 (progn
1000 (ewoc-goto-node vc-ewoc next)
1001 (vc-dir-move-to-goal-column)
1002 (if (vc-dir-fileinfo->directory (ewoc-data next))
1003 (throw 'foundit nil))))))))
1004 (goto-char orig))))
1005
1006(defun vc-dir-previous-directory ()
1007 "Go to the previous directory."
1008 (interactive)
1009 (let ((orig (point)))
1010 (if
1011 (catch 'foundit
1012 (while t
1013 (let* ((prev (ewoc-prev vc-ewoc (ewoc-locate vc-ewoc))))
1014 (cond ((not prev)
1015 (throw 'foundit t))
1016 (t
1017 (progn
1018 (ewoc-goto-node vc-ewoc prev)
1019 (vc-dir-move-to-goal-column)
1020 (if (vc-dir-fileinfo->directory (ewoc-data prev))
1021 (throw 'foundit nil))))))))
1022 (goto-char orig))))
1023
1024(defun vc-dir-mark-unmark (mark-unmark-function)
1025 (if (use-region-p)
1026 (let ((firstl (line-number-at-pos (region-beginning)))
1027 (lastl (line-number-at-pos (region-end))))
1028 (save-excursion
1029 (goto-char (region-beginning))
1030 (while (<= (line-number-at-pos) lastl)
1031 (funcall mark-unmark-function))))
1032 (funcall mark-unmark-function)))
1033
1034(defun vc-string-prefix-p (prefix string)
1035 (let ((lpref (length prefix)))
1036 (and (>= (length string) lpref)
1037 (eq t (compare-strings prefix nil nil string nil lpref)))))
1038
1039(defun vc-dir-parent-marked-p (arg)
1040 ;; Return nil if none of the parent directories of arg is marked.
1041 (let* ((argdir (vc-dir-node-directory arg))
1042 (arglen (length argdir))
1043 (crt arg)
1044 data dir)
1045 ;; Go through the predecessors, checking if any directory that is
1046 ;; a parent is marked.
1047 (while (setq crt (ewoc-prev vc-ewoc crt))
1048 (setq data (ewoc-data crt))
1049 (setq dir (vc-dir-node-directory crt))
1050 (when (and (vc-dir-fileinfo->directory data)
1051 (vc-string-prefix-p dir argdir))
1052 (when (vc-dir-fileinfo->marked data)
1053 (error "Cannot mark `%s', parent directory `%s' marked"
1054 (vc-dir-fileinfo->name (ewoc-data arg))
1055 (vc-dir-fileinfo->name data)))))
1056 nil))
1057
1058(defun vc-dir-children-marked-p (arg)
1059 ;; Return nil if none of the children of arg is marked.
1060 (let* ((argdir-re (concat "\\`" (regexp-quote (vc-dir-node-directory arg))))
1061 (is-child t)
1062 (crt arg)
1063 data dir)
1064 (while (and is-child (setq crt (ewoc-next vc-ewoc crt)))
1065 (setq data (ewoc-data crt))
1066 (setq dir (vc-dir-node-directory crt))
1067 (if (string-match argdir-re dir)
1068 (when (vc-dir-fileinfo->marked data)
1069 (error "Cannot mark `%s', child `%s' marked"
1070 (vc-dir-fileinfo->name (ewoc-data arg))
1071 (vc-dir-fileinfo->name data)))
1072 ;; We are done, we got to an entry that is not a child of `arg'.
1073 (setq is-child nil)))
1074 nil))
1075
1076(defun vc-dir-mark-file (&optional arg)
1077 ;; Mark ARG or the current file and move to the next line.
1078 (let* ((crt (or arg (ewoc-locate vc-ewoc)))
1079 (file (ewoc-data crt))
1080 (isdir (vc-dir-fileinfo->directory file)))
1081 (when (or (and isdir (not (vc-dir-children-marked-p crt)))
1082 (and (not isdir) (not (vc-dir-parent-marked-p crt))))
1083 (setf (vc-dir-fileinfo->marked file) t)
1084 (ewoc-invalidate vc-ewoc crt)
1085 (unless (or arg (mouse-event-p last-command-event))
1086 (vc-dir-next-line 1)))))
1087
1088(defun vc-dir-mark ()
1089 "Mark the current file or all files in the region.
1090If the region is active, mark all the files in the region.
1091Otherwise mark the file on the current line and move to the next
1092line."
1093 (interactive)
1094 (vc-dir-mark-unmark 'vc-dir-mark-file))
1095
1096(defun vc-dir-mark-all-files (arg)
1097 "Mark all files with the same state as the current one.
1098With a prefix argument mark all files.
1099If the current entry is a directory, mark all child files.
1100
1101The commands operate on files that are on the same state.
1102This command is intended to make it easy to select all files that
1103share the same state."
1104 (interactive "P")
1105 (if arg
1106 ;; Mark all files.
1107 (progn
1108 ;; First check that no directory is marked, we can't mark
1109 ;; files in that case.
1110 (ewoc-map
1111 (lambda (filearg)
1112 (when (and (vc-dir-fileinfo->directory filearg)
1113 (vc-dir-fileinfo->marked filearg))
1114 (error "Cannot mark all files, directory `%s' marked"
1115 (vc-dir-fileinfo->name filearg))))
1116 vc-ewoc)
1117 (ewoc-map
1118 (lambda (filearg)
1119 (unless (vc-dir-fileinfo->marked filearg)
1120 (setf (vc-dir-fileinfo->marked filearg) t)
1121 t))
1122 vc-ewoc))
1123 (let ((data (ewoc-data (ewoc-locate vc-ewoc))))
1124 (if (vc-dir-fileinfo->directory data)
1125 ;; It's a directory, mark child files.
1126 (let ((crt (ewoc-locate vc-ewoc)))
1127 (unless (vc-dir-children-marked-p crt)
1128 (while (setq crt (ewoc-next vc-ewoc crt))
1129 (let ((crt-data (ewoc-data crt)))
1130 (unless (vc-dir-fileinfo->directory crt-data)
1131 (setf (vc-dir-fileinfo->marked crt-data) t)
1132 (ewoc-invalidate vc-ewoc crt))))))
1133 ;; It's a file
1134 (let ((state (vc-dir-fileinfo->state data))
1135 (crt (ewoc-nth vc-ewoc 0)))
1136 (while crt
1137 (let ((crt-data (ewoc-data crt)))
1138 (when (and (not (vc-dir-fileinfo->marked crt-data))
1139 (eq (vc-dir-fileinfo->state crt-data) state)
1140 (not (vc-dir-fileinfo->directory crt-data)))
1141 (vc-dir-mark-file crt)))
1142 (setq crt (ewoc-next vc-ewoc crt))))))))
1143
1144(defun vc-dir-unmark-file ()
1145 ;; Unmark the current file and move to the next line.
1146 (let* ((crt (ewoc-locate vc-ewoc))
1147 (file (ewoc-data crt)))
1148 (setf (vc-dir-fileinfo->marked file) nil)
1149 (ewoc-invalidate vc-ewoc crt)
1150 (unless (mouse-event-p last-command-event)
1151 (vc-dir-next-line 1))))
1152
1153(defun vc-dir-unmark ()
1154 "Unmark the current file or all files in the region.
1155If the region is active, unmark all the files in the region.
1156Otherwise mark the file on the current line and move to the next
1157line."
1158 (interactive)
1159 (vc-dir-mark-unmark 'vc-dir-unmark-file))
1160
1161(defun vc-dir-unmark-file-up ()
1162 "Move to the previous line and unmark the file."
1163 (interactive)
1164 ;; If we're on the first line, we won't move up, but we will still
1165 ;; remove the mark. This seems a bit odd but it is what buffer-menu
1166 ;; does.
1167 (let* ((prev (ewoc-goto-prev vc-ewoc 1))
1168 (file (ewoc-data prev)))
1169 (setf (vc-dir-fileinfo->marked file) nil)
1170 (ewoc-invalidate vc-ewoc prev)
1171 (vc-dir-move-to-goal-column)))
1172
1173(defun vc-dir-unmark-all-files (arg)
1174 "Unmark all files with the same state as the current one.
1175With a prefix argument unmark all files.
1176If the current entry is a directory, unmark all the child files.
1177
1178The commands operate on files that are on the same state.
1179This command is intended to make it easy to deselect all files
1180that share the same state."
1181 (interactive "P")
1182 (if arg
1183 (ewoc-map
1184 (lambda (filearg)
1185 (when (vc-dir-fileinfo->marked filearg)
1186 (setf (vc-dir-fileinfo->marked filearg) nil)
1187 t))
1188 vc-ewoc)
1189 (let* ((crt (ewoc-locate vc-ewoc))
1190 (data (ewoc-data crt)))
1191 (if (vc-dir-fileinfo->directory data)
1192 ;; It's a directory, unmark child files.
1193 (while (setq crt (ewoc-next vc-ewoc crt))
1194 (let ((crt-data (ewoc-data crt)))
1195 (unless (vc-dir-fileinfo->directory crt-data)
1196 (setf (vc-dir-fileinfo->marked crt-data) nil)
1197 (ewoc-invalidate vc-ewoc crt))))
1198 ;; It's a file
1199 (let ((crt-state (vc-dir-fileinfo->state (ewoc-data crt))))
1200 (ewoc-map
1201 (lambda (filearg)
1202 (when (and (vc-dir-fileinfo->marked filearg)
1203 (eq (vc-dir-fileinfo->state filearg) crt-state))
1204 (setf (vc-dir-fileinfo->marked filearg) nil)
1205 t))
1206 vc-ewoc))))))
1207
1208(defun vc-dir-toggle-mark-file ()
1209 (let* ((crt (ewoc-locate vc-ewoc))
1210 (file (ewoc-data crt)))
1211 (if (vc-dir-fileinfo->marked file)
1212 (vc-dir-unmark-file)
1213 (vc-dir-mark-file))))
1214
1215(defun vc-dir-toggle-mark (e)
1216 (interactive "e")
1217 (vc-at-event e (vc-dir-mark-unmark 'vc-dir-toggle-mark-file)))
1218
1219(defun vc-dir-delete-file ()
1220 "Delete the marked files, or the current file if no marks."
1221 (interactive)
1222 (mapc 'vc-delete-file (or (vc-dir-marked-files)
1223 (list (vc-dir-current-file)))))
1224
1225(defun vc-dir-find-file ()
1226 "Find the file on the current line."
1227 (interactive)
1228 (find-file (vc-dir-current-file)))
1229
1230(defun vc-dir-find-file-other-window ()
1231 "Find the file on the current line, in another window."
1232 (interactive)
1233 (find-file-other-window (vc-dir-current-file)))
1234
1235(defun vc-dir-current-file ()
1236 (let ((node (ewoc-locate vc-ewoc)))
1237 (unless node
1238 (error "No file available."))
1239 (expand-file-name (vc-dir-fileinfo->name (ewoc-data node)))))
1240
1241(defun vc-dir-marked-files ()
1242 "Return the list of marked files."
1243 (mapcar
1244 (lambda (elem) (expand-file-name (vc-dir-fileinfo->name elem)))
1245 (ewoc-collect vc-ewoc 'vc-dir-fileinfo->marked)))
1246
1247(defun vc-dir-marked-only-files ()
1248 "Return the list of marked files, for marked directories return child files."
1249 (let ((crt (ewoc-nth vc-ewoc 0))
1250 result)
1251 (while crt
1252 (let ((crt-data (ewoc-data crt)))
1253 (if (vc-dir-fileinfo->marked crt-data)
1254 ;; FIXME: use vc-dir-child-files here instead of duplicating it.
1255 (if (vc-dir-fileinfo->directory crt-data)
1256 (let* ((dir (vc-dir-fileinfo->directory crt-data))
1257 (dirlen (length dir))
1258 data)
1259 (while
1260 (and (setq crt (ewoc-next vc-ewoc crt))
1261 (vc-string-prefix-p dir
1262 (progn
1263 (setq data (ewoc-data crt))
1264 (vc-dir-node-directory crt))))
1265 (unless (vc-dir-fileinfo->directory data)
1266 (push (expand-file-name (vc-dir-fileinfo->name data)) result))))
1267 (push (expand-file-name (vc-dir-fileinfo->name crt-data)) result)
1268 (setq crt (ewoc-next vc-ewoc crt)))
1269 (setq crt (ewoc-next vc-ewoc crt)))))
1270 result))
1271
1272(defun vc-dir-child-files ()
1273 "Return the list of child files for the current entry if it's a directory.
1274If it is a file, return the file itself."
1275 (let* ((crt (ewoc-locate vc-ewoc))
1276 (crt-data (ewoc-data crt))
1277 result)
1278 (if (vc-dir-fileinfo->directory crt-data)
1279 (let* ((dir (vc-dir-fileinfo->directory crt-data))
1280 (dirlen (length dir))
1281 data)
1282 (while
1283 (and (setq crt (ewoc-next vc-ewoc crt))
1284 (vc-string-prefix-p dir (progn
1285 (setq data (ewoc-data crt))
1286 (vc-dir-node-directory crt))))
1287 (unless (vc-dir-fileinfo->directory data)
1288 (push (expand-file-name (vc-dir-fileinfo->name data)) result))))
1289 (push (expand-file-name (vc-dir-fileinfo->name crt-data)) result))
1290 result))
1291
1292(defun vc-dir-resynch-file (&optional fname)
1293 "Update the entries for FILE in any directory buffers that list it."
1294 (let ((file (or fname (expand-file-name buffer-file-name))))
1295 (if (file-directory-p file)
1296 ;; FIXME: Maybe this should never happen?
1297 ;; FIXME: But it is useful to update the state of a directory
1298 ;; (more precisely the files in the directory) after some VC
1299 ;; operations.
1300 nil
1301 (let ((found-vc-dir-buf nil))
1302 (save-excursion
1303 (dolist (status-buf (buffer-list))
1304 (set-buffer status-buf)
1305 ;; look for a vc-dir buffer that might show this file.
1306 (when (derived-mode-p 'vc-dir-mode)
1307 (setq found-vc-dir-buf t)
1308 (let ((ddir (expand-file-name default-directory)))
1309 (when (vc-string-prefix-p ddir file)
1310 (let*
1311 ;; FIXME: Any reason we don't use file-relative-name?
1312 ((file-short (substring file (length ddir)))
1313 (state (funcall (vc-client-object->file-to-state
1314 vc-client-mode)
1315 file))
1316 (extra (funcall (vc-client-object->file-to-extra
1317 vc-client-mode)
1318 file))
1319 (entry
1320 (list file-short state extra)))
1321 (vc-dir-update (list entry) status-buf))))))
1322 ;; We didn't find any vc-dir buffers, remove the hook, it is
1323 ;; not needed.
1324 (unless found-vc-dir-buf
1325 (remove-hook 'after-save-hook 'vc-dir-resynch-file)))))))
1326
1327(defun vc-dir-mode (client-object)
1328 "Major mode for dispatcher directory buffers.
1329Marking/Unmarking key bindings and actions:
1330m - marks a file/directory or if the region is active, mark all the files
1331 in region.
1332 Restrictions: - a file cannot be marked if any parent directory is marked
1333 - a directory cannot be marked if any child file or
1334 directory is marked
1335u - marks a file/directory or if the region is active, unmark all the files
1336 in region.
1337M - if the cursor is on a file: mark all the files with the same state as
1338 the current file
1339 - if the cursor is on a directory: mark all child files
1340 - with a prefix argument: mark all files
1341U - if the cursor is on a file: unmark all the files with the same state
1342 as the current file
1343 - if the cursor is on a directory: unmark all child files
1344 - with a prefix argument: unmark all files
1345
1346
1347\\{vc-dir-mode-map}"
1348 (setq mode-name (vc-client-object->name client-object))
1349 (setq major-mode 'vc-dir-mode)
1350 (setq buffer-read-only t)
1351 (use-local-map vc-dir-mode-map)
1352 (if (boundp 'tool-bar-map)
1353 (set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map))
1354 (set (make-local-variable 'vc-client-mode) client-object)
1355 (let ((buffer-read-only nil))
1356 (erase-buffer)
1357 (set (make-local-variable 'vc-dir-process-buffer) nil)
1358 (set (make-local-variable 'vc-ewoc)
1359 (ewoc-create (vc-client-object->file-to-info client-object)
1360 (vc-client-object->headers client-object)))
1361 (add-hook 'after-save-hook 'vc-dir-resynch-file)
1362 ;; Make sure that if the directory buffer is killed, the update
1363 ;; process running in the background is also killed.
1364 (add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t)
1365 (funcall (vc-client-object->updater client-object)))
1366 (run-hooks 'vc-dir-mode-hook))
1367
1368(put 'vc-dir-mode 'mode-class 'special)
1369
1370(defun vc-dispatcher-browsing () 613(defun vc-dispatcher-browsing ()
1371 "Are we in a directory browser buffer?" 614 "Are we in a directory browser buffer?"
1372 (derived-mode-p 'vc-dir-mode)) 615 (derived-mode-p 'vc-dir-mode))
1373 616
1374(defun vc-dispatcher-in-fileset-p (fileset) 617;; These are unused.
1375 (let ((member nil)) 618;; (defun vc-dispatcher-in-fileset-p (fileset)
1376 (while (and (not member) fileset) 619;; (let ((member nil))
1377 (let ((elem (pop fileset))) 620;; (while (and (not member) fileset)
1378 (if (if (file-directory-p elem) 621;; (let ((elem (pop fileset)))
1379 (eq t (compare-strings buffer-file-name nil (length elem) 622;; (if (if (file-directory-p elem)
1380 elem nil nil)) 623;; (eq t (compare-strings buffer-file-name nil (length elem)
1381 (eq (current-buffer) (get-file-buffer elem))) 624;; elem nil nil))
1382 (setq member t)))) 625;; (eq (current-buffer) (get-file-buffer elem)))
1383 member)) 626;; (setq member t))))
1384 627;; member))
1385(defun vc-dispatcher-selection-set (&optional observer) 628
1386 "Deduce a set of files to which to apply an operation. Return a cons 629;; (defun vc-dispatcher-selection-set (&optional observer)
1387cell (SELECTION . FILESET), where SELECTION is what the user chose 630;; "Deduce a set of files to which to apply an operation. Return a cons
1388and FILES is the flist with any directories replaced by the listed files 631;; cell (SELECTION . FILESET), where SELECTION is what the user chose
1389within them. 632;; and FILES is the flist with any directories replaced by the listed files
1390 633;; within them.
1391If we're in a directory display, the fileset is the list of marked files (if 634
1392there is one) else the file on the current line. If not in a directory 635;; If we're in a directory display, the fileset is the list of marked files (if
1393display, but the current buffer visits a file, the fileset is a singleton 636;; there is one) else the file on the current line. If not in a directory
1394containing that file. Otherwise, throw an error." 637;; display, but the current buffer visits a file, the fileset is a singleton
1395 (let ((selection 638;; containing that file. Otherwise, throw an error."
1396 (cond 639;; (let ((selection
1397 ;; Browsing with vc-dir 640;; (cond
1398 ((vc-dispatcher-browsing) 641;; ;; Browsing with vc-dir
1399 ;; If no files are marked, temporarily mark current file 642;; ((vc-dispatcher-browsing)
1400 ;; and choose on that basis (so we get subordinate files) 643;; ;; If no files are marked, temporarily mark current file
1401 (if (not (vc-dir-marked-files)) 644;; ;; and choose on that basis (so we get subordinate files)
1402 (prog2 645;; (if (not (vc-dir-marked-files))
1403 (vc-dir-mark-file) 646;; (prog2
1404 (cons (vc-dir-marked-files) (vc-dir-marked-only-files)) 647;; (vc-dir-mark-file)
1405 (vc-dir-unmark-all-files t)) 648;; (cons (vc-dir-marked-files) (vc-dir-marked-only-files))
1406 (cons (vc-dir-marked-files) (vc-dir-marked-only-files)))) 649;; (vc-dir-unmark-all-files t))
1407 ;; Visiting an eligible file 650;; (cons (vc-dir-marked-files) (vc-dir-marked-only-files))))
1408 ((buffer-file-name) 651;; ;; Visiting an eligible file
1409 (cons (list buffer-file-name) (list buffer-file-name))) 652;; ((buffer-file-name)
1410 ;; No eligible file -- if there's a parent buffer, deduce from there 653;; (cons (list buffer-file-name) (list buffer-file-name)))
1411 ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer) 654;; ;; No eligible file -- if there's a parent buffer, deduce from there
1412 (with-current-buffer vc-parent-buffer 655;; ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer)
1413 (vc-dispatcher-browsing)))) 656;; (with-current-buffer vc-parent-buffer
1414 (with-current-buffer vc-parent-buffer 657;; (vc-dispatcher-browsing))))
1415 (vc-dispatcher-selection-set))) 658;; (with-current-buffer vc-parent-buffer
1416 ;; No good set here, throw error 659;; (vc-dispatcher-selection-set)))
1417 (t (error "No fileset is available here"))))) 660;; ;; No good set here, throw error
1418 ;; We assume, in order to avoid unpleasant surprises to the user, 661;; (t (error "No fileset is available here")))))
1419 ;; that a fileset is not in good shape to be handed to the user if the 662;; ;; We assume, in order to avoid unpleasant surprises to the user,
1420 ;; buffers visiting the fileset don't match the on-disk contents. 663;; ;; that a fileset is not in good shape to be handed to the user if the
1421 (unless observer 664;; ;; buffers visiting the fileset don't match the on-disk contents.
1422 (save-some-buffers 665;; (unless observer
1423 nil (lambda () (vc-dispatcher-in-fileset-p (cdr selection))))) 666;; (save-some-buffers
1424 selection)) 667;; nil (lambda () (vc-dispatcher-in-fileset-p (cdr selection)))))
668;; selection))
1425 669
1426(provide 'vc-dispatcher) 670(provide 'vc-dispatcher)
1427 671
diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el
index 7ac1e85650f..2ccbdcc5671 100644
--- a/lisp/vc-hooks.el
+++ b/lisp/vc-hooks.el
@@ -745,7 +745,7 @@ Before doing that, check if there are any old backups and get rid of them."
745 (vc-call-backend backend 'make-version-backups-p file) 745 (vc-call-backend backend 'make-version-backups-p file)
746 (vc-make-version-backup file))))) 746 (vc-make-version-backup file)))))
747 747
748(declare-function vc-dir-resynch-file "vc-dispatcher" (&optional fname)) 748(declare-function vc-dir-resynch-file "vc-dir" (&optional fname))
749 749
750(defun vc-after-save () 750(defun vc-after-save ()
751 "Function to be called by `basic-save-buffer' (in files.el)." 751 "Function to be called by `basic-save-buffer' (in files.el)."
diff --git a/lisp/vc.el b/lisp/vc.el
index 600d432dad2..c783ffa8e91 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -640,6 +640,14 @@
640;; Those logs should likely use a local variable to hardware the VC they 640;; Those logs should likely use a local variable to hardware the VC they
641;; are supposed to work with. 641;; are supposed to work with.
642;; 642;;
643;; - vc-dir-kill-dir-status-process should not be specific to dir-status,
644;; it should work for other async commands done through vc-do-command
645;; as well,
646;;
647;; - vc-dir toolbar needs more icons.
648;;
649;; - vc-dir-menu-map-filter hook call needs to be moved to vc.el.
650;;
643;;;; Problems: 651;;;; Problems:
644;; 652;;
645;; - the *vc-dir* buffer is not updated correctly anymore after VC 653;; - the *vc-dir* buffer is not updated correctly anymore after VC
@@ -886,8 +894,7 @@ Within directories, only files already under version control are noticed."
886 (vc-parent-buffer (vc-derived-from-dir-mode vc-parent-buffer)) 894 (vc-parent-buffer (vc-derived-from-dir-mode vc-parent-buffer))
887 (t nil)))) 895 (t nil))))
888 896
889(defvar vc-dir-backend nil 897(defvar vc-dir-backend)
890 "The backend used by the current *vc-dir* buffer.")
891 898
892;; FIXME: this is not functional, commented out. 899;; FIXME: this is not functional, commented out.
893;; (defun vc-deduce-fileset (&optional observer) 900;; (defun vc-deduce-fileset (&optional observer)
@@ -906,6 +913,11 @@ Within directories, only files already under version control are noticed."
906;; (vc-backend (car cooked))))) 913;; (vc-backend (car cooked)))))
907;; (cons backend selection))) 914;; (cons backend selection)))
908 915
916(declare-function vc-dir-child-files "vc-dir" ())
917(declare-function vc-dir-current-file "vc-dir" ())
918(declare-function vc-dir-marked-files "vc-dir" ())
919(declare-function vc-dir-marked-only-files "vc-dir" ())
920
909(defun vc-deduce-fileset (&optional observer allow-unregistered only-files) 921(defun vc-deduce-fileset (&optional observer allow-unregistered only-files)
910 "Deduce a set of files and a backend to which to apply an operation. 922 "Deduce a set of files and a backend to which to apply an operation.
911 923
@@ -1751,259 +1763,6 @@ See Info node `Merging'."
1751;;;###autoload 1763;;;###autoload
1752(defalias 'vc-resolve-conflicts 'smerge-ediff) 1764(defalias 'vc-resolve-conflicts 'smerge-ediff)
1753 1765
1754;; VC status implementation
1755
1756(defun vc-default-status-extra-headers (backend dir)
1757 ;; Be loud by default to remind people to add code to display
1758 ;; backend specific headers.
1759 ;; XXX: change this to return nil before the release.
1760 (concat
1761 (propertize "Extra : " 'face 'font-lock-type-face)
1762 (propertize "Please add backend specific headers here. It's easy!"
1763 'face 'font-lock-warning-face)))
1764
1765(defun vc-dir-headers (backend dir)
1766 "Display the headers in the *VC dir* buffer.
1767It calls the `status-extra-headers' backend method to display backend
1768specific headers."
1769 (concat
1770 (propertize "VC backend : " 'face 'font-lock-type-face)
1771 (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face)
1772 (propertize "Working dir: " 'face 'font-lock-type-face)
1773 (propertize (format "%s\n" dir) 'face 'font-lock-variable-name-face)
1774 (vc-call-backend backend 'status-extra-headers dir)
1775 "\n"))
1776
1777(defun vc-default-status-printer (backend fileentry)
1778 "Pretty print FILEENTRY."
1779 ;; If you change the layout here, change vc-dir-move-to-goal-column.
1780 (let* ((isdir (vc-dir-fileinfo->directory fileentry))
1781 (state (if isdir 'DIRECTORY (vc-dir-fileinfo->state fileentry)))
1782 (filename (vc-dir-fileinfo->name fileentry)))
1783 ;; FIXME: Backends that want to print the state in a different way
1784 ;; can do it by defining the `status-printer' function. Using
1785 ;; `prettify-state-info' adds two extra vc-calls per item, which
1786 ;; is too expensive.
1787 ;;(prettified (if isdir state (vc-call-backend backend 'prettify-state-info filename))))
1788 (insert
1789 (propertize
1790 (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? ))
1791 'face 'font-lock-type-face)
1792 " "
1793 (propertize
1794 (format "%-20s" state)
1795 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
1796 ((memq state '(missing conflict)) 'font-lock-warning-face)
1797 (t 'font-lock-variable-name-face))
1798 'mouse-face 'highlight)
1799 " "
1800 (propertize
1801 (format "%s" filename)
1802 'face 'font-lock-function-name-face
1803 'mouse-face 'highlight))))
1804
1805(defun vc-default-extra-status-menu (backend)
1806 nil)
1807
1808(defun vc-dir-refresh-files (files default-state)
1809 "Refresh some files in the *VC-dir* buffer."
1810 (let ((def-dir default-directory)
1811 (backend vc-dir-backend))
1812 (vc-set-mode-line-busy-indicator)
1813 ;; Call the `dir-status-file' backend function.
1814 ;; `dir-status-file' is supposed to be asynchronous.
1815 ;; It should compute the results, and then call the function
1816 ;; passed as an argument in order to update the vc-dir buffer
1817 ;; with the results.
1818 (unless (buffer-live-p vc-dir-process-buffer)
1819 (setq vc-dir-process-buffer
1820 (generate-new-buffer (format " *VC-%s* tmp status" backend))))
1821 (lexical-let ((buffer (current-buffer)))
1822 (with-current-buffer vc-dir-process-buffer
1823 (cd def-dir)
1824 (erase-buffer)
1825 (vc-call-backend
1826 backend 'dir-status-files def-dir files default-state
1827 (lambda (entries &optional more-to-come)
1828 ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
1829 ;; If MORE-TO-COME is true, then more updates will come from
1830 ;; the asynchronous process.
1831 (with-current-buffer buffer
1832 (vc-dir-update entries buffer)
1833 (unless more-to-come
1834 (setq mode-line-process nil)
1835 ;; Remove the ones that haven't been updated at all.
1836 ;; Those not-updated are those whose state is nil because the
1837 ;; file/dir doesn't exist and isn't versioned.
1838 (ewoc-filter vc-ewoc
1839 (lambda (info)
1840 ;; The state for directory entries might
1841 ;; have been changed to 'up-to-date,
1842 ;; reset it, othewise it will be removed when doing 'x'
1843 ;; next time.
1844 ;; FIXME: There should be a more elegant way to do this.
1845 (when (and (vc-dir-fileinfo->directory info)
1846 (eq (vc-dir-fileinfo->state info)
1847 'up-to-date))
1848 (setf (vc-dir-fileinfo->state info) nil))
1849
1850 (not (vc-dir-fileinfo->needs-update info))))))))))))
1851
1852(defun vc-dir-refresh ()
1853 "Refresh the contents of the *VC-dir* buffer.
1854Throw an error if another update process is in progress."
1855 (interactive)
1856 (if (vc-dir-busy)
1857 (error "Another update process is in progress, cannot run two at a time")
1858 (let ((def-dir default-directory)
1859 (backend vc-dir-backend))
1860 (vc-set-mode-line-busy-indicator)
1861 ;; Call the `dir-status' backend function.
1862 ;; `dir-status' is supposed to be asynchronous.
1863 ;; It should compute the results, and then call the function
1864 ;; passed as an argument in order to update the vc-dir buffer
1865 ;; with the results.
1866
1867 ;; Create a buffer that can be used by `dir-status' and call
1868 ;; `dir-status' with this buffer as the current buffer. Use
1869 ;; `vc-dir-process-buffer' to remember this buffer, so that
1870 ;; it can be used later to kill the update process in case it
1871 ;; takes too long.
1872 (unless (buffer-live-p vc-dir-process-buffer)
1873 (setq vc-dir-process-buffer
1874 (generate-new-buffer (format " *VC-%s* tmp status" backend))))
1875 ;; set the needs-update flag on all entries
1876 (ewoc-map (lambda (info) (setf (vc-dir-fileinfo->needs-update info) t) nil)
1877 vc-ewoc)
1878 (lexical-let ((buffer (current-buffer)))
1879 (with-current-buffer vc-dir-process-buffer
1880 (cd def-dir)
1881 (erase-buffer)
1882 (vc-call-backend
1883 backend 'dir-status def-dir
1884 (lambda (entries &optional more-to-come)
1885 ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
1886 ;; If MORE-TO-COME is true, then more updates will come from
1887 ;; the asynchronous process.
1888 (with-current-buffer buffer
1889 (vc-dir-update entries buffer)
1890 (unless more-to-come
1891 (let ((remaining
1892 (ewoc-collect
1893 vc-ewoc 'vc-dir-fileinfo->needs-update)))
1894 (if remaining
1895 (vc-dir-refresh-files
1896 (mapcar 'vc-dir-fileinfo->name remaining)
1897 'up-to-date)
1898 (setq mode-line-process nil))))))))))))
1899
1900(defun vc-dir-show-fileentry (file)
1901 "Insert an entry for a specific file into the current *VC-dir* listing.
1902This is typically used if the file is up-to-date (or has been added
1903outside of VC) and one wants to do some operation on it."
1904 (interactive "fShow file: ")
1905 (vc-dir-update (list (list (file-relative-name file) (vc-state file))) (current-buffer)))
1906
1907(defun vc-dir-hide-up-to-date ()
1908 "Hide up-to-date items from display."
1909 (interactive)
1910 (ewoc-filter
1911 vc-ewoc
1912 (lambda (crt) (not (eq (vc-dir-fileinfo->state crt) 'up-to-date)))))
1913
1914(defun vc-default-status-fileinfo-extra (backend file)
1915 "Default absence of extra information returned for a file."
1916 nil)
1917
1918;; FIXME: Replace these with a more efficient dispatch
1919
1920(defun vc-generic-status-printer (fileentry)
1921 (vc-call-backend vc-dir-backend 'status-printer fileentry))
1922
1923(defun vc-generic-state (file)
1924 (vc-call-backend vc-dir-backend 'state file))
1925
1926(defun vc-generic-status-fileinfo-extra (file)
1927 (vc-call-backend vc-dir-backend 'status-fileinfo-extra file))
1928
1929(defun vc-dir-extra-menu ()
1930 (vc-call-backend vc-dir-backend 'extra-status-menu))
1931
1932(defun vc-make-backend-object (file-or-dir)
1933 "Create the backend capability object needed by vc-dispatcher."
1934 (vc-create-client-object
1935 "VC dir"
1936 (vc-dir-headers vc-dir-backend file-or-dir)
1937 #'vc-generic-status-printer
1938 #'vc-generic-state
1939 #'vc-generic-status-fileinfo-extra
1940 #'vc-dir-refresh
1941 #'vc-dir-extra-menu))
1942
1943;;;###autoload
1944(defun vc-dir (dir)
1945 "Show the VC status for DIR."
1946 (interactive "DVC status for directory: ")
1947 (pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir))
1948 (if (and (derived-mode-p 'vc-dir-mode) (boundp 'client-object))
1949 (vc-dir-refresh)
1950 ;; Otherwise, initialize a new view using the dispatcher layer
1951 (progn
1952 (set (make-local-variable 'vc-dir-backend) (vc-responsible-backend dir))
1953 ;; Build a capability object and hand it to the dispatcher initializer
1954 (vc-dir-mode (vc-make-backend-object dir))
1955 ;; FIXME: Make a derived-mode instead.
1956 ;; Add VC-specific keybindings
1957 (let ((map (current-local-map)))
1958 (define-key map "v" 'vc-next-action) ;; C-x v v
1959 (define-key map "=" 'vc-diff) ;; C-x v =
1960 (define-key map "i" 'vc-register) ;; C-x v i
1961 (define-key map "+" 'vc-update) ;; C-x v +
1962 (define-key map "l" 'vc-print-log) ;; C-x v l
1963 ;; More confusing than helpful, probably
1964 ;(define-key map "R" 'vc-revert) ;; u is taken by dispatcher unmark.
1965 ;(define-key map "A" 'vc-annotate) ;; g is taken by dispatcher refresh
1966 (define-key map "x" 'vc-dir-hide-up-to-date))
1967 )
1968 ;; FIXME: Needs to alter a buffer-local map, otherwise clients may clash
1969 (let ((map vc-dir-menu-map))
1970 ;; VC info details
1971 (define-key map [sepvcdet] '("--"))
1972 (define-key map [remup]
1973 '(menu-item "Hide up-to-date" vc-dir-hide-up-to-date
1974 :help "Hide up-to-date items from display"))
1975 ;; FIXME: This needs a key binding. And maybe a better name
1976 ;; ("Insert" like PCL-CVS uses does not sound that great either)...
1977 (define-key map [ins]
1978 '(menu-item "Show File" vc-dir-show-fileentry
1979 :help "Show a file in the VC status listing even though it might be up to date"))
1980 (define-key map [annotate]
1981 '(menu-item "Annotate" vc-annotate
1982 :help "Display the edit history of the current file using colors"))
1983 (define-key map [diff]
1984 '(menu-item "Compare with Base Version" vc-diff
1985 :help "Compare file set with the base version"))
1986 (define-key map [log]
1987 '(menu-item "Show history" vc-print-log
1988 :help "List the change log of the current file set in a window"))
1989 ;; VC commands.
1990 (define-key map [sepvccmd] '("--"))
1991 (define-key map [update]
1992 '(menu-item "Update to latest version" vc-update
1993 :help "Update the current fileset's files to their tip revisions"))
1994 (define-key map [revert]
1995 '(menu-item "Revert to base version" vc-revert
1996 :help "Revert working copies of the selected fileset to their repository contents."))
1997 (define-key map [next-action]
1998 ;; FIXME: This really really really needs a better name!
1999 ;; And a key binding too.
2000 '(menu-item "Check In/Out" vc-next-action
2001 :help "Do the next logical version control operation on the current fileset"))
2002 (define-key map [register]
2003 '(menu-item "Register" vc-dir-register
2004 :help "Register file set into the version control system"))
2005 )))
2006
2007;; Named-configuration entry points 1766;; Named-configuration entry points
2008 1767
2009(defun vc-tag-precondition (dir) 1768(defun vc-tag-precondition (dir)