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