;;; 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/
;; - C-x v l
;; - C-x v i
;; - C-x v g
+;; - M-x vc-rename-file RET
;;; Bugs:
-;; - Both the diff and log output contain Meta-CVS inode names so that
-;; several operations in those buffers don't work as advertised.
-;; - 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"
- :group 'vc)
-
-(defcustom vc-mcvs-stay-local vc-cvs-stay-local
- "*Non-nil means use local operations when possible for remote repositories.
-This avoids slow queries over the network and instead uses heuristics
-and past information to determine the current status of a file.
-The value can also be a regular expression to match against the host name
-of a repository; then VC only stays local for hosts that match it."
- :type '(choice (const :tag "Always stay local" t)
- (string :tag "Host regexp")
- (const :tag "Don't stay local" nil))
- :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."
- (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))
+ (or (vc-file-getprop file 'mcvs-root)
+ (vc-file-setprop file 'mcvs-root (vc-find-root file "MCVS/CVS"))))
(defun vc-mcvs-read (file)
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (read (current-buffer))))
+ (if (file-readable-p file)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (read (current-buffer)))))
(defun vc-mcvs-map-file (dir file)
(let ((map (vc-mcvs-read (expand-file-name "MCVS/MAP" dir)))
(let (root inode cvsfile)
(when (and (setq root (vc-mcvs-root file))
(setq inode (vc-mcvs-map-file
- root (substring file (length root)))))
+ root (file-relative-name file root))))
(vc-file-setprop file 'mcvs-inode inode)
- (vc-file-setprop file 'mcvs-root root)
;; Avoid calling `mcvs diff' in vc-workfile-unchanged-p.
(vc-file-setprop file 'vc-checkout-time
(if (vc-cvs-registered
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))
"Meta-CVS-specific version of `vc-state'."
- (if (vc-mcvs-stay-local-p file)
+ (if (vc-stay-local-p file)
(let ((state (vc-file-getprop file 'vc-state)))
;; If we should stay local, use the heuristic but only if
;; we don't have a more precise state already available.
(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))))
"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-mcvs-stay-local-p 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)
(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) (vc-mcvs-cvs mode-line-string file))
-
;;;
;;; State-changing functions
;;;
;; belly-up.
(unless (file-writable-p map-file)
(vc-checkout map-file t))
- (unless (file-writable-p types-file)
+ (unless (or (file-writable-p types-file) (not (file-exists-p types-file)))
(vc-checkout types-file t))
;; 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")))
(push (list ext (make-symbol (upcase (concat ":" type)))) types)
(setq types (sort types (lambda (x y) (string< (car x) (car y)))))
(with-current-buffer (find-file-noselect types-file)
- (if buffer-read-only (vc-checkout buffer-file-name t))
(erase-buffer)
(pp types (current-buffer))
(save-buffer)
(unless (get-buffer-window (current-buffer) t)
(kill-buffer (current-buffer)))))))
;; Now do the ADD.
- (let ((switches (append
- (if (stringp vc-register-switches)
- (list vc-register-switches)
- vc-register-switches)
- (if (stringp vc-mcvs-register-switches)
- (list vc-mcvs-register-switches)
- vc-mcvs-register-switches))))
- (prog1 (apply 'vc-mcvs-command nil 0 file
- "add"
- (and comment (string-match "[^\t\n ]" comment)
- (concat "-m" comment))
- switches)
- ;; 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.
- (vc-mcvs-registered file)
- ;; 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-file-setprop file 'vc-checkout-time 0))))
+ (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)))
(defalias 'vc-mcvs-responsible-p 'vc-mcvs-root
"Return non-nil if CVS thinks it is responsible for FILE.")
(defun vc-mcvs-checkin (file rev comment)
"Meta-CVS-specific version of `vc-backend-checkin'."
- (let ((switches (if (stringp vc-checkin-switches)
- (list vc-checkin-switches)
- vc-checkin-switches))
- status)
- (if (or (not rev) (vc-mcvs-valid-version-number-p rev))
- (setq status (apply 'vc-mcvs-command nil 1 file
- "ci" (if rev (concat "-r" rev))
- "-m" comment
- switches))
- (if (not (vc-mcvs-valid-symbolic-tag-name-p rev))
- (error "%s is not a valid symbolic tag name" rev)
- ;; If the input revison is a valid symbolic tag name, we create it
- ;; as a branch, commit and switch to it.
- (apply 'vc-mcvs-command nil 0 file "tag" "-b" (list rev))
- (apply 'vc-mcvs-command nil 0 file "update" "-r" (list rev))
- (setq status (apply 'vc-mcvs-command nil 1 file
- "ci"
- "-m" comment
- switches))
- (vc-file-setprop file 'vc-mcvs-sticky-tag rev)))
+ (unless (or (not rev) (vc-mcvs-valid-version-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
+ ;; 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)
+ (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
+ "ci" "-m" comment
+ (vc-switches 'MCVS 'checkin))))
(set-buffer "*vc*")
(goto-char (point-min))
(when (not (zerop status))
(and rev (not (string= rev ""))
(concat "-r" rev))
"-p"
- (if (stringp vc-checkout-switches)
- (list vc-checkout-switches)
- vc-checkout-switches)))
+ (vc-switches 'MCVS 'checkout)))
(defun vc-mcvs-checkout (file &optional editable rev)
(message "Checking out %s..." file)
(with-current-buffer (or (get-file-buffer file) (current-buffer))
- (let ((switches (if (stringp vc-checkout-switches)
- (list vc-checkout-switches)
- vc-checkout-switches)))
- (vc-call update file editable rev switches)))
+ (vc-call update file editable rev (vc-switches 'MCVS 'checkout)))
(vc-mode-line file)
(message "Checking out %s...done" file))
(concat "-r" rev))
switches)))
+(defun vc-mcvs-rename-file (old new)
+ (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."
- (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-mcvs-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."
- (let (status (diff-switches-list (vc-diff-switches-list 'MCVS)))
- (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 "*vc-diff*"
- 1 "diff" file
- (append diff-switches-list '("/dev/null"))))
- (setq status
- (apply 'vc-mcvs-command "*vc-diff*"
- (if (and (vc-mcvs-stay-local-p file)
- (fboundp 'start-process))
- 'async
- 1)
- file "diff"
- (and oldvers (concat "-r" oldvers))
- (and newvers (concat "-r" newvers))
- diff-switches-list))
- (if (vc-mcvs-stay-local-p file)
- 1 ;; async diff, pessimistic assumption
- status))))
+ (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)
+ (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 (or buffer "*vc-diff*")
+ (if async 'async 1)
+ file "diff"
+ (and oldvers (concat "-r" oldvers))
+ (and newvers (concat "-r" newvers))
+ (vc-switches 'MCVS 'diff))))
+ (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*"
- (setq default-directory dir)
- (if (vc-mcvs-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-diff-switches-list 'MCVS))))))
+ ;; 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.
Optional arg VERSION is a version to annotate from."
(vc-mcvs-command
buffer
- (if (and (vc-mcvs-stay-local-p file) (fboundp 'start-process)) 'async 0)
- file "annotate" (if version (concat "-r" version))))
+ (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
+ 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.
;;; Miscellaneous
;;;
-(defalias 'vc-mcvs-make-version-backups-p 'vc-mcvs-stay-local-p
+(defalias 'vc-mcvs-make-version-backups-p 'vc-stay-local-p
"Return non-nil if version backups should be made for FILE.")
(defalias 'vc-mcvs-check-headers 'vc-cvs-check-headers)
"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."
- (apply 'vc-do-command buffer okstatus "mcvs" file
- (append '("--error-continue")
- (if (stringp vc-mcvs-global-switches)
- (cons vc-mcvs-global-switches flags)
- (append vc-mcvs-global-switches
- flags)))))
-
-(defun vc-mcvs-stay-local-p (file) (vc-mcvs-cvs stay-local-p file))
+ (let ((args (append '("--error-terminate")
+ (if (stringp vc-mcvs-global-switches)
+ (cons vc-mcvs-global-switches 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)
+ ;; 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)))
(defun vc-mcvs-dir-state-heuristic (dir)
"Find the Meta-CVS state of all files in DIR, using only local information."
(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