;;; vc-dir.el --- Directory status display under VC
-;; Copyright (C) 2007, 2008, 2009
+;; Copyright (C) 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Dan Nicolaescu <dann@ics.uci.edu>
(defun vc-dir-prepare-status-buffer (bname dir backend &optional create-new)
"Find a buffer named BNAME showing DIR, or create a new one."
(setq dir (file-name-as-directory (expand-file-name dir)))
- (let*
- ;; Look for another buffer name BNAME visiting the same directory.
- ((buf (save-excursion
- (unless create-new
- (dolist (buffer (buffer-list))
- (set-buffer buffer)
- (when (and (derived-mode-p 'vc-dir-mode)
- (eq vc-dir-backend backend)
- (string= (expand-file-name default-directory) dir))
- (return buffer)))))))
+ (let* ;; Look for another buffer name BNAME visiting the same directory.
+ ((buf (save-excursion
+ (unless create-new
+ (dolist (buffer vc-dir-buffers)
+ (when (buffer-live-p buffer)
+ (set-buffer buffer)
+ (when (and (derived-mode-p 'vc-dir-mode)
+ (eq vc-dir-backend backend)
+ (string= default-directory dir))
+ (return buffer))))))))
(or buf
;; Create a new buffer named BNAME.
- (with-current-buffer (create-file-buffer bname)
+ ;; We pass a filename to create-file-buffer because it is what
+ ;; the function expects, and also what uniquify needs (if active)
+ (with-current-buffer (create-file-buffer (expand-file-name bname dir))
(cd dir)
(vc-setup-buffer (current-buffer))
;; Reset the vc-parent-buffer-name so that it does not appear
(defun vc-dir-node-directory (node)
;; Compute the directory for NODE.
- ;; If it's a directory node, get it from the the node.
+ ;; If it's a directory node, get it from the node.
(let ((data (ewoc-data node)))
(or (vc-dir-fileinfo->directory data)
;; Otherwise compute it from the file name.
(file-name-directory
- (expand-file-name
- (vc-dir-fileinfo->name data))))))
+ (directory-file-name
+ (expand-file-name
+ (vc-dir-fileinfo->name data)))))))
(defun vc-dir-update (entries buffer &optional noinsert)
"Update BUFFER's ewoc from the list of ENTRIES.
;; names too many times
(sort entries
(lambda (entry1 entry2)
- (let ((dir1 (file-name-directory (expand-file-name (car entry1))))
- (dir2 (file-name-directory (expand-file-name (car entry2)))))
+ (let ((dir1 (file-name-directory
+ (directory-file-name (expand-file-name (car entry1)))))
+ (dir2 (file-name-directory
+ (directory-file-name (expand-file-name (car entry2))))))
(cond
((string< dir1 dir2) t)
((not (string= dir1 dir2)) nil)
((string< (car entry1) (car entry2))))))))
;; Insert directory entries in the right places.
(let ((entry (car entries))
- (node (ewoc-nth vc-ewoc 0)))
+ (node (ewoc-nth vc-ewoc 0))
+ (dotname (file-relative-name default-directory)))
;; Insert . if it is not present.
(unless node
- (let ((rd (file-relative-name default-directory)))
- (ewoc-enter-last
- vc-ewoc (vc-dir-create-fileinfo
- rd nil nil nil (expand-file-name default-directory))))
+ (ewoc-enter-last
+ vc-ewoc (vc-dir-create-fileinfo
+ dotname nil nil nil default-directory))
(setq node (ewoc-nth vc-ewoc 0)))
(while (and entry node)
(let* ((entryfile (car entry))
- (entrydir (file-name-directory (expand-file-name entryfile)))
+ (entrydir (file-name-directory (directory-file-name
+ (expand-file-name entryfile))))
(nodedir (vc-dir-node-directory node)))
(cond
;; First try to find the directory.
;; Found the directory, find the place for the file name.
(let ((nodefile (vc-dir-fileinfo->name (ewoc-data node))))
(cond
+ ((string= nodefile dotname)
+ (setq node (ewoc-next vc-ewoc node)))
((string-lessp nodefile entryfile)
(setq node (ewoc-next vc-ewoc node)))
((string-equal nodefile entryfile)
(unless (or node noinsert)
(let ((lastdir (vc-dir-node-directory (ewoc-nth vc-ewoc -1))))
(dolist (entry entries)
- (let ((entrydir (file-name-directory (expand-file-name (car entry)))))
+ (let ((entrydir (file-name-directory
+ (directory-file-name (expand-file-name (car entry))))))
;; Insert a directory node if needed.
(unless (string-equal lastdir entrydir)
(setq lastdir entrydir)
(interactive)
(find-file (vc-dir-current-file)))
-(defun vc-dir-find-file-other-window ()
+(defun vc-dir-find-file-other-window (&optional event)
"Find the file on the current line, in another window."
- (interactive)
+ (interactive (list last-nonmenu-event))
+ (if event (posn-set-point (event-end event)))
(find-file-other-window (vc-dir-current-file)))
(defun vc-dir-isearch ()
;; Update the entries for all the child files of DIRNAME shown in
;; the current *vc-dir* buffer.
(let ((files (vc-dir-find-child-files dirname))
- (ddir (expand-file-name default-directory))
+ (ddir default-directory)
fileentries)
(when files
(dolist (crt files)
(defun vc-dir-resynch-file (&optional fname)
"Update the entries for FNAME in any directory buffers that list it."
(let ((file (or fname (expand-file-name buffer-file-name)))
- (found-vc-dir-buf nil))
- (save-excursion
- (dolist (status-buf (buffer-list))
- (set-buffer status-buf)
- ;; look for a vc-dir buffer that might show this file.
- (when (derived-mode-p 'vc-dir-mode)
- (setq found-vc-dir-buf t)
- (let ((ddir (expand-file-name default-directory)))
- (when (vc-string-prefix-p ddir file)
- (if (file-directory-p file)
- (vc-dir-resync-directory-files file)
- (vc-dir-update
- (list (vc-dir-recompute-file-state file ddir))
- status-buf)))))))
- ;; We didn't find any vc-dir buffers, remove the hook, it is
- ;; not needed.
- (unless found-vc-dir-buf
- (remove-hook 'after-save-hook 'vc-dir-resynch-file))))
+ (drop '()))
+ (save-current-buffer
+ ;; look for a vc-dir buffer that might show this file.
+ (dolist (status-buf vc-dir-buffers)
+ (if (not (buffer-live-p status-buf))
+ (push status-buf drop)
+ (set-buffer status-buf)
+ (if (not (derived-mode-p 'vc-dir-mode))
+ (push status-buf drop)
+ (let ((ddir default-directory))
+ (when (vc-string-prefix-p ddir file)
+ (if (file-directory-p file)
+ (vc-dir-resync-directory-files file)
+ (let ((state (vc-dir-recompute-file-state file ddir)))
+ (vc-dir-update
+ (list state)
+ status-buf (eq (cadr state) 'up-to-date))))))))))
+ ;; Remove out-of-date entries from vc-dir-buffers.
+ (dolist (b drop) (setq vc-dir-buffers (delq b vc-dir-buffers)))))
(defvar use-vc-backend) ;; dynamically bound
(define-derived-mode vc-dir-mode special-mode "VC dir"
"Major mode for VC directory buffers.
Marking/Unmarking key bindings and actions:
-m - marks a file/directory or if the region is active, mark all the files
- in region.
+m - mark a file/directory
+ - if the region is active, mark all the files in region.
Restrictions: - a file cannot be marked if any parent directory is marked
- a directory cannot be marked if any child file or
directory is marked
-u - marks a file/directory or if the region is active, unmark all the files
- in region.
+u - unmark a file/directory
+ - if the region is active, unmark all the files in region.
M - if the cursor is on a file: mark all the files with the same state as
the current file
- if the cursor is on a directory: mark all child files
as the current file
- if the cursor is on a directory: unmark all child files
- with a prefix argument: unmark all files
+mouse-2 - toggles the mark state
VC commands
-VC commands in the `C-x v' can be used, they act on the marked
-entries, or on the current entry if nothing is marked.
+VC commands in the `C-x v' prefix can be used.
+VC commands act on the marked entries. If nothing is marked, VC
+commands act on the current entry.
Search & Replace
S - searches the marked files
M-s a C-M-s - does a regexp isearch on the marked files
If nothing is marked, these commands act on the current entry.
When a directory is current or marked, the Search & Replace
-commands act on the files in those directories displayed in the
-*vc-dir* buffer.
+commands act on the child files of that directory that are displayed in
+the *vc-dir* buffer.
\\{vc-dir-mode-map}"
(set (make-local-variable 'vc-dir-backend) use-vc-backend)
(set (make-local-variable 'vc-ewoc) (ewoc-create #'vc-dir-printer))
(set (make-local-variable 'revert-buffer-function)
'vc-dir-revert-buffer-function)
- (set (make-local-variable 'list-buffers-directory)
- (expand-file-name default-directory))
- (add-hook 'after-save-hook 'vc-dir-resynch-file)
+ (setq list-buffers-directory (expand-file-name "*vc-dir*" default-directory))
+ (add-to-list 'vc-dir-buffers (current-buffer))
;; Make sure that if the directory buffer is killed, the update
;; process running in the background is also killed.
(add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t)
;; state to decide which operation to perform.
(dolist (crt (cdr only-files-list))
(unless (vc-compatible-state (cdr crt) state)
- (error "%s:%s clashes with %s:%s"
+ (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"
(car crt) (cdr crt) (caar only-files-list) state)))
(setq only-files-list (mapcar 'car only-files-list))
(when (and state (not (eq state 'unregistered)))
;;;###autoload
(defun vc-dir (dir &optional backend)
- "Show the VC status for DIR.
+ "Show the VC status for \"interesting\" files in and below DIR.
+This allows you to mark files and perform VC operations on them.
+The list omits files which are up to date, with no changes in your copy
+or the repository, if there is nothing in particular to say about them.
+
+Preparing the list of file status takes time; when the buffer
+first appears, it has only the first few lines of summary information.
+The file lines appear later.
+
Optional second argument BACKEND specifies the VC backend to use.
-Interactively, a prefix argument means to ask for the backend."
+Interactively, a prefix argument means to ask for the backend.
+
+These are the commands available for use in the file status buffer:
+
+\\{vc-dir-mode-map}"
+
(interactive
(list
;; When you hit C-x v d in a visited VC file,
(propertize "Please add backend specific headers here. It's easy!"
'face 'font-lock-warning-face)))
+(defvar vc-dir-filename-mouse-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2] 'vc-dir-find-file-other-window)
+ map)
+ "Local keymap for visiting a file.")
+
(defun vc-default-dir-printer (backend fileentry)
"Pretty print FILEENTRY."
;; If you change the layout here, change vc-dir-move-to-goal-column.
+ ;; VC backends can implement backend specific versions of this
+ ;; function. Changes here might need to be reflected in the
+ ;; vc-BACKEND-dir-printer functions.
(let* ((isdir (vc-dir-fileinfo->directory fileentry))
(state (if isdir "" (vc-dir-fileinfo->state fileentry)))
(filename (vc-dir-fileinfo->name fileentry)))
(if isdir
"Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
"File\nmouse-3: Pop-up menu")
- 'mouse-face 'highlight))))
+ 'mouse-face 'highlight
+ 'keymap vc-dir-filename-mouse-map))))
(defun vc-default-extra-status-menu (backend)
nil)