X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d699c8e2cf7b1f88803127ee3595f2aaf9520bc5..fca8b94cf0138be6a92b24b039c10e3680227d5d:/lisp/vc-mcvs.el?ds=sidebyside diff --git a/lisp/vc-mcvs.el b/lisp/vc-mcvs.el index b2c4a9aef2..271cd01cbf 100644 --- a/lisp/vc-mcvs.el +++ b/lisp/vc-mcvs.el @@ -1,6 +1,6 @@ ;;; 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 Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Stefan Monnier @@ -19,15 +19,15 @@ ;; 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/ @@ -50,7 +50,8 @@ ;;; 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: @@ -68,7 +69,7 @@ (repeat :tag "Argument List" :value ("") string)) - :version "21.4" + :version "22.1" :group 'vc) (defcustom vc-mcvs-register-switches nil @@ -80,7 +81,7 @@ A string or list of strings passed to the checkin program by (repeat :tag "Argument List" :value ("") string)) - :version "21.4" + :version "22.1" :group 'vc) (defcustom vc-mcvs-diff-switches nil @@ -90,13 +91,13 @@ A string or list of strings passed to the checkin program by (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) @@ -105,7 +106,7 @@ A string or list of strings passed to the checkin program by 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) ;;; @@ -113,29 +114,15 @@ This is only meaningful if you don't use the implicit checkout model ;;; ;;;###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) @@ -166,13 +153,6 @@ This is only meaningful if you don't use the implicit checkout model 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)) @@ -185,7 +165,7 @@ This is only meaningful if you don't use the implicit checkout model (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)))) @@ -202,6 +182,7 @@ This is only meaningful if you don't use the implicit checkout model ;; 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) @@ -210,14 +191,13 @@ This is only meaningful if you don't use the implicit checkout model (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 ;;; @@ -284,6 +264,9 @@ This is only possible if Meta-CVS is responsible for FILE's directory.") (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) @@ -438,14 +421,17 @@ The changes are between FIRST-VERSION and SECOND-VERSION." ;;; 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. @@ -454,14 +440,19 @@ The changes are between FIRST-VERSION and SECOND-VERSION." ;; 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)) @@ -472,26 +463,15 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (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. @@ -499,7 +479,11 @@ Optional arg VERSION is a version 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)))) + 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) @@ -512,8 +496,10 @@ Optional arg VERSION is a version to annotate from." "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. @@ -569,22 +555,26 @@ If UPDATE is non-nil, then update (resynch) any affected buffers." "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))) @@ -606,4 +596,6 @@ and that it passes `vc-mcvs-global-switches' to it before FLAGS." (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