;;; vc-mcvs.el --- VC backend for the Meta-CVS version-control system
-;; Copyright (C) 1995,98,99,2000,01,02,2003 Free Software Foundation, Inc.
+;; Copyright (C) 1995,98,99,2000,01,02,03,2004 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Stefan Monnier <monnier@gnu.org>
;;; Bugs:
-;; - VC-dired doesn't work.
+;; - Retrieving snapshots doesn't filter `cvs update' output and thus
+;; parses bogus filenames. Don't know if it harms.
;;; Code:
;;;###autoload (defun vc-mcvs-registered (file)
;;;###autoload (let ((dir file))
;;;###autoload (while (and (stringp dir)
-;;;###autoload (not (equal dir (setq dir (file-name-directory dir)))))
+;;;###autoload (not (equal
+;;;###autoload dir (setq dir (file-name-directory dir))))
+;;;###autoload dir)
;;;###autoload (setq dir (if (file-directory-p
-;;;###autoload (expand-file-name "MCVS/CVS" dir))
-;;;###autoload t (directory-file-name dir))))
+;;;###autoload (expand-file-name "MCVS/CVS" dir))
+;;;###autoload t (directory-file-name dir))))
;;;###autoload (if (eq dir t)
-;;;###autoload (progn
-;;;###autoload (load "vc-mcvs")
-;;;###autoload (vc-mcvs-registered file)))))
+;;;###autoload (progn
+;;;###autoload (load "vc-mcvs")
+;;;###autoload (vc-mcvs-registered file)))))
(defun vc-mcvs-root (file)
"Return the root directory of a Meta-CVS project, if any."
file 'mcvs-root
(let ((root nil))
(while (not (or root
- (equal file (setq file (file-name-directory file)))))
+ (equal file (setq file (file-name-directory file)))
+ (null file)))
(if (file-directory-p (expand-file-name "MCVS/CVS" file))
(setq root file)
(setq file (directory-file-name file))))
0))
t)))
-(defmacro vc-mcvs-cvs (op file &rest args)
- (declare (debug t))
- `(,(intern (concat "vc-cvs-" (symbol-name op)))
- (expand-file-name (vc-file-getprop ,file 'mcvs-inode)
- (vc-file-getprop ,file 'mcvs-root))
- ,@args))
-
(defun vc-mcvs-state (file)
;; This would assume the Meta-CVS sandbox is synchronized.
;; (vc-mcvs-cvs state file))
(vc-mcvs-state-heuristic file)
state))
(with-temp-buffer
- (cd (file-name-directory file))
+ (setq default-directory (vc-mcvs-root file))
(vc-mcvs-command t 0 file "status")
(vc-cvs-parse-status t))))
;; 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)
(goto-char (point-max))
(widen)))))))
-(defun vc-mcvs-workfile-version (file) (vc-mcvs-cvs workfile-version file))
+(defun vc-mcvs-workfile-version (file)
+ (vc-cvs-workfile-version
+ (expand-file-name (vc-file-getprop file 'mcvs-inode)
+ (vc-file-getprop file 'mcvs-root))))
(defalias 'vc-mcvs-checkout-model 'vc-cvs-checkout-model)
-(defun vc-mcvs-mode-line-string (file)
- (let ((s (vc-mcvs-cvs mode-line-string file)))
- (if s (concat "M" s))))
-
;;;
;;; State-changing functions
;;;
(error "%s is not a valid symbolic tag name" rev)
;; If the input revision is a valid symbolic tag name, we create it
;; as a branch, commit and switch to it.
+ ;; 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)
(defun vc-mcvs-print-log (file)
"Get change log associated with FILE."
- (vc-mcvs-command
- nil
- (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
- file "log"))
+ (let ((default-directory (vc-mcvs-root file)))
+ ;; Run the command from the root dir so that `mcvs filt' returns
+ ;; valid relative names.
+ (vc-mcvs-command
+ nil
+ (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
+ file "log")))
(defun vc-mcvs-diff (file &optional oldvers newvers)
"Get a difference report using Meta-CVS between two versions of FILE."
;; Even if it's empty, it's locally modified.
1)
(let* ((async (and (vc-stay-local-p file) (fboundp 'start-process)))
+ ;; Run the command from the root dir so that `mcvs filt' returns
+ ;; valid relative names.
+ (default-directory (vc-mcvs-root file))
(status
(apply 'vc-mcvs-command "*vc-diff*"
(if async 'async 1)
(defun vc-mcvs-diff-tree (dir &optional rev1 rev2)
"Diff all files at and below DIR."
(with-current-buffer "*vc-diff*"
- (setq default-directory dir)
- (if (vc-stay-local-p dir)
- ;; local diff: do it filewise, and only for files that are modified
- (vc-file-tree-walk
- dir
- (lambda (f)
- (vc-exec-after
- `(let ((coding-system-for-read (vc-coding-system-for-diff ',f)))
- ;; possible optimization: fetch the state of all files
- ;; in the tree via vc-mcvs-dir-state-heuristic
- (unless (vc-up-to-date-p ',f)
- (message "Looking at %s" ',f)
- (vc-diff-internal ',f ',rev1 ',rev2))))))
- ;; 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 nil "diff"
- (and rev1 (concat "-r" rev1))
- (and rev2 (concat "-r" rev2))
- (vc-switches 'MCVS '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)
"Execute \"mcvs annotate\" on FILE, inserting the contents in BUFFER.
"Assign to DIR's current version 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)."
- (vc-mcvs-command nil 0 dir "tag" "-c" (if branchp "-b") name)
- (when branchp (vc-mcvs-command nil 0 dir "update" "-r" name)))
+ (if (not branchp)
+ (vc-mcvs-command nil 0 dir "tag" "-c" name)
+ (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.
"A wrapper around `vc-do-command' for use in vc-mcvs.el.
The difference to vc-do-command is that this function always invokes `mcvs',
and that it passes `vc-mcvs-global-switches' to it before FLAGS."
- (let ((args (append '("--error-continue")
+ (let ((args (append '("--error-terminate")
(if (stringp vc-mcvs-global-switches)
(cons vc-mcvs-global-switches flags)
- (append vc-mcvs-global-switches
- flags)))))
- (if (member (car flags) '("diff" "log"))
- ;; We need to filter the output.
- (vc-do-command buffer okstatus "sh" nil "-c"
- (concat "mcvs "
- (mapconcat
- 'shell-quote-argument
- (append (remq nil args)
- (if file (list (file-relative-name file))))
- " ")
- " | mcvs filt"))
- (apply 'vc-do-command buffer okstatus "mcvs" file args))))
+ (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)
+ ;; 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"
+ (concat "mcvs "
+ (mapconcat
+ 'shell-quote-argument
+ (append (remq nil args)
+ (if file (list (file-relative-name file))))
+ " ")
+ " | mcvs filt")))))
(defun vc-mcvs-repository-hostname (dirname)
(vc-cvs-repository-hostname (vc-mcvs-root dirname)))
(defalias 'vc-mcvs-valid-version-number-p 'vc-cvs-valid-version-number-p)
(provide 'vc-mcvs)
+
+;;; arch-tag: a39c7c1c-5247-429d-88df-dd7187d2e704
;;; vc-mcvs.el ends here