]> code.delx.au - gnu-emacs/blobdiff - lisp/vc-dir.el
Tweak previous change.
[gnu-emacs] / lisp / vc-dir.el
index 17b2489654f6f92125f9ba5a859ed0e4b43ae0f4..1f91ff4d3796a02f49bd5e0608c33d2a0e51ab92 100644 (file)
@@ -1,6 +1,6 @@
 ;;; vc-dir.el --- Directory status display under VC
 
-;; Copyright (C) 2007, 2008
+;; Copyright (C) 2007, 2008, 2009
 ;;   Free Software Foundation, Inc.
 
 ;; Author:   Dan Nicolaescu <dann@ics.uci.edu>
@@ -83,12 +83,12 @@ See `run-hooks'."
   ;; 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))
+  (setq dir (file-name-as-directory (expand-file-name dir)))
   (let*
         ;; Look for another buffer name BNAME visiting the same directory.
         ((buf (save-excursion
@@ -206,7 +206,7 @@ See `run-hooks'."
       '(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.
@@ -231,8 +231,9 @@ See `run-hooks'."
     (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)
@@ -258,6 +259,7 @@ See `run-hooks'."
     (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)
@@ -273,21 +275,22 @@ See `run-hooks'."
     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)))
@@ -673,7 +676,7 @@ that share the same state."
 
 (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."
@@ -776,7 +779,7 @@ child files."
                    result)
              (setq crt (ewoc-next vc-ewoc crt)))
          (setq crt (ewoc-next vc-ewoc crt)))))
-    result))
+    (nreverse result)))
 
 (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.
@@ -801,7 +804,7 @@ If it is a file, return the corresponding cons for the file itself."
       (push
        (cons (expand-file-name (vc-dir-fileinfo->name crt-data))
             (vc-dir-fileinfo->state crt-data)) result))
-    result))
+    (nreverse result)))
 
 (defun vc-dir-recompute-file-state (fname def-dir)
   (let* ((file-short (file-relative-name fname def-dir))
@@ -847,7 +850,7 @@ If it is a file, return the corresponding cons for the file itself."
       (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."
+  "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
@@ -871,15 +874,15 @@ If it is a file, return the corresponding cons for the file itself."
 (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
@@ -888,7 +891,22 @@ U - if the cursor is on a file: unmark all the files with the same state
       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)
@@ -898,9 +916,7 @@ U - if the cursor is on a file: unmark all the files with the same state
   (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)
     (set (make-local-variable 'list-buffers-directory)
@@ -913,14 +929,16 @@ U - if the cursor is on a file: unmark all the files with the same state
 
 (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)
@@ -1018,7 +1036,8 @@ Throw an error if another update process is in progress."
                        (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.
@@ -1054,8 +1073,8 @@ outside of VC) and one wants to do some operation on it."
            (ewoc-delete vc-ewoc crt))
          (setq crt prev)))))
 
-(defun vc-dir-status-printer (fileentry)
-  (vc-call-backend vc-dir-backend 'status-printer fileentry))
+(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))
@@ -1093,9 +1112,14 @@ Optional second argument BACKEND specifies the VC backend to use.
 Interactively, a prefix argument means to ask for the backend."
   (interactive
    (list
-    (read-file-name "VC status for directory: "
-                   default-directory default-directory t
-                   nil #'file-directory-p)
+    ;; 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
@@ -1112,7 +1136,7 @@ Interactively, a prefix argument means to ask for the backend."
     (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.
@@ -1121,7 +1145,7 @@ Interactively, a prefix argument means to ask for the backend."
    (propertize "Please add backend specific headers here.  It's easy!"
               'face 'font-lock-warning-face)))
 
-(defun vc-default-status-printer (backend fileentry)
+(defun vc-default-dir-printer (backend fileentry)
   "Pretty print FILEENTRY."
   ;; If you change the layout here, change vc-dir-move-to-goal-column.
   (let* ((isdir (vc-dir-fileinfo->directory fileentry))