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

Contents of /meta-cvs/F-A7A64FB1054A27E5F51A7E95C6A80309

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.18 - (show annotations)
Wed Apr 17 15:46:35 2002 UTC (12 years ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-12
Changes since 1.17: +6 -6 lines
Remove check that disables checking out to existing places other than the
current directory.  Added check for existing MCVS subdirectory in the
target directory.
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 (dir "d" module))
16 checkout-options
17 (let ((checkout-dir (canonicalize-path dir)))
18 (ensure-directories-exist (path-cat checkout-dir *mcvs-dir*))
19
20 (current-dir-restore
21 (chdir checkout-dir)
22
23 (when (ignore-errors (stat *mcvs-dir*))
24 (error "mcvs-checkout: directory ~a seems to be the root of an existing sandbox."
25 checkout-dir))
26
27 (chatter-debug "Invoking CVS.~%")
28 (execute-program `("cvs" ,@(format-opt cvs-options)
29 "checkout" "-d" ,*mcvs-dir*
30 ,@(format-opt cvs-checkout-options) ,module))
31
32 (when (not (ignore-errors (stat *mcvs-dir*)))
33 (error "mcvs-checkout: checkout failed to create ~a directory."
34 *mcvs-dir*))
35
36 (chatter-debug "Generating file structure.~%")
37 (mapping-write nil *mcvs-map-local*)
38 (mapping-update)
39 (chatter-info "Checkout to directory ~a completed." checkout-dir))
40 (values))))
41
42 (defun mcvs-checkout-wrapper (cvs-options cvs-command-options mcvs-args)
43 (if (< (length mcvs-args) 1)
44 (error "mcvs-checkout: specify module."))
45 (destructuring-bind (module &rest superfluous) mcvs-args
46 (when superfluous
47 (error "mcvs-checkout: specify one module to check out."))
48 (mcvs-checkout module cvs-options cvs-command-options)))

  ViewVC Help
Powered by ViewVC 1.1.5