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

Contents of /meta-cvs/F-9AB435A23565E6385CE7F4F347D7A205

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.10.2.3 - (hide annotations)
Thu Apr 24 04:02:55 2003 UTC (11 years ago) by kaz
Branch: mcvs-1-0-branch
CVS Tags: mcvs-1-0-branch~merged-to-HEAD-1, mcvs-1-0-branch~merged-to-HEAD-0, mcvs-1-0-11, mcvs-1-0-10, mcvs-1-0-13, mcvs-1-0-12, mcvs-1-0-9, mcvs-1-0-8, mcvs-1-0-7
Changes since 1.10.2.2: +8 -21 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.1 ;;; This source file is part of the Meta-CVS program,
2     ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5     (require "chatter")
6 kaz 1.8 (require "find-bind")
7 kaz 1.1 (provide "error")
8    
9     (defvar *mcvs-error-treatment* :interactive
10     "This variable is used by the top level error handler set up in mcvs-execute to
11     decide on what to do with a restartable error condition. If no restarts are
12     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
14     variable is examined. A value of :interactive indicates that a menu of options
15 kaz 1.10.2.3 should be presented to a user, who can choose to terminate the program,
16     or invoke one of the available restarts. A value of :continue means
17     to emit a warning message and then invoke the a continue restart if
18     one is available. If restarts are available, but not ones that can
19     be automatically selected by the handler, then it will terminate the
20     program. A value of :terminate means to terminate on error, restartable
21     or not. A value of :decline means to return normally handling the error.")
22 kaz 1.1
23 kaz 1.4 (defvar *mcvs-errors-occured-p* nil)
24    
25 kaz 1.10.2.2 (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 kaz 1.1 (defun mcvs-error-handler (condition)
32     (let ((*print-escape* nil))
33 kaz 1.4 (setf *mcvs-errors-occured-p* t)
34 kaz 1.8 (find-bind (:key #'restart-name)
35     (others (continue 'continue)
36 kaz 1.10.2.1 (info 'info)
37 kaz 1.8 (retry 'retry))
38     (compute-restarts)
39 kaz 1.1 (ecase *mcvs-error-treatment*
40 kaz 1.10.2.2 ((:interactive)
41     (unless *interactive-error-io*
42     (return-from mcvs-error-handler nil))
43 kaz 1.1 (when (null (compute-restarts))
44 kaz 1.10.2.2 (mcvs-terminate condition))
45 kaz 1.1 (let* (command-list
46     (menu (with-output-to-string (stream)
47     (format stream "~%The following error has occured:~%~%")
48     (format stream " ~a~%~%" condition)
49     (format stream "You have these alternatives:~%~%")
50     (format stream " ?) Re-print this menu.~%" continue)
51 kaz 1.10.2.1 (when info
52     (format stream " I) (Info) ~a~%" info)
53     (push (list "I" #'(lambda ()
54     (invoke-restart info)))
55     command-list))
56 kaz 1.1 (when continue
57 kaz 1.2 (format stream " C) (Continue) ~a~%" continue)
58 kaz 1.1 (format stream " A) Auto-continue all continuable errors.~%")
59     (push (list "C" #'(lambda ()
60     (invoke-restart continue)))
61     command-list)
62     (push (list "A" #'(lambda ()
63     (setf *mcvs-error-treatment*
64     :continue)
65     (invoke-restart continue)))
66 kaz 1.10.2.1 command-list))
67 kaz 1.2 (when retry
68     (format stream " R) (Retry) ~a~%" retry)
69     (push (list "R" #'(lambda ()
70     (invoke-restart retry)))
71 kaz 1.1 command-list))
72 kaz 1.10.2.3 (format stream " T) Recover, clean-up and terminate.~%")
73 kaz 1.5 (push (list "T" #'(lambda ()
74     (throw 'mcvs-terminate t)))
75     command-list)
76 kaz 1.1 (when others
77 kaz 1.5 (format stream "~%These special alternatives are also available:~%~%")
78 kaz 1.1 (let ((counter 0))
79     (dolist (restart others)
80     (format stream " ~a) ~a~%" (incf counter) restart)
81     (push (list (format nil "~a" counter)
82 kaz 1.7 (let ((restart restart))
83     #'(lambda ()
84     (invoke-restart restart))))
85 kaz 1.1 command-list))))
86 kaz 1.5 (terpri stream))))
87 kaz 1.10.2.2 (write-string menu *interactive-error-io*)
88 kaz 1.1 (loop
89 kaz 1.10.2.2 (write-string ">" *interactive-error-io*)
90     (let* ((line (read-line *interactive-error-io*))
91 kaz 1.1 (command (find line command-list
92     :key #'first
93     :test #'string-equal)))
94     (cond
95     ((string= line "?")
96 kaz 1.10.2.2 (write-string menu *interactive-error-io*))
97 kaz 1.7 (command
98     (funcall (second command)))
99 kaz 1.10.2.2 (t (format *interactive-error-io* "What?~%")))))))
100 kaz 1.1 ((:continue)
101     (when continue
102 kaz 1.3 (chatter-terse "Auto-continuing error:~%")
103 kaz 1.1 (chatter-terse " ~a~%" condition)
104     (invoke-restart continue))
105 kaz 1.10.2.2 (mcvs-terminate condition))
106 kaz 1.1 ((:terminate)
107 kaz 1.10.2.2 (mcvs-terminate condition))
108 kaz 1.1 ((:decline)
109     (return-from mcvs-error-handler nil))))))

  ViewVC Help
Powered by ViewVC 1.1.5