Mercurial > emacs

comparison lisp/vc-mcvs.el @ 50646:1ce282fd32cf

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