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

Contents of /meta-cvs/F-9AB435A23565E6385CE7F4F347D7A205

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.18 - (show annotations)
Tue Nov 28 04:12:08 2006 UTC (7 years, 4 months ago) by kaz
Branch: MAIN
CVS Tags: asdf-import-branch~merged-to-HEAD-0, mcvs-1-1-98, asdf-import-branch~branch-point, HEAD
Branch point for: asdf-import-branch
Changes since 1.17: +15 -15 lines
Getting rid of mcvs- prefixes.

* code/package.lisp (defpackage): shadow the merge symbol.

* code/purge.lisp (mcvs-purge): renamed to purge
(mcvs-purge-wrapper): renamed to purge-wrapper

* code/restore.lisp (mcvs-restore): renamed to restore
(mcvs-restore-wrapper): renamed to restore-wrapper

* code/update.lisp (mcvs-update): renamed to update
(mcvs-update-wrapper): renamed to update-wrapper

* code/main.lisp (mcvs-help): renamed to help
(*mcvs-command-table*): renamed to *command-table*
(mcvs-terminate catch): renamed to terminate.

* code/execute.lisp (mcvs-execute): renamed to execute

* code/move.lisp (mcvs-move): renamed to move
(mcvs-move-wrapper): renamed to move-wrapper

* code/grab.lisp (mcvs-grab): renamed to grab
(mcvs-grab-wrapper): renamed to grab-wrapper

* code/prop.lisp (mcvs-prop): renamed to prop
(mcvs-prop-wrapper): renamed to prop-wrapper

* code/filt.lisp (mcvs-filt-loop): renamed to filt-loop
(mcvs-filt): renamed to filt
(mcvs-remote-filt): renamed to remote-filt
(mcvs-filt-wrapper): renamed to filt-wrapper
(mcvs-remote-filt-wrapper): renamed to remote-filt-wrapper

* code/branch.lisp (mcvs-branch): renamed to branch
(mcvs-branch-wrapper): renamed to branch-wrapper
(mcvs-merge): renamed to merge
(mcvs-list-branches): renamed to list-branches
(mcvs-merge-wrapper): renamed to merge-wrapper
(mcvs-remerge-wrapper): renamed to remerge-wrapper
(mcvs-list-branches-wrapper): renamed to list-branches-wrapper
(mcvs-switch-wrapper): renamed to switch-wrapper

* code/link.lisp (mcvs-link): renamed to ln
(mcvs-link-wrapper): renamed to link-wrapper

* code/watch.lisp (mcvs-watch): renamed to watch
(mcvs-watch-wrapper): renamed to watch-wrapper

* code/add.lisp (mcvs-add): renamed to add
(mcvs-add-wrapper): renamed to add-wrapper

* code/remove.lisp (mcvs-remove): renamed to rm
(mcvs-remove-wrapper): renamed to remove-wrapper

* code/convert.lisp (mcvs-convert): renamed to convert
(mcvs-convert-wrapper): renamed to convert-wrapper

* code/error.lisp (mcvs-terminate): renamed to terminate
(mcvs-error-handler): renamed to error-handler
(*mcvs-error-treatment*): renamed to *error-treatment*
(*mcvs-errors-occured-p*): renamed to *errors-occured-p*

* code/checkout.lisp (mcvs-checkout): renamed to checkout
(mcvs-checkout-wrapper): renamed to checkout-wrapper
(mcvs-export-wrapper): renamed to export-wrapper

* code/generic.lisp (mcvs-generic): renamed to generic
(mcvs-commit-wrapper): renamed to commit-wrapper
(mcvs-diff-wrapper): renamed to diff-wrapper
(mcvs-tag-wrapper): renamed to tag-wrapper
(mcvs-log-wrapper): renamed to log-wrapper
(mcvs-status-wrapper): renamed to status-wrapper
(mcvs-annotate-wrapper): renamed to annotate-wrapper
(mcvs-watchers-wrapper): renamed to watchers-wrapper
(mcvs-edit-wrapper): renamed to edit-wrapper
(mcvs-unedit-wrapper): renamed to unedit-wrapper
(mcvs-editors-wrapper): renamed to editors-wrapper
(mcvs-sync-to-wrapper): renamed to sync-to-wrapper
(mcvs-sync-from-wrapper): renamed to sync-from-wrapper

* code/create.lisp (mcvs-create): renamed to create
(mcvs-create-wrapper): renamed to create-wrapper

* code/remap.lisp (mcvs-remap): renamed to remap
(mcvs-remap-wrapper): renamed to remap-wrapper

* code/mapping.lisp (mcvs-locate): renamed to locate
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 (in-package :meta-cvs)
6
7 (defvar *error-treatment* :interactive
8 "This variable is used by the top level error handler set up in 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 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
21 (defvar *errors-occured-p* nil)
22
23 (defvar *interactive-error-io* nil)
24
25 (defun terminate (condition)
26 (format *error-output* "mcvs: ~a~%" condition)
27 (throw 'terminate t))
28
29 (defun error-handler (condition)
30 (let* ((*print-escape* nil)
31 (mcvs-package (find-package "META-CVS"))
32 (our-restarts (remove-if-not #'(lambda (r)
33 (eq (symbol-package (restart-name r))
34 mcvs-package))
35 (compute-restarts))))
36
37 (setf *errors-occured-p* t)
38 (find-bind (:key #'restart-name)
39 (others (continue 'continue)
40 (info 'info)
41 (retry 'retry))
42 our-restarts
43 (ecase *error-treatment*
44 ((:interactive)
45 (unless *interactive-error-io*
46 (return-from error-handler nil))
47 (when (null our-restarts)
48 (terminate condition))
49 (let* (command-list
50 (menu (with-output-to-string (stream)
51 (format stream "~%The following error has occured:~%~%")
52 (format stream " ~a~%~%" condition)
53 (format stream "You have these alternatives:~%~%")
54 (format stream " ?) Re-print this menu.~%" continue)
55 (when info
56 (format stream " I) (Info) ~a~%" info)
57 (push (list "I" #'(lambda ()
58 (invoke-restart info)))
59 command-list))
60 (when continue
61 (format stream " C) (Continue) ~a~%" continue)
62 (format stream " A) Auto-continue all continuable errors.~%")
63 (push (list "C" #'(lambda ()
64 (invoke-restart continue)))
65 command-list)
66 (push (list "A" #'(lambda ()
67 (setf *error-treatment*
68 :continue)
69 (invoke-restart continue)))
70 command-list))
71 (when retry
72 (format stream " R) (Retry) ~a~%" retry)
73 (push (list "R" #'(lambda ()
74 (invoke-restart retry)))
75 command-list))
76 (format stream " T) Recover, clean-up and terminate.~%")
77 (push (list "T" #'(lambda ()
78 (throw 'terminate t)))
79 command-list)
80 (when others
81 (format stream "~%These special alternatives are also available:~%~%")
82 (let ((counter 0))
83 (dolist (restart others)
84 (format stream " ~a) ~a~%" (incf counter) restart)
85 (push (list (format nil "~a" counter)
86 (let ((restart restart))
87 #'(lambda ()
88 (invoke-restart restart))))
89 command-list))))
90 (terpri stream))))
91 (write-string menu *interactive-error-io*)
92 (loop
93 (write-string ">" *interactive-error-io*)
94 (let* ((line (read-line *interactive-error-io*))
95 (command (find line command-list
96 :key #'first
97 :test #'string-equal)))
98 (cond
99 ((string= line "?")
100 (write-string menu *interactive-error-io*))
101 (command
102 (funcall (second command)))
103 (t (format *interactive-error-io* "What?~%")))))))
104 ((:continue)
105 (when continue
106 (chatter-terse "Auto-continuing error:~%")
107 (chatter-terse " ~a~%" condition)
108 (invoke-restart continue))
109 (terminate condition))
110 ((:terminate)
111 (terminate condition))
112 ((:decline)
113 (return-from error-handler nil))))))

  ViewVC Help
Powered by ViewVC 1.1.5