/[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.2 - (show annotations)
Sat Oct 26 21:09:27 2002 UTC (11 years, 5 months ago) by kaz
Branch: mcvs-1-0-branch
CVS Tags: mcvs-1-0, mcvs-1-0-branch~merged-to-HEAD-1, mcvs-1-0-branch~merged-to-HEAD-0, mcvs-0-99, mcvs-1-0-11, mcvs-1-0-10, mcvs-1-0-13, mcvs-1-0-12, mcvs-1-0-9, mcvs-1-0-8, mcvs-1-0-5, mcvs-1-0-4, mcvs-1-0-7, mcvs-1-0-6, mcvs-1-0-1, mcvs-1-0-2
Changes since 1.26.2.1: +8 -7 lines
* code/grab.lisp (*grab-help*): Rewritten.

* code/checkout.lisp (*export-help*): Formatted for 80 columns.
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 subdir cvs-options checkout-options
13 &key no-generate behave-like-export)
14 (when subdir
15 (when (path-absolute-p subdir)
16 (error "subdirectory path must be relative"))
17 (multiple-value-bind (canon-subdir out-of-bounds)
18 (canonicalize-path subdir)
19 (declare (ignore canon-subdir))
20 (when out-of-bounds
21 (error "subdirectory path ~a leads outside of module."
22 subdir))))
23 (find-bind (:key #'first :test #'string= :take #'second)
24 (cvs-checkout-options (dir "d" (or subdir module)))
25 checkout-options
26 (let ((checkout-dir (canonicalize-path dir))
27 path checkout-okay created-dir created-mcvs-dir)
28 (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
34 (when (ignore-errors (stat *mcvs-dir*))
35 (error "directory ~a seems to be the root of an existing sandbox."
36 checkout-dir))
37
38 (chatter-debug "Invoking CVS.~%")
39 (unless
40 (execute-program `("cvs" ,@(format-opt cvs-options)
41 ,(if behave-like-export "export" "checkout")
42 "-d" ,*mcvs-dir*
43 ,@(format-opt cvs-checkout-options) ,module))
44 (error "CVS checkout failed."))
45
46 (unless (ignore-errors (stat *mcvs-dir*))
47 (error "checkout failed to create ~a directory."
48 *mcvs-dir*))
49
50 (setf created-mcvs-dir t)
51 (mapping-write nil *mcvs-map-local*)
52 (if subdir
53 (displaced-path-write (concatenate 'string
54 (canonicalize-path subdir)
55 *path-sep*)))
56 (unless no-generate
57 (in-sandbox-root-dir
58 (chatter-debug "Generating file structure.~%")
59 (mapping-update)))
60 (chatter-info "Checkout to directory ~a completed.~%" checkout-dir)
61 (setf checkout-okay t))
62 (when (or behave-like-export (not checkout-okay))
63 (when created-mcvs-dir
64 (delete-recursive (path-cat checkout-dir *mcvs-dir*))))
65 (unless checkout-okay
66 (when created-dir
67 (delete-recursive checkout-dir))))
68 (values))))
69
70 (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
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
143 (defconstant *export-help*
144 "Syntax:
145
146 mcvs export { -D date | -r revision } [ options ]
147 module-name [ subdirectory-path ]
148
149 Options:
150
151 -f Force a head revision match if tag or date is not found.
152 -r revision Check out specific revision or branch and make it sticky.
153 -D date Check out by date.
154 -d dir Check out into specified directory instead of creating
155 a directory based on the module name.
156 -k key-expansion Specify RCS keyword expansion option.
157
158 Semantics:
159
160 The export command is almost the same as the checkout command. Unlike
161 checkout, export does not create a MCVS subdirectory, and so the result is
162 not a working copy. It requires that a document baseline be specified by
163 symbolic revision or date. Lastly, it does not accept the -j option to
164 specify merging (but this way of merging on checkout is deprecated in
165 Meta-CVS; do not use it with managed branches).")

  ViewVC Help
Powered by ViewVC 1.1.5