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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.71 - (show annotations)
Sun Oct 13 22:41:30 2002 UTC (11 years, 6 months ago) by kaz
Branch: MAIN
Changes since 1.70: +6 -0 lines
Merging from mcvs-1-0-branch.

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

  ViewVC Help
Powered by ViewVC 1.1.5