(defstruct (restart (:copier nil) (:predicate nil))
(name (missing-arg) :type symbol :read-only t)
- function
- report-function
- interactive-function
- (test-fun (lambda (cond) (declare (ignore cond)) t)))
+ (function (missing-arg) :type function)
+ (report-function nil :type (or null function))
+ (interactive-function nil :type (or null function))
+ (test-function (lambda (cond) (declare (ignore cond)) t) :type function))
(def!method print-object ((restart restart) stream)
(if *print-escape*
(print-unreadable-object (restart stream :type t :identity t)
(when (and (or (not condition)
(member restart associated)
(not (member restart other)))
- (funcall (restart-test-fun restart) condition))
+ (funcall (restart-test-function restart)
+ condition))
(res restart))))
(res))))
returned. It is an error to supply NIL as a name. If CONDITION is specified
and not NIL, then only restarts associated with that condition (or with no
condition) will be returned."
- (find-if (lambda (x)
- (or (eq x name)
- (eq (restart-name x) name)))
- (compute-restarts condition)))
+ (let ((restarts (compute-restarts condition)))
+ (declare (type list restarts))
+ (find-if (lambda (x)
+ (or (eq x name)
+ (eq (restart-name x) name)))
+ restarts)))
+
+(defun find-restart-or-lose (restart-designator)
+ (let ((real-restart (find-restart restart-designator)))
+ (unless real-restart
+ (error 'simple-control-error
+ :format-control "Restart ~S is not active."
+ :format-arguments (list restart-designator)))
+ real-restart))
(defun invoke-restart (restart &rest values)
#!+sb-doc
arguments. If the argument restart is not a restart or a currently active
non-nil restart name, then a control-error is signalled."
(/show "entering INVOKE-RESTART" restart)
- (let ((real-restart (find-restart restart)))
- (unless real-restart
- (error 'simple-control-error
- :format-control "Restart ~S is not active."
- :format-arguments (list restart)))
- (/show (restart-name real-restart))
+ (let ((real-restart (find-restart-or-lose restart)))
(apply (restart-function real-restart) values)))
+(defun interactive-restart-arguments (real-restart)
+ (let ((interactive-function (restart-interactive-function real-restart)))
+ (if interactive-function
+ (funcall interactive-function)
+ '())))
+
(defun invoke-restart-interactively (restart)
#!+sb-doc
"Calls the function associated with the given restart, prompting for any
necessary arguments. If the argument restart is not a restart or a
currently active non-nil restart name, then a control-error is signalled."
- (/show "entering INVOKE-RESTART-INTERACTIVELY" restart)
- (let ((real-restart (find-restart restart)))
- (unless real-restart
- (error 'simple-control-error
- :format-control "Restart ~S is not active."
- :format-arguments (list restart)))
- (/show (restart-name real-restart))
- (/show0 "falling through to APPLY of RESTART-FUNCTION")
- (apply (restart-function real-restart)
- (let ((interactive-function
- (restart-interactive-function real-restart)))
- (if interactive-function
- (funcall interactive-function)
- '())))))
+ (let* ((real-restart (find-restart-or-lose restart))
+ (args (interactive-restart-arguments real-restart)))
+ (apply (restart-function real-restart) args)))
(eval-when (:compile-toplevel :load-toplevel :execute)
;;; Wrap the RESTART-CASE expression in a WITH-CONDITION-RESTARTS if
:interactive-function
result)))
(when test
- (setq result (list* `#',test :test-fun result)))
+ (setq result (list* `#',test :test-function result)))
(nreverse result)))
(parse-keyword-pairs (list keys)
(do ((l list (cddr l))