/[meta-cvs]/meta-cvs/F-9AB435A23565E6385CE7F4F347D7A205
ViewVC logotype

Diff of /meta-cvs/F-9AB435A23565E6385CE7F4F347D7A205

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

revision 1.10 by kaz, Sat Oct 5 18:19:23 2002 UTC revision 1.10.2.3 by kaz, Thu Apr 24 04:02:55 2003 UTC
# Line 12  decide on what to do with a restartable Line 12  decide on what to do with a restartable
12  available, then this variable is ignored; the handler will print the error  available, then this variable is ignored; the handler will print the error
13  message and terminate the program.  If the error is restartable, then this  message and terminate the program.  If the error is restartable, then this
14  variable is examined. A value of :interactive indicates that a menu of options  variable is examined. A value of :interactive indicates that a menu of options
15  should be presented to a user, who can choose to bail the program, or invoke  should be presented to a user, who can choose to terminate the program,
16  one of the available restarts. A value of :continue means to emit a warning  or invoke one of the available restarts. A value of :continue means
17  message and then invoke the a continue restart if one is available. If restarts  to emit a warning message and then invoke the a continue restart if
18  are available, but not ones that can be automatically selected by the handler,  one is available. If restarts are available, but not ones that can
19  then it will terminate the program. A value of :terminate means to terminate  be automatically selected by the handler, then it will terminate the
20  on error, restartable or not. A value of :decline means to return normally  program. A value of :terminate means to terminate on error, restartable
21  handling the error.")  or not. A value of :decline means to return normally handling the error.")
22    
23  (defvar *mcvs-errors-occured-p* nil)  (defvar *mcvs-errors-occured-p* nil)
24    
25    (defvar *interactive-error-io* nil)
26    
27    (defun mcvs-terminate (condition)
28      (format *error-output* "mcvs: ~a~%" condition)
29      (throw 'mcvs-terminate t))
30    
31  (defun mcvs-error-handler (condition)  (defun mcvs-error-handler (condition)
32    (let ((*print-escape* nil))    (let ((*print-escape* nil))
33      (setf *mcvs-errors-occured-p* t)      (setf *mcvs-errors-occured-p* t)
34      (find-bind (:key #'restart-name)      (find-bind (:key #'restart-name)
35                 (others (continue 'continue)                 (others (continue 'continue)
36                           (info 'info)
37                         (retry 'retry))                         (retry 'retry))
38                 (compute-restarts)                 (compute-restarts)
39        (ecase *mcvs-error-treatment*        (ecase *mcvs-error-treatment*
40          ((:interactive)          ((:interactive)
41               (unless *interactive-error-io*
42                 (return-from mcvs-error-handler nil))
43             (when (null (compute-restarts))             (when (null (compute-restarts))
44                (format *error-output* "mcvs: ~a~%" condition)               (mcvs-terminate condition))
               (throw 'mcvs-terminate t))  
45             (let* (command-list             (let* (command-list
46                    (menu (with-output-to-string (stream)                    (menu (with-output-to-string (stream)
47                            (format stream "~%The following error has occured:~%~%")                            (format stream "~%The following error has occured:~%~%")
48                            (format stream "    ~a~%~%" condition)                            (format stream "    ~a~%~%" condition)
49                            (format stream "You have these alternatives:~%~%")                            (format stream "You have these alternatives:~%~%")
50                            (format stream "    ?) Re-print this menu.~%" continue)                            (format stream "    ?) Re-print this menu.~%" continue)
51                              (when info
52                                (format stream "    I) (Info) ~a~%" info)
53                                (push (list "I" #'(lambda ()
54                                                    (invoke-restart info)))
55                                      command-list))
56                            (when continue                            (when continue
57                              (format stream "    C) (Continue) ~a~%" continue)                              (format stream "    C) (Continue) ~a~%" continue)
58                              (format stream "    A) Auto-continue all continuable errors.~%")                              (format stream "    A) Auto-continue all continuable errors.~%")
# Line 56  handling the error.") Line 69  handling the error.")
69                              (push (list "R" #'(lambda ()                              (push (list "R" #'(lambda ()
70                                                  (invoke-restart retry)))                                                  (invoke-restart retry)))
71                                    command-list))                                    command-list))
72                            (format stream "    T) Terminate.~%")                            (format stream "    T) Recover, clean-up and terminate.~%")
73                            (push (list "T" #'(lambda ()                            (push (list "T" #'(lambda ()
74                                                (throw 'mcvs-terminate t)))                                                (throw 'mcvs-terminate t)))
75                                  command-list)                                  command-list)
# Line 71  handling the error.") Line 84  handling the error.")
84                                                    (invoke-restart restart))))                                                    (invoke-restart restart))))
85                                        command-list))))                                        command-list))))
86                            (terpri stream))))                            (terpri stream))))
87               (write-string menu)               (write-string menu *interactive-error-io*)
88               (loop               (loop
89                 (write-string ">")                 (write-string ">" *interactive-error-io*)
90                 (let* ((line (read-line))                 (let* ((line (read-line *interactive-error-io*))
91                        (command (find line command-list                        (command (find line command-list
92                                       :key #'first                                       :key #'first
93                                       :test #'string-equal)))                                       :test #'string-equal)))
94                   (cond                   (cond
95                     ((string= line "?")                     ((string= line "?")
96                       (write-string menu))                       (write-string menu *interactive-error-io*))
97                     (command                     (command
98                       (funcall (second command)))                       (funcall (second command)))
99                    (t (format t "What?~%")))))))                    (t (format *interactive-error-io* "What?~%")))))))
100          ((:continue)          ((:continue)
101             (when continue             (when continue
102               (chatter-terse "Auto-continuing error:~%")               (chatter-terse "Auto-continuing error:~%")
103               (chatter-terse "    ~a~%" condition)               (chatter-terse "    ~a~%" condition)
104               (invoke-restart continue))               (invoke-restart continue))
105             (print-object condition *error-output*)             (mcvs-terminate condition))
            (throw 'mcvs-terminate t))  
106          ((:terminate)          ((:terminate)
107             (print-object condition *error-output*)             (mcvs-terminate condition))
            (throw 'mcvs-terminate t))  
108          ((:decline)          ((:decline)
109             (return-from mcvs-error-handler nil))))))             (return-from mcvs-error-handler nil))))))

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

  ViewVC Help
Powered by ViewVC 1.1.5