(unless (>= (length binding) 2)
(error "ill-formed restart binding: ~S" binding))
(destructuring-bind (name function
- &rest args
- &key report-function &allow-other-keys)
+ &key interactive-function
+ test-function
+ report-function)
binding
(unless (or name report-function)
(warn "Unnamed restart does not have a report function: ~
~S" binding))
- `(make-restart :name ',name :function ,function ,@args))))
+ `(make-restart ',name ,function
+ ,report-function
+ ,interactive-function
+ ,@(and test-function
+ `(,test-function))))))
`(let ((*restart-clusters*
(cons (list ,@(mapcar #'parse-binding bindings))
*restart-clusters*)))
(declaim (inline restart-test-function
restart-associated-conditions
(setf restart-associated-conditions)))
-(defstruct (restart (:copier nil) (:predicate nil))
+(defstruct (restart (:constructor make-restart
+ ;; Having TEST-FUNCTION at the end allows
+ ;; to not replicate its default value in RESTART-BIND.
+ (name function
+ &optional report-function
+ interactive-function
+ test-function))
+ (:copier nil) (:predicate nil))
(name (missing-arg) :type symbol :read-only t)
(function (missing-arg) :type function :read-only t)
(report-function nil :type (or null function) :read-only t)
;; extent.
(associated-conditions '() :type list))
+#!-sb-fluid (declaim (freeze-type restart))
+
(def!method print-object ((restart restart) stream)
(if *print-escape*
(print-unreadable-object (restart stream :type t :identity t)