/[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.20 - (hide annotations)
Thu Apr 24 04:02:54 2003 UTC (10 years, 11 months ago) by kaz
Branch: mcvs-1-0-branch
Changes since 1.69.2.19: +3 -6 lines
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 kaz 1.16 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.7 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5 kaz 1.69.2.7 ;; Clear out requires for mcvs-upgrade to work right.
6     (setf *modules* nil)
7    
8 kaz 1.45 (require "create")
9 kaz 1.1 (require "checkout")
10 kaz 1.46 (require "grab")
11 kaz 1.1 (require "add")
12 kaz 1.3 (require "remove")
13 kaz 1.4 (require "move")
14 kaz 1.69.2.10 (require "link")
15 kaz 1.1 (require "update")
16 kaz 1.12 (require "filt")
17 kaz 1.21 (require "generic")
18 kaz 1.25 (require "convert")
19 kaz 1.38 (require "branch")
20 kaz 1.44 (require "remap")
21 kaz 1.48 (require "purge")
22 kaz 1.49 (require "restore")
23 kaz 1.54 (require "prop")
24 kaz 1.69.2.3 (require "watch")
25 kaz 1.8 (require "split")
26     (require "restart")
27 kaz 1.27 (require "error")
28 kaz 1.10 (require "options")
29 kaz 1.33 (require "find-bind")
30 kaz 1.6 (provide "mcvs-main")
31 kaz 1.5
32 kaz 1.69.2.15 (define-option-constant *global-options*
33 kaz 1.55 (0 arg "H" "help" "Q" "q" "r" "w" "l" "n" "t" "v" "f" "version"
34 kaz 1.69.2.20 "meta" "metaonly" "nometa" "error-continue" "error-terminate" "debug")
35 kaz 1.69.2.16 (1 arg "T" "e" "d" "r" "z" "s" "i" "up"))
36 kaz 1.55
37 kaz 1.58 (define-option-constant *help-options*)
38    
39 kaz 1.55 (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 kaz 1.61 (0 arg "f")
49 kaz 1.55 (1 arg "r" "D" "d" "k" "j"))
50    
51 kaz 1.69.2.2 (define-option-constant *export-options*
52     (0 arg "f")
53     (1 arg "r" "D" "d" "k"))
54    
55 kaz 1.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 kaz 1.69.2.1 (0 arg "A" "C" "f" "p")
64 kaz 1.55 (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 kaz 1.69.2.18 (define-option-constant *remote-filt-options*
106     (1 arg "r" "D"))
107    
108 kaz 1.57 (define-option-constant *move-options*)
109 kaz 1.69.2.10 (define-option-constant *link-options*)
110 kaz 1.55 (define-option-constant *convert-options*)
111     (define-option-constant *branch-options*)
112 kaz 1.69.2.14
113     (define-option-constant *merge-options*
114     (1 arg "k"))
115    
116     (define-option-constant *remerge-options*
117     (1 arg "k"))
118    
119 kaz 1.55 (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 kaz 1.18
128 kaz 1.69.2.3 (define-option-constant *watch-options*
129     (0 arg "on" "off")
130     (1 arg "add" "remove"))
131    
132 kaz 1.69.2.5 (define-option-constant *watchers-options*)
133     (define-option-constant *edit-options*)
134     (define-option-constant *unedit-options*)
135     (define-option-constant *editors-options*)
136    
137 kaz 1.58 (defun mcvs-help (global-options command-options args)
138     (declare (special *usage* *mcvs-command-table*)
139     (ignore global-options command-options))
140     (cond
141     ((null args)
142     (terpri)
143     (write-line *usage*)
144     (terpri))
145     ((= (length args) 1)
146     (let* ((command-name (first args))
147     (command (find command-name *mcvs-command-table*
148     :key #'first
149     :test #'string=)))
150     (when (null command)
151 kaz 1.69 (error "~a is not a recognized mcvs command."
152 kaz 1.58 command-name))
153 kaz 1.59 (let ((help-text (third command)))
154     (when (null help-text)
155 kaz 1.69 (error "sorry, no help available for ~a command."
156 kaz 1.58 command-name))
157 kaz 1.59 (terpri)
158     (write-line help-text)
159     (terpri))))
160 kaz 1.69 (t (error "try \"mcvs help <name-of-command>\"."))))
161 kaz 1.58
162 kaz 1.5 (defconstant *mcvs-command-table*
163 kaz 1.58 `(("help" ,#'mcvs-help nil ,*help-options*)
164 kaz 1.59 ("create" ,#'mcvs-create-wrapper ,*create-help* ,*create-options*)
165 kaz 1.60 ("grab" ,#'mcvs-grab-wrapper ,*grab-help* ,*grab-options*)
166 kaz 1.61 ("checkout" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
167     ("co" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
168 kaz 1.69.2.2 ("export" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
169     ("ex" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
170 kaz 1.61 ("add" ,#'mcvs-add-wrapper ,*add-help* ,*add-options*)
171 kaz 1.63 ("remove" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
172 kaz 1.64 ("rm" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
173 kaz 1.69.2.8 ("move" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
174     ("mv" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
175 kaz 1.69.2.10 ("link" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
176     ("ln" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
177 kaz 1.58 ("update" ,#'mcvs-update-wrapper nil ,*update-options*)
178     ("up" ,#'mcvs-update-wrapper nil ,*update-options*)
179     ("commit" ,#'mcvs-commit-wrapper nil ,*commit-options*)
180     ("ci" ,#'mcvs-commit-wrapper nil ,*commit-options*)
181     ("diff" ,#'mcvs-diff-wrapper nil ,*diff-options*)
182     ("tag" ,#'mcvs-tag-wrapper nil ,*tag-options*)
183     ("log" ,#'mcvs-log-wrapper nil ,*log-options*)
184     ("status" ,#'mcvs-status-wrapper nil ,*status-options*)
185     ("stat" ,#'mcvs-status-wrapper nil ,*status-options*)
186     ("annotate" ,#'mcvs-annotate-wrapper nil ,*annotate-options*)
187     ("filt" ,#'mcvs-filt-wrapper nil ,*filt-options*)
188     ("fi" ,#'mcvs-filt-wrapper nil ,*filt-options*)
189 kaz 1.69.2.18 ("remote-filt" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
190     ("rfilt" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
191     ("rfi" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
192 kaz 1.58 ("convert" ,#'mcvs-convert-wrapper nil ,*convert-options*)
193 kaz 1.69.2.12 ("branch" ,#'mcvs-branch-wrapper ,*branch-help* ,*branch-options*)
194 kaz 1.58 ("switch" ,#'mcvs-switch-wrapper nil ,*switch-options*)
195     ("sw" ,#'mcvs-switch-wrapper nil ,*switch-options*)
196     ("merge" ,#'mcvs-merge-wrapper nil ,*merge-options*)
197     ("remerge" ,#'mcvs-remerge-wrapper nil ,*remerge-options*)
198     ("list-branches" ,#'mcvs-list-branches-wrapper nil ,*list-branches-options*)
199     ("lb" ,#'mcvs-list-branches-wrapper nil ,*list-branches-options*)
200     ("purge" ,#'mcvs-purge-wrapper nil ,*purge-options*)
201     ("restore" ,#'mcvs-restore-wrapper nil ,*restore-options*)
202     ("remap" ,#'mcvs-remap-wrapper nil ,*remap-options*)
203 kaz 1.69.2.3 ("prop" ,#'mcvs-prop-wrapper nil ,*prop-options*)
204 kaz 1.69.2.5 ("watch" ,#'mcvs-watch-wrapper nil ,*watch-options*)
205     ("watchers" ,#'mcvs-watchers-wrapper nil ,*watchers-options*)
206     ("edit" ,#'mcvs-edit-wrapper nil ,*edit-options*)
207     ("unedit" ,#'mcvs-unedit-wrapper nil ,*unedit-options*)
208     ("editors" ,#'mcvs-editors-wrapper nil ,*editors-options*)))
209 kaz 1.5
210 kaz 1.33 (defconstant *usage*
211     "Meta-CVS command syntax:
212    
213 kaz 1.59 mcvs [ global-options] command [ command-options ] [ command-arguments ]
214 kaz 1.33
215     Global options:
216    
217 kaz 1.35 -H --help Print this help and terminate. If a command is specified,
218     help specific to that command is printed instead.
219     -Q Very quiet, generate output only for serious problems. (*)
220     -q Somewhat quiet, some informational messages suppresed. (*)
221 kaz 1.69.2.13 -n Dry run; do not modify filesystem. (*)
222 kaz 1.69 --debug Verbose debug output; -Q and -q are ignored but still
223     passed to CVS.
224 kaz 1.35 -r Make working files read-only. (@)
225     -w Make new working files read-write (default). (@)
226     -l Do not log cvs command in command history, but execute
227     it anyway. (@)
228     -t Trace CVS execution. (@)
229     -v --version Display version information and terminate.
230     -f CVS not to read ~/.cvsrc file. (@)
231 kaz 1.65 -i script-name Load a Lisp file and evaluate its top level forms,
232     allowing Meta-CVS to behave as an interpreter.
233 kaz 1.50 --meta Include metafiles such as MCVS/MAP in the set of files
234     to operate on.
235     --metaonly Operate only on metafiles.
236     --nometa Exclude metafiles from the set of files to operate on.
237 kaz 1.35 --error-continue Instead of interactive error handling, automatically
238     continue all continuable errors.
239 kaz 1.69.2.20 --error-terminate Terminate with cleanup when an error happens instead
240 kaz 1.69.2.19 of interactive error handling.
241 kaz 1.35 -T tempdir Place temporary files in tempdir. (@)
242     -e editor Edit messages with editor. (*)
243     -d root Specify CVSROOT. (@)
244     -z gzip-level Specify compression level. (@)
245 kaz 1.69.2.17 --up N Escape out of N levels of sandbox nesting before executing
246     operation.
247 kaz 1.33
248     Notes: (*) option processed by Meta-CVS and passed to CVS too.
249     (@) option merely passed to CVS.
250    
251     Commands:
252    
253 kaz 1.59 help Obtain more detailed help for a specific command.
254 kaz 1.45 create Create new project from an existing file tree.
255 kaz 1.46 grab Take a snapshot of an external source tree, such
256     as a third-party release, and incorporate it into
257     the working copy. Tries to discover file moves.
258 kaz 1.69.2.4 checkout (co) Retrieve a Meta-CVS project from the repository to
259     create a working copy.
260     export (ex) Retrieve a Meta-CVS project without creating a
261 kaz 1.35 working copy.
262     add Place files (or directories with add -R) under
263     version control.
264     remove (rm) Remove files or directories.
265     move (mv) Rename files and directories.
266 kaz 1.69.2.10 link (ln) Create a versioned symbolic link.
267 kaz 1.35 update (up) Incorporate latest changes from repository into
268     working copy.
269     commit (ci) Incorporate outstanding changes in the working copy
270     into the repository.
271     diff Compute differences between files in the working copy
272     and the repository or between revisions in the repository.
273     tag Associate a symbolic name with file revisions to create
274     an identifiable baseline. By default, tags the
275     revisions that were last synchronized with the
276     directory. A branch is created using tag -b.
277     log Display log information for files.
278     status (stat) Show current status of files.
279     annotate Perform a detailed analysis of files, showing the
280     version information about every individual line of text.
281     filt (fi) Act as a text filter, which converts Meta-CVS F- file
282     names to readable paths, according to the current mapping.
283 kaz 1.69.2.18 remote-filt (rfi) Remote version of filt, requires module name.
284 kaz 1.38 branch Create a managed branch. Meta-CVS managed branches keep
285     track of what has been merged where, so users don't have
286     to track merges with tags at all.
287     merge Merge a managed branch to the current branch or trunk.
288 kaz 1.40 remerge Re-apply the most recent merge without changing any tags.
289     Useful when a merge goes bad so the local changes have
290     to be discarded and the merge done over again.
291 kaz 1.41 list-branches (lb) List Meta-CVS managed branches.
292 kaz 1.43 switch (sw) Switch to a branch. With no arguments, switch to
293 kaz 1.42 main trunk.
294 kaz 1.44 remap Force Meta-CVS to notice and incorporate moves and
295     deletions that were performed directly on the sandbox.
296 kaz 1.48 purge Execute a CVS remove on files that have been unmapped
297     with the remove command.
298 kaz 1.51 restore Restore files that have been deleted with the remove
299     command, but not purged. These appear in the lost+found
300     directory under cryptic names.
301 kaz 1.54 prop Manipulate properties.
302 kaz 1.56 prop --set <bool-prop-name> [ files ... ]
303 kaz 1.69.2.9 prop --clear <bool-prop-name> [ files ... ]
304     prop --value <prop-name> <new-value> [ files ... ]
305     prop --remove <prop-name> [ files ... ]
306     The ``exec'' property represents the execute permission
307     of a file. More than one --set, --clear, --value
308     or --remove may be specified before the files.
309 kaz 1.69.2.4 watch Manipulate per-file CVS watch settings.
310     watch --on [ files ... ]
311     watch --off [ files ... ]
312     watch --add <action> [ files ... ]
313     watch --remove <action> [ files ... ]
314 kaz 1.69.2.5 watchers See who is watching files.
315     edit Indicate the intent to edit a watched file.
316     unedit Retract the indication signaled by edit.
317     editors See who is editing files.
318 kaz 1.35 convert Convert a CVS module to a Meta-CVS project. This requires
319     filesystem-level access to the repository. This is
320     currently an experimental command that is known not
321     to work 100%.")
322 kaz 1.33
323 kaz 1.5 (defun mcvs-execute (args)
324 kaz 1.69.2.19 (let* ((*interactive-error-io* (open (unix-funcs:ctermid) :direction :io))
325     (*mcvs-error-treatment* (if *interactive-error-io*
326     :interactive
327 kaz 1.69.2.20 :terminate)))
328 kaz 1.69.2.19 (handler-bind ((error #'mcvs-error-handler))
329     (multiple-value-bind (global-options global-args)
330     (parse-opt args *global-options*)
331     (setf global-options (filter-global-options global-options))
332    
333     (when *print-usage*
334     (terpri)
335     (write-line *usage*)
336     (terpri)
337     (throw 'mcvs-terminate nil))
338    
339     (when (not (first global-args))
340     (write-line "Meta-CVS requires a command argument." *error-output*)
341     (write-line "Use mcvs -H to view help." *error-output*)
342     (throw 'mcvs-terminate nil))
343    
344     (let ((command (find (first global-args) *mcvs-command-table*
345     :key #'first
346     :test #'string=)))
347     (when (not command)
348     (error "~a is not a recognized mcvs command."
349     (first global-args)))
350     (destructuring-bind (name func help-text opt-spec) command
351     (declare (ignore name help-text))
352     (multiple-value-bind (command-options command-args)
353     (parse-opt (rest global-args) opt-spec)
354     (funcall func global-options command-options command-args))))))
355     nil))
356 kaz 1.5
357 kaz 1.8 (defun mcvs-debug-shell ()
358 kaz 1.24 (let ((counter 0)
359     (*mcvs-error-treatment* :decline))
360     (loop
361     (format t "~&mcvs[~a]> " (incf counter))
362     (let ((line (string-trim #(#\space #\tab) (read-line))))
363 kaz 1.29 (restart-case
364 kaz 1.24 (cond
365     ((zerop (length line)))
366     ((string-equal line "exit")
367     (return-from mcvs-debug-shell))
368     ((char-equal (char line 0) #\!)
369     (print (eval (read-from-string (subseq line 1)))))
370 kaz 1.29 (t (mcvs-execute (split-words line #(#\space #\tab)))))
371 kaz 1.36 (debug () :report "Return to mcvs debug shell"
372 kaz 1.29 (terpri)))))))
373 kaz 1.10
374 kaz 1.5 #+clisp
375     (defun mcvs ()
376 kaz 1.28 (exit (catch 'mcvs-terminate (or (mcvs-execute ext:*args*)
377     *mcvs-errors-occured-p*))))

  ViewVC Help
Powered by ViewVC 1.1.5