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

Contents of /meta-cvs/F-A7A64FB1054A27E5F51A7E95C6A80309

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.26.2.1 - (hide annotations)
Sun Oct 13 22:39:20 2002 UTC (11 years, 6 months ago) by kaz
Branch: mcvs-1-0-branch
CVS Tags: mcvs-0-98
Changes since 1.26: +57 -11 lines
* code/mcvs-main.lisp (*export-options*): New constant.
(*mcvs-command-table*): New entries for export command.

* code/checkout.lisp (mcvs-checkout): New keyword to specify export behavior.
This causes cvs export to be run instead of checkout, and the MCVS directory
to be deleted after.
(mcvs-checkout-wrapper): Common function factored out into a flet.
(mcvs-export-wrapper): New function. Verifies that one of -D and -r options
is present, then runs mcvs-checkout, specifying export behavior.
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.23 (defun mcvs-checkout (module &optional subdir cvs-options checkout-options
13 kaz 1.26.2.1 &key no-generate behave-like-export)
14 kaz 1.25 (when subdir
15     (when (path-absolute-p subdir)
16 kaz 1.26 (error "subdirectory path must be relative"))
17 kaz 1.25 (multiple-value-bind (canon-subdir out-of-bounds)
18     (canonicalize-path subdir)
19     (declare (ignore canon-subdir))
20     (when out-of-bounds
21 kaz 1.26 (error "subdirectory path ~a leads outside of module."
22 kaz 1.25 subdir))))
23 kaz 1.13 (find-bind (:key #'first :test #'string= :take #'second)
24 kaz 1.23 (cvs-checkout-options (dir "d" (or subdir module)))
25 kaz 1.13 checkout-options
26 kaz 1.19 (let ((checkout-dir (canonicalize-path dir))
27 kaz 1.22 path checkout-okay created-dir created-mcvs-dir)
28 kaz 1.19 (multiple-value-setq (path created-dir)
29     (ensure-directories-exist (path-cat checkout-dir *mcvs-dir*)))
30     (unwind-protect
31     (current-dir-restore
32     (chdir checkout-dir)
33 kaz 1.13
34 kaz 1.19 (when (ignore-errors (stat *mcvs-dir*))
35 kaz 1.26 (error "directory ~a seems to be the root of an existing sandbox."
36 kaz 1.19 checkout-dir))
37 kaz 1.18
38 kaz 1.19 (chatter-debug "Invoking CVS.~%")
39 kaz 1.20 (unless
40     (execute-program `("cvs" ,@(format-opt cvs-options)
41 kaz 1.26.2.1 ,(if behave-like-export "export" "checkout")
42     "-d" ,*mcvs-dir*
43 kaz 1.20 ,@(format-opt cvs-checkout-options) ,module))
44     (error "CVS checkout failed."))
45 kaz 1.18
46 kaz 1.20 (unless (ignore-errors (stat *mcvs-dir*))
47 kaz 1.26 (error "checkout failed to create ~a directory."
48 kaz 1.19 *mcvs-dir*))
49 kaz 1.13
50 kaz 1.22 (setf created-mcvs-dir t)
51 kaz 1.21 (mapping-write nil *mcvs-map-local*)
52 kaz 1.23 (if subdir
53     (displaced-path-write (concatenate 'string
54     (canonicalize-path subdir)
55     *path-sep*)))
56 kaz 1.20 (unless no-generate
57 kaz 1.23 (in-sandbox-root-dir
58     (chatter-debug "Generating file structure.~%")
59     (mapping-update)))
60 kaz 1.20 (chatter-info "Checkout to directory ~a completed.~%" checkout-dir)
61 kaz 1.19 (setf checkout-okay t))
62 kaz 1.26.2.1 (when (or behave-like-export (not checkout-okay))
63 kaz 1.22 (when created-mcvs-dir
64 kaz 1.26.2.1 (delete-recursive (path-cat checkout-dir *mcvs-dir*))))
65     (unless checkout-okay
66 kaz 1.20 (when created-dir
67     (delete-recursive checkout-dir))))
68 kaz 1.17 (values))))
69 kaz 1.2
70 kaz 1.26.2.1 (flet ((err ()
71     (error "specify module, and optional subdirectory")))
72     (defun mcvs-checkout-wrapper (global-options command-options args)
73     (when (< (length args) 1)
74     (err))
75     (destructuring-bind (module &optional subdir &rest superfluous) args
76     (when superfluous
77     (err))
78     (mcvs-checkout module subdir global-options command-options)))
79    
80     (defun mcvs-export-wrapper (global-options command-options args)
81     (when (< (length args) 1)
82     (err))
83     (destructuring-bind (module &optional subdir &rest superfluous) args
84     (when superfluous
85     (err))
86     (find-bind (:test #'string= :key #'first)
87     ((revision "r")
88     (date "D"))
89     command-options
90     (cond
91     ((not (or revision date))
92     (error "specify tag with -r or date with -D."))
93     ((and revision date)
94     (error "both -r and -D specified.")))
95    
96     (mcvs-checkout module subdir global-options command-options
97     :behave-like-export t)))))
98 kaz 1.24
99     (defconstant *checkout-help*
100     "Syntax:
101    
102     mcvs co [ options ] module-name [ subdirectory-path ]
103    
104     Options:
105    
106     -f Force a head revision match if tag or date is not found.
107     -r revision Check out specific revision or branch and make it sticky.
108     -D date Check out by date.
109     -d dir Check out into specified directory instead of creating
110     a directory based on the module name.
111     -k key-expansion Specify RCS keyword expansion option.
112     -j revision Merge in the changes between current revision and rev.
113     Note that Meta-CVS has branch and merge commands; using
114     the -j options of checkout or update bypasses the
115     Meta-CVS merge system.
116    
117     Semantics:
118    
119     The checkout command retrieves a module from Meta-CVS to form a working copy,
120     also known as a ``sandbox'' in version control jargon.
121    
122     By default, a subdirectory is created whose name is the same as the
123     module-name. The module's directory structure is unfolded down there. An
124     alternate directory can be specified with the -d option. Meta-CVS will
125     try to create the checkout directory if it does not exist. Populating
126     an existing directory is safe; Meta-CVS will stop if it encounters
127     any conflicting local files.
128    
129     If the optional subdirectory-path parameter is specified, Meta-CVS will
130     create a ``partial sandbox'', whose root directory is the specified
131     path. This parameter is understood to be a relative path within the
132     module's tree structure, resolved with respect to the root. For example
133     if the module has a lib/zlib subdirectory, then specifying lib/zlib
134     will create a sandbox whose root directory corresponds to lib/zlib.
135     Files not under lib/zlib won't be visible in the sandbox. A nonexistent
136     path can be specified; in that case the partial sandbox will be empty. Adding
137     new files within the sandbox will cause the path to exist. For example,
138     if the module contains no directory called lib/libdes it's still possible
139     to check out that directory. Then adding a file called foo.c in the
140     root directory of the sandbox will actually add a lib/libdes/foo.c file
141     to the module.")
142 kaz 1.26.2.1
143     (defconstant *export-help*
144     "Syntax:
145    
146     mcvs export { -D date | -r revision } [ options ] module-name [ subdirectory-path ]
147    
148     Options:
149    
150     -f Force a head revision match if tag or date is not found.
151     -r revision Check out specific revision or branch and make it sticky.
152     -D date Check out by date.
153     -d dir Check out into specified directory instead of creating
154     a directory based on the module name.
155     -k key-expansion Specify RCS keyword expansion option.
156    
157     Semantics:
158    
159     The export command is almost the same as the checkout command. Unlike checkout,
160     export does not create a MCVS subdirectory, and so the result is not a working copy.
161     It requires that a document baseline be specified by symbolic revision or date.
162     Lastly, it does not accept the -j option to specify merging (but this way of
163     merging on checkout is deprecated in Meta-CVS; do not use it with managed
164     branches).")

  ViewVC Help
Powered by ViewVC 1.1.5