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

Diff of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10 by kaz, Sun Jan 27 16:33:13 2002 UTC revision 1.11 by kaz, Sun Jan 27 18:13:49 2002 UTC
# Line 15  Line 15 
15  (require "options")  (require "options")
16  (provide "mcvs-main")  (provide "mcvs-main")
17    
18    (defvar *mcvs-error-treatment* :interactive
19    "This variable is used by the top level error handler set up in mcvs-execute to
20    decide on what to do with a restartable error condition.  If no restarts are
21    available, then this variable is ignored; the handler will print the error
22    message and terminate the program.  If the error is restartable, then this
23    variable is examined. A value of :interactive indicates that a menu of options
24    should be presented to a user, who can choose to bail the program, or invoke
25    one of the available restarts. A value of :continue means to emit a warning
26    message and then invoke the a continue restart if one is available. If restarts
27    are available, but not ones that can be automatically selected by the handler,
28    then it will terminate the program. A value of :terminate means to terminate
29    on error, restartable or not.")
30    
31    (defun mcvs-top-error-handler (condition)
32      (let ((available-restarts (compute-restarts)))
33        (when available-restarts
34          (let ((*print-escape* nil))
35            (ecase *mcvs-error-treatment*
36              ((:interactive)
37                 (print-object condition t)
38                 (format t
39                  "~2&Choose one of the following ways of resolving this error:~%")
40                 (format t "~%Type C to continue.~%")
41                 (format t "     A to continue and automatically continue~%")
42                 (format t "       any subsequent errors.~%")
43                 (format t "     T terminate mcvs.~%~%")
44                 (loop
45                    (format t "Your choice: ")
46                    (let ((response (read-line)))
47                      (if (> (length response) 0)
48                        (let ((command (char-upcase (char response 0))))
49                          (cond
50                            ((char-equal command #\C)
51                               (invoke-restart (first available-restarts)))
52                            ((char-equal command #\A)
53                               (setf *mcvs-error-treatment* :continue)
54                               (invoke-restart (first available-restarts)))
55                            ((char-equal command #\T)
56                               #+clisp (exit 1))))))))
57              ((:continue)
58                 (print-object condition *error-output*)
59                 (format *error-output* "~&mcvs: auto-continuing.~%")
60                 (invoke-restart (first available-restarts)))
61              ((:terminate))
62                 (print-object condition *error-output*)
63                 (format *error-output* "~&mcvs: terminating.~%")
64                 #+clisp (exit 1))))))
65    
66  (defconstant *mcvs-command-table*  (defconstant *mcvs-command-table*
67   `(("import" ,#'mcvs-import-wrapper)   `(("import" ,#'mcvs-import-wrapper)
68     ("checkout" ,#'mcvs-checkout-wrapper)     ("checkout" ,#'mcvs-checkout-wrapper)
# Line 31  Line 79 
79     ("diff" ,#'mcvs-diff-wrapper)))     ("diff" ,#'mcvs-diff-wrapper)))
80    
81  (defun mcvs-execute (args)  (defun mcvs-execute (args)
82    (when (null args)    (handler-bind ((error #'mcvs-top-error-handler))
83      (error "mcvs: requires arguments."))      (when (null args)
84    (multiple-value-bind (command-string cvs-options cvs-command-options        (error "mcvs: requires arguments."))
85                          mcvs-args) (parse-args args)      (multiple-value-bind (command-string cvs-options cvs-command-options
86      (let ((command (find command-string *mcvs-command-table* :key #'first                            mcvs-args) (parse-args args)
87                                          :test #'string=)))        (let ((command (find command-string *mcvs-command-table* :key #'first
88        (when (not command)                                            :test #'string=)))
89          (error "mcvs: ~a is not a recognized mcvs command." command-string))          (when (not command)
90        (funcall (second command) cvs-options cvs-command-options mcvs-args))))            (error "mcvs: ~a is not a recognized mcvs command." command-string))
91            (funcall (second command)
92                     cvs-options cvs-command-options mcvs-args)))))
93    
94  (defun mcvs-debug-shell ()  (defun mcvs-debug-shell ()
95    (let ((counter 0))    (let ((counter 0))

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11

  ViewVC Help
Powered by ViewVC 1.1.5