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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5