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

Contents of /meta-cvs/F-A7A64FB1054A27E5F51A7E95C6A80309

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.31 - (show annotations)
Fri Nov 24 04:53:50 2006 UTC (7 years, 5 months ago) by kaz
Branch: MAIN
Changes since 1.30: +1 -1 lines
Stylistic change.

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

  ViewVC Help
Powered by ViewVC 1.1.5