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

Contents of /meta-cvs/F-A7A64FB1054A27E5F51A7E95C6A80309

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.33 - (hide annotations)
Tue Nov 28 07:47:22 2006 UTC (7 years, 4 months ago) by kaz
Branch: MAIN
CVS Tags: asdf-import-branch~merged-to-HEAD-0, mcvs-1-1-98, asdf-import-branch~branch-point, HEAD
Branch point for: asdf-import-branch
Changes since 1.32: +7 -7 lines
More renaming to get rid of mcvs- prefix.

* code/chatter.lisp (*mcvs-debug*): Renamed to *chatter-debug*.
(*mcvs-info*, *mcvs-terse*, *mcvs-silent*): Similarly.
(*mcvs-chatter-level*): Renamed to *chatter-level*.

* code/unix.lisp (*mcvs-editor*): Renamed to *edit-program*.

* code/types.lisp (*mcvs-types-name*): Renamed to *types-file*.
(*mcvs-types*): Renamed to *types-path*.
(*mcvs-new-types*): Renamed to *types-new-path*.

* code/mapping.lisp (*mcvs-dir*): Renamed to *admin-dir*.
(*mcvs-map-name*): Renamed to *map-file*.
(*mcvs-map-local-name*): Renamed to *map-local-file*.
(*mcvs-displaced-name*): Renamed to *displaced-file*.
(*mcvs-map*): Renamed to *map-path*.
(*mcvs-map-local*): Renamed to *map-local-path*.
(*mcvs-displaced*): Renamed to *displaced-path*.
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.31 (in-package :meta-cvs)
6 kaz 1.1
7 kaz 1.32 (defun checkout (module &optional subdir cvs-options checkout-options
8     &key no-generate behave-like-export)
9 kaz 1.25 (when subdir
10     (when (path-absolute-p subdir)
11 kaz 1.26 (error "subdirectory path must be relative"))
12 kaz 1.25 (multiple-value-bind (canon-subdir out-of-bounds)
13     (canonicalize-path subdir)
14     (declare (ignore canon-subdir))
15     (when out-of-bounds
16 kaz 1.26 (error "subdirectory path ~a leads outside of module."
17 kaz 1.25 subdir))))
18 kaz 1.13 (find-bind (:key #'first :test #'string= :take #'second)
19 kaz 1.23 (cvs-checkout-options (dir "d" (or subdir module)))
20 kaz 1.13 checkout-options
21 kaz 1.19 (let ((checkout-dir (canonicalize-path dir))
22 kaz 1.22 path checkout-okay created-dir created-mcvs-dir)
23 kaz 1.19 (multiple-value-setq (path created-dir)
24 kaz 1.33 (ensure-directories-exist (path-cat checkout-dir *admin-dir*)))
25 kaz 1.19 (unwind-protect
26     (current-dir-restore
27     (chdir checkout-dir)
28 kaz 1.13
29 kaz 1.33 (when (ignore-errors (stat *admin-dir*))
30 kaz 1.26 (error "directory ~a seems to be the root of an existing sandbox."
31 kaz 1.19 checkout-dir))
32 kaz 1.18
33 kaz 1.19 (chatter-debug "Invoking CVS.~%")
34 kaz 1.20 (unless
35     (execute-program `("cvs" ,@(format-opt cvs-options)
36 kaz 1.27 ,(if behave-like-export "export" "checkout")
37 kaz 1.33 "-d" ,*admin-dir*
38 kaz 1.20 ,@(format-opt cvs-checkout-options) ,module))
39     (error "CVS checkout failed."))
40 kaz 1.18
41 kaz 1.33 (unless (ignore-errors (stat *admin-dir*))
42 kaz 1.26 (error "checkout failed to create ~a directory."
43 kaz 1.33 *admin-dir*))
44 kaz 1.13
45 kaz 1.22 (setf created-mcvs-dir t)
46 kaz 1.33 (mapping-write nil *map-local-path*)
47 kaz 1.23 (if subdir
48     (displaced-path-write (concatenate 'string
49     (canonicalize-path subdir)
50     *path-sep*)))
51 kaz 1.20 (unless no-generate
52 kaz 1.23 (in-sandbox-root-dir
53     (chatter-debug "Generating file structure.~%")
54     (mapping-update)))
55 kaz 1.20 (chatter-info "Checkout to directory ~a completed.~%" checkout-dir)
56 kaz 1.19 (setf checkout-okay t))
57 kaz 1.27 (when (or behave-like-export (not checkout-okay))
58     (when created-mcvs-dir
59 kaz 1.33 (delete-recursive (path-cat checkout-dir *admin-dir*))))
60 kaz 1.20 (unless checkout-okay
61     (when created-dir
62     (delete-recursive checkout-dir))))
63 kaz 1.17 (values))))
64 kaz 1.2
65 kaz 1.27 (flet ((err ()
66     (error "specify module, and optional subdirectory")))
67 kaz 1.32 (defun checkout-wrapper (global-options command-options args)
68 kaz 1.27 (when (< (length args) 1)
69     (err))
70     (destructuring-bind (module &optional subdir &rest superfluous) args
71     (when superfluous
72     (err))
73 kaz 1.32 (checkout module subdir global-options command-options)))
74 kaz 1.27
75 kaz 1.32 (defun export-wrapper (global-options command-options args)
76 kaz 1.27 (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 kaz 1.32 (checkout module subdir global-options command-options
92     :behave-like-export t)))))
93 kaz 1.24
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 kaz 1.27
138     (defconstant *export-help*
139     "Syntax:
140    
141 kaz 1.28 mcvs export { -D date | -r revision } [ options ]
142     module-name [ subdirectory-path ]
143 kaz 1.27
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 kaz 1.28 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