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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.86 - (show annotations)
Thu Apr 24 04:14:41 2003 UTC (11 years ago) by kaz
Branch: MAIN
Changes since 1.85: +3 -6 lines
Merging from mcvs-1-0-branch.

Improved error handling again in a flash of sanity. The whole
idea of ``bail'' as a restart is gone. All code which must perform
some complex cleanup action does so as part of normal unwinding.
And so termination becomes safe.

* code/update.lisp (mcvs-update): Change bail restart to continue.

* code/mcvs-main.lisp (*global-options*): Remove "error-bail".
(*usage*): Remove description of --error-bail.
(mcvs-execute): Bind *mcvs-error-treatment* to :terminate rather
than :bail if controlling TTY cannot be opened.

* code/move.lisp (mcvs-move): Change "Undoing move" error message
to "Undoing changes to map".

* code/add.lisp (mcvs-add): Get rid of bail restart; move cleanup
code into unwind-protect block.

* code/error.lisp (*mcvs-error-treatment*): Touch up docstring.
(mcvs-error-handler): Remove anything having to do with :bail.
Change description of `T' command to suggest that it is safe.

* code/options.lisp (filter-mcvs-options): Remove handling of
"error-bail" option.

* code/mapping.lisp (mapping-update): Get rid of outermost
restart-case, which had just a bail restart. Replace it with
unwind-protect block which does exactly the same restoration.
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
140 (defun mcvs-help (global-options command-options args)
141 (declare (special *usage* *mcvs-command-table*)
142 (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
213 (defconstant *usage*
214 "Meta-CVS command syntax:
215
216 mcvs [ global-options] command [ command-options ] [ command-arguments ]
217
218 Global options:
219
220 -H --help Print this help and terminate. If a command is specified,
221 help specific to that command is printed instead.
222 -Q Very quiet, generate output only for serious problems. (*)
223 -q Somewhat quiet, some informational messages suppresed. (*)
224 -n Dry run; do not modify filesystem. (*)
225 --debug Verbose debug output; -Q and -q are ignored but still
226 passed to CVS.
227 -r Make working files read-only. (@)
228 -w Make new working files read-write (default). (@)
229 -l Do not log cvs command in command history, but execute
230 it anyway. (@)
231 -t Trace CVS execution. (@)
232 -v --version Display version information and terminate.
233 -f CVS not to read ~/.cvsrc file. (@)
234 -i script-name Load a Lisp file and evaluate its top level forms,
235 allowing Meta-CVS to behave as an interpreter.
236 --meta Include metafiles such as MCVS/MAP in the set of files
237 to operate on.
238 --metaonly Operate only on metafiles.
239 --nometa Exclude metafiles from the set of files to operate on.
240 --error-continue Instead of interactive error handling, automatically
241 continue all continuable errors.
242 --error-terminate Terminate with cleanup when an error happens instead
243 of interactive error handling.
244 -T tempdir Place temporary files in tempdir. (@)
245 -e editor Edit messages with editor. (*)
246 -d root Specify CVSROOT. (@)
247 -z gzip-level Specify compression level. (@)
248 --up N Escape out of N levels of sandbox nesting before executing
249 operation.
250
251 Notes: (*) option processed by Meta-CVS and passed to CVS too.
252 (@) option merely passed to CVS.
253
254 Commands:
255
256 help Obtain more detailed help for a specific command.
257 create Create new project from an existing file tree.
258 grab Take a snapshot of an external source tree, such
259 as a third-party release, and incorporate it into
260 the working copy. Tries to discover file moves.
261 checkout (co) Retrieve a Meta-CVS project from the repository to
262 create a working copy.
263 export (ex) Retrieve a Meta-CVS project without creating a
264 working copy.
265 add Place files (or directories with add -R) under
266 version control.
267 remove (rm) Remove files or directories.
268 move (mv) Rename files and directories.
269 link (ln) Create a versioned symbolic link.
270 update (up) Incorporate latest changes from repository into
271 working copy.
272 commit (ci) Incorporate outstanding changes in the working copy
273 into the repository.
274 diff Compute differences between files in the working copy
275 and the repository or between revisions in the repository.
276 tag Associate a symbolic name with file revisions to create
277 an identifiable baseline. By default, tags the
278 revisions that were last synchronized with the
279 directory. A branch is created using tag -b.
280 log Display log information for files.
281 status (stat) Show current status of files.
282 annotate Perform a detailed analysis of files, showing the
283 version information about every individual line of text.
284 filt (fi) Act as a text filter, which converts Meta-CVS F- file
285 names to readable paths, according to the current mapping.
286 remote-filt (rfi) Remote version of filt, requires module name.
287 branch Create a managed branch. Meta-CVS managed branches keep
288 track of what has been merged where, so users don't have
289 to track merges with tags at all.
290 merge Merge a managed branch to the current branch or trunk.
291 remerge Re-apply the most recent merge without changing any tags.
292 Useful when a merge goes bad so the local changes have
293 to be discarded and the merge done over again.
294 list-branches (lb) List Meta-CVS managed branches.
295 switch (sw) Switch to a branch. With no arguments, switch to
296 main trunk.
297 remap Force Meta-CVS to notice and incorporate moves and
298 deletions that were performed directly on the sandbox.
299 purge Execute a CVS remove on files that have been unmapped
300 with the remove command.
301 restore Restore files that have been deleted with the remove
302 command, but not purged. These appear in the lost+found
303 directory under cryptic names.
304 prop Manipulate properties.
305 prop --set <bool-prop-name> [ files ... ]
306 prop --clear <bool-prop-name> [ files ... ]
307 prop --value <prop-name> <new-value> [ files ... ]
308 prop --remove <prop-name> [ files ... ]
309 The ``exec'' property represents the execute permission
310 of a file. More than one --set, --clear, --value
311 or --remove may be specified before the files.
312 watch Manipulate per-file CVS watch settings.
313 watch --on [ files ... ]
314 watch --off [ files ... ]
315 watch --add <action> [ files ... ]
316 watch --remove <action> [ files ... ]
317 watchers See who is watching files.
318 edit Indicate the intent to edit a watched file.
319 unedit Retract the indication signaled by edit.
320 editors See who is editing files.
321 convert Convert a CVS module to a Meta-CVS project. This requires
322 filesystem-level access to the repository. This is
323 currently an experimental command that is known not
324 to work 100%.")
325
326 (defun mcvs-execute (args)
327 (let* ((*interactive-error-io* (open (unix-funcs:ctermid) :direction :io))
328 (*mcvs-error-treatment* (if *interactive-error-io*
329 :interactive
330 :terminate)))
331 (handler-bind ((error #'mcvs-error-handler))
332 (multiple-value-bind (global-options global-args)
333 (parse-opt args *global-options*)
334 (setf global-options (filter-global-options global-options))
335
336 (when *print-usage*
337 (terpri)
338 (write-line *usage*)
339 (terpri)
340 (throw 'mcvs-terminate nil))
341
342 (when (not (first global-args))
343 (write-line "Meta-CVS requires a command argument." *error-output*)
344 (write-line "Use mcvs -H to view help." *error-output*)
345 (throw 'mcvs-terminate nil))
346
347 (let ((command (find (first global-args) *mcvs-command-table*
348 :key #'first
349 :test #'string=)))
350 (when (not command)
351 (error "~a is not a recognized mcvs command."
352 (first global-args)))
353 (destructuring-bind (name func help-text opt-spec) command
354 (declare (ignore name help-text))
355 (multiple-value-bind (command-options command-args)
356 (parse-opt (rest global-args) opt-spec)
357 (funcall func global-options command-options command-args))))))
358 nil))
359
360 (defun mcvs-debug-shell ()
361 (let ((counter 0)
362 (*mcvs-error-treatment* :decline))
363 (loop
364 (format t "~&mcvs[~a]> " (incf counter))
365 (let ((line (string-trim #(#\space #\tab) (read-line))))
366 (restart-case
367 (cond
368 ((zerop (length line)))
369 ((string-equal line "exit")
370 (return-from mcvs-debug-shell))
371 ((char-equal (char line 0) #\!)
372 (print (eval (read-from-string (subseq line 1)))))
373 (t (mcvs-execute (split-words line #(#\space #\tab)))))
374 (debug () :report "Return to mcvs debug shell"
375 (terpri)))))))
376
377 #+clisp
378 (defun main ()
379 (ext:exit (catch 'mcvs-terminate (or (mcvs-execute ext:*args*)
380 *mcvs-errors-occured-p*))))

  ViewVC Help
Powered by ViewVC 1.1.5