/[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.19 - (hide annotations)
Wed Apr 23 05:37:35 2003 UTC (10 years, 11 months ago) by kaz
Branch: mcvs-1-0-branch
Changes since 1.69.2.18: +35 -29 lines
Improved error handling.  Use of tty for user interaction, plus
new global option for selecting non-interactive bail behavior.

* code/mcvs-main.lisp (*global-options*): add --error-bail option.
(*usage*): Describe new option.
(mcvs-execute): Dynamically bind *interactive-error-io* variable
to a stream formed by opening the controlling tty.
Send error message to *error-output* rather than *standard-output*.

* code/unix-bindings/unix.lisp (unix-funcs:ctermid): New function,
FFI interface to mcvs_ctermid.

* code/unix-bindings/wrap.c (mcvs_ctermid): New function.

* code/chatter.lisp (chatter): Chatter now goes to *error-output*
rather than *standard-output*.

* code/error.lisp (*interactive-error-io*): New special variable,
holds stream open to controlling tty.
(mcvs-terminate): New function.
(mcvs-error-handler): Use *interactive-error-io* to print menu
and obtain user input. Support the :bail value of
*mcvs-error-treatment* Plus some cosmetic changes.

* code/options.lisp (filter-mcvs-options): Support --error-bail option.

* code/filt.lisp (mcvs-filt-loop): Bugfix, (read-line t ...)
should be (read-line *standard-input* ...) because t stands
for *terminal-io* rather than *standard-io*, unlike in the
format function!

* code/rcs-utils.lisp (rcs-read-token): Read from *standard-input*
rather than *terminal-io*.
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 "meta" "metaonly" "nometa" "error-continue" "error-terminate"
35 kaz 1.69.2.19 "error-bail" "debug")
36 kaz 1.69.2.16 (1 arg "T" "e" "d" "r" "z" "s" "i" "up"))
37 kaz 1.55
38 kaz 1.58 (define-option-constant *help-options*)
39    
40 kaz 1.55 (define-option-constant *create-options*
41     (0 arg "d")
42     (1 arg "k" "I" "b" "m" "W"))
43    
44     (define-option-constant *grab-options*
45     (0 arg "A")
46     (1 arg "r"))
47    
48     (define-option-constant *checkout-options*
49 kaz 1.61 (0 arg "f")
50 kaz 1.55 (1 arg "r" "D" "d" "k" "j"))
51    
52 kaz 1.69.2.2 (define-option-constant *export-options*
53     (0 arg "f")
54     (1 arg "r" "D" "d" "k"))
55    
56 kaz 1.55 (define-option-constant *add-options*
57     (0 arg "R")
58     (1 arg "k" "m"))
59    
60     (define-option-constant *remove-options*
61     (0 arg "R"))
62    
63     (define-option-constant *update-options*
64 kaz 1.69.2.1 (0 arg "A" "C" "f" "p")
65 kaz 1.55 (1 arg "k" "r" "D" "j" "I" "W"))
66    
67     (define-option-constant *switch-options*
68     (1 arg "k" "I" "W"))
69    
70     (define-option-constant *commit-options*
71     (0 arg "f")
72     (1 arg "F" "m" "r"))
73    
74     (define-option-constant *diff-options*
75     (0 arg "a" "b" "B" "brief" "c" "d" "e" "ed" "expand-tabs" "f" "forward-ed"
76     "H" "i" "ignore-all-space" "ignore-blank-lines" "ignore-case"
77     "ignore-space-change" "initial-tab" "l" "left-column" "minimal" "n"
78     "N" "new-file" "p" "P" "--paginate" "q" "rcs" "report-identical-files"
79     "s" "show-c-function" "side-by-side" "speed-large-files"
80     "suppress-common-lines" "t" "T" "text" "u" "unidirectional-new-file"
81     "w" "y")
82     (1 arg "C" "context" "D" "F" "horizon-lines" "ifdef" "ignore-matching-lines"
83     "L" "label" "line-format" "new-group-format" "new-line-format"
84     "old-group-format" "old-line-format" "r" "show-function-line"
85     "unchanged-group-format" "unchanged-line-format" "U" "unified" "W"
86     "width"))
87    
88     (define-option-constant *tag-options*
89     (0 arg "l" "d" "f" "b" "F" "c")
90     (1 arg "r" "D"))
91    
92     (define-option-constant *log-options*
93     (0 arg "R" "h" "t" "N" "b")
94     (1 arg "r" "d" "s" "w"))
95    
96     (define-option-constant *status-options*
97     (0 arg "v"))
98    
99     (define-option-constant *annotate-options*
100     (0 arg "f")
101     (1 arg "r" "D"))
102    
103     (define-option-constant *filt-options*
104     (1 arg "r" "D"))
105    
106 kaz 1.69.2.18 (define-option-constant *remote-filt-options*
107     (1 arg "r" "D"))
108    
109 kaz 1.57 (define-option-constant *move-options*)
110 kaz 1.69.2.10 (define-option-constant *link-options*)
111 kaz 1.55 (define-option-constant *convert-options*)
112     (define-option-constant *branch-options*)
113 kaz 1.69.2.14
114     (define-option-constant *merge-options*
115     (1 arg "k"))
116    
117     (define-option-constant *remerge-options*
118     (1 arg "k"))
119    
120 kaz 1.55 (define-option-constant *list-branches-options*)
121     (define-option-constant *remap-options*)
122     (define-option-constant *purge-options*)
123     (define-option-constant *restore-options*)
124    
125     (define-option-constant *prop-options*
126     (1 arg "set" "clear" "remove")
127     (2 arg "value"))
128 kaz 1.18
129 kaz 1.69.2.3 (define-option-constant *watch-options*
130     (0 arg "on" "off")
131     (1 arg "add" "remove"))
132    
133 kaz 1.69.2.5 (define-option-constant *watchers-options*)
134     (define-option-constant *edit-options*)
135     (define-option-constant *unedit-options*)
136     (define-option-constant *editors-options*)
137    
138 kaz 1.58 (defun mcvs-help (global-options command-options args)
139     (declare (special *usage* *mcvs-command-table*)
140     (ignore global-options command-options))
141     (cond
142     ((null args)
143     (terpri)
144     (write-line *usage*)
145     (terpri))
146     ((= (length args) 1)
147     (let* ((command-name (first args))
148     (command (find command-name *mcvs-command-table*
149     :key #'first
150     :test #'string=)))
151     (when (null command)
152 kaz 1.69 (error "~a is not a recognized mcvs command."
153 kaz 1.58 command-name))
154 kaz 1.59 (let ((help-text (third command)))
155     (when (null help-text)
156 kaz 1.69 (error "sorry, no help available for ~a command."
157 kaz 1.58 command-name))
158 kaz 1.59 (terpri)
159     (write-line help-text)
160     (terpri))))
161 kaz 1.69 (t (error "try \"mcvs help <name-of-command>\"."))))
162 kaz 1.58
163 kaz 1.5 (defconstant *mcvs-command-table*
164 kaz 1.58 `(("help" ,#'mcvs-help nil ,*help-options*)
165 kaz 1.59 ("create" ,#'mcvs-create-wrapper ,*create-help* ,*create-options*)
166 kaz 1.60 ("grab" ,#'mcvs-grab-wrapper ,*grab-help* ,*grab-options*)
167 kaz 1.61 ("checkout" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
168     ("co" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
169 kaz 1.69.2.2 ("export" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
170     ("ex" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
171 kaz 1.61 ("add" ,#'mcvs-add-wrapper ,*add-help* ,*add-options*)
172 kaz 1.63 ("remove" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
173 kaz 1.64 ("rm" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
174 kaz 1.69.2.8 ("move" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
175     ("mv" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
176 kaz 1.69.2.10 ("link" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
177     ("ln" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
178 kaz 1.58 ("update" ,#'mcvs-update-wrapper nil ,*update-options*)
179     ("up" ,#'mcvs-update-wrapper nil ,*update-options*)
180     ("commit" ,#'mcvs-commit-wrapper nil ,*commit-options*)
181     ("ci" ,#'mcvs-commit-wrapper nil ,*commit-options*)
182     ("diff" ,#'mcvs-diff-wrapper nil ,*diff-options*)
183     ("tag" ,#'mcvs-tag-wrapper nil ,*tag-options*)
184     ("log" ,#'mcvs-log-wrapper nil ,*log-options*)
185     ("status" ,#'mcvs-status-wrapper nil ,*status-options*)
186     ("stat" ,#'mcvs-status-wrapper nil ,*status-options*)
187     ("annotate" ,#'mcvs-annotate-wrapper nil ,*annotate-options*)
188     ("filt" ,#'mcvs-filt-wrapper nil ,*filt-options*)
189     ("fi" ,#'mcvs-filt-wrapper nil ,*filt-options*)
190 kaz 1.69.2.18 ("remote-filt" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
191     ("rfilt" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
192     ("rfi" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
193 kaz 1.58 ("convert" ,#'mcvs-convert-wrapper nil ,*convert-options*)
194 kaz 1.69.2.12 ("branch" ,#'mcvs-branch-wrapper ,*branch-help* ,*branch-options*)
195 kaz 1.58 ("switch" ,#'mcvs-switch-wrapper nil ,*switch-options*)
196     ("sw" ,#'mcvs-switch-wrapper nil ,*switch-options*)
197     ("merge" ,#'mcvs-merge-wrapper nil ,*merge-options*)
198     ("remerge" ,#'mcvs-remerge-wrapper nil ,*remerge-options*)
199     ("list-branches" ,#'mcvs-list-branches-wrapper nil ,*list-branches-options*)
200     ("lb" ,#'mcvs-list-branches-wrapper nil ,*list-branches-options*)
201     ("purge" ,#'mcvs-purge-wrapper nil ,*purge-options*)
202     ("restore" ,#'mcvs-restore-wrapper nil ,*restore-options*)
203     ("remap" ,#'mcvs-remap-wrapper nil ,*remap-options*)
204 kaz 1.69.2.3 ("prop" ,#'mcvs-prop-wrapper nil ,*prop-options*)
205 kaz 1.69.2.5 ("watch" ,#'mcvs-watch-wrapper nil ,*watch-options*)
206     ("watchers" ,#'mcvs-watchers-wrapper nil ,*watchers-options*)
207     ("edit" ,#'mcvs-edit-wrapper nil ,*edit-options*)
208     ("unedit" ,#'mcvs-unedit-wrapper nil ,*unedit-options*)
209     ("editors" ,#'mcvs-editors-wrapper nil ,*editors-options*)))
210 kaz 1.5
211 kaz 1.33 (defconstant *usage*
212     "Meta-CVS command syntax:
213    
214 kaz 1.59 mcvs [ global-options] command [ command-options ] [ command-arguments ]
215 kaz 1.33
216     Global options:
217    
218 kaz 1.35 -H --help Print this help and terminate. If a command is specified,
219     help specific to that command is printed instead.
220     -Q Very quiet, generate output only for serious problems. (*)
221     -q Somewhat quiet, some informational messages suppresed. (*)
222 kaz 1.69.2.13 -n Dry run; do not modify filesystem. (*)
223 kaz 1.69 --debug Verbose debug output; -Q and -q are ignored but still
224     passed to CVS.
225 kaz 1.35 -r Make working files read-only. (@)
226     -w Make new working files read-write (default). (@)
227     -l Do not log cvs command in command history, but execute
228     it anyway. (@)
229     -t Trace CVS execution. (@)
230     -v --version Display version information and terminate.
231     -f CVS not to read ~/.cvsrc file. (@)
232 kaz 1.65 -i script-name Load a Lisp file and evaluate its top level forms,
233     allowing Meta-CVS to behave as an interpreter.
234 kaz 1.50 --meta Include metafiles such as MCVS/MAP in the set of files
235     to operate on.
236     --metaonly Operate only on metafiles.
237     --nometa Exclude metafiles from the set of files to operate on.
238 kaz 1.35 --error-continue Instead of interactive error handling, automatically
239     continue all continuable errors.
240 kaz 1.69.2.19 --error-bail Terminate with cleanup when error happens instead
241     of interactive error handling.
242 kaz 1.35 --error-terminate Terminate without cleanup when an error happens instead
243     of interactive error handling (use with care).
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 kaz 1.69.2.17 --up N Escape out of N levels of sandbox nesting before executing
249     operation.
250 kaz 1.33
251     Notes: (*) option processed by Meta-CVS and passed to CVS too.
252     (@) option merely passed to CVS.
253    
254     Commands:
255    
256 kaz 1.59 help Obtain more detailed help for a specific command.
257 kaz 1.45 create Create new project from an existing file tree.
258 kaz 1.46 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 kaz 1.69.2.4 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 kaz 1.35 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 kaz 1.69.2.10 link (ln) Create a versioned symbolic link.
270 kaz 1.35 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 kaz 1.69.2.18 remote-filt (rfi) Remote version of filt, requires module name.
287 kaz 1.38 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 kaz 1.40 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 kaz 1.41 list-branches (lb) List Meta-CVS managed branches.
295 kaz 1.43 switch (sw) Switch to a branch. With no arguments, switch to
296 kaz 1.42 main trunk.
297 kaz 1.44 remap Force Meta-CVS to notice and incorporate moves and
298     deletions that were performed directly on the sandbox.
299 kaz 1.48 purge Execute a CVS remove on files that have been unmapped
300     with the remove command.
301 kaz 1.51 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 kaz 1.54 prop Manipulate properties.
305 kaz 1.56 prop --set <bool-prop-name> [ files ... ]
306 kaz 1.69.2.9 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 kaz 1.69.2.4 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 kaz 1.69.2.5 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 kaz 1.35 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 kaz 1.33
326 kaz 1.5 (defun mcvs-execute (args)
327 kaz 1.69.2.19 (let* ((*interactive-error-io* (open (unix-funcs:ctermid) :direction :io))
328     (*mcvs-error-treatment* (if *interactive-error-io*
329     :interactive
330     :bail)))
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 kaz 1.5
360 kaz 1.8 (defun mcvs-debug-shell ()
361 kaz 1.24 (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 kaz 1.29 (restart-case
367 kaz 1.24 (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 kaz 1.29 (t (mcvs-execute (split-words line #(#\space #\tab)))))
374 kaz 1.36 (debug () :report "Return to mcvs debug shell"
375 kaz 1.29 (terpri)))))))
376 kaz 1.10
377 kaz 1.5 #+clisp
378     (defun mcvs ()
379 kaz 1.28 (exit (catch 'mcvs-terminate (or (mcvs-execute ext:*args*)
380     *mcvs-errors-occured-p*))))

  ViewVC Help
Powered by ViewVC 1.1.5