;;; 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) 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Stefan Monnier <monnier@gnu.org>
;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; The home page of the Meta-CVS version control system is at
-;;
+;;
;; http://users.footprints.net/~kaz/mcvs.html
-;;
+;;
;; This is derived from vc-cvs.el as follows:
;; - cp vc-cvs.el vc-mcvs.el
;; - Replace CVS/ with MCVS/CVS/
;;; 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:
(repeat :tag "Argument List"
:value ("")
string))
- :version "21.4"
+ :version "22.1"
:group 'vc)
(defcustom vc-mcvs-register-switches nil
(repeat :tag "Argument List"
:value ("")
string))
- :version "21.4"
+ :version "22.1"
:group 'vc)
(defcustom vc-mcvs-diff-switches nil
(repeat :tag "Argument List"
:value ("")
string))
- :version "21.4"
+ :version "22.1"
:group 'vc)
(defcustom vc-mcvs-header (or (cdr (assoc 'MCVS vc-header-alist))
vc-cvs-header)
"*Header keywords to be inserted by `vc-insert-headers'."
- :version "21.4"
+ :version "22.1"
:type '(repeat string)
:group 'vc)
This is only meaningful if you don't use the implicit checkout model
\(i.e. if you have $CVSREAD set)."
:type 'boolean
- :version "21.4"
+ :version "22.1"
:group 'vc)
;;;
;;;
;;;###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 (setq dir (if (file-directory-p
-;;;###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 (if (vc-find-root file "MCVS/CVS")
+;;;###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."
(or (vc-file-getprop file 'mcvs-root)
- (vc-file-setprop
- file 'mcvs-root
- (let ((root nil))
- (while (not (or root
- (equal file (setq file (file-name-directory file)))))
- (if (file-directory-p (expand-file-name "MCVS/CVS" file))
- (setq root file)
- (setq file (directory-file-name file))))
- root))))
+ (vc-file-setprop file 'mcvs-root (vc-find-root file "MCVS/CVS"))))
(defun vc-mcvs-read (file)
(if (file-readable-p 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
;;;
;; Make sure the `mcvs add' will not fire up the CVSEDITOR
;; to add a rule for the given file's extension.
(when (and ext (not (assoc ext types)))
- (let ((type (completing-read "Type to use [default]: "
+ (let ((type (completing-read "Type to use (default): "
'("default" "name-only" "keep-old"
"binary" "value-only")
nil t nil nil "default")))
(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-revert (file &optional contents-done)
"Revert FILE to the version it was based on."
- (vc-default-revert file contents-done)
+ (vc-default-revert 'MCVS file contents-done)
(unless (eq (vc-checkout-model file) 'implicit)
(if vc-mcvs-use-edit
(vc-mcvs-command nil 0 file "unedit")
;;; History functions
;;;
-(defun vc-mcvs-print-log (file)
+(defun vc-mcvs-print-log (file &optional buffer)
"Get change log associated with FILE."
- (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)
+ (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
+ 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.
;; We regard this as "changed".
;; Diff it against /dev/null.
;; Note: this is NOT a "mcvs diff".
- (apply 'vc-do-command "*vc-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)
- (let* ((async (and (vc-stay-local-p file) (fboundp 'start-process)))
+ (let* ((async (and (not vc-disable-async-diff)
+ (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*"
+ (apply 'vc-mcvs-command (or buffer "*vc-diff*")
(if async 'async 1)
file "diff"
(and oldvers (concat "-r" oldvers))
(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.
(vc-mcvs-command
buffer
(if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
- file "annotate" (if version (concat "-r" version))))
+ file "annotate" (if version (concat "-r" version)))
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (re-search-forward "^[0-9]")
+ (delete-region (point-min) (1- (point)))))
(defalias 'vc-mcvs-annotate-current-time 'vc-cvs-annotate-current-time)
(defalias 'vc-mcvs-annotate-time 'vc-cvs-annotate-time)
"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