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

Contents of /meta-cvs/F-9AB435A23565E6385CE7F4F347D7A205

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.13 - (show annotations)
Wed Apr 23 05:39:27 2003 UTC (10 years, 11 months ago) by kaz
Branch: MAIN
Changes since 1.12: +23 -11 lines
Merging from mcvs-1-0-branch.

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 ;;; 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 (require "find-bind")
7 (require "mcvs-package")
8 (provide "error")
9
10 (in-package "META-CVS")
11
12 (defvar *mcvs-error-treatment* :interactive
13 "This variable is used by the top level error handler set up in mcvs-execute to
14 decide on what to do with a restartable error condition. If no restarts are
15 available, then this variable is ignored; the handler will print the error
16 message and terminate the program. If the error is restartable, then this
17 variable is examined. A value of :interactive indicates that a menu of options
18 should be presented to a user, who can choose to bail the program, or invoke
19 one of the available restarts. A value of :continue means to emit a warning
20 message and then invoke the a continue restart if one is available. If restarts
21 are available, but not ones that can be automatically selected by the handler,
22 then it will terminate the program. A value of :terminate means to terminate
23 on error, restartable or not. A value of :decline means to return normally
24 handling the error.")
25
26 (defvar *mcvs-errors-occured-p* nil)
27
28 (defvar *interactive-error-io* nil)
29
30 (defun mcvs-terminate (condition)
31 (format *error-output* "mcvs: ~a~%" condition)
32 (throw 'mcvs-terminate t))
33
34 (defun mcvs-error-handler (condition)
35 (let ((*print-escape* nil))
36 (setf *mcvs-errors-occured-p* t)
37 (find-bind (:key #'restart-name)
38 (others (continue 'continue)
39 (bail 'bail)
40 (info 'info)
41 (retry 'retry))
42 (compute-restarts)
43 (ecase *mcvs-error-treatment*
44 ((:interactive)
45 (unless *interactive-error-io*
46 (when bail
47 (invoke-restart bail))
48 (return-from mcvs-error-handler nil))
49 (when (null (compute-restarts))
50 (mcvs-terminate condition))
51 (let* (command-list
52 (menu (with-output-to-string (stream)
53 (format stream "~%The following error has occured:~%~%")
54 (format stream " ~a~%~%" condition)
55 (format stream "You have these alternatives:~%~%")
56 (format stream " ?) Re-print this menu.~%" continue)
57 (when info
58 (format stream " I) (Info) ~a~%" info)
59 (push (list "I" #'(lambda ()
60 (invoke-restart info)))
61 command-list))
62 (when continue
63 (format stream " C) (Continue) ~a~%" continue)
64 (format stream " A) Auto-continue all continuable errors.~%")
65 (push (list "C" #'(lambda ()
66 (invoke-restart continue)))
67 command-list)
68 (push (list "A" #'(lambda ()
69 (setf *mcvs-error-treatment*
70 :continue)
71 (invoke-restart continue)))
72 command-list))
73 (when bail
74 (format stream " B) (Bail) ~a~%" bail)
75 (push (list "B" #'(lambda ()
76 (invoke-restart bail)))
77 command-list))
78 (when retry
79 (format stream " R) (Retry) ~a~%" retry)
80 (push (list "R" #'(lambda ()
81 (invoke-restart retry)))
82 command-list))
83 (format stream " T) Terminate.~%")
84 (push (list "T" #'(lambda ()
85 (throw 'mcvs-terminate t)))
86 command-list)
87 (when others
88 (format stream "~%These special alternatives are also available:~%~%")
89 (let ((counter 0))
90 (dolist (restart others)
91 (format stream " ~a) ~a~%" (incf counter) restart)
92 (push (list (format nil "~a" counter)
93 (let ((restart restart))
94 #'(lambda ()
95 (invoke-restart restart))))
96 command-list))))
97 (terpri stream))))
98 (write-string menu *interactive-error-io*)
99 (loop
100 (write-string ">" *interactive-error-io*)
101 (let* ((line (read-line *interactive-error-io*))
102 (command (find line command-list
103 :key #'first
104 :test #'string-equal)))
105 (cond
106 ((string= line "?")
107 (write-string menu *interactive-error-io*))
108 (command
109 (funcall (second command)))
110 (t (format *interactive-error-io* "What?~%")))))))
111 ((:continue)
112 (when continue
113 (chatter-terse "Auto-continuing error:~%")
114 (chatter-terse " ~a~%" condition)
115 (invoke-restart continue))
116 (mcvs-terminate condition))
117 ((:bail)
118 (format *error-output* "mcvs: ~a~%" condition)
119 (when bail
120 (invoke-restart bail))
121 (throw 'mcvs-terminate t))
122 ((:terminate)
123 (mcvs-terminate condition))
124 ((:decline)
125 (return-from mcvs-error-handler nil))))))

  ViewVC Help
Powered by ViewVC 1.1.5