/[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.2 by kaz, Wed Apr 23 05:37:35 2003 UTC
# Line 22  handling the error.") Line 22  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                           (bail 'bail)
37                           (info 'info)
38                         (retry 'retry))                         (retry 'retry))
39                 (compute-restarts)                 (compute-restarts)
40        (ecase *mcvs-error-treatment*        (ecase *mcvs-error-treatment*
41          ((:interactive)          ((:interactive)
42               (unless *interactive-error-io*
43                 (when bail
44                   (invoke-restart bail))
45                 (return-from mcvs-error-handler nil))
46             (when (null (compute-restarts))             (when (null (compute-restarts))
47                (format *error-output* "mcvs: ~a~%" condition)               (mcvs-terminate condition))
               (throw 'mcvs-terminate t))  
48             (let* (command-list             (let* (command-list
49                    (menu (with-output-to-string (stream)                    (menu (with-output-to-string (stream)
50                            (format stream "~%The following error has occured:~%~%")                            (format stream "~%The following error has occured:~%~%")
51                            (format stream "    ~a~%~%" condition)                            (format stream "    ~a~%~%" condition)
52                            (format stream "You have these alternatives:~%~%")                            (format stream "You have these alternatives:~%~%")
53                            (format stream "    ?) Re-print this menu.~%" continue)                            (format stream "    ?) Re-print this menu.~%" continue)
54                              (when info
55                                (format stream "    I) (Info) ~a~%" info)
56                                (push (list "I" #'(lambda ()
57                                                    (invoke-restart info)))
58                                      command-list))
59                            (when continue                            (when continue
60                              (format stream "    C) (Continue) ~a~%" continue)                              (format stream "    C) (Continue) ~a~%" continue)
61                              (format stream "    A) Auto-continue all continuable errors.~%")                              (format stream "    A) Auto-continue all continuable errors.~%")
# Line 51  handling the error.") Line 67  handling the error.")
67                                                        :continue)                                                        :continue)
68                                                  (invoke-restart continue)))                                                  (invoke-restart continue)))
69                                    command-list))                                    command-list))
70                              (when bail
71                                (format stream "    B) (Bail) ~a~%" bail)
72                                (push (list "B" #'(lambda ()
73                                                    (invoke-restart bail)))
74                                      command-list))
75                            (when retry                            (when retry
76                              (format stream "    R) (Retry) ~a~%" retry)                              (format stream "    R) (Retry) ~a~%" retry)
77                              (push (list "R" #'(lambda ()                              (push (list "R" #'(lambda ()
# Line 71  handling the error.") Line 92  handling the error.")
92                                                    (invoke-restart restart))))                                                    (invoke-restart restart))))
93                                        command-list))))                                        command-list))))
94                            (terpri stream))))                            (terpri stream))))
95               (write-string menu)               (write-string menu *interactive-error-io*)
96               (loop               (loop
97                 (write-string ">")                 (write-string ">" *interactive-error-io*)
98                 (let* ((line (read-line))                 (let* ((line (read-line *interactive-error-io*))
99                        (command (find line command-list                        (command (find line command-list
100                                       :key #'first                                       :key #'first
101                                       :test #'string-equal)))                                       :test #'string-equal)))
102                   (cond                   (cond
103                     ((string= line "?")                     ((string= line "?")
104                       (write-string menu))                       (write-string menu *interactive-error-io*))
105                     (command                     (command
106                       (funcall (second command)))                       (funcall (second command)))
107                    (t (format t "What?~%")))))))                    (t (format *interactive-error-io* "What?~%")))))))
108          ((:continue)          ((:continue)
109             (when continue             (when continue
110               (chatter-terse "Auto-continuing error:~%")               (chatter-terse "Auto-continuing error:~%")
111               (chatter-terse "    ~a~%" condition)               (chatter-terse "    ~a~%" condition)
112               (invoke-restart continue))               (invoke-restart continue))
113             (print-object condition *error-output*)             (mcvs-terminate condition))
114            ((:bail)
115               (format *error-output* "mcvs: ~a~%" condition)
116               (when bail
117                 (invoke-restart bail))
118             (throw 'mcvs-terminate t))             (throw 'mcvs-terminate t))
119          ((:terminate)          ((:terminate)
120             (print-object condition *error-output*)             (mcvs-terminate condition))
            (throw 'mcvs-terminate t))  
121          ((:decline)          ((:decline)
122             (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.2

  ViewVC Help
Powered by ViewVC 1.1.5