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

Contents of /meta-cvs/F-A7A64FB1054A27E5F51A7E95C6A80309

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.13 - (show annotations)
Mon Mar 11 23:09:09 2002 UTC (12 years, 1 month ago) by kaz
Branch: MAIN
Changes since 1.12: +33 -30 lines
Sane filtering of -d option in checkout.

* find-bind.lisp (find-bind): Variable bindings can specify
a third element, which provides a default value for any variables
that turn out NIL.

* checkout.lisp (mcvs-checkout): Filter out the -d dir option,
and use it to override the name of the checkout directory,
the way CVS checkout does it.
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 (require "find-bind")
10 (provide "checkout")
11
12 (defun mcvs-checkout (module &optional cvs-options checkout-options)
13 ;; checkout module from cvs
14 (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 (chatter-info "Invoking CVS.~%")
30 (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 (chatter-info "Generating file structure.~%")
39
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
47 (defun mcvs-checkout-wrapper (cvs-options cvs-command-options mcvs-args)
48 (if (< (length mcvs-args) 1)
49 (error "mcvs-checkout: specify module."))
50 (destructuring-bind (module &rest superfluous) mcvs-args
51 (when superfluous
52 (error "mcvs-checkout: specify one module to check out."))
53 (mcvs-checkout module cvs-options cvs-command-options)))

  ViewVC Help
Powered by ViewVC 1.1.5