+;; Call FUNCTION with all restarts in the current dynamic environment,
+;; 1) that are associated to CONDITION (when CONDITION is NIL, all
+;; restarts are processed)
+;; 2) and for which the restart test returns non-NIL for CONDITION.
+;; When CALL-TEST-P is non-NIL, all restarts are processed.
+(defun map-restarts (function &optional condition (call-test-p t))
+ ;; FIXME: if MAP-RESTARTS is internal, we could require the FUNCTION
+ ;; argument to be of type FUNCTION.
+ (let ((function (coerce function 'function))
+ (stack *restart-test-stack*))
+ (dolist (restart-cluster *restart-clusters*)
+ (dolist (restart restart-cluster)
+ (when (and (or (not condition)
+ (null (restart-associated-conditions restart))
+ (memq condition (restart-associated-conditions restart)))
+ ;; A call to COMPUTE-RESTARTS -- from an error,
+ ;; from user code, whatever -- inside the test
+ ;; function would cause infinite recursion here, so
+ ;; we disable each restart using
+ ;; *restart-test-stack* for the duration of the
+ ;; test call.
+ (not (memq restart stack))
+ (or (not call-test-p)
+ (let ((*restart-test-stack* (cons restart stack)))
+ (declare (truly-dynamic-extent *restart-test-stack*))
+ (funcall (restart-test-function restart) condition))))
+ (funcall function restart))))))
+