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

Contents of /meta-cvs/F-A7A64FB1054A27E5F51A7E95C6A80309

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (hide annotations)
Sat Feb 2 10:11:09 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-3, mcvs-0-4, latest-patch
Changes since 1.8: +1 -1 lines
* checkout.lisp (mcvs-checkout): Checkout also performs
sanity check.
1 kaz 1.7 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.5 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5 kaz 1.1 (require "dirwalk")
6     (require "chatter")
7     (require "sync")
8 kaz 1.6 (require "options")
9 kaz 1.1 (provide "checkout")
10    
11 kaz 1.6 (defun mcvs-checkout (module &optional cvs-options checkout-options)
12 kaz 1.1 ;; 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 kaz 1.4 (declare (ignore path))
21 kaz 1.1 (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 kaz 1.6 (execute-program `("cvs" ,@(format-opt cvs-options)
28     "checkout" "-d" ,*mcvs-dir*
29     ,@(format-opt checkout-options) ,module))
30 kaz 1.1
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 kaz 1.9 (let ((filemap (mapping-read *mcvs-map* :sanity-check t)))
38 kaz 1.8 (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*)))
42 kaz 1.1 (values))
43 kaz 1.2
44 kaz 1.6 (defun mcvs-checkout-wrapper (cvs-options cvs-command-options mcvs-args)
45 kaz 1.2 (destructuring-bind (module &rest superfluous) mcvs-args
46     (when superfluous
47     (error "mcvs-checkout: specify one module to check out."))
48 kaz 1.6 (mcvs-checkout module cvs-options cvs-command-options)))

  ViewVC Help
Powered by ViewVC 1.1.5