/[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.2 - (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.10.2.1: +23 -11 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.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     should be presented to a user, who can choose to bail the program, or invoke
16     one of the available restarts. A value of :continue means to emit a warning
17     message and then invoke the a continue restart if one is available. If restarts
18     are available, but not ones that can be automatically selected by the handler,
19     then it will terminate the program. A value of :terminate means to terminate
20     on error, restartable or not. A value of :decline means to return normally
21     handling the error.")
22    
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 (bail 'bail)
37     (info 'info)
38 kaz 1.8 (retry 'retry))
39     (compute-restarts)
40 kaz 1.1 (ecase *mcvs-error-treatment*
41 kaz 1.10.2.2 ((:interactive)
42     (unless *interactive-error-io*
43     (when bail
44     (invoke-restart bail))
45     (return-from mcvs-error-handler nil))
46 kaz 1.1 (when (null (compute-restarts))
47 kaz 1.10.2.2 (mcvs-terminate condition))
48 kaz 1.1 (let* (command-list
49     (menu (with-output-to-string (stream)
50     (format stream "~%The following error has occured:~%~%")
51     (format stream " ~a~%~%" condition)
52     (format stream "You have these alternatives:~%~%")
53     (format stream " ?) Re-print this menu.~%" continue)
54 kaz 1.10.2.1 (when info
55     (format stream " I) (Info) ~a~%" info)
56     (push (list "I" #'(lambda ()
57     (invoke-restart info)))
58     command-list))
59 kaz 1.1 (when continue
60 kaz 1.2 (format stream " C) (Continue) ~a~%" continue)
61 kaz 1.1 (format stream " A) Auto-continue all continuable errors.~%")
62     (push (list "C" #'(lambda ()
63     (invoke-restart continue)))
64     command-list)
65     (push (list "A" #'(lambda ()
66     (setf *mcvs-error-treatment*
67     :continue)
68     (invoke-restart continue)))
69 kaz 1.10.2.1 command-list))
70     (when bail
71     (format stream " B) (Bail) ~a~%" bail)
72     (push (list "B" #'(lambda ()
73     (invoke-restart bail)))
74 kaz 1.2 command-list))
75     (when retry
76     (format stream " R) (Retry) ~a~%" retry)
77     (push (list "R" #'(lambda ()
78     (invoke-restart retry)))
79 kaz 1.1 command-list))
80 kaz 1.6 (format stream " T) Terminate.~%")
81 kaz 1.5 (push (list "T" #'(lambda ()
82     (throw 'mcvs-terminate t)))
83     command-list)
84 kaz 1.1 (when others
85 kaz 1.5 (format stream "~%These special alternatives are also available:~%~%")
86 kaz 1.1 (let ((counter 0))
87     (dolist (restart others)
88     (format stream " ~a) ~a~%" (incf counter) restart)
89     (push (list (format nil "~a" counter)
90 kaz 1.7 (let ((restart restart))
91     #'(lambda ()
92     (invoke-restart restart))))
93 kaz 1.1 command-list))))
94 kaz 1.5 (terpri stream))))
95 kaz 1.10.2.2 (write-string menu *interactive-error-io*)
96 kaz 1.1 (loop
97 kaz 1.10.2.2 (write-string ">" *interactive-error-io*)
98     (let* ((line (read-line *interactive-error-io*))
99 kaz 1.1 (command (find line command-list
100     :key #'first
101     :test #'string-equal)))
102     (cond
103     ((string= line "?")
104 kaz 1.10.2.2 (write-string menu *interactive-error-io*))
105 kaz 1.7 (command
106     (funcall (second command)))
107 kaz 1.10.2.2 (t (format *interactive-error-io* "What?~%")))))))
108 kaz 1.1 ((:continue)
109     (when continue
110 kaz 1.3 (chatter-terse "Auto-continuing error:~%")
111 kaz 1.1 (chatter-terse " ~a~%" condition)
112     (invoke-restart continue))
113 kaz 1.10.2.2 (mcvs-terminate condition))
114     ((:bail)
115     (format *error-output* "mcvs: ~a~%" condition)
116     (when bail
117     (invoke-restart bail))
118 kaz 1.1 (throw 'mcvs-terminate t))
119     ((:terminate)
120 kaz 1.10.2.2 (mcvs-terminate condition))
121 kaz 1.1 ((:decline)
122     (return-from mcvs-error-handler nil))))))

  ViewVC Help
Powered by ViewVC 1.1.5