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

Contents of /meta-cvs/F-A7A64FB1054A27E5F51A7E95C6A80309

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (hide annotations)
Sat Jan 26 02:37:53 2002 UTC (12 years, 3 months ago) by kaz
Branch: MAIN
CVS Tags: cvs-options-passthrough
Changes since 1.4: +4 -0 lines
Copyright notices.
1 kaz 1.5 ;;; This source file is part of the MCVS program,
2     ;;; 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     (provide "checkout")
9    
10 kaz 1.2 (defun mcvs-checkout (module &optional cvs-args checkout-args)
11 kaz 1.1 ;; checkout module from cvs
12    
13     (when (ignore-errors (stat module))
14     (error "mcvs-checkout: a directory or file called ~a exists here already."
15     module))
16    
17     (multiple-value-bind (path created)
18     (ensure-directories-exist (path-cat module *mcvs-dir*))
19 kaz 1.4 (declare (ignore path))
20 kaz 1.1 (if (not created)
21     (error "mcvs-import: unable to create directory ~a." module)))
22    
23     (current-dir-restore
24     (chdir module)
25     (chatter-info "Invoking CVS.~%")
26 kaz 1.2 (execute-program `("cvs" ,@cvs-args "checkout" "-d" ,*mcvs-dir*
27     ,@checkout-args ,module))
28 kaz 1.1
29     (if (not (ignore-errors (stat *mcvs-dir*)))
30     (error "mcvs-checkout: checkout failed to create ~a directory."
31     *mcvs-dir*))
32    
33     (chatter-info "Generating file structure.~%")
34    
35     (let (filemap)
36     (with-open-file (file *mcvs-map* :direction :input)
37     (setf filemap (read file))
38     (dolist (item filemap)
39     (chatter-info "~a -> ~a~%" (first item) (second item))
40     (synchronize-files (first item) (second item))))
41    
42     (with-open-file (file *mcvs-map-local* :direction :output)
43     (let ((*print-right-margin* 1))
44     (prin1 filemap file)
45     (terpri file)))))
46     (values))
47 kaz 1.2
48     (defun mcvs-checkout-wrapper (cvs-options cvs-specific-options mcvs-args)
49     (destructuring-bind (module &rest superfluous) mcvs-args
50     (when superfluous
51     (error "mcvs-checkout: specify one module to check out."))
52 kaz 1.3 (mcvs-checkout module cvs-options cvs-specific-options)))

  ViewVC Help
Powered by ViewVC 1.1.5