/[meta-cvs]/meta-cvs/F-233AD6EEE14894A7303F09519A2AB734
ViewVC logotype

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.69.2.16 - (show annotations)
Thu Feb 13 07:20:49 2003 UTC (11 years, 2 months ago) by kaz
Branch: mcvs-1-0-branch
CVS Tags: mcvs-1-0-4
Changes since 1.69.2.15: +1 -1 lines
New --up option added for escaping out of nested sandboxes.

* code/mcvs-main.lisp (*cvs-options*): Added "up" 1 arg option.

* code/options.lisp (*nesting-escape-option*): New global,
default value 0.
(filter-mcvs-options): Filter new option, parse out and validate
integer argument.

* code/mapping.lisp (mcvs-locate): When searching for MCVS
directory, skip N matches, where N is the value of
*nesting-escape-option*.
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 ;; Clear out requires for mcvs-upgrade to work right.
6 (setf *modules* nil)
7
8 (require "create")
9 (require "checkout")
10 (require "grab")
11 (require "add")
12 (require "remove")
13 (require "move")
14 (require "link")
15 (require "update")
16 (require "filt")
17 (require "generic")
18 (require "convert")
19 (require "branch")
20 (require "remap")
21 (require "purge")
22 (require "restore")
23 (require "prop")
24 (require "watch")
25 (require "split")
26 (require "restart")
27 (require "error")
28 (require "options")
29 (require "find-bind")
30 (provide "mcvs-main")
31
32 (define-option-constant *global-options*
33 (0 arg "H" "help" "Q" "q" "r" "w" "l" "n" "t" "v" "f" "version"
34 "meta" "metaonly" "nometa" "error-continue" "error-terminate"
35 "debug")
36 (1 arg "T" "e" "d" "r" "z" "s" "i" "up"))
37
38 (define-option-constant *help-options*)
39
40 (define-option-constant *create-options*
41 (0 arg "d")
42 (1 arg "k" "I" "b" "m" "W"))
43
44 (define-option-constant *grab-options*
45 (0 arg "A")
46 (1 arg "r"))
47
48 (define-option-constant *checkout-options*
49 (0 arg "f")
50 (1 arg "r" "D" "d" "k" "j"))
51
52 (define-option-constant *export-options*
53 (0 arg "f")
54 (1 arg "r" "D" "d" "k"))
55
56 (define-option-constant *add-options*
57 (0 arg "R")
58 (1 arg "k" "m"))
59
60 (define-option-constant *remove-options*
61 (0 arg "R"))
62
63 (define-option-constant *update-options*
64 (0 arg "A" "C" "f" "p")
65 (1 arg "k" "r" "D" "j" "I" "W"))
66
67 (define-option-constant *switch-options*
68 (1 arg "k" "I" "W"))
69
70 (define-option-constant *commit-options*
71 (0 arg "f")
72 (1 arg "F" "m" "r"))
73
74 (define-option-constant *diff-options*
75 (0 arg "a" "b" "B" "brief" "c" "d" "e" "ed" "expand-tabs" "f" "forward-ed"
76 "H" "i" "ignore-all-space" "ignore-blank-lines" "ignore-case"
77 "ignore-space-change" "initial-tab" "l" "left-column" "minimal" "n"
78 "N" "new-file" "p" "P" "--paginate" "q" "rcs" "report-identical-files"
79 "s" "show-c-function" "side-by-side" "speed-large-files"
80 "suppress-common-lines" "t" "T" "text" "u" "unidirectional-new-file"
81 "w" "y")
82 (1 arg "C" "context" "D" "F" "horizon-lines" "ifdef" "ignore-matching-lines"
83 "L" "label" "line-format" "new-group-format" "new-line-format"
84 "old-group-format" "old-line-format" "r" "show-function-line"
85 "unchanged-group-format" "unchanged-line-format" "U" "unified" "W"
86 "width"))
87
88 (define-option-constant *tag-options*
89 (0 arg "l" "d" "f" "b" "F" "c")
90 (1 arg "r" "D"))
91
92 (define-option-constant *log-options*
93 (0 arg "R" "h" "t" "N" "b")
94 (1 arg "r" "d" "s" "w"))
95
96 (define-option-constant *status-options*
97 (0 arg "v"))
98
99 (define-option-constant *annotate-options*
100 (0 arg "f")
101 (1 arg "r" "D"))
102
103 (define-option-constant *filt-options*
104 (1 arg "r" "D"))
105
106 (define-option-constant *move-options*)
107 (define-option-constant *link-options*)
108 (define-option-constant *convert-options*)
109 (define-option-constant *branch-options*)
110
111 (define-option-constant *merge-options*
112 (1 arg "k"))
113
114 (define-option-constant *remerge-options*
115 (1 arg "k"))
116
117 (define-option-constant *list-branches-options*)
118 (define-option-constant *remap-options*)
119 (define-option-constant *purge-options*)
120 (define-option-constant *restore-options*)
121
122 (define-option-constant *prop-options*
123 (1 arg "set" "clear" "remove")
124 (2 arg "value"))
125
126 (define-option-constant *watch-options*
127 (0 arg "on" "off")
128 (1 arg "add" "remove"))
129
130 (define-option-constant *watchers-options*)
131 (define-option-constant *edit-options*)
132 (define-option-constant *unedit-options*)
133 (define-option-constant *editors-options*)
134
135 (defun mcvs-help (global-options command-options args)
136 (declare (special *usage* *mcvs-command-table*)
137 (ignore global-options command-options))
138 (cond
139 ((null args)
140 (terpri)
141 (write-line *usage*)
142 (terpri))
143 ((= (length args) 1)
144 (let* ((command-name (first args))
145 (command (find command-name *mcvs-command-table*
146 :key #'first
147 :test #'string=)))
148 (when (null command)
149 (error "~a is not a recognized mcvs command."
150 command-name))
151 (let ((help-text (third command)))
152 (when (null help-text)
153 (error "sorry, no help available for ~a command."
154 command-name))
155 (terpri)
156 (write-line help-text)
157 (terpri))))
158 (t (error "try \"mcvs help <name-of-command>\"."))))
159
160 (defconstant *mcvs-command-table*
161 `(("help" ,#'mcvs-help nil ,*help-options*)
162 ("create" ,#'mcvs-create-wrapper ,*create-help* ,*create-options*)
163 ("grab" ,#'mcvs-grab-wrapper ,*grab-help* ,*grab-options*)
164 ("checkout" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
165 ("co" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
166 ("export" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
167 ("ex" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
168 ("add" ,#'mcvs-add-wrapper ,*add-help* ,*add-options*)
169 ("remove" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
170 ("rm" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
171 ("move" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
172 ("mv" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
173 ("link" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
174 ("ln" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
175 ("update" ,#'mcvs-update-wrapper nil ,*update-options*)
176 ("up" ,#'mcvs-update-wrapper nil ,*update-options*)
177 ("commit" ,#'mcvs-commit-wrapper nil ,*commit-options*)
178 ("ci" ,#'mcvs-commit-wrapper nil ,*commit-options*)
179 ("diff" ,#'mcvs-diff-wrapper nil ,*diff-options*)
180 ("tag" ,#'mcvs-tag-wrapper nil ,*tag-options*)
181 ("log" ,#'mcvs-log-wrapper nil ,*log-options*)
182 ("status" ,#'mcvs-status-wrapper nil ,*status-options*)
183 ("stat" ,#'mcvs-status-wrapper nil ,*status-options*)
184 ("annotate" ,#'mcvs-annotate-wrapper nil ,*annotate-options*)
185 ("filt" ,#'mcvs-filt-wrapper nil ,*filt-options*)
186 ("fi" ,#'mcvs-filt-wrapper nil ,*filt-options*)
187 ("convert" ,#'mcvs-convert-wrapper nil ,*convert-options*)
188 ("branch" ,#'mcvs-branch-wrapper ,*branch-help* ,*branch-options*)
189 ("switch" ,#'mcvs-switch-wrapper nil ,*switch-options*)
190 ("sw" ,#'mcvs-switch-wrapper nil ,*switch-options*)
191 ("merge" ,#'mcvs-merge-wrapper nil ,*merge-options*)
192 ("remerge" ,#'mcvs-remerge-wrapper nil ,*remerge-options*)
193 ("list-branches" ,#'mcvs-list-branches-wrapper nil ,*list-branches-options*)
194 ("lb" ,#'mcvs-list-branches-wrapper nil ,*list-branches-options*)
195 ("purge" ,#'mcvs-purge-wrapper nil ,*purge-options*)
196 ("restore" ,#'mcvs-restore-wrapper nil ,*restore-options*)
197 ("remap" ,#'mcvs-remap-wrapper nil ,*remap-options*)
198 ("prop" ,#'mcvs-prop-wrapper nil ,*prop-options*)
199 ("watch" ,#'mcvs-watch-wrapper nil ,*watch-options*)
200 ("watchers" ,#'mcvs-watchers-wrapper nil ,*watchers-options*)
201 ("edit" ,#'mcvs-edit-wrapper nil ,*edit-options*)
202 ("unedit" ,#'mcvs-unedit-wrapper nil ,*unedit-options*)
203 ("editors" ,#'mcvs-editors-wrapper nil ,*editors-options*)))
204
205 (defconstant *usage*
206 "Meta-CVS command syntax:
207
208 mcvs [ global-options] command [ command-options ] [ command-arguments ]
209
210 Global options:
211
212 -H --help Print this help and terminate. If a command is specified,
213 help specific to that command is printed instead.
214 -Q Very quiet, generate output only for serious problems. (*)
215 -q Somewhat quiet, some informational messages suppresed. (*)
216 -n Dry run; do not modify filesystem. (*)
217 --debug Verbose debug output; -Q and -q are ignored but still
218 passed to CVS.
219 -r Make working files read-only. (@)
220 -w Make new working files read-write (default). (@)
221 -l Do not log cvs command in command history, but execute
222 it anyway. (@)
223 -t Trace CVS execution. (@)
224 -v --version Display version information and terminate.
225 -f CVS not to read ~/.cvsrc file. (@)
226 -i script-name Load a Lisp file and evaluate its top level forms,
227 allowing Meta-CVS to behave as an interpreter.
228 --meta Include metafiles such as MCVS/MAP in the set of files
229 to operate on.
230 --metaonly Operate only on metafiles.
231 --nometa Exclude metafiles from the set of files to operate on.
232 --error-continue Instead of interactive error handling, automatically
233 continue all continuable errors.
234 --error-terminate Terminate without cleanup when an error happens instead
235 of interactive error handling (use with care).
236 -T tempdir Place temporary files in tempdir. (@)
237 -e editor Edit messages with editor. (*)
238 -d root Specify CVSROOT. (@)
239 -z gzip-level Specify compression level. (@)
240
241 Notes: (*) option processed by Meta-CVS and passed to CVS too.
242 (@) option merely passed to CVS.
243
244 Commands:
245
246 help Obtain more detailed help for a specific command.
247 create Create new project from an existing file tree.
248 grab Take a snapshot of an external source tree, such
249 as a third-party release, and incorporate it into
250 the working copy. Tries to discover file moves.
251 checkout (co) Retrieve a Meta-CVS project from the repository to
252 create a working copy.
253 export (ex) Retrieve a Meta-CVS project without creating a
254 working copy.
255 add Place files (or directories with add -R) under
256 version control.
257 remove (rm) Remove files or directories.
258 move (mv) Rename files and directories.
259 link (ln) Create a versioned symbolic link.
260 update (up) Incorporate latest changes from repository into
261 working copy.
262 commit (ci) Incorporate outstanding changes in the working copy
263 into the repository.
264 diff Compute differences between files in the working copy
265 and the repository or between revisions in the repository.
266 tag Associate a symbolic name with file revisions to create
267 an identifiable baseline. By default, tags the
268 revisions that were last synchronized with the
269 directory. A branch is created using tag -b.
270 log Display log information for files.
271 status (stat) Show current status of files.
272 annotate Perform a detailed analysis of files, showing the
273 version information about every individual line of text.
274 filt (fi) Act as a text filter, which converts Meta-CVS F- file
275 names to readable paths, according to the current mapping.
276 branch Create a managed branch. Meta-CVS managed branches keep
277 track of what has been merged where, so users don't have
278 to track merges with tags at all.
279 merge Merge a managed branch to the current branch or trunk.
280 remerge Re-apply the most recent merge without changing any tags.
281 Useful when a merge goes bad so the local changes have
282 to be discarded and the merge done over again.
283 list-branches (lb) List Meta-CVS managed branches.
284 switch (sw) Switch to a branch. With no arguments, switch to
285 main trunk.
286 remap Force Meta-CVS to notice and incorporate moves and
287 deletions that were performed directly on the sandbox.
288 purge Execute a CVS remove on files that have been unmapped
289 with the remove command.
290 restore Restore files that have been deleted with the remove
291 command, but not purged. These appear in the lost+found
292 directory under cryptic names.
293 prop Manipulate properties.
294 prop --set <bool-prop-name> [ files ... ]
295 prop --clear <bool-prop-name> [ files ... ]
296 prop --value <prop-name> <new-value> [ files ... ]
297 prop --remove <prop-name> [ files ... ]
298 The ``exec'' property represents the execute permission
299 of a file. More than one --set, --clear, --value
300 or --remove may be specified before the files.
301 watch Manipulate per-file CVS watch settings.
302 watch --on [ files ... ]
303 watch --off [ files ... ]
304 watch --add <action> [ files ... ]
305 watch --remove <action> [ files ... ]
306 watchers See who is watching files.
307 edit Indicate the intent to edit a watched file.
308 unedit Retract the indication signaled by edit.
309 editors See who is editing files.
310 convert Convert a CVS module to a Meta-CVS project. This requires
311 filesystem-level access to the repository. This is
312 currently an experimental command that is known not
313 to work 100%.")
314
315 (defun mcvs-execute (args)
316 (handler-bind ((error #'mcvs-error-handler))
317 (multiple-value-bind (global-options global-args)
318 (parse-opt args *global-options*)
319 (setf global-options (filter-global-options global-options))
320
321 (when *print-usage*
322 (terpri)
323 (write-line *usage*)
324 (terpri)
325 (throw 'mcvs-terminate nil))
326
327 (when (not (first global-args))
328 (write-line "Meta-CVS requires a command argument.")
329 (write-line "Use mcvs -H to view help.")
330 (throw 'mcvs-terminate nil))
331
332 (let ((command (find (first global-args) *mcvs-command-table*
333 :key #'first
334 :test #'string=)))
335 (when (not command)
336 (error "~a is not a recognized mcvs command."
337 (first global-args)))
338 (destructuring-bind (name func help-text opt-spec) command
339 (declare (ignore name help-text))
340 (multiple-value-bind (command-options command-args)
341 (parse-opt (rest global-args) opt-spec)
342 (funcall func global-options command-options command-args))))))
343 nil)
344
345 (defun mcvs-debug-shell ()
346 (let ((counter 0)
347 (*mcvs-error-treatment* :decline))
348 (loop
349 (format t "~&mcvs[~a]> " (incf counter))
350 (let ((line (string-trim #(#\space #\tab) (read-line))))
351 (restart-case
352 (cond
353 ((zerop (length line)))
354 ((string-equal line "exit")
355 (return-from mcvs-debug-shell))
356 ((char-equal (char line 0) #\!)
357 (print (eval (read-from-string (subseq line 1)))))
358 (t (mcvs-execute (split-words line #(#\space #\tab)))))
359 (debug () :report "Return to mcvs debug shell"
360 (terpri)))))))
361
362 #+clisp
363 (defun mcvs ()
364 (exit (catch 'mcvs-terminate (or (mcvs-execute ext:*args*)
365 *mcvs-errors-occured-p*))))

  ViewVC Help
Powered by ViewVC 1.1.5