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

Contents of /meta-cvs/F-9AB435A23565E6385CE7F4F347D7A205

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.15 - (hide annotations)
Mon Mar 8 06:11:40 2004 UTC (10 years, 1 month ago) by kaz
Branch: MAIN
CVS Tags: mcvs-1-1-0
Changes since 1.14: +0 -5 lines
Revamped loading system. Got rid of require/provide in all
Lisp source files.

* code/mcvs.lisp: New file. Responsible for compiling and loading
everything in the right order.

* code/mcvs-main.lisp: File renamed to main.lisp.

* code/mcvs-package.lisp: File renamed to package.lisp.

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

  ViewVC Help
Powered by ViewVC 1.1.5