annotate lisp/vc-mcvs.el @ 58365:1b70e511be22

*** empty log message ***

申鐃緒申     1 ;;; vc-mcvs.el --- VC backend for the Meta-CVS version-control system
申鐃緒申     2 
申鐃緒申     3 ;; Copyright (C) 1995, 1998, 1999, 2000, 2001, 2002, 2003, 2004
申鐃緒申     4 ;;           Free Software Foundation, Inc.
申鐃緒申     5 
申鐃緒申     6 ;; Author:      FSF (see vc.el for full credits)
申鐃緒申     7 ;; Maintainer:  Stefan Monnier <[e-mail]>
申鐃緒申     8 
申鐃緒申     9 ;; This file is part of GNU Emacs.
申鐃緒申    10 
申鐃緒申    11 ;; GNU Emacs is free software; you can redistribute it and/or modify
申鐃緒申    12 ;; it under the terms of the GNU General Public License as published by
申鐃緒申    13 ;; the Free Software Foundation; either version 2, or (at your option)
申鐃緒申    14 ;; any later version.
申鐃緒申    15 
申鐃緒申    16 ;; GNU Emacs is distributed in the hope that it will be useful,
申鐃緒申    17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
申鐃緒申    18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
申鐃緒申    19 ;; GNU General Public License for more details.
申鐃緒申    20 
申鐃緒申    21 ;; You should have received a copy of the GNU General Public License
申鐃緒申    22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
申鐃緒申    23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
申鐃緒申    24 ;; Boston, MA 02111-1307, USA.
申鐃緒申    25 
申鐃緒申    26 ;;; Commentary:
申鐃緒申    27 
申鐃緒申    28 ;; The home page of the Meta-CVS version control system is at
申鐃緒申    29 ;;
申鐃緒申    30 ;;      http://users.footprints.net/~kaz/mcvs.html
申鐃緒申    31 ;;
申鐃緒申    32 ;; This is derived from vc-cvs.el as follows:
申鐃緒申    33 ;; - cp vc-cvs.el vc-mcvs.el
申鐃緒申    34 ;; - Replace CVS/ with MCVS/CVS/
申鐃緒申    35 ;; - Replace 'CVS with 'MCVS
申鐃緒申    36 ;; - Replace -cvs- with -mcvs-
申鐃緒申    37 ;; - Replace most of the rest of CVS to Meta-CVS
申鐃緒申    38 ;;
申鐃緒申    39 ;; Then of course started the hacking.  Only a small part of the code
申鐃緒申    40 ;; has been touched and not much more than that was tested, so if
申鐃緒申    41 ;; you bump into a bug, don't be surprised: just report it to me.
申鐃緒申    42 ;;
申鐃緒申    43 ;; What has been partly tested:
申鐃緒申    44 ;; - C-x v v to start editing a file that was checked out with CVSREAD on.
申鐃緒申    45 ;; - C-x v v to commit a file
申鐃緒申    46 ;; - C-x v =
申鐃緒申    47 ;; - C-x v l
申鐃緒申    48 ;; - C-x v i
申鐃緒申    49 ;; - C-x v g
申鐃緒申    50 ;; - M-x vc-rename-file RET
申鐃緒申    51 
申鐃緒申    52 ;;; Bugs:
申鐃緒申    53 
申鐃緒申    54 ;; - Retrieving snapshots doesn't filter `cvs update' output and thus
申鐃緒申    55 ;;   parses bogus filenames.  Don't know if it harms.
申鐃緒申    56 
申鐃緒申    57 ;;; Code:
申鐃緒申    58 
申鐃緒申    59 (eval-when-compile (require 'vc))
申鐃緒申    60 (require 'vc-cvs)
申鐃緒申    61 
申鐃緒申    62 ;;;
申鐃緒申    63 ;;; Customization options
申鐃緒申    64 ;;;
申鐃緒申    65 
申鐃緒申    66 (defcustom vc-mcvs-global-switches nil
申鐃緒申    67   "*Global switches to pass to any Meta-CVS command."
申鐃緒申    68   :type '(choice (const :tag "None" nil)
申鐃緒申    69 		 (string :tag "Argument String")
申鐃緒申    70 		 (repeat :tag "Argument List"
申鐃緒申    71 			 :value ("")
申鐃緒申    72 			 string))
申鐃緒申    73   :version "21.4"
申鐃緒申    74   :group 'vc)
申鐃緒申    75 
申鐃緒申    76 (defcustom vc-mcvs-register-switches nil
申鐃緒申    77   "*Extra switches for registering a file into Meta-CVS.
申鐃緒申    78 A string or list of strings passed to the checkin program by
申鐃緒申    79 \\[vc-register]."
申鐃緒申    80   :type '(choice (const :tag "None" nil)
申鐃緒申    81 		 (string :tag "Argument String")
申鐃緒申    82 		 (repeat :tag "Argument List"
申鐃緒申    83 			 :value ("")
申鐃緒申    84 			 string))
申鐃緒申    85   :version "21.4"
申鐃緒申    86   :group 'vc)
申鐃緒申    87 
申鐃緒申    88 (defcustom vc-mcvs-diff-switches nil
申鐃緒申    89   "*A string or list of strings specifying extra switches for cvs diff under VC."
申鐃緒申    90     :type '(choice (const :tag "None" nil)
申鐃緒申    91 		 (string :tag "Argument String")
申鐃緒申    92 		 (repeat :tag "Argument List"
申鐃緒申    93 			 :value ("")
申鐃緒申    94 			 string))
申鐃緒申    95   :version "21.4"
申鐃緒申    96   :group 'vc)
申鐃緒申    97 
申鐃緒申    98 (defcustom vc-mcvs-header (or (cdr (assoc 'MCVS vc-header-alist))
申鐃緒申    99 			      vc-cvs-header)
申鐃緒申   100   "*Header keywords to be inserted by `vc-insert-headers'."
申鐃緒申   101   :version "21.4"
申鐃緒申   102   :type '(repeat string)
申鐃緒申   103   :group 'vc)
申鐃緒申   104 
申鐃緒申   105 (defcustom vc-mcvs-use-edit vc-cvs-use-edit
申鐃緒申   106   "*Non-nil means to use `cvs edit' to \"check out\" a file.
申鐃緒申   107 This is only meaningful if you don't use the implicit checkout model
申鐃緒申   108 \(i.e. if you have $CVSREAD set)."
申鐃緒申   109   :type 'boolean
申鐃緒申   110   :version "21.4"
申鐃緒申   111   :group 'vc)
申鐃緒申   112 
申鐃緒申   113 ;;;
申鐃緒申   114 ;;; State-querying functions
申鐃緒申   115 ;;;
申鐃緒申   116 
申鐃緒申   117 ;;;###autoload (defun vc-mcvs-registered (file)
申鐃緒申   118 ;;;###autoload   (if (vc-find-root file "MCVS/CVS")
申鐃緒申   119 ;;;###autoload       (progn
申鐃緒申   120 ;;;###autoload         (load "vc-mcvs")
申鐃緒申   121 ;;;###autoload         (vc-mcvs-registered file))))
申鐃緒申   122 
申鐃緒申   123 (defun vc-mcvs-root (file)
申鐃緒申   124   "Return the root directory of a Meta-CVS project, if any."
申鐃緒申   125   (or (vc-file-getprop file 'mcvs-root)
申鐃緒申   126       (vc-file-setprop file 'mcvs-root (vc-find-root file "MCVS/CVS"))))
申鐃緒申   127 
申鐃緒申   128 (defun vc-mcvs-read (file)
申鐃緒申   129   (if (file-readable-p file)
申鐃緒申   130       (with-temp-buffer
申鐃緒申   131 	(insert-file-contents file)
申鐃緒申   132 	(goto-char (point-min))
申鐃緒申   133 	(read (current-buffer)))))
申鐃緒申   134 
申鐃緒申   135 (defun vc-mcvs-map-file (dir file)
申鐃緒申   136   (let ((map (vc-mcvs-read (expand-file-name "MCVS/MAP" dir)))
申鐃緒申   137 	inode)
申鐃緒申   138     (dolist (x map inode)
申鐃緒申   139       (if (equal (nth 2 x) file) (setq inode (nth 1 x))))))
申鐃緒申   140 
申鐃緒申   141 (defun vc-mcvs-registered (file)
申鐃緒申   142   (let (root inode cvsfile)
申鐃緒申   143     (when (and (setq root (vc-mcvs-root file))
申鐃緒申   144 	       (setq inode (vc-mcvs-map-file
申鐃緒申   145 			    root (file-relative-name file root))))
申鐃緒申   146       (vc-file-setprop file 'mcvs-inode inode)
申鐃緒申   147       ;; Avoid calling `mcvs diff' in vc-workfile-unchanged-p.
申鐃緒申   148       (vc-file-setprop file 'vc-checkout-time
申鐃緒申   149 		       (if (vc-cvs-registered
申鐃緒申   150 			    (setq cvsfile (expand-file-name inode root)))
申鐃緒申   151 			   (vc-file-getprop cvsfile 'vc-checkout-time)
申鐃緒申   152 			 ;; The file might not be registered yet because
申鐃緒申   153 			 ;; of lazy-adding.
申鐃緒申   154 			 0))
申鐃緒申   155       t)))
申鐃緒申   156 
申鐃緒申   157 (defun vc-mcvs-state (file)
申鐃緒申   158   ;; This would assume the Meta-CVS sandbox is synchronized.
申鐃緒申   159   ;; (vc-mcvs-cvs state file))
申鐃緒申   160   "Meta-CVS-specific version of `vc-state'."
申鐃緒申   161   (if (vc-stay-local-p file)
申鐃緒申   162       (let ((state (vc-file-getprop file 'vc-state)))
申鐃緒申   163         ;; If we should stay local, use the heuristic but only if
申鐃緒申   164         ;; we don't have a more precise state already available.
申鐃緒申   165 	(if (memq state '(up-to-date edited))
申鐃緒申   166 	    (vc-mcvs-state-heuristic file)
申鐃緒申   167 	  state))
申鐃緒申   168     (with-temp-buffer
申鐃緒申   169       (setq default-directory (vc-mcvs-root file))
申鐃緒申   170       (vc-mcvs-command t 0 file "status")
申鐃緒申   171       (vc-cvs-parse-status t))))
申鐃緒申   172 
申鐃緒申   173 
申鐃緒申   174 (defalias 'vc-mcvs-state-heuristic 'vc-cvs-state-heuristic)
申鐃緒申   175 
申鐃緒申   176 (defun vc-mcvs-dir-state (dir)
申鐃緒申   177   "Find the Meta-CVS state of all files in DIR."
申鐃緒申   178   ;; if DIR is not under Meta-CVS control, don't do anything.
申鐃緒申   179   (when (file-readable-p (expand-file-name "MCVS/CVS/Entries" dir))
申鐃緒申   180     (if (vc-stay-local-p dir)
申鐃緒申   181 	(vc-mcvs-dir-state-heuristic dir)
申鐃緒申   182       (let ((default-directory dir))
申鐃緒申   183 	;; Don't specify DIR in this command, the default-directory is
申鐃緒申   184 	;; enough.  Otherwise it might fail with remote repositories.
申鐃緒申   185 	(with-temp-buffer
申鐃緒申   186 	  (setq default-directory (vc-mcvs-root dir))
申鐃緒申   187 	  (vc-mcvs-command t 0 nil "status" "-l")
申鐃緒申   188 	  (goto-char (point-min))
申鐃緒申   189 	  (while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t)
申鐃緒申   190 	    (narrow-to-region (match-beginning 0) (match-end 0))
申鐃緒申   191 	    (vc-cvs-parse-status)
申鐃緒申   192 	    (goto-char (point-max))
申鐃緒申   193 	    (widen)))))))
申鐃緒申   194 
申鐃緒申   195 (defun vc-mcvs-workfile-version (file)
申鐃緒申   196   (vc-cvs-workfile-version
申鐃緒申   197    (expand-file-name (vc-file-getprop file 'mcvs-inode)
申鐃緒申   198 		     (vc-file-getprop file 'mcvs-root))))
申鐃緒申   199 
申鐃緒申   200 (defalias 'vc-mcvs-checkout-model 'vc-cvs-checkout-model)
申鐃緒申   201 
申鐃緒申   202 ;;;
申鐃緒申   203 ;;; State-changing functions
申鐃緒申   204 ;;;
申鐃緒申   205 
申鐃緒申   206 (defun vc-mcvs-register (file &optional rev comment)
申鐃緒申   207   "Register FILE into the Meta-CVS version-control system.
申鐃緒申   208 COMMENT can be used to provide an initial description of FILE.
申鐃緒申   209 
申鐃緒申   210 `vc-register-switches' and `vc-mcvs-register-switches' are passed to
申鐃緒申   211 the Meta-CVS command (in that order)."
申鐃緒申   212   (let* ((filename (file-name-nondirectory file))
申鐃緒申   213 	 (extpos (string-match "\\." filename))
申鐃緒申   214 	 (ext (if extpos (substring filename (1+ extpos))))
申鐃緒申   215 	 (root (vc-mcvs-root file))
申鐃緒申   216 	 (types-file (expand-file-name "MCVS/TYPES" root))
申鐃緒申   217 	 (map-file (expand-file-name "MCVS/MAP" root))
申鐃緒申   218 	 (types (vc-mcvs-read types-file)))
申鐃緒申   219     ;; Make sure meta files like MCVS/MAP are not read-only (happens with
申鐃緒申   220     ;; CVSREAD) since Meta-CVS doesn't pay attention to it at all and goes
申鐃緒申   221     ;; belly-up.
申鐃緒申   222     (unless (file-writable-p map-file)
申鐃緒申   223       (vc-checkout map-file t))
申鐃緒申   224     (unless (or (file-writable-p types-file) (not (file-exists-p types-file)))
申鐃緒申   225       (vc-checkout types-file t))
申鐃緒申   226     ;; Make sure the `mcvs add' will not fire up the CVSEDITOR
申鐃緒申   227     ;; to add a rule for the given file's extension.
申鐃緒申   228     (when (and ext (not (assoc ext types)))
申鐃緒申   229       (let ((type (completing-read "Type to use [default]: "
申鐃緒申   230 				   '("default" "name-only" "keep-old"
申鐃緒申   231 				     "binary" "value-only")
申鐃緒申   232 				   nil t nil nil "default")))
申鐃緒申   233 	(push (list ext (make-symbol (upcase (concat ":" type)))) types)
申鐃緒申   234 	(setq types (sort types (lambda (x y) (string< (car x) (car y)))))
申鐃緒申   235 	(with-current-buffer (find-file-noselect types-file)
申鐃緒申   236 	  (erase-buffer)
申鐃緒申   237 	  (pp types (current-buffer))
申鐃緒申   238 	  (save-buffer)
申鐃緒申   239 	  (unless (get-buffer-window (current-buffer) t)
申鐃緒申   240 	    (kill-buffer (current-buffer)))))))
申鐃緒申   241   ;; Now do the ADD.
申鐃緒申   242   (prog1 (apply 'vc-mcvs-command nil 0 file
申鐃緒申   243 		"add"
申鐃緒申   244 		(and comment (string-match "[^\t\n ]" comment)
申鐃緒申   245 		     (concat "-m" comment))
申鐃緒申   246 		(vc-switches 'MCVS 'register))
申鐃緒申   247     ;; I'm not sure exactly why, but if we don't setup the inode and root
申鐃緒申   248     ;; prop of the file, things break later on in vc-mode-line that
申鐃緒申   249     ;; ends up calling vc-mcvs-workfile-version.
申鐃緒申   250     ;; We also need to set vc-checkout-time so that vc-workfile-unchanged-p
申鐃緒申   251     ;; doesn't try to call `mcvs diff' on the file.
申鐃緒申   252     (vc-mcvs-registered file)))
申鐃緒申   253 
申鐃緒申   254 (defalias 'vc-mcvs-responsible-p 'vc-mcvs-root
申鐃緒申   255   "Return non-nil if CVS thinks it is responsible for FILE.")
申鐃緒申   256 
申鐃緒申   257 (defalias 'vc-cvs-could-register 'vc-cvs-responsible-p
申鐃緒申   258   "Return non-nil if FILE could be registered in Meta-CVS.
申鐃緒申   259 This is only possible if Meta-CVS is responsible for FILE's directory.")
申鐃緒申   260 
申鐃緒申   261 (defun vc-mcvs-checkin (file rev comment)
申鐃緒申   262   "Meta-CVS-specific version of `vc-backend-checkin'."
申鐃緒申   263   (unless (or (not rev) (vc-mcvs-valid-version-number-p rev))
申鐃緒申   264     (if (not (vc-mcvs-valid-symbolic-tag-name-p rev))
申鐃緒申   265 	(error "%s is not a valid symbolic tag name" rev)
申鐃緒申   266       ;; If the input revision is a valid symbolic tag name, we create it
申鐃緒申   267       ;; as a branch, commit and switch to it.
申鐃緒申   268       ;; This file-specific form of branching is deprecated.
申鐃緒申   269       ;; We can't use `mcvs branch' and `mcvs switch' because they cannot
申鐃緒申   270       ;; be applied just to this one file.
申鐃緒申   271       (apply 'vc-mcvs-command nil 0 file "tag" "-b" (list rev))
申鐃緒申   272       (apply 'vc-mcvs-command nil 0 file "update" "-r" (list rev))
申鐃緒申   273       (vc-file-setprop file 'vc-mcvs-sticky-tag rev)
申鐃緒申   274       (setq rev nil)))
申鐃緒申   275   ;; This commit might cvs-commit several files (e.g. MAP and TYPES)
申鐃緒申   276   ;; so using numbered revs here is dangerous and somewhat meaningless.
申鐃緒申   277   (when rev (error "Cannot commit to a specific revision number"))
申鐃緒申   278   (let ((status (apply 'vc-mcvs-command nil 1 file
申鐃緒申   279 		       "ci" "-m" comment
申鐃緒申   280 		       (vc-switches 'MCVS 'checkin))))
申鐃緒申   281     (set-buffer "*vc*")
申鐃緒申   282     (goto-char (point-min))
申鐃緒申   283     (when (not (zerop status))
申鐃緒申   284       ;; Check checkin problem.
申鐃緒申   285       (cond
申鐃緒申   286        ((re-search-forward "Up-to-date check failed" nil t)
申鐃緒申   287         (vc-file-setprop file 'vc-state 'needs-merge)
申鐃緒申   288         (error (substitute-command-keys
申鐃緒申   289                 (concat "Up-to-date check failed: "
申鐃緒申   290                         "type \\[vc-next-action] to merge in changes"))))
申鐃緒申   291        (t
申鐃緒申   292         (pop-to-buffer (current-buffer))
申鐃緒申   293         (goto-char (point-min))
申鐃緒申   294         (shrink-window-if-larger-than-buffer)
申鐃緒申   295         (error "Check-in failed"))))
申鐃緒申   296     ;; Update file properties
申鐃緒申   297     (vc-file-setprop
申鐃緒申   298      file 'vc-workfile-version
申鐃緒申   299      (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
申鐃緒申   300     ;; Forget the checkout model of the file, because we might have
申鐃緒申   301     ;; guessed wrong when we found the file.  After commit, we can
申鐃緒申   302     ;; tell it from the permissions of the file (see
申鐃緒申   303     ;; vc-mcvs-checkout-model).
申鐃緒申   304     (vc-file-setprop file 'vc-checkout-model nil)
申鐃緒申   305 
申鐃緒申   306     ;; if this was an explicit check-in (does not include creation of
申鐃緒申   307     ;; a branch), remove the sticky tag.
申鐃緒申   308     (if (and rev (not (vc-mcvs-valid-symbolic-tag-name-p rev)))
申鐃緒申   309 	(vc-mcvs-command nil 0 file "update" "-A"))))
申鐃緒申   310 
申鐃緒申   311 (defun vc-mcvs-find-version (file rev buffer)
申鐃緒申   312   (apply 'vc-mcvs-command
申鐃緒申   313 	 buffer 0 file
申鐃緒申   314 	 "-Q"				; suppress diagnostic output
申鐃緒申   315 	 "update"
申鐃緒申   316 	 (and rev (not (string= rev ""))
申鐃緒申   317 	      (concat "-r" rev))
申鐃緒申   318 	 "-p"
申鐃緒申   319 	 (vc-switches 'MCVS 'checkout)))
申鐃緒申   320 
申鐃緒申   321 (defun vc-mcvs-checkout (file &optional editable rev)
申鐃緒申   322   (message "Checking out %s..." file)
申鐃緒申   323   (with-current-buffer (or (get-file-buffer file) (current-buffer))
申鐃緒申   324     (vc-call update file editable rev (vc-switches 'MCVS 'checkout)))
申鐃緒申   325   (vc-mode-line file)
申鐃緒申   326   (message "Checking out %s...done" file))
申鐃緒申   327 
申鐃緒申   328 (defun vc-mcvs-update (file editable rev switches)
申鐃緒申   329   (if (and (file-exists-p file) (not rev))
申鐃緒申   330       ;; If no revision was specified, just make the file writable
申鐃緒申   331       ;; if necessary (using `cvs-edit' if requested).
申鐃緒申   332       (and editable (not (eq (vc-mcvs-checkout-model file) 'implicit))
申鐃緒申   333 	   (if vc-mcvs-use-edit
申鐃緒申   334 	       (vc-mcvs-command nil 0 file "edit")
申鐃緒申   335 	     (set-file-modes file (logior (file-modes file) 128))
申鐃緒申   336 	     (if (equal file buffer-file-name) (toggle-read-only -1))))
申鐃緒申   337     ;; Check out a particular version (or recreate the file).
申鐃緒申   338     (vc-file-setprop file 'vc-workfile-version nil)
申鐃緒申   339     (apply 'vc-mcvs-command nil 0 file
申鐃緒申   340 	   (if editable "-w")
申鐃緒申   341 	   "update"
申鐃緒申   342 	   ;; default for verbose checkout: clear the sticky tag so
申鐃緒申   343 	   ;; that the actual update will get the head of the trunk
申鐃緒申   344 	   (if (or (not rev) (string= rev ""))
申鐃緒申   345 	       "-A"
申鐃緒申   346 	     (concat "-r" rev))
申鐃緒申   347 	   switches)))
申鐃緒申   348 
申鐃緒申   349 (defun vc-mcvs-rename-file (old new)
申鐃緒申   350   (vc-mcvs-command nil 0 new "move" (file-relative-name old)))
申鐃緒申   351 
申鐃緒申   352 (defun vc-mcvs-revert (file &optional contents-done)
申鐃緒申   353   "Revert FILE to the version it was based on."
申鐃緒申   354   (vc-default-revert file contents-done)
申鐃緒申   355   (unless (eq (vc-checkout-model file) 'implicit)
申鐃緒申   356     (if vc-mcvs-use-edit
申鐃緒申   357         (vc-mcvs-command nil 0 file "unedit")
申鐃緒申   358       ;; Make the file read-only by switching off all w-bits
申鐃緒申   359       (set-file-modes file (logand (file-modes file) 3950)))))
申鐃緒申   360 
申鐃緒申   361 (defun vc-mcvs-merge (file first-version &optional second-version)
申鐃緒申   362   "Merge changes into current working copy of FILE.
申鐃緒申   363 The changes are between FIRST-VERSION and SECOND-VERSION."
申鐃緒申   364   (vc-mcvs-command nil 0 file
申鐃緒申   365 		   "update" "-kk"
申鐃緒申   366 		   (concat "-j" first-version)
申鐃緒申   367 		   (concat "-j" second-version))
申鐃緒申   368   (vc-file-setprop file 'vc-state 'edited)
申鐃緒申   369   (with-current-buffer (get-buffer "*vc*")
申鐃緒申   370     (goto-char (point-min))
申鐃緒申   371     (if (re-search-forward "conflicts during merge" nil t)
申鐃緒申   372         1				; signal error
申鐃緒申   373       0)))				; signal success
申鐃緒申   374 
申鐃緒申   375 (defun vc-mcvs-merge-news (file)
申鐃緒申   376   "Merge in any new changes made to FILE."
申鐃緒申   377   (message "Merging changes into %s..." file)
申鐃緒申   378   ;; (vc-file-setprop file 'vc-workfile-version nil)
申鐃緒申   379   (vc-file-setprop file 'vc-checkout-time 0)
申鐃緒申   380   (vc-mcvs-command nil 0 file "update")
申鐃緒申   381   ;; Analyze the merge result reported by Meta-CVS, and set
申鐃緒申   382   ;; file properties accordingly.
申鐃緒申   383   (with-current-buffer (get-buffer "*vc*")
申鐃緒申   384     (goto-char (point-min))
申鐃緒申   385     ;; get new workfile version
申鐃緒申   386     (if (re-search-forward
申鐃緒申   387 	 "^Merging differences between [0-9.]* and \\([0-9.]*\\) into" nil t)
申鐃緒申   388 	(vc-file-setprop file 'vc-workfile-version (match-string 1))
申鐃緒申   389       (vc-file-setprop file 'vc-workfile-version nil))
申鐃緒申   390     ;; get file status
申鐃緒申   391     (prog1
申鐃緒申   392         (if (eq (buffer-size) 0)
申鐃緒申   393             0 ;; there were no news; indicate success
申鐃緒申   394           (if (re-search-forward
申鐃緒申   395                (concat "^\\([CMUP] \\)?"
申鐃緒申   396                        ".*"
申鐃緒申   397                        "\\( already contains the differences between \\)?")
申鐃緒申   398                nil t)
申鐃緒申   399               (cond
申鐃緒申   400                ;; Merge successful, we are in sync with repository now
申鐃緒申   401                ((or (match-string 2)
申鐃緒申   402                     (string= (match-string 1) "U ")
申鐃緒申   403                     (string= (match-string 1) "P "))
申鐃緒申   404                 (vc-file-setprop file 'vc-state 'up-to-date)
申鐃緒申   405                 (vc-file-setprop file 'vc-checkout-time
申鐃緒申   406                                  (nth 5 (file-attributes file)))
申鐃緒申   407                 0);; indicate success to the caller
申鐃緒申   408                ;; Merge successful, but our own changes are still in the file
申鐃緒申   409                ((string= (match-string 1) "M ")
申鐃緒申   410                 (vc-file-setprop file 'vc-state 'edited)
申鐃緒申   411                 0);; indicate success to the caller
申鐃緒申   412                ;; Conflicts detected!
申鐃緒申   413                (t
申鐃緒申   414                 (vc-file-setprop file 'vc-state 'edited)
申鐃緒申   415                 1);; signal the error to the caller
申鐃緒申   416                )
申鐃緒申   417             (pop-to-buffer "*vc*")
申鐃緒申   418             (error "Couldn't analyze mcvs update result")))
申鐃緒申   419       (message "Merging changes into %s...done" file))))
申鐃緒申   420 
申鐃緒申   421 ;;;
申鐃緒申   422 ;;; History functions
申鐃緒申   423 ;;;
申鐃緒申   424 
申鐃緒申   425 (defun vc-mcvs-print-log (file &optional buffer)
申鐃緒申   426   "Get change log associated with FILE."
申鐃緒申   427   (let ((default-directory (vc-mcvs-root file)))
申鐃緒申   428     ;; Run the command from the root dir so that `mcvs filt' returns
申鐃緒申   429     ;; valid relative names.
申鐃緒申   430     (vc-mcvs-command
申鐃緒申   431      buffer
申鐃緒申   432      (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
申鐃緒申   433      file "log")))
申鐃緒申   434 
申鐃緒申   435 (defun vc-mcvs-diff (file &optional oldvers newvers buffer)
申鐃緒申   436   "Get a difference report using Meta-CVS between two versions of FILE."
申鐃緒申   437   (if (string= (vc-workfile-version file) "0")
申鐃緒申   438       ;; This file is added but not yet committed; there is no master file.
申鐃緒申   439       (if (or oldvers newvers)
申鐃緒申   440 	  (error "No revisions of %s exist" file)
申鐃緒申   441 	;; We regard this as "changed".
申鐃緒申   442 	;; Diff it against /dev/null.
申鐃緒申   443 	;; Note: this is NOT a "mcvs diff".
申鐃緒申   444 	(apply 'vc-do-command (or buffer "*vc-diff*")
申鐃緒申   445 	       1 "diff" file
申鐃緒申   446 	       (append (vc-switches nil 'diff) '("/dev/null")))
申鐃緒申   447 	;; Even if it's empty, it's locally modified.
申鐃緒申   448 	1)
申鐃緒申   449     (let* ((async (and (vc-stay-local-p file) (fboundp 'start-process)))
申鐃緒申   450 	   ;; Run the command from the root dir so that `mcvs filt' returns
申鐃緒申   451 	   ;; valid relative names.
申鐃緒申   452 	   (default-directory (vc-mcvs-root file))
申鐃緒申   453 	   (status
申鐃緒申   454 	    (apply 'vc-mcvs-command (or buffer "*vc-diff*")
申鐃緒申   455 		   (if async 'async 1)
申鐃緒申   456 		   file "diff"
申鐃緒申   457 		   (and oldvers (concat "-r" oldvers))
申鐃緒申   458 		   (and newvers (concat "-r" newvers))
申鐃緒申   459 		   (vc-switches 'MCVS 'diff))))
申鐃緒申   460       (if async 1 status))))	       ; async diff, pessimistic assumption.
申鐃緒申   461 
申鐃緒申   462 (defun vc-mcvs-diff-tree (dir &optional rev1 rev2)
申鐃緒申   463   "Diff all files at and below DIR."
申鐃緒申   464   (with-current-buffer "*vc-diff*"
申鐃緒申   465     ;; Run the command from the root dir so that `mcvs filt' returns
申鐃緒申   466     ;; valid relative names.
申鐃緒申   467     (setq default-directory (vc-mcvs-root dir))
申鐃緒申   468     ;; cvs diff: use a single call for the entire tree
申鐃緒申   469     (let ((coding-system-for-read (or coding-system-for-read 'undecided)))
申鐃緒申   470       (apply 'vc-mcvs-command "*vc-diff*" 1 dir "diff"
申鐃緒申   471 	     (and rev1 (concat "-r" rev1))
申鐃緒申   472 	     (and rev2 (concat "-r" rev2))
申鐃緒申   473 	     (vc-switches 'MCVS 'diff)))))
申鐃緒申   474 
申鐃緒申   475 (defun vc-mcvs-annotate-command (file buffer &optional version)
申鐃緒申   476   "Execute \"mcvs annotate\" on FILE, inserting the contents in BUFFER.
申鐃緒申   477 Optional arg VERSION is a version to annotate from."
申鐃緒申   478   (vc-mcvs-command
申鐃緒申   479    buffer
申鐃緒申   480    (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
申鐃緒申   481    file "annotate" (if version (concat "-r" version)))
申鐃緒申   482   (with-current-buffer buffer
申鐃緒申   483     (goto-char (point-min))
申鐃緒申   484     (re-search-forward "^[0-9]")
申鐃緒申   485     (delete-region (point-min) (1- (point)))))
申鐃緒申   486 
申鐃緒申   487 (defalias 'vc-mcvs-annotate-current-time 'vc-cvs-annotate-current-time)
申鐃緒申   488 (defalias 'vc-mcvs-annotate-time 'vc-cvs-annotate-time)
申鐃緒申   489 
申鐃緒申   490 ;;;
申鐃緒申   491 ;;; Snapshot system
申鐃緒申   492 ;;;
申鐃緒申   493 
申鐃緒申   494 (defun vc-mcvs-create-snapshot (dir name branchp)
申鐃緒申   495   "Assign to DIR's current version a given NAME.
申鐃緒申   496 If BRANCHP is non-nil, the name is created as a branch (and the current
申鐃緒申   497 workspace is immediately moved to that new branch)."
申鐃緒申   498   (if (not branchp)
申鐃緒申   499       (vc-mcvs-command nil 0 dir "tag" "-c" name)
申鐃緒申   500     (vc-mcvs-command nil 0 dir "branch" name)
申鐃緒申   501     (vc-mcvs-command nil 0 dir "switch" name)))
申鐃緒申   502 
申鐃緒申   503 (defun vc-mcvs-retrieve-snapshot (dir name update)
申鐃緒申   504   "Retrieve a snapshot at and below DIR.
申鐃緒申   505 NAME is the name of the snapshot; if it is empty, do a `cvs update'.
申鐃緒申   506 If UPDATE is non-nil, then update (resynch) any affected buffers."
申鐃緒申   507   (with-current-buffer (get-buffer-create "*vc*")
申鐃緒申   508     (let ((default-directory dir)
申鐃緒申   509 	  (sticky-tag))
申鐃緒申   510       (erase-buffer)
申鐃緒申   511       (if (or (not name) (string= name ""))
申鐃緒申   512 	  (vc-mcvs-command t 0 nil "update")
申鐃緒申   513 	(vc-mcvs-command t 0 nil "update" "-r" name)
申鐃緒申   514 	(setq sticky-tag name))
申鐃緒申   515       (when update
申鐃緒申   516 	(goto-char (point-min))
申鐃緒申   517 	(while (not (eobp))
申鐃緒申   518 	  (if (looking-at "\\([CMUP]\\) \\(.*\\)")
申鐃緒申   519 	      (let* ((file (expand-file-name (match-string 2) dir))
申鐃緒申   520 		     (state (match-string 1))
申鐃緒申   521 		     (buffer (find-buffer-visiting file)))
申鐃緒申   522 		(when buffer
申鐃緒申   523 		  (cond
申鐃緒申   524 		   ((or (string= state "U")
申鐃緒申   525 			(string= state "P"))
申鐃緒申   526 		    (vc-file-setprop file 'vc-state 'up-to-date)
申鐃緒申   527 		    (vc-file-setprop file 'vc-workfile-version nil)
申鐃緒申   528 		    (vc-file-setprop file 'vc-checkout-time
申鐃緒申   529 				     (nth 5 (file-attributes file))))
申鐃緒申   530 		   ((or (string= state "M")
申鐃緒申   531 			(string= state "C"))
申鐃緒申   532 		    (vc-file-setprop file 'vc-state 'edited)
申鐃緒申   533 		    (vc-file-setprop file 'vc-workfile-version nil)
申鐃緒申   534 		    (vc-file-setprop file 'vc-checkout-time 0)))
申鐃緒申   535 		  (vc-file-setprop file 'vc-mcvs-sticky-tag sticky-tag)
申鐃緒申   536 		  (vc-resynch-buffer file t t))))
申鐃緒申   537 	  (forward-line 1))))))
申鐃緒申   538 
申鐃緒申   539 
申鐃緒申   540 ;;;
申鐃緒申   541 ;;; Miscellaneous
申鐃緒申   542 ;;;
申鐃緒申   543 
申鐃緒申   544 (defalias 'vc-mcvs-make-version-backups-p 'vc-stay-local-p
申鐃緒申   545   "Return non-nil if version backups should be made for FILE.")
申鐃緒申   546 (defalias 'vc-mcvs-check-headers 'vc-cvs-check-headers)
申鐃緒申   547 
申鐃緒申   548 
申鐃緒申   549 ;;;
申鐃緒申   550 ;;; Internal functions
申鐃緒申   551 ;;;
申鐃緒申   552 
申鐃緒申   553 (defun vc-mcvs-command (buffer okstatus file &rest flags)
申鐃緒申   554   "A wrapper around `vc-do-command' for use in vc-mcvs.el.
申鐃緒申   555 The difference to vc-do-command is that this function always invokes `mcvs',
申鐃緒申   556 and that it passes `vc-mcvs-global-switches' to it before FLAGS."
申鐃緒申   557   (let ((args (append '("--error-terminate")
申鐃緒申   558 		      (if (stringp vc-mcvs-global-switches)
申鐃緒申   559 			  (cons vc-mcvs-global-switches flags)
申鐃緒申   560 			(append vc-mcvs-global-switches flags)))))
申鐃緒申   561     (if (not (member (car flags) '("diff" "log" "status")))
申鐃緒申   562 	;; No need to filter: do it the easy way.
申鐃緒申   563 	(apply 'vc-do-command buffer okstatus "mcvs" file args)
申鐃緒申   564       ;; We need to filter the output.
申鐃緒申   565       ;; The output of the filter uses filenames relative to the root,
申鐃緒申   566       ;; so we need to change the default-directory.
申鐃緒申   567       ;; (assert (equal default-directory (vc-mcvs-root file)))
申鐃緒申   568       (vc-do-command
申鐃緒申   569        buffer okstatus "sh" nil "-c"
申鐃緒申   570        (concat "mcvs "
申鐃緒申   571 	       (mapconcat
申鐃緒申   572 		'shell-quote-argument
申鐃緒申   573 		(append (remq nil args)
申鐃緒申   574 			(if file (list (file-relative-name file))))
申鐃緒申   575 		" ")
申鐃緒申   576 	       " | mcvs filt")))))
申鐃緒申   577 
申鐃緒申   578 (defun vc-mcvs-repository-hostname (dirname)
申鐃緒申   579   (vc-cvs-repository-hostname (vc-mcvs-root dirname)))
申鐃緒申   580 
申鐃緒申   581 (defun vc-mcvs-dir-state-heuristic (dir)
申鐃緒申   582   "Find the Meta-CVS state of all files in DIR, using only local information."
申鐃緒申   583   (with-temp-buffer
申鐃緒申   584     (vc-cvs-get-entries dir)
申鐃緒申   585     (goto-char (point-min))
申鐃緒申   586     (while (not (eobp))
申鐃緒申   587       ;; Meta-MCVS-removed files are not taken under VC control.
申鐃緒申   588       (when (looking-at "/\\([^/]*\\)/[^/-]")
申鐃緒申   589 	(let ((file (expand-file-name (match-string 1) dir)))
申鐃緒申   590 	  (unless (vc-file-getprop file 'vc-state)
申鐃緒申   591 	    (vc-cvs-parse-entry file t))))
申鐃緒申   592       (forward-line 1))))
申鐃緒申   593 
申鐃緒申   594 (defalias 'vc-mcvs-valid-symbolic-tag-name-p 'vc-cvs-valid-symbolic-tag-name-p)
申鐃緒申   595 (defalias 'vc-mcvs-valid-version-number-p 'vc-cvs-valid-version-number-p)
申鐃緒申   596 
申鐃緒申   597 (provide 'vc-mcvs)
申鐃緒申   598 
申鐃緒申   599 ;; arch-tag: a39c7c1c-5247-429d-88df-dd7187d2e704
申鐃緒申   600 ;;; vc-mcvs.el ends here