/[meta-cvs]/meta-cvs/F-A7A64FB1054A27E5F51A7E95C6A80309
ViewVC logotype

Contents of /meta-cvs/F-A7A64FB1054A27E5F51A7E95C6A80309

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12 - (show annotations)
Thu Feb 14 02:02:56 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-6, mcvs-0-7
Changes since 1.11: +2 -2 lines
* error.lisp (mcvs-error-handler): Bugfix. We were closing over
a binding of the iteration variable of a dolist, which has only
one binding over the entire loop.

* mapping.lisp (mapping-update): Gathers up info all local
clobbered files, and then throw the error. Provides restart
which allows user to print the list of clobbered files, and
a restart which allows the user to have those files clobbered.

* checkout.lisp (mcvs-checkout-wrapper): Bugfix for last bugfix.
1 ;;; This source file is part of the Meta-CVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
4
5 (require "dirwalk")
6 (require "chatter")
7 (require "sync")
8 (require "options")
9 (provide "checkout")
10
11 (defun mcvs-checkout (module &optional cvs-options checkout-options)
12 ;; checkout module from cvs
13
14 (when (ignore-errors (stat module))
15 (error "mcvs-checkout: a directory or file called ~a exists here already."
16 module))
17
18 (multiple-value-bind (path created)
19 (ensure-directories-exist (path-cat module *mcvs-dir*))
20 (declare (ignore path))
21 (if (not created)
22 (error "mcvs-import: unable to create directory ~a." module)))
23
24 (current-dir-restore
25 (chdir module)
26 (chatter-info "Invoking CVS.~%")
27 (execute-program `("cvs" ,@(format-opt cvs-options)
28 "checkout" "-d" ,*mcvs-dir*
29 ,@(format-opt checkout-options) ,module))
30
31 (if (not (ignore-errors (stat *mcvs-dir*)))
32 (error "mcvs-checkout: checkout failed to create ~a directory."
33 *mcvs-dir*))
34
35 (chatter-info "Generating file structure.~%")
36
37 (let ((filemap (mapping-read *mcvs-map* :sanity-check t)))
38 (dolist (item filemap)
39 (chatter-info "~a -> ~a~%" (first item) (second item))
40 (synchronize-files (first item) (second item)))
41 (mapping-write filemap *mcvs-map-local* :sort-map t)))
42 (values))
43
44 (defun mcvs-checkout-wrapper (cvs-options cvs-command-options mcvs-args)
45 (if (< (length mcvs-args) 1)
46 (error "mcvs-checkout: specify module."))
47 (destructuring-bind (module &rest superfluous) mcvs-args
48 (when superfluous
49 (error "mcvs-checkout: specify one module to check out."))
50 (mcvs-checkout module cvs-options cvs-command-options)))

  ViewVC Help
Powered by ViewVC 1.1.5