chiark / gitweb /
src/utilities.lisp: New function `invoke-associated-restart'.
[sod] / src / utilities.lisp
index 0415a90fed193ee950fc8ee01ca0e8e7334f3d3b..0f6a54b0d3a562d855c49177e9cad2924cd3bd30 100644 (file)
@@ -972,6 +972,30 @@ (defun designated-condition (default-type datum arguments
     (t
      (error "Unexpected condition designator datum ~S" datum))))
 
+(export 'simple-control-error)
+(define-condition simple-control-error (control-error simple-error)
+  ())
+
+(export 'invoke-associated-restart)
+(defun invoke-associated-restart (restart condition &rest arguments)
+  "Invoke the active RESTART associated with CONDITION, with the ARGUMENTS.
+
+   Find an active restart designated by RESTART; if CONDITION is not nil,
+   then restrict the search to restarts associated with CONDITION, and
+   restarts not associated with any condition.  If no such restart is found
+   then signal an error of type `control-error'; otherwise invoke the restart
+   with the given ARGUMENTS."
+  (apply #'invoke-restart
+        (or (find-restart restart condition)
+            (error 'simple-control-error
+                   :format-control "~:[Restart ~S is not active~;~
+                                       No active `~(~A~)' restart~]~
+                                    ~@[ for condition ~S~]"
+                   :format-arguments (list (symbolp restart)
+                                           restart
+                                           condition)))
+        arguments))
+
 ;;;--------------------------------------------------------------------------
 ;;; CLOS hacking.