Mercurial > emacs
comparison lisp/vc-mcvs.el @ 50646:1ce282fd32cf
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 |