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