Move vc-dir menu hook back to vc-dispatcher.
[bpt/emacs.git] / lisp / vc.el
index 68f0aa2..0f522ff 100644 (file)
 ;; - add a mechanism for editing the underlying VCS's list of files
 ;;   to be ignored, when that's possible.
 ;;
+;;;; Primitives that need changing:
+;;
+;; - vc-update/vc-merge should deal with VC systems that don't
+;;   update/merge on a file basis, but on a whole repository basis.
+;;   vc-update and vc-merge assume the arguments are always files,
+;;   they don't deal with directories.  Make sure the *vc-dir* buffer
+;;   is updated after these operations. 
+;;   At least bzr, git and hg should benefit from this.
+;;
 ;;;; Improved branch and tag handling:
 ;;
 ;; - "snapshots" should be renamed to "tags", and thoroughly reworked.
@@ -922,45 +931,6 @@ been updated to their corresponding values."
              (put (intern file vc-file-prop-obarray)
                   property (cdr setting))))))))
 
-;; Two macros for elisp programming
-
-;;;###autoload
-(defmacro with-vc-file (file comment &rest body)
-  "Check out a writable copy of FILE if necessary, then execute BODY.
-Check in FILE with COMMENT (a string) after BODY has been executed.
-FILE is passed through `expand-file-name'; BODY executed within
-`save-excursion'.  If FILE is not under version control, or you are
-using a locking version-control system and the file is locked by
-somebody else, signal error."
-  (declare (debug t) (indent 2))
-  (let ((filevar (make-symbol "file")))
-    `(let ((,filevar (expand-file-name ,file)))
-       (or (vc-backend ,filevar)
-           (error "File not under version control: `%s'" file))
-       (unless (vc-editable-p ,filevar)
-         (let ((state (vc-state ,filevar)))
-           (if (stringp state)
-               (error "`%s' is locking `%s'" state ,filevar)
-             (vc-checkout ,filevar t))))
-       (save-excursion
-         ,@body)
-       (vc-checkin (list ,filevar) nil ,comment))))
-
-;;;###autoload
-(defmacro edit-vc-file (file comment &rest body)
-  "Edit FILE under version control, executing body.
-Checkin with COMMENT after executing BODY.
-This macro uses `with-vc-file', passing args to it.
-However, before executing BODY, find FILE, and after BODY, save buffer."
-  (declare (debug t) (indent 2))
-  (let ((filevar (make-symbol "file")))
-    `(let ((,filevar (expand-file-name ,file)))
-       (with-vc-file
-        ,filevar ,comment
-        (set-buffer (find-file-noselect ,filevar))
-        ,@body
-        (save-buffer)))))
-
 ;;; Code for deducing what fileset and backend to assume
 
 (defun vc-responsible-backend (file &optional register)
@@ -1003,24 +973,35 @@ be registered."
 
 (defun vc-expand-dirs (file-or-dir-list)
   "Expands directories in a file list specification.
-Only files already under version control are noticed."
+Within directories, only files already under version control are noticed."
   (let ((flattened '()))
     (dolist (node file-or-dir-list)
-      (vc-file-tree-walk
-       node (lambda (f) (when (vc-backend f) (push f flattened)))))
+      (if (file-directory-p node)
+         (vc-file-tree-walk
+          node (lambda (f) (when (vc-backend f) (push f flattened)))))
+      (push node flattened))
     (nreverse flattened)))
 
+(defun vc-derived-from-dir-mode (&optional buffer)
+  "Are we in a VC-directory buffer, or do we have one as an ancestor?"
+  (let ((buffer (or buffer (current-buffer))))
+    (cond ((derived-mode-p 'vc-dir-mode) t)
+         (vc-parent-buffer (vc-derived-from-dir-mode vc-parent-buffer))
+         (t nil))))
+
 (defun vc-deduce-fileset (&optional observer)
   "Deduce a set of files and a backend to which to apply an operation and
 the common state of the fileset.  Return (BACKEND . FILESET)."
-  (let* ((fileset (vc-dispatcher-selection-set observer))
+  (let* ((selection (vc-dispatcher-selection-set observer))
+        (raw (car selection))          ;; Selection as user made it
+        (cooked (cdr selection))       ;; Files only
          ;; FIXME: Store the backend in a buffer-local variable.
-         (backend (if (derived-mode-p 'vc-dir-mode)
+         (backend (if (vc-derived-from-dir-mode (current-buffer))
                       (vc-responsible-backend default-directory)
-                    (assert (and (= 1 (length fileset))
-                                 (not (file-directory-p (car fileset)))))
-                    (vc-backend (car fileset)))))
-       (cons backend fileset)))
+                    (assert (and (= 1 (length raw))
+                                 (not (file-directory-p (car raw)))))
+                    (vc-backend (car cooked)))))
+       (cons backend selection)))
 
 (defun vc-ensure-vc-buffer ()
   "Make sure that the current buffer visits a version-controlled file."
@@ -1092,8 +1073,8 @@ merge in the changes into your working copy."
   (interactive "P")
   (let* ((vc-fileset (vc-deduce-fileset))
          (backend (car vc-fileset))
-        (files (cdr vc-fileset))
-         (fileset-only-files (vc-expand-dirs files))
+        (files (cadr vc-fileset))
+         (fileset-only-files (cddr vc-fileset))
          ;; FIXME: We used to call `vc-recompute-state' here.
          (state (vc-state (car fileset-only-files)))
          ;; The backend should check that the checkout-model is consistent
@@ -1505,7 +1486,7 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
   "Report diffs between two revisions of a fileset.
 Diff output goes to the *vc-diff* buffer.  The function
 returns t if the buffer had changes, nil otherwise."
-  (let* ((files (cdr vc-fileset))
+  (let* ((files (cadr vc-fileset))
         (messages (cons (format "Finding changes in %s..."
                                  (vc-delistify files))
                          (format "No changes between %s and %s"
@@ -1571,7 +1552,7 @@ returns t if the buffer had changes, nil otherwise."
   "Report diffs between revisions of the fileset in the repository history."
   (interactive
    (let* ((vc-fileset (vc-deduce-fileset t))
-         (files (cdr vc-fileset))
+         (files (cadr vc-fileset))
           (backend (car vc-fileset))
          (first (car files))
          (completion-table
@@ -1855,20 +1836,6 @@ specific headers."
 (defun vc-default-extra-status-menu (backend)
   nil)
 
-;; This is used to that VC backends could add backend specific menu
-;; items to vc-dir-menu-map.
-(defun vc-dir-menu-map-filter (orig-binding)
-  (when (and (symbolp orig-binding) (fboundp orig-binding))
-    (setq orig-binding (indirect-function orig-binding)))
-  (let ((ext-binding
-        (vc-call-backend (vc-responsible-backend default-directory)
-                         'extra-status-menu)))
-    (if (null ext-binding)
-       orig-binding
-      (append orig-binding
-             '("----")
-             ext-binding))))
-
 (defun vc-dir-refresh-files (files default-state)
   "Refresh some files in the VC status buffer."
   (let ((backend (vc-responsible-backend default-directory))
@@ -1997,6 +1964,9 @@ outside of VC) and one wants to do some operation on it."
   (let ((backend (vc-responsible-backend dir)))
     (vc-dir-headers backend dir)))
 
+(defun vc-dir-extra-menu ()
+  (vc-call-backend (vc-responsible-backend default-directory) 'extra-status-menu))
+
 (defun vc-make-backend-object (file-or-dir)
   "Create the backend capability object needed by vc-dispatcher."
   (vc-create-client-object 
@@ -2006,7 +1976,8 @@ outside of VC) and one wants to do some operation on it."
    #'vc-generic-status-printer
    #'vc-generic-state
    #'vc-generic-status-fileinfo-extra
-   #'vc-dir-refresh))
+   #'vc-dir-refresh
+   #'vc-dir-extra-menu))
 
 ;;;###autoload
 (defun vc-dir (dir)
@@ -2134,7 +2105,7 @@ If WORKING-REVISION is non-nil, leave the point at that revision."
   (interactive)
   (let* ((vc-fileset (vc-deduce-fileset t))
         (backend (car vc-fileset))
-        (files (cdr vc-fileset))
+        (files (cadr vc-fileset))
         (working-revision (or working-revision (vc-working-revision (car files)))))
     ;; Don't switch to the output buffer before running the command,
     ;; so that any buffer-local settings in the vc-controlled
@@ -2164,7 +2135,7 @@ This asks for confirmation if the buffer contents are not identical
 to the working revision (except for keyword expansion)."
   (interactive)
   (let* ((vc-fileset (vc-deduce-fileset))
-        (files (cdr vc-fileset)))
+        (files (cadr vc-fileset)))
     ;; If any of the files is visited by the current buffer, make
     ;; sure buffer is saved.  If the user says `no', abort since
     ;; we cannot show the changes and ask for confirmation to
@@ -2196,7 +2167,7 @@ depending on the underlying version-control system."
   (interactive)
   (let* ((vc-fileset (vc-deduce-fileset))
         (backend (car vc-fileset))
-        (files (cdr vc-fileset))
+        (files (cadr vc-fileset))
         (granularity (vc-call-backend backend 'revision-granularity)))
     (unless (vc-find-backend-function backend 'rollback)
       (error "Rollback is not supported in %s" backend))
@@ -2254,7 +2225,7 @@ changes from the current branch are merged into the working file."
   (interactive)
   (let* ((vc-fileset (vc-deduce-fileset))
         (backend (car vc-fileset))
-        (files (cdr vc-fileset)))
+        (files (cadr vc-fileset)))
     (dolist (file files)
       (when (let ((buf (get-file-buffer file)))
              (and buf (buffer-modified-p buf)))