X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1af74d06e5bdafad9d629d2ed729c5d743cfaf0f..838d78d411955dbe3ef5d75ff404ced8ca832c5a:/lisp/vc-mcvs.el diff --git a/lisp/vc-mcvs.el b/lisp/vc-mcvs.el index 766daf3c97..32c7b99b41 100644 --- a/lisp/vc-mcvs.el +++ b/lisp/vc-mcvs.el @@ -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 +;; 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 . ;;; 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: @@ -111,8 +109,8 @@ This is only meaningful if you don't use the implicit checkout model ;;; Properties of the backend -(defun vc-mcvs-revision-granularity () - 'file) +(defalias 'vc-mcvs-revision-granularity 'vc-cvs-revision-granularity) +(defalias 'vc-mcvs-checkout-model 'vc-cvs-checkout-model) ;;; ;;; State-querying functions @@ -177,32 +175,11 @@ 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 ;;; @@ -215,7 +192,7 @@ COMMENT can be used to provide an initial description of FILE. the Meta-CVS command (in that order)." ;; FIXME: multiple-file case should be made to work (if (> (length files) 1) (error "Registering filesets is not yet supported.")) - (let* ((file (car files)) + (let* ((file (car files)) (filename (file-name-nondirectory file)) (extpos (string-match "\\." filename)) (ext (if extpos (substring filename (1+ extpos)))) @@ -244,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.") @@ -267,7 +244,7 @@ This is only possible if Meta-CVS is responsible for FILE's directory.") (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 @@ -277,8 +254,8 @@ This is only possible if Meta-CVS is responsible for FILE's directory.") ;; be applied just to this one file. (apply 'vc-mcvs-command nil 0 files "tag" "-b" (list rev)) (apply 'vc-mcvs-command nil 0 files "update" "-r" (list rev)) - (mapcar (lambda (file) (vc-file-setprop file 'vc-mcvs-sticky-tag rev)) - files) + (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. @@ -292,9 +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) - (mapcar (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge)) + (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge)) files) - (error (substitute-command-keys + (error "%s" (substitute-command-keys (concat "Up-to-date check failed: " "type \\[vc-next-action] to merge in changes")))) (t @@ -302,12 +279,12 @@ 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")))) - ;; Single-file commit? Then update the version by parsing the buffer. + ;; 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-workfile-version + (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 @@ -322,7 +299,7 @@ This is only possible if Meta-CVS is responsible for FILE's directory.") (if (and rev (not (vc-mcvs-valid-symbolic-tag-name-p rev))) (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 @@ -335,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)) @@ -343,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" @@ -364,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)) @@ -389,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) @@ -432,6 +409,12 @@ 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 ;;; @@ -443,14 +426,13 @@ The changes are between FIRST-VERSION and SECOND-VERSION." ;; valid relative names. (vc-mcvs-command buffer - (if (and (vc-stay-local-p files) (fboundp 'start-process)) 'async 0) + (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 versions of FILES." + "Get a difference report using Meta-CVS between two revisions of FILES." (let* ((async (and (not vc-disable-async-diff) - (vc-stay-local-p files) - (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 (car files))) @@ -463,26 +445,13 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (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*" - ;; 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]") @@ -492,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) @@ -504,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) @@ -528,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)))) @@ -564,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 @@ -596,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)