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

Contents of /meta-cvs/F-A7A64FB1054A27E5F51A7E95C6A80309

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.29 - (hide annotations)
Thu Oct 31 04:06:01 2002 UTC (11 years, 5 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-1-0-3
Changes since 1.28: +3 -0 lines
* code/mcvs-package.lisp: New file, defines META-CVS package.

* code/purge.lisp: Put all symbols in new package.
* code/restore.lisp: Likewise.
* code/paths.lisp: Likewise.
* code/install.sh: Likewise.
* code/restart.lisp: Likewise.
* code/update.lisp: Likewise.
* code/move.lisp: Likewise.
* code/grab.lisp: Likewise.
* code/unix.lisp: Likewise.
* code/slot-refs.lisp: Likewise.
* code/prop.lisp: Likewise.
* code/multi-hash.lisp: Likewise.
* code/rcs-utils.lisp: Likewise.
* code/branch.lisp: Likewise.
* code/find-bind.lisp: Likewise.
* code/execute.lisp: Likewise.
* code/link.lisp: Likewise.
* code/split.lisp: Likewise.
* code/watch.lisp: Likewise.
* code/clisp-unix.lisp: Likewise.
* code/add.lisp: Likewise.
* code/chatter.lisp: Likewise.
* code/print.lisp: Likewise.
* code/types.lisp: Likewise.
* code/remove.lisp: Likewise.
* code/convert.lisp: Likewise.
* code/error.lisp: Likewise.
* code/options.lisp: Likewise.
* code/dirwalk.lisp: Likewise.
* code/checkout.lisp: Likewise.
* code/generic.lisp: Likewise.
* code/sync.lisp: Likewise.
* code/create.lisp: Likewise.
* code/memoize.lisp: Likewise.
* code/seqfuncs.lisp: Likewise.
* code/cmucl-unix.lisp: Likewise.
* code/remap.lisp: Likewise.

* code/mapping.lisp: Put symbols in new package. Replace use
of CLISP specific substring function with subseq.
* code/filt.lisp: Likewise.

* code/mcvs-main.lisp: Put symbols in new package. The mcvs
function is renamed to main.

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

  ViewVC Help
Powered by ViewVC 1.1.5