ViewVC logotype

Contents of /meta-cvs/F-A7A64FB1054A27E5F51A7E95C6A80309

Parent Directory Parent Directory | Revision Log Revision Log

Revision - (show 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 ;;; This source file is part of the Meta-CVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
5 (require "dirwalk")
6 (require "chatter")
7 (require "sync")
8 (require "options")
9 (require "find-bind")
10 (provide "checkout")
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)
34 (when (ignore-errors (stat *mcvs-dir*))
35 (error "directory ~a seems to be the root of an existing sandbox."
36 checkout-dir))
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."))
46 (unless (ignore-errors (stat *mcvs-dir*))
47 (error "checkout failed to create ~a directory."
48 *mcvs-dir*))
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))))
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)))
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.")))
96 (mcvs-checkout module subdir global-options command-options
97 :behave-like-export t)))))
99 (defconstant *checkout-help*
100 "Syntax:
102 mcvs co [ options ] module-name [ subdirectory-path ]
104 Options:
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.
117 Semantics:
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.
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.
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.")
143 (defconstant *export-help*
144 "Syntax:
146 mcvs export { -D date | -r revision } [ options ] module-name [ subdirectory-path ]
148 Options:
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.
157 Semantics:
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