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

Contents of /meta-cvs/F-A7A64FB1054A27E5F51A7E95C6A80309

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.14 - (hide annotations)
Tue Mar 12 19:54:58 2002 UTC (12 years, 1 month ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-9, mcvs-0-8
Changes since 1.13: +2 -2 lines
* update.lisp (mcvs-update): Changing level of chatter messages.
* move.lisp (mcvs-move): Likewise.
* add.lisp (mcvs-add): Likewise.
* remove.lisp (mcvs-remove): Likewise.
* checkout.lisp (mcvs-checkout): Likewise.
* generic.lisp (mcvs-generic): Likewise.
* import.lisp (mcvs-import): Likewise.
* mapping.lisp (mapping-dupe-check): Likewise.
(mapping-update): Likewise.
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.13 (require "find-bind")
10 kaz 1.1 (provide "checkout")
11    
12 kaz 1.6 (defun mcvs-checkout (module &optional cvs-options checkout-options)
13 kaz 1.1 ;; checkout module from cvs
14 kaz 1.13 (find-bind (:key #'first :test #'string= :take #'second)
15     (cvs-checkout-options (checkout-dir "d" module))
16     checkout-options
17     (when (ignore-errors (stat module))
18     (error "mcvs-checkout: a directory or file called ~a exists here already."
19     module))
20    
21     (multiple-value-bind (path created)
22     (ensure-directories-exist (path-cat checkout-dir *mcvs-dir*))
23     (declare (ignore path))
24     (if (not created)
25     (error "mcvs-import: unable to create directory ~a." module)))
26    
27     (current-dir-restore
28     (chdir checkout-dir)
29 kaz 1.14 (chatter-debug "Invoking CVS.~%")
30 kaz 1.13 (execute-program `("cvs" ,@(format-opt cvs-options)
31     "checkout" "-d" ,*mcvs-dir*
32     ,@(format-opt cvs-checkout-options) ,module))
33    
34     (if (not (ignore-errors (stat *mcvs-dir*)))
35     (error "mcvs-checkout: checkout failed to create ~a directory."
36     *mcvs-dir*))
37    
38 kaz 1.14 (chatter-debug "Generating file structure.~%")
39 kaz 1.13
40     (let ((filemap (mapping-read *mcvs-map* :sanity-check t)))
41     (dolist (item filemap)
42     (chatter-info "~a -> ~a~%" (first item) (second item))
43     (synchronize-files (first item) (second item)))
44     (mapping-write filemap *mcvs-map-local* :sort-map t)))
45     (values)))
46 kaz 1.2
47 kaz 1.6 (defun mcvs-checkout-wrapper (cvs-options cvs-command-options mcvs-args)
48 kaz 1.12 (if (< (length mcvs-args) 1)
49     (error "mcvs-checkout: specify module."))
50 kaz 1.2 (destructuring-bind (module &rest superfluous) mcvs-args
51     (when superfluous
52     (error "mcvs-checkout: specify one module to check out."))
53 kaz 1.6 (mcvs-checkout module cvs-options cvs-command-options)))

  ViewVC Help
Powered by ViewVC 1.1.5