;;; vc-dir.el --- Directory status display under VC
-;; Copyright (C) 2007, 2008
+;; Copyright (C) 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: Dan Nicolaescu <dann@ics.uci.edu>
;; This implementation was inspired by PCL-CVS.
;; Many people contributed comments, ideas and code to this
;; implementation. These include:
-;;
+;;
;; Alexandre Julliard <julliard@winehq.org>
;; Stefan Monnier <monnier@iro.umontreal.ca>
;; Tom Tromey <tromey@redhat.com>
;;; Commentary:
-;;
+;;
;;; Todo: see vc.el.
(require 'vc-hooks)
(require 'vc)
+(require 'tool-bar)
(require 'ewoc)
;;; Code:
;; Used to keep the cursor on the file name column.
(beginning-of-line)
(unless (eolp)
- ;; Must be in sync with vc-default-status-printer.
+ ;; Must be in sync with vc-default-dir-printer.
(forward-char 25)))
(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 (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)))))))
+ (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 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
:help "Mark the current file or all files in the region"))
(define-key map [sepopn] '("--"))
+ (define-key map [qr]
+ '(menu-item "Query Replace in Files..." vc-dir-query-replace-regexp
+ :help "Replace a string in the marked files"))
+ (define-key map [se]
+ '(menu-item "Search Files..." vc-dir-search
+ :help "Search a regexp in the marked files"))
+ (define-key map [ires]
+ '(menu-item "Isearch Regexp Files..." vc-dir-isearch-regexp
+ :help "Incremental search a regexp in the marked files"))
+ (define-key map [ise]
+ '(menu-item "Isearch Files..." vc-dir-isearch
+ :help "Incremental search a string in the marked files"))
(define-key map [open-other]
'(menu-item "Open in other window" vc-dir-find-file-other-window
:help "Find the file on the current line, in another window"))
'(menu-item "Register" vc-register
:help "Register file set into the version control system"))
map)
- "Menu for dispatcher status")
+ "Menu for VC dir.")
;; VC backends can use this to add mode-specific menu items to
;; vc-dir-menu-map.
ext-binding))))
(defvar vc-dir-mode-map
- (let ((map (make-keymap)))
- (suppress-keymap map)
+ (let ((map (make-sparse-keymap)))
;; VC commands
(define-key map "v" 'vc-next-action) ;; C-x v v
(define-key map "=" 'vc-diff) ;; C-x v =
(define-key map "+" 'vc-update) ;; C-x v +
(define-key map "l" 'vc-print-log) ;; C-x v l
;; More confusing than helpful, probably
- ;;(define-key map "R" 'vc-revert) ;; u is taken by dispatcher unmark.
- ;;(define-key map "A" 'vc-annotate) ;; g is taken by dispatcher refresh
+ ;;(define-key map "R" 'vc-revert) ;; u is taken by vc-dir-unmark.
+ ;;(define-key map "A" 'vc-annotate) ;; g is taken by revert-buffer
+ ;; bound by `special-mode'.
;; Marking.
(define-key map "m" 'vc-dir-mark)
(define-key map "M" 'vc-dir-mark-all-files)
(define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process)
(define-key map [down-mouse-3] 'vc-dir-menu)
(define-key map [mouse-2] 'vc-dir-toggle-mark)
+ (define-key map [follow-link] 'mouse-face)
(define-key map "x" 'vc-dir-hide-up-to-date)
+ (define-key map "S" 'vc-dir-search) ;; FIXME: Maybe use A like dired?
+ (define-key map "Q" 'vc-dir-query-replace-regexp)
+ (define-key map (kbd "M-s a C-s") 'vc-dir-isearch)
+ (define-key map (kbd "M-s a M-C-s") 'vc-dir-isearch-regexp)
;; Hook up the menu.
(define-key map [menu-bar vc-dir-mode]
map)
"Keymap for directory buffer.")
-(defmacro vc-at-event (event &rest body)
- "Evaluate `body' with point located at event-start of `event'.
-If `body' uses `event', it should be a variable,
+(defmacro vc-dir-at-event (event &rest body)
+ "Evaluate BODY with point located at event-start of EVENT.
+If BODY uses EVENT, it should be a variable,
otherwise it will be evaluated twice."
- (let ((posn (make-symbol "vc-at-event-posn")))
- `(let ((,posn (event-start ,event)))
- (save-excursion
- (set-buffer (window-buffer (posn-window ,posn)))
- (goto-char (posn-point ,posn))
- ,@body))))
+ (let ((posn (make-symbol "vc-dir-at-event-posn")))
+ `(save-excursion
+ (unless (equal ,event '(tool-bar))
+ (let ((,posn (event-start ,event)))
+ (set-buffer (window-buffer (posn-window ,posn)))
+ (goto-char (posn-point ,posn))))
+ ,@body)))
(defun vc-dir-menu (e)
- "Popup the dispatcher status menu."
+ "Popup the VC dir menu."
(interactive "e")
- (vc-at-event e (popup-menu vc-dir-menu-map e)))
+ (vc-dir-at-event e (popup-menu vc-dir-menu-map e)))
(defvar vc-dir-tool-bar-map
(let ((map (make-sparse-keymap)))
map vc-dir-mode-map)
(tool-bar-local-item-from-menu 'nonincremental-search-forward
"search" map)
+ (tool-bar-local-item-from-menu 'vc-dir-query-replace-regexp
+ "search-replace" map vc-dir-mode-map)
(tool-bar-local-item-from-menu 'vc-dir-kill-dir-status-process "cancel"
map vc-dir-mode-map)
(tool-bar-local-item-from-menu 'quit-window "exit"
(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))
+ (to-remove nil)
+ (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)
- (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
- (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
- (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
- (ewoc-invalidate vc-ewoc node)
- (setq entries (cdr entries))
+ (if (nth 1 entry)
+ (progn
+ (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
+ (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
+ (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
+ (ewoc-invalidate vc-ewoc node))
+ ;; If the state is nil, the file does not exist
+ ;; anymore, so remember the entry so we can remove
+ ;; it after we are done inserting all ENTRIES.
+ (push node to-remove))
+ (setq entries (cdr entries))
(setq entry (car entries))
(setq node (ewoc-next vc-ewoc node)))
(t
- (ewoc-enter-before vc-ewoc node
- (apply 'vc-dir-create-fileinfo entry))
+ (unless noinsert
+ (ewoc-enter-before vc-ewoc node
+ (apply 'vc-dir-create-fileinfo entry)))
(setq entries (cdr entries))
(setq entry (car entries))))))
(t
- ;; We might need to insert a directory node if the
- ;; previous node was in a different directory.
- (let* ((rd (file-relative-name entrydir))
- (prev-node (ewoc-prev vc-ewoc node))
- (prev-dir (vc-dir-node-directory prev-node)))
- (unless (string-equal entrydir prev-dir)
- (ewoc-enter-before
- vc-ewoc node (vc-dir-create-fileinfo rd nil nil nil entrydir))))
- ;; Now insert the node itself.
- (ewoc-enter-before vc-ewoc node
- (apply 'vc-dir-create-fileinfo entry))
+ (unless noinsert
+ ;; We might need to insert a directory node if the
+ ;; previous node was in a different directory.
+ (let* ((rd (file-relative-name entrydir))
+ (prev-node (ewoc-prev vc-ewoc node))
+ (prev-dir (vc-dir-node-directory prev-node)))
+ (unless (string-equal entrydir prev-dir)
+ (ewoc-enter-before
+ vc-ewoc node (vc-dir-create-fileinfo rd nil nil nil entrydir))))
+ ;; Now insert the node itself.
+ (ewoc-enter-before vc-ewoc node
+ (apply 'vc-dir-create-fileinfo entry)))
(setq entries (cdr entries) entry (car entries))))))
;; We're past the last node, all remaining entries go to the end.
(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)
vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir))))
;; Now insert the node itself.
(ewoc-enter-last vc-ewoc
- (apply 'vc-dir-create-fileinfo entry)))))))))
+ (apply 'vc-dir-create-fileinfo entry))))))
+ (when to-remove
+ (let ((inhibit-read-only t))
+ (apply 'ewoc-delete vc-ewoc (nreverse to-remove)))))))
(defun vc-dir-busy ()
(and (buffer-live-p vc-dir-process-buffer)
(funcall mark-unmark-function))))
(funcall mark-unmark-function)))
-(defun vc-string-prefix-p (prefix string)
- (let ((lpref (length prefix)))
- (and (>= (length string) lpref)
- (eq t (compare-strings prefix nil nil string nil lpref)))))
-
(defun vc-dir-parent-marked-p (arg)
;; Return nil if none of the parent directories of arg is marked.
(let* ((argdir (vc-dir-node-directory arg))
(defun vc-dir-toggle-mark (e)
(interactive "e")
- (vc-at-event e (vc-dir-mark-unmark 'vc-dir-toggle-mark-file)))
+ (vc-dir-at-event e (vc-dir-mark-unmark 'vc-dir-toggle-mark-file)))
(defun vc-dir-delete-file ()
"Delete the marked files, or the current file if no marks."
(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 ()
+ "Search for a string through all marked buffers using Isearch."
+ (interactive)
+ (multi-isearch-files
+ (mapcar 'car (vc-dir-marked-only-files-and-states))))
+
+(defun vc-dir-isearch-regexp ()
+ "Search for a regexp through all marked buffers using Isearch."
+ (interactive)
+ (multi-isearch-files-regexp
+ (mapcar 'car (vc-dir-marked-only-files-and-states))))
+
+(defun vc-dir-search (regexp)
+ "Search through all marked files for a match for REGEXP.
+For marked directories, use the files displayed from those directories.
+Stops when a match is found.
+To continue searching for next match, use command \\[tags-loop-continue]."
+ (interactive "sSearch marked files (regexp): ")
+ (tags-search regexp '(mapcar 'car (vc-dir-marked-only-files-and-states))))
+
+(defun vc-dir-query-replace-regexp (from to &optional delimited)
+ "Do `query-replace-regexp' of FROM with TO, on all marked files.
+For marked directories, use the files displayed from those directories.
+If a directory is marked, then use the files displayed for that directory.
+Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
+If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
+with the command \\[tags-loop-continue]."
+ ;; FIXME: this is almost a copy of `dired-do-replace-regexp'. This
+ ;; should probably be made generic and used in both places instead of
+ ;; duplicating it here.
+ (interactive
+ (let ((common
+ (query-replace-read-args
+ "Query replace regexp in marked files" t t)))
+ (list (nth 0 common) (nth 1 common) (nth 2 common))))
+ (dolist (file (mapcar 'car (vc-dir-marked-only-files-and-states)))
+ (let ((buffer (get-file-buffer file)))
+ (if (and buffer (with-current-buffer buffer
+ buffer-read-only))
+ (error "File `%s' is visited read-only" file))))
+ (tags-query-replace from to delimited
+ '(mapcar 'car (vc-dir-marked-only-files-and-states))))
+
(defun vc-dir-current-file ()
(let ((node (ewoc-locate vc-ewoc)))
(unless node
(lambda (elem) (expand-file-name (vc-dir-fileinfo->name elem)))
(ewoc-collect vc-ewoc 'vc-dir-fileinfo->marked)))
-(defun vc-dir-marked-only-files ()
- "Return the list of marked files, for marked directories return child files."
+(defun vc-dir-marked-only-files-and-states ()
+ "Return the list of conses (FILE . STATE) for the marked files.
+For marked directories return the corresponding conses for the
+child files."
(let ((crt (ewoc-nth vc-ewoc 0))
result)
(while crt
(let ((crt-data (ewoc-data crt)))
(if (vc-dir-fileinfo->marked crt-data)
- ;; FIXME: use vc-dir-child-files here instead of duplicating it.
+ ;; FIXME: use vc-dir-child-files-and-states here instead of duplicating it.
(if (vc-dir-fileinfo->directory crt-data)
(let* ((dir (vc-dir-fileinfo->directory crt-data))
(dirlen (length dir))
(setq data (ewoc-data crt))
(vc-dir-node-directory crt))))
(unless (vc-dir-fileinfo->directory data)
- (push (expand-file-name (vc-dir-fileinfo->name data)) result))))
- (push (expand-file-name (vc-dir-fileinfo->name crt-data)) result)
+ (push
+ (cons (expand-file-name (vc-dir-fileinfo->name data))
+ (vc-dir-fileinfo->state data))
+ result))))
+ (push (cons (expand-file-name (vc-dir-fileinfo->name crt-data))
+ (vc-dir-fileinfo->state crt-data))
+ result)
(setq crt (ewoc-next vc-ewoc crt)))
(setq crt (ewoc-next vc-ewoc crt)))))
- result))
+ (nreverse result)))
-(defun vc-dir-child-files ()
- "Return the list of child files for the current entry if it's a directory.
-If it is a file, return the file itself."
+(defun vc-dir-child-files-and-states ()
+ "Return the list of conses (FILE . STATE) for child files of the current entry if it's a directory.
+If it is a file, return the corresponding cons for the file itself."
(let* ((crt (ewoc-locate vc-ewoc))
(crt-data (ewoc-data crt))
result)
(setq data (ewoc-data crt))
(vc-dir-node-directory crt))))
(unless (vc-dir-fileinfo->directory data)
- (push (expand-file-name (vc-dir-fileinfo->name data)) result))))
- (push (expand-file-name (vc-dir-fileinfo->name crt-data)) result))
- result))
+ (push
+ (cons (expand-file-name (vc-dir-fileinfo->name data))
+ (vc-dir-fileinfo->state data))
+ result))))
+ (push
+ (cons (expand-file-name (vc-dir-fileinfo->name crt-data))
+ (vc-dir-fileinfo->state crt-data)) result))
+ (nreverse result)))
+
+(defun vc-dir-recompute-file-state (fname def-dir)
+ (let* ((file-short (file-relative-name fname def-dir))
+ (remove-me-when-CVS-works
+ (when (eq vc-dir-backend 'CVS)
+ ;; FIXME: Warning: UGLY HACK. The CVS backend caches the state
+ ;; info, this forces the backend to update it.
+ (vc-call-backend vc-dir-backend 'registered fname)))
+ (state (vc-call-backend vc-dir-backend 'state fname))
+ (extra (vc-call-backend vc-dir-backend
+ 'status-fileinfo-extra fname)))
+ (list file-short state extra)))
+
+(defun vc-dir-find-child-files (dirname)
+ ;; Give a DIRNAME string return the list of all child files shown in
+ ;; the current *vc-dir* buffer.
+ (let ((crt (ewoc-nth vc-ewoc 0))
+ children
+ dname)
+ ;; Find DIR
+ (while (and crt (not (vc-string-prefix-p
+ dirname (vc-dir-node-directory crt))))
+ (setq crt (ewoc-next vc-ewoc crt)))
+ (while (and crt (vc-string-prefix-p
+ dirname
+ (setq dname (vc-dir-node-directory crt))))
+ (let ((data (ewoc-data crt)))
+ (unless (vc-dir-fileinfo->directory data)
+ (push (expand-file-name (vc-dir-fileinfo->name data)) children)))
+ (setq crt (ewoc-next vc-ewoc crt)))
+ children))
+
+(defun vc-dir-resync-directory-files (dirname)
+ ;; 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 default-directory)
+ fileentries)
+ (when files
+ (dolist (crt files)
+ (push (vc-dir-recompute-file-state crt ddir)
+ fileentries))
+ (vc-dir-update fileentries (current-buffer)))))
(defun vc-dir-resynch-file (&optional fname)
- "Update the entries for FILE in any directory buffers that list it."
- (let ((file (or fname (expand-file-name buffer-file-name))))
- (if (file-directory-p file)
- ;; FIXME: Maybe this should never happen?
- ;; FIXME: But it is useful to update the state of a directory
- ;; (more precisely the files in the directory) after some VC
- ;; operations.
- nil
- (let ((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)
- (let*
- ;; FIXME: Any reason we don't use file-relative-name?
- ((file-short (substring file (length ddir)))
- (state (vc-call-backend vc-dir-backend 'state file))
- (extra (vc-call-backend vc-dir-backend
- 'status-fileinfo-extra file))
- (entry
- (list file-short state extra)))
- (vc-dir-update (list entry) 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)))))))
+ "Update the entries for FNAME in any directory buffers that list it."
+ (let ((file (or fname (expand-file-name buffer-file-name)))
+ (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)
+ (progn
+ (vc-dir-resync-directory-files file)
+ (ewoc-set-hf vc-ewoc
+ (vc-dir-headers vc-dir-backend default-directory) ""))
+ (let* ((complete-state (vc-dir-recompute-file-state file ddir))
+ (state (cadr complete-state)))
+ (vc-dir-update
+ (list complete-state)
+ status-buf (or (not state)
+ (eq 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 dispatcher directory buffers.
+ "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' 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
+Q - does a query replace on the marked files
+M-s a C-s - does an isearch on 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 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)
(let ((buffer-read-only nil))
(erase-buffer)
(set (make-local-variable 'vc-dir-process-buffer) nil)
- (set (make-local-variable 'vc-ewoc)
- (ewoc-create #'vc-dir-status-printer
- (vc-dir-headers vc-dir-backend default-directory)))
+ (set (make-local-variable 'vc-ewoc) (ewoc-create #'vc-dir-printer))
(set (make-local-variable 'revert-buffer-function)
'vc-dir-revert-buffer-function)
- (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)
(defun vc-dir-headers (backend dir)
"Display the headers in the *VC dir* buffer.
-It calls the `status-extra-headers' backend method to display backend
+It calls the `dir-extra-headers' backend method to display backend
specific headers."
(concat
+ ;; First layout the common headers.
(propertize "VC backend : " 'face 'font-lock-type-face)
(propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face)
(propertize "Working dir: " 'face 'font-lock-type-face)
(propertize (format "%s\n" dir) 'face 'font-lock-variable-name-face)
- (vc-call-backend backend 'status-extra-headers dir)
+ ;; Then the backend specific ones.
+ (vc-call-backend backend 'dir-extra-headers dir)
"\n"))
(defun vc-dir-refresh-files (files default-state)
(unless (buffer-live-p vc-dir-process-buffer)
(setq vc-dir-process-buffer
(generate-new-buffer (format " *VC-%s* tmp status" backend))))
- ;; set the needs-update flag on all entries
- (ewoc-map (lambda (info) (setf (vc-dir-fileinfo->needs-update info) t) nil)
+ ;; set the needs-update flag on all non-directory entries
+ (ewoc-map (lambda (info)
+ (unless (vc-dir-fileinfo->directory info)
+ (setf (vc-dir-fileinfo->needs-update info) t) nil))
vc-ewoc)
(lexical-let ((buffer (current-buffer)))
(with-current-buffer vc-dir-process-buffer
(vc-dir-refresh-files
(mapcar 'vc-dir-fileinfo->name remaining)
'up-to-date)
- (setq mode-line-process nil))))))))))))
+ (setq mode-line-process nil)))))))))
+ (ewoc-set-hf vc-ewoc (vc-dir-headers backend def-dir) ""))))
(defun vc-dir-show-fileentry (file)
"Insert an entry for a specific file into the current *VC-dir* listing.
(defun vc-dir-hide-up-to-date ()
"Hide up-to-date items from display."
(interactive)
- (ewoc-filter
- vc-ewoc
- (lambda (crt) (not (eq (vc-dir-fileinfo->state crt) 'up-to-date)))))
-
-(defun vc-dir-status-printer (fileentry)
- (vc-call-backend vc-dir-backend 'status-printer fileentry))
+ (let ((crt (ewoc-nth vc-ewoc -1))
+ (first (ewoc-nth vc-ewoc 0)))
+ ;; Go over from the last item to the first and remove the
+ ;; up-to-date files and directories with no child files.
+ (while (not (eq crt first))
+ (let* ((data (ewoc-data crt))
+ (dir (vc-dir-fileinfo->directory data))
+ (next (ewoc-next vc-ewoc crt))
+ (prev (ewoc-prev vc-ewoc crt))
+ ;; ewoc-delete does not work without this...
+ (inhibit-read-only t))
+ (when (or
+ ;; Remove directories with no child files.
+ (and dir
+ (or
+ ;; Nothing follows this directory.
+ (not next)
+ ;; Next item is a directory.
+ (vc-dir-fileinfo->directory (ewoc-data next))))
+ ;; Remove files in the up-to-date state.
+ (eq (vc-dir-fileinfo->state data) 'up-to-date))
+ (ewoc-delete vc-ewoc crt))
+ (setq crt prev)))))
+
+(defun vc-dir-printer (fileentry)
+ (vc-call-backend vc-dir-backend 'dir-printer fileentry))
+
+(defun vc-dir-deduce-fileset (&optional state-model-only-files)
+ (let ((marked (vc-dir-marked-files))
+ files
+ only-files-list
+ state
+ model)
+ (if marked
+ (progn
+ (setq files marked)
+ (when state-model-only-files
+ (setq only-files-list (vc-dir-marked-only-files-and-states))))
+ (let ((crt (vc-dir-current-file)))
+ (setq files (list crt))
+ (when state-model-only-files
+ (setq only-files-list (vc-dir-child-files-and-states)))))
+
+ (when state-model-only-files
+ (setq state (cdar only-files-list))
+ ;; Check that all files are in a consistent state, since we use that
+ ;; state to decide which operation to perform.
+ (dolist (crt (cdr only-files-list))
+ (unless (vc-compatible-state (cdr crt) state)
+ (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)))
+ (setq model (vc-checkout-model vc-dir-backend only-files-list))))
+ (list vc-dir-backend files only-files-list state model)))
;;;###autoload
-(defun vc-dir (dir backend)
- "Show the VC status for DIR.
-With a prefix argument ask what VC backend to use."
+(defun vc-dir (dir &optional backend)
+ "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.
+
+These are the commands available for use in the file status buffer:
+
+\\{vc-dir-mode-map}"
+
(interactive
(list
- (read-file-name "VC status for directory: "
- default-directory default-directory t)
+ ;; When you hit C-x v d in a visited VC file,
+ ;; the *vc-dir* buffer visits the directory under its truename;
+ ;; therefore it makes sense to always do that.
+ ;; Otherwise if you do C-x v d -> C-x C-f -> C-c v d
+ ;; you may get a new *vc-dir* buffer, different from the original
+ (file-truename (read-file-name "VC status for directory: "
+ default-directory default-directory t
+ nil #'file-directory-p))
(if current-prefix-arg
(intern
(completing-read
"Use VC backend: "
- (mapcar (lambda (b) (list (symbol-name b))) vc-handled-backends)
- nil t nil nil))
- (vc-responsible-backend default-directory))))
+ (mapcar (lambda (b) (list (symbol-name b)))
+ vc-handled-backends)
+ nil t nil nil)))))
+ (unless backend
+ (setq backend (vc-responsible-backend dir)))
(pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir backend))
(if (derived-mode-p 'vc-dir-mode)
(vc-dir-refresh)
(let ((use-vc-backend backend))
(vc-dir-mode))))
-(defun vc-default-status-extra-headers (backend dir)
+(defun vc-default-dir-extra-headers (backend dir)
;; Be loud by default to remind people to add code to display
;; backend specific headers.
;; XXX: change this to return nil before the release.
(propertize "Please add backend specific headers here. It's easy!"
'face 'font-lock-warning-face)))
-(defun vc-default-status-printer (backend fileentry)
+(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)))
'face
(if isdir 'font-lock-comment-delimiter-face 'font-lock-function-name-face)
'help-echo
- (if isdir
- "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
+ (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)