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

Contents of /meta-cvs/F-9AB435A23565E6385CE7F4F347D7A205

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.11 - (hide annotations)
Thu Oct 31 04:06:01 2002 UTC (11 years, 5 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-1-0-3
Changes since 1.10: +3 -0 lines
* code/mcvs-package.lisp: New file, defines META-CVS package.

* code/purge.lisp: Put all symbols in new package.
* code/restore.lisp: Likewise.
* code/paths.lisp: Likewise.
* code/install.sh: Likewise.
* code/restart.lisp: Likewise.
* code/update.lisp: Likewise.
* code/move.lisp: Likewise.
* code/grab.lisp: Likewise.
* code/unix.lisp: Likewise.
* code/slot-refs.lisp: Likewise.
* code/prop.lisp: Likewise.
* code/multi-hash.lisp: Likewise.
* code/rcs-utils.lisp: Likewise.
* code/branch.lisp: Likewise.
* code/find-bind.lisp: Likewise.
* code/execute.lisp: Likewise.
* code/link.lisp: Likewise.
* code/split.lisp: Likewise.
* code/watch.lisp: Likewise.
* code/clisp-unix.lisp: Likewise.
* code/add.lisp: Likewise.
* code/chatter.lisp: Likewise.
* code/print.lisp: Likewise.
* code/types.lisp: Likewise.
* code/remove.lisp: Likewise.
* code/convert.lisp: Likewise.
* code/error.lisp: Likewise.
* code/options.lisp: Likewise.
* code/dirwalk.lisp: Likewise.
* code/checkout.lisp: Likewise.
* code/generic.lisp: Likewise.
* code/sync.lisp: Likewise.
* code/create.lisp: Likewise.
* code/memoize.lisp: Likewise.
* code/seqfuncs.lisp: Likewise.
* code/cmucl-unix.lisp: Likewise.
* code/remap.lisp: Likewise.

* code/mapping.lisp: Put symbols in new package. Replace use
of CLISP specific substring function with subseq.
* code/filt.lisp: Likewise.

* code/mcvs-main.lisp: Put symbols in new package. The mcvs
function is renamed to main.

* code/install.sh: Generate mcvs script that uses qualified name
of new startup functiont to start the software.
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.11 (require "mcvs-package")
8 kaz 1.1 (provide "error")
9 kaz 1.11
10     (in-package "META-CVS")
11 kaz 1.1
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 kaz 1.4 (defvar *mcvs-errors-occured-p* nil)
27    
28 kaz 1.1 (defun mcvs-error-handler (condition)
29     (let ((*print-escape* nil))
30 kaz 1.4 (setf *mcvs-errors-occured-p* t)
31 kaz 1.8 (find-bind (:key #'restart-name)
32     (others (continue 'continue)
33     (retry 'retry))
34     (compute-restarts)
35 kaz 1.1 (ecase *mcvs-error-treatment*
36     ((:interactive)
37     (when (null (compute-restarts))
38 kaz 1.10 (format *error-output* "mcvs: ~a~%" condition)
39 kaz 1.1 (throw 'mcvs-terminate t))
40     (let* (command-list
41     (menu (with-output-to-string (stream)
42     (format stream "~%The following error has occured:~%~%")
43     (format stream " ~a~%~%" condition)
44     (format stream "You have these alternatives:~%~%")
45     (format stream " ?) Re-print this menu.~%" continue)
46     (when continue
47 kaz 1.2 (format stream " C) (Continue) ~a~%" continue)
48 kaz 1.1 (format stream " A) Auto-continue all continuable errors.~%")
49     (push (list "C" #'(lambda ()
50     (invoke-restart continue)))
51     command-list)
52     (push (list "A" #'(lambda ()
53     (setf *mcvs-error-treatment*
54     :continue)
55     (invoke-restart continue)))
56 kaz 1.2 command-list))
57     (when retry
58     (format stream " R) (Retry) ~a~%" retry)
59     (push (list "R" #'(lambda ()
60     (invoke-restart retry)))
61 kaz 1.1 command-list))
62 kaz 1.6 (format stream " T) Terminate.~%")
63 kaz 1.5 (push (list "T" #'(lambda ()
64     (throw 'mcvs-terminate t)))
65     command-list)
66 kaz 1.1 (when others
67 kaz 1.5 (format stream "~%These special alternatives are also available:~%~%")
68 kaz 1.1 (let ((counter 0))
69     (dolist (restart others)
70     (format stream " ~a) ~a~%" (incf counter) restart)
71     (push (list (format nil "~a" counter)
72 kaz 1.7 (let ((restart restart))
73     #'(lambda ()
74     (invoke-restart restart))))
75 kaz 1.1 command-list))))
76 kaz 1.5 (terpri stream))))
77 kaz 1.1 (write-string menu)
78     (loop
79     (write-string ">")
80     (let* ((line (read-line))
81     (command (find line command-list
82     :key #'first
83     :test #'string-equal)))
84     (cond
85     ((string= line "?")
86 kaz 1.7 (write-string menu))
87     (command
88     (funcall (second command)))
89 kaz 1.1 (t (format t "What?~%")))))))
90     ((:continue)
91     (when continue
92 kaz 1.3 (chatter-terse "Auto-continuing error:~%")
93 kaz 1.1 (chatter-terse " ~a~%" condition)
94     (invoke-restart continue))
95     (print-object condition *error-output*)
96     (throw 'mcvs-terminate t))
97     ((:terminate)
98     (print-object condition *error-output*)
99     (throw 'mcvs-terminate t))
100     ((:decline)
101     (return-from mcvs-error-handler nil))))))

  ViewVC Help
Powered by ViewVC 1.1.5