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

  ViewVC Help
Powered by ViewVC 1.1.5