(define-ccl-program): Move `doc-string' decl down.
[bpt/emacs.git] / lisp / vc-mcvs.el
index 0007aa4..32c7b99 100644 (file)
@@ -1,16 +1,16 @@
 ;;; vc-mcvs.el --- VC backend for the Meta-CVS version-control system
 
-;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author:      FSF (see vc.el for full credits)
-;; Maintainer:  Stefan Monnier <monnier@gnu.org>
+;; Maintainer:  None
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -18,9 +18,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -50,7 +48,7 @@
 
 ;;; Bugs:
 
-;; - Retrieving snapshots doesn't filter `cvs update' output and thus
+;; - Retrieving tags doesn't filter `cvs update' output and thus
 ;;   parses bogus filenames.  Don't know if it harms.
 
 ;;; Code:
@@ -109,6 +107,11 @@ This is only meaningful if you don't use the implicit checkout model
   :version "22.1"
   :group 'vc)
 
+;;; Properties of the backend
+
+(defalias 'vc-mcvs-revision-granularity 'vc-cvs-revision-granularity)
+(defalias 'vc-mcvs-checkout-model 'vc-cvs-checkout-model)
+
 ;;;
 ;;; State-querying functions
 ;;;
@@ -172,43 +175,25 @@ This is only meaningful if you don't use the implicit checkout model
 
 (defalias 'vc-mcvs-state-heuristic 'vc-cvs-state-heuristic)
 
-(defun vc-mcvs-dir-state (dir)
-  "Find the Meta-CVS state of all files in DIR."
-  ;; if DIR is not under Meta-CVS control, don't do anything.
-  (when (file-readable-p (expand-file-name "MCVS/CVS/Entries" dir))
-    (if (vc-stay-local-p dir)
-       (vc-mcvs-dir-state-heuristic dir)
-      (let ((default-directory dir))
-       ;; Don't specify DIR in this command, the default-directory is
-       ;; enough.  Otherwise it might fail with remote repositories.
-       (with-temp-buffer
-         (setq default-directory (vc-mcvs-root dir))
-         (vc-mcvs-command t 0 nil "status" "-l")
-         (goto-char (point-min))
-         (while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t)
-           (narrow-to-region (match-beginning 0) (match-end 0))
-           (vc-cvs-parse-status)
-           (goto-char (point-max))
-           (widen)))))))
-
-(defun vc-mcvs-workfile-version (file)
-  (vc-cvs-workfile-version
+(defun vc-mcvs-working-revision (file)
+  (vc-cvs-working-revision
    (expand-file-name (vc-file-getprop file 'mcvs-inode)
                     (vc-file-getprop file 'mcvs-root))))
 
-(defalias 'vc-mcvs-checkout-model 'vc-cvs-checkout-model)
-
 ;;;
 ;;; State-changing functions
 ;;;
 
-(defun vc-mcvs-register (file &optional rev comment)
-  "Register FILE into the Meta-CVS version-control system.
+(defun vc-mcvs-register (files &optional rev comment)
+  "Register FILES into the Meta-CVS version-control system.
 COMMENT can be used to provide an initial description of FILE.
 
 `vc-register-switches' and `vc-mcvs-register-switches' are passed to
 the Meta-CVS command (in that order)."
-  (let* ((filename (file-name-nondirectory file))
+  ;; FIXME: multiple-file case should be made to work
+  (if (> (length files) 1) (error "Registering filesets is not yet supported."))
+  (let* ((file (car files))
+        (filename (file-name-nondirectory file))
         (extpos (string-match "\\." filename))
         (ext (if extpos (substring filename (1+ extpos))))
         (root (vc-mcvs-root file))
@@ -236,19 +221,19 @@ the Meta-CVS command (in that order)."
          (pp types (current-buffer))
          (save-buffer)
          (unless (get-buffer-window (current-buffer) t)
-           (kill-buffer (current-buffer)))))))
-  ;; Now do the ADD.
-  (prog1 (apply 'vc-mcvs-command nil 0 file
-               "add"
-               (and comment (string-match "[^\t\n ]" comment)
-                    (concat "-m" comment))
-               (vc-switches 'MCVS 'register))
-    ;; I'm not sure exactly why, but if we don't setup the inode and root
-    ;; prop of the file, things break later on in vc-mode-line that
-    ;; ends up calling vc-mcvs-workfile-version.
-    ;; We also need to set vc-checkout-time so that vc-workfile-unchanged-p
-    ;; doesn't try to call `mcvs diff' on the file.
-    (vc-mcvs-registered file)))
+           (kill-buffer (current-buffer))))))
+    ;; Now do the ADD.
+    (prog1 (apply 'vc-mcvs-command nil 0 file
+                  "add"
+                  (and comment (string-match "[^\t\n ]" comment)
+                       (concat "-m" comment))
+                  (vc-switches 'MCVS 'register))
+      ;; I'm not sure exactly why, but if we don't setup the inode and root
+      ;; prop of the file, things break later on in vc-mode-line that
+      ;; ends up calling vc-mcvs-working-revision.
+      ;; We also need to set vc-checkout-time so that vc-workfile-unchanged-p
+      ;; doesn't try to call `mcvs diff' on the file.
+      (vc-mcvs-registered file))))
 
 (defalias 'vc-mcvs-responsible-p 'vc-mcvs-root
   "Return non-nil if CVS thinks it is responsible for FILE.")
@@ -257,9 +242,9 @@ the Meta-CVS command (in that order)."
   "Return non-nil if FILE could be registered in Meta-CVS.
 This is only possible if Meta-CVS is responsible for FILE's directory.")
 
-(defun vc-mcvs-checkin (file rev comment)
+(defun vc-mcvs-checkin (files rev comment)
   "Meta-CVS-specific version of `vc-backend-checkin'."
-  (unless (or (not rev) (vc-mcvs-valid-version-number-p rev))
+  (unless (or (not rev) (vc-mcvs-valid-revision-number-p rev))
     (if (not (vc-mcvs-valid-symbolic-tag-name-p rev))
        (error "%s is not a valid symbolic tag name" rev)
       ;; If the input revision is a valid symbolic tag name, we create it
@@ -267,14 +252,15 @@ This is only possible if Meta-CVS is responsible for FILE's directory.")
       ;; This file-specific form of branching is deprecated.
       ;; We can't use `mcvs branch' and `mcvs switch' because they cannot
       ;; be applied just to this one file.
-      (apply 'vc-mcvs-command nil 0 file "tag" "-b" (list rev))
-      (apply 'vc-mcvs-command nil 0 file "update" "-r" (list rev))
-      (vc-file-setprop file 'vc-mcvs-sticky-tag rev)
+      (apply 'vc-mcvs-command nil 0 files "tag" "-b" (list rev))
+      (apply 'vc-mcvs-command nil 0 files "update" "-r" (list rev))
+      (mapc (lambda (file) (vc-file-setprop file 'vc-mcvs-sticky-tag rev))
+           files)
       (setq rev nil)))
   ;; This commit might cvs-commit several files (e.g. MAP and TYPES)
   ;; so using numbered revs here is dangerous and somewhat meaningless.
   (when rev (error "Cannot commit to a specific revision number"))
-  (let ((status (apply 'vc-mcvs-command nil 1 file
+  (let ((status (apply 'vc-mcvs-command nil 1 files
                       "ci" "-m" comment
                       (vc-switches 'MCVS 'checkin))))
     (set-buffer "*vc*")
@@ -283,8 +269,9 @@ This is only possible if Meta-CVS is responsible for FILE's directory.")
       ;; Check checkin problem.
       (cond
        ((re-search-forward "Up-to-date check failed" nil t)
-        (vc-file-setprop file 'vc-state 'needs-merge)
-        (error (substitute-command-keys
+       (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
+             files)
+        (error "%s" (substitute-command-keys
                 (concat "Up-to-date check failed: "
                         "type \\[vc-next-action] to merge in changes"))))
        (t
@@ -292,22 +279,27 @@ This is only possible if Meta-CVS is responsible for FILE's directory.")
         (goto-char (point-min))
         (shrink-window-if-larger-than-buffer)
         (error "Check-in failed"))))
-    ;; Update file properties
-    (vc-file-setprop
-     file 'vc-workfile-version
-     (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
-    ;; Forget the checkout model of the file, because we might have
+    ;; Single-file commit?  Then update the revision by parsing the buffer.
+    ;; Otherwise we can't necessarily tell what goes with what; clear
+    ;; its properties so they have to be refetched.
+    (if (= (length files) 1)
+       (vc-file-setprop
+        (car files) 'vc-working-revision
+        (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
+      (mapc (lambda (file) (vc-file-clearprops file)) files))
+    ;; Anyway, forget the checkout model of the file, because we might have
     ;; guessed wrong when we found the file.  After commit, we can
     ;; tell it from the permissions of the file (see
     ;; vc-mcvs-checkout-model).
-    (vc-file-setprop file 'vc-checkout-model nil)
+    (mapc (lambda (file) (vc-file-setprop file 'vc-checkout-model nil))
+           files)
 
     ;; if this was an explicit check-in (does not include creation of
     ;; a branch), remove the sticky tag.
     (if (and rev (not (vc-mcvs-valid-symbolic-tag-name-p rev)))
-       (vc-mcvs-command nil 0 file "update" "-A"))))
+       (vc-mcvs-command nil 0 files "update" "-A"))))
 
-(defun vc-mcvs-find-version (file rev buffer)
+(defun vc-mcvs-find-revision (file rev buffer)
   (apply 'vc-mcvs-command
         buffer 0 file
         "-Q"                           ; suppress diagnostic output
@@ -320,7 +312,7 @@ This is only possible if Meta-CVS is responsible for FILE's directory.")
 (defun vc-mcvs-checkout (file &optional editable rev)
   (message "Checking out %s..." file)
   (with-current-buffer (or (get-file-buffer file) (current-buffer))
-    (vc-call update file editable rev (vc-switches 'MCVS 'checkout)))
+    (vc-mcvs-update file editable rev (vc-switches 'MCVS 'checkout)))
   (vc-mode-line file)
   (message "Checking out %s...done" file))
 
@@ -328,13 +320,13 @@ This is only possible if Meta-CVS is responsible for FILE's directory.")
   (if (and (file-exists-p file) (not rev))
       ;; If no revision was specified, just make the file writable
       ;; if necessary (using `cvs-edit' if requested).
-      (and editable (not (eq (vc-mcvs-checkout-model file) 'implicit))
+      (and editable (not (eq (vc-mcvs-checkout-model (list file)) 'implicit))
           (if vc-mcvs-use-edit
               (vc-mcvs-command nil 0 file "edit")
             (set-file-modes file (logior (file-modes file) 128))
             (if (equal file buffer-file-name) (toggle-read-only -1))))
-    ;; Check out a particular version (or recreate the file).
-    (vc-file-setprop file 'vc-workfile-version nil)
+    ;; Check out a particular revision (or recreate the file).
+    (vc-file-setprop file 'vc-working-revision nil)
     (apply 'vc-mcvs-command nil 0 file
           (if editable "-w")
           "update"
@@ -349,21 +341,21 @@ This is only possible if Meta-CVS is responsible for FILE's directory.")
   (vc-mcvs-command nil 0 new "move" (file-relative-name old)))
 
 (defun vc-mcvs-revert (file &optional contents-done)
-  "Revert FILE to the version it was based on."
+  "Revert FILE to the working revision it was based on."
   (vc-default-revert 'MCVS file contents-done)
-  (unless (eq (vc-checkout-model file) 'implicit)
+  (unless (eq (vc-mcvs-checkout-model (list file)) 'implicit)
     (if vc-mcvs-use-edit
         (vc-mcvs-command nil 0 file "unedit")
       ;; Make the file read-only by switching off all w-bits
       (set-file-modes file (logand (file-modes file) 3950)))))
 
-(defun vc-mcvs-merge (file first-version &optional second-version)
+(defun vc-mcvs-merge (file first-revision &optional second-revision)
   "Merge changes into current working copy of FILE.
-The changes are between FIRST-VERSION and SECOND-VERSION."
+The changes are between FIRST-REVISION and SECOND-REVISION."
   (vc-mcvs-command nil 0 file
                   "update" "-kk"
-                  (concat "-j" first-version)
-                  (concat "-j" second-version))
+                  (concat "-j" first-revision)
+                  (concat "-j" second-revision))
   (vc-file-setprop file 'vc-state 'edited)
   (with-current-buffer (get-buffer "*vc*")
     (goto-char (point-min))
@@ -374,18 +366,18 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
 (defun vc-mcvs-merge-news (file)
   "Merge in any new changes made to FILE."
   (message "Merging changes into %s..." file)
-  ;; (vc-file-setprop file 'vc-workfile-version nil)
+  ;; (vc-file-setprop file 'vc-working-revision nil)
   (vc-file-setprop file 'vc-checkout-time 0)
   (vc-mcvs-command nil 0 file "update")
   ;; Analyze the merge result reported by Meta-CVS, and set
   ;; file properties accordingly.
   (with-current-buffer (get-buffer "*vc*")
     (goto-char (point-min))
-    ;; get new workfile version
+    ;; get new working revision
     (if (re-search-forward
         "^Merging differences between [0-9.]* and \\([0-9.]*\\) into" nil t)
-       (vc-file-setprop file 'vc-workfile-version (match-string 1))
-      (vc-file-setprop file 'vc-workfile-version nil))
+       (vc-file-setprop file 'vc-working-revision (match-string 1))
+      (vc-file-setprop file 'vc-working-revision nil))
     ;; get file status
     (prog1
         (if (eq (buffer-size) 0)
@@ -417,69 +409,49 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
             (error "Couldn't analyze mcvs update result")))
       (message "Merging changes into %s...done" file))))
 
+(defun vc-mcvs-modify-change-comment (files rev comment)
+  "Modify the change comments for FILES on a specified REV. 
+Will fail unless you have administrative privileges on the repo."
+  (vc-mcvs-command nil 0 files "rcs" (concat "-m" comment ":" rev)))
+
+
 ;;;
 ;;; History functions
 ;;;
 
-(defun vc-mcvs-print-log (file &optional buffer)
-  "Get change log associated with FILE."
-  (let ((default-directory (vc-mcvs-root file)))
+(defun vc-mcvs-print-log (files &optional buffer)
+  "Get change log associated with FILES."
+  (let ((default-directory (vc-mcvs-root (car files))))
     ;; Run the command from the root dir so that `mcvs filt' returns
     ;; valid relative names.
     (vc-mcvs-command
      buffer
-     (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
-     file "log")))
-
-(defun vc-mcvs-diff (file &optional oldvers newvers buffer)
-  "Get a difference report using Meta-CVS between two versions of FILE."
-  (if (string= (vc-workfile-version file) "0")
-      ;; This file is added but not yet committed; there is no master file.
-      (if (or oldvers newvers)
-         (error "No revisions of %s exist" file)
-       ;; We regard this as "changed".
-       ;; Diff it against /dev/null.
-       ;; Note: this is NOT a "mcvs diff".
-       (apply 'vc-do-command (or buffer "*vc-diff*")
-              1 "diff" file
-              (append (vc-switches nil 'diff) '("/dev/null")))
-       ;; Even if it's empty, it's locally modified.
-       1)
+     (if (vc-stay-local-p files) 'async 0)
+     files "log")))
+
+(defun vc-mcvs-diff (files &optional oldvers newvers buffer)
+  "Get a difference report using Meta-CVS between two revisions of FILES."
     (let* ((async (and (not vc-disable-async-diff)
-                       (vc-stay-local-p file)
-                       (fboundp 'start-process)))
+                       (vc-stay-local-p files)))
           ;; Run the command from the root dir so that `mcvs filt' returns
           ;; valid relative names.
-          (default-directory (vc-mcvs-root file))
+          (default-directory (vc-mcvs-root (car files)))
           (status
            (apply 'vc-mcvs-command (or buffer "*vc-diff*")
                   (if async 'async 1)
-                  file "diff"
+                  files "diff"
                   (and oldvers (concat "-r" oldvers))
                   (and newvers (concat "-r" newvers))
                   (vc-switches 'MCVS 'diff))))
-      (if async 1 status))))          ; async diff, pessimistic assumption.
+      (if async 1 status)))           ; async diff, pessimistic assumption.
 
-(defun vc-mcvs-diff-tree (dir &optional rev1 rev2)
-  "Diff all files at and below DIR."
-  (with-current-buffer "*vc-diff*"
-    ;; Run the command from the root dir so that `mcvs filt' returns
-    ;; valid relative names.
-    (setq default-directory (vc-mcvs-root dir))
-    ;; cvs diff: use a single call for the entire tree
-    (let ((coding-system-for-read (or coding-system-for-read 'undecided)))
-      (apply 'vc-mcvs-command "*vc-diff*" 1 dir "diff"
-            (and rev1 (concat "-r" rev1))
-            (and rev2 (concat "-r" rev2))
-            (vc-switches 'MCVS 'diff)))))
-
-(defun vc-mcvs-annotate-command (file buffer &optional version)
+(defun vc-mcvs-annotate-command (file buffer &optional revision)
   "Execute \"mcvs annotate\" on FILE, inserting the contents in BUFFER.
-Optional arg VERSION is a version to annotate from."
+Optional arg REVISION is a revision to annotate from."
   (vc-mcvs-command
    buffer
-   (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
-   file "annotate" (if version (concat "-r" version)))
+   (if (vc-stay-local-p file) 'async 0)
+   file "annotate" (if revision (concat "-r" revision)))
   (with-current-buffer buffer
     (goto-char (point-min))
     (re-search-forward "^[0-9]")
@@ -489,11 +461,11 @@ Optional arg VERSION is a version to annotate from."
 (defalias 'vc-mcvs-annotate-time 'vc-cvs-annotate-time)
 
 ;;;
-;;; Snapshot system
+;;; Tag system
 ;;;
 
-(defun vc-mcvs-create-snapshot (dir name branchp)
-  "Assign to DIR's current version a given NAME.
+(defun vc-mcvs-create-tag (dir name branchp)
+  "Assign to DIR's current revision a given NAME.
 If BRANCHP is non-nil, the name is created as a branch (and the current
 workspace is immediately moved to that new branch)."
   (if (not branchp)
@@ -501,9 +473,9 @@ workspace is immediately moved to that new branch)."
     (vc-mcvs-command nil 0 dir "branch" name)
     (vc-mcvs-command nil 0 dir "switch" name)))
 
-(defun vc-mcvs-retrieve-snapshot (dir name update)
-  "Retrieve a snapshot at and below DIR.
-NAME is the name of the snapshot; if it is empty, do a `cvs update'.
+(defun vc-mcvs-retrieve-tag (dir name update)
+  "Retrieve a tag at and below DIR.
+NAME is the name of the tag; if it is empty, do a `cvs update'.
 If UPDATE is non-nil, then update (resynch) any affected buffers."
   (with-current-buffer (get-buffer-create "*vc*")
     (let ((default-directory dir)
@@ -525,13 +497,13 @@ If UPDATE is non-nil, then update (resynch) any affected buffers."
                   ((or (string= state "U")
                        (string= state "P"))
                    (vc-file-setprop file 'vc-state 'up-to-date)
-                   (vc-file-setprop file 'vc-workfile-version nil)
+                   (vc-file-setprop file 'vc-working-revision nil)
                    (vc-file-setprop file 'vc-checkout-time
                                     (nth 5 (file-attributes file))))
                   ((or (string= state "M")
                        (string= state "C"))
                    (vc-file-setprop file 'vc-state 'edited)
-                   (vc-file-setprop file 'vc-workfile-version nil)
+                   (vc-file-setprop file 'vc-working-revision nil)
                    (vc-file-setprop file 'vc-checkout-time 0)))
                  (vc-file-setprop file 'vc-mcvs-sticky-tag sticky-tag)
                  (vc-resynch-buffer file t t))))
@@ -561,13 +533,13 @@ and that it passes `vc-mcvs-global-switches' to it before FLAGS."
                        (append vc-mcvs-global-switches flags)))))
     (if (not (member (car flags) '("diff" "log" "status")))
        ;; No need to filter: do it the easy way.
-       (apply 'vc-do-command buffer okstatus "mcvs" file args)
+       (apply 'vc-do-command (or buffer "*vc*") okstatus "mcvs" file args)
       ;; We need to filter the output.
       ;; The output of the filter uses filenames relative to the root,
       ;; so we need to change the default-directory.
       ;; (assert (equal default-directory (vc-mcvs-root file)))
       (vc-do-command
-       buffer okstatus "sh" nil "-c"
+       (or buffer "*vc*") okstatus "sh" nil "-c"
        (concat "mcvs "
               (mapconcat
                'shell-quote-argument
@@ -593,7 +565,7 @@ and that it passes `vc-mcvs-global-switches' to it before FLAGS."
       (forward-line 1))))
 
 (defalias 'vc-mcvs-valid-symbolic-tag-name-p 'vc-cvs-valid-symbolic-tag-name-p)
-(defalias 'vc-mcvs-valid-version-number-p 'vc-cvs-valid-version-number-p)
+(defalias 'vc-mcvs-valid-revision-number-p 'vc-cvs-valid-revision-number-p)
 
 (provide 'vc-mcvs)