;;; 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
(define-key map [diff]
'(menu-item "Compare with Base Version" vc-diff
:help "Compare file set with the base version"))
+ (define-key map [logo]
+ '(menu-item "Show Outgoing Log" vc-log-outgoing
+ :help "Show a log of changes that will be sent with a push operation"))
+ (define-key map [logi]
+ '(menu-item "Show Incoming Log" vc-log-incoming
+ :help "Show a log of changes that will be received with a pull operation"))
(define-key map [log]
- '(menu-item "Show history" vc-print-log
- :help "List the change log of the current file set in a window"))
+ '(menu-item "Show history" vc-print-log
+ :help "List the change log of the current file set in a window"))
+ (define-key map [rlog]
+ '(menu-item "Show Top of the Tree History " vc-print-root-log
+ :help "List the change log for the current tree in a window"))
;; VC commands.
(define-key map [sepvccmd] '("--"))
(define-key map [update]
(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 [?\C-k] 'vc-dir-kill-line)
(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)
map vc-dir-mode-map)
(tool-bar-local-item "bookmark_add"
'vc-dir-toggle-mark 'vc-dir-toggle-mark map
- :help "Toggle mark on current item")
+ :help "Toggle mark on current item"
+ :label "Toggle Mark")
(tool-bar-local-item-from-menu 'vc-dir-previous-line "left-arrow"
map vc-dir-mode-map
:rtl "right-arrow")
(tool-bar-local-item-from-menu 'revert-buffer "refresh"
map vc-dir-mode-map)
(tool-bar-local-item-from-menu 'nonincremental-search-forward
- "search" map)
+ "search" map nil
+ :label "Search")
(tool-bar-local-item-from-menu 'vc-dir-query-replace-regexp
- "search-replace" map vc-dir-mode-map)
+ "search-replace" map vc-dir-mode-map
+ :label "Replace")
(tool-bar-local-item-from-menu 'vc-dir-kill-dir-status-process "cancel"
- map vc-dir-mode-map)
+ map vc-dir-mode-map
+ :label "Cancel")
(tool-bar-local-item-from-menu 'quit-window "exit"
map vc-dir-mode-map)
map))
(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.
;; Insert directory entries in the right places.
(let ((entry (car entries))
(node (ewoc-nth vc-ewoc 0))
+ (to-remove nil)
(dotname (file-relative-name default-directory)))
;; Insert . if it is not present.
(unless node
(ewoc-enter-last
vc-ewoc (vc-dir-create-fileinfo
- dotname nil nil nil (expand-file-name default-directory)))
+ dotname nil nil nil default-directory))
(setq node (ewoc-nth vc-ewoc 0)))
(while (and entry 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)
+ (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)))
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)
;; 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)
- (let ((state (vc-dir-recompute-file-state file ddir)))
- (vc-dir-update
- (list state)
- status-buf (eq (cadr state) 'up-to-date)))))))))
- ;; 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)
+ (progn
+ (vc-dir-resync-directory-files file)
+ (ewoc-set-hf vc-ewoc
+ (vc-dir-headers vc-dir-backend default-directory) ""))
+ (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
(set (make-local-variable 'vc-ewoc) (ewoc-create #'vc-dir-printer))
(set (make-local-variable 'revert-buffer-function)
'vc-dir-revert-buffer-function)
- (setq 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)
+ (hack-dir-local-variables-non-file-buffer)
(vc-dir-refresh)))
(defun vc-dir-headers (backend dir)
(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)
+ (propertize (format "%s\n" (abbreviate-file-name dir))
+ 'face 'font-lock-variable-name-face)
;; Then the backend specific ones.
(vc-call-backend backend 'dir-extra-headers dir)
"\n"))
(ewoc-delete vc-ewoc crt))
(setq crt prev)))))
+(defun vc-dir-kill-line ()
+ "Remove the current line from display."
+ (interactive)
+ (let ((crt (ewoc-locate vc-ewoc))
+ (inhibit-read-only t))
+ (ewoc-delete vc-ewoc crt)))
+
(defun vc-dir-printer (fileentry)
(vc-call-backend vc-dir-backend 'dir-printer fileentry))
These are the commands available for use in the file status buffer:
-\\<vc-dir-mode-map>"
+\\{vc-dir-mode-map}"
(interactive
(list
nil t nil nil)))))
(unless backend
(setq backend (vc-responsible-backend dir)))
- (pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir backend))
+ (let (pop-up-windows) ; based on cvs-examine; bug#6204
+ (pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir backend)))
(if (derived-mode-p 'vc-dir-mode)
(vc-dir-refresh)
;; FIXME: find a better way to pass the backend to `vc-dir-mode'.
HCoop / bpt / emacs.git / blobdiff