src/**/*.lisp: Use convenience functions to invoke restarts.

Introduce a new function `noted' to invoke the `noted' restart.  Fiddle
other code to do the right thing.

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 07fedc1f33fc7565d1f4244ddca7e9633beab338..f77f549285fbcb9a36155a61e8e00da01f6a6c77 100644 (file)
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -1605,7 +1605,7 @@ floc-proto.lisp
   information-with-location                     class
   make-condition-with-location                  function
   make-file-location                            function
-  noted
+  noted                                         function
   simple-condition-with-location                class
   simple-error-with-location                    class
   simple-information                            class

diff --git a/doc/misc.tex b/doc/misc.tex
index 3f3cf762fb058f8395687248176e0fc2d89281ca..e77d512a37ff8847cb8044d744889f3177c96f98 100644 (file)
--- a/doc/misc.tex
+++ b/doc/misc.tex
@@ -261,8 +261,10 @@ These symbols are defined in the @|sod-parser| package.
 \begin{describe}{fun}{info @<datum> \&rest @<arguments> @> @<flag>}
 \end{describe}
 
-\begin{describe}{rst}{noted}
-\end{describe}
+\begin{describe*}
+    {\dhead{rst}{noted}
+     \dhead{fun}{noted \&optional @<condition>}}
+\end{describe*}
 
 \begin{describe}{fun}{cerror* @<datum> \&rest @<arguments>}
 \end{describe}

diff --git a/src/parser/floc-proto.lisp b/src/parser/floc-proto.lisp
index f65ed738671afeb12ec830f69514fcfe15346f84..3a111237cd8a76ba585011157c30e65b77b6a8a3 100644 (file)
--- a/src/parser/floc-proto.lisp
+++ b/src/parser/floc-proto.lisp
@@ -134,7 +134,7 @@ (export 'simple-information)
 (define-condition simple-information (simple-condition information)
   ())
 
-(export '(info noted))
+(export 'info)
 (defun info (datum &rest arguments)
   "Report some useful diagnostic information.
 
@@ -145,6 +145,11 @@ (defun info (datum &rest arguments)
       (signal (designated-condition 'simple-information datum arguments))
     (noted () :report "Noted." t)))
 
+(export 'noted)
+(defun noted (&optional condition)
+  "Invoke the `noted' restart, possibly associated with the given CONDITION."
+  (invoke-associated-restart 'noted condition))
+
 (export 'simple-information-with-location)
 (define-condition simple-information-with-location
     (information-with-location simple-information)
@@ -342,18 +347,18 @@ (defun count-and-report-errors* (thunk)
                          (if fatal
                              (return-from count-and-report-errors*
                                (values nil errors warnings))
-                             (invoke-restart 'continue)))))
+                             (continue error)))))
               (warning (lambda (warning)
                          (format *error-output* "~&~A: Warning: ~A~%"
                                  (file-location warning)
                                  warning)
                          (incf warnings)
-                         (invoke-restart 'muffle-warning)))
+                         (muffle-warning warning)))
               (information (lambda (info)
                              (format *error-output* "~&~A: Info: ~A~%"
                                      (file-location info)
                                      info)
-                         (invoke-restart 'noted))))
+                             (noted info))))
            (values (funcall thunk)
                    errors
                    warnings)))

diff --git a/src/pset-test.lisp b/src/pset-test.lisp
index 42182517360260bcf740dd5fa1f8d84acd55cf19..c31bd76150a75200f45ebc0d1a21f83087880249 100644 (file)
--- a/src/pset-test.lisp
+++ b/src/pset-test.lisp
@@ -65,10 +65,9 @@ (defun check-pset-parse (string pset)
     (with-parser-context (token-scanner-context :scanner scanner)
       (multiple-value-bind (result winp consumedp)
          (handler-bind ((error (lambda (cond)
-                                 (declare (ignore cond))
                                  (setf errors t)
-                                 (if (find-restart 'continue)
-                                     (invoke-restart 'continue)
+                                 (if (find-restart 'continue cond)
+                                     (continue cond)
                                      :decline))))
            (parse-property-set scanner))
        (declare (ignore consumedp))

diff --git a/src/sod-test.asd.in b/src/sod-test.asd.in
index 1a5fa59834b0922c4b7b43a6b511ed6b701655d0..c65f4dca664b12fa83f1c512a13ae0400596132f 100644 (file)
--- a/src/sod-test.asd.in
+++ b/src/sod-test.asd.in
@@ -67,10 +67,7 @@
 ;;; Testing.
 
 (defmethod perform ((op test-op) (system (eql (find-system "sod-test"))))
-  (handler-bind (((or warning style-warning)
-                 (lambda (cond)
-                   (declare (ignore cond))
-                   (invoke-restart 'muffle-warning))))
+  (handler-bind (((or warning style-warning) #'muffle-warning))
     (operate 'load-op system)
     (let ((result (funcall (find-symbol "RUN-TESTS" "SOD-TEST"))))
       (unless (funcall (find-symbol "WAS-SUCCESSFUL" "XLUNIT") result)

diff --git a/src/sod.asd.in b/src/sod.asd.in
index f88ea2542e7bbb621980a7c16e8df25dc867eed2..4a1c341f32be98c8824887a34d008d6b7cffae9a 100644 (file)
--- a/src/sod.asd.in
+++ b/src/sod.asd.in
@@ -178,10 +178,7 @@
 
 (defmethod perform ((op test-op) (component (eql (find-system "sod"))))
   (declare (ignore op component))
-  (handler-bind (((or warning style-warning)
-                 (lambda (cond)
-                   (declare (ignore cond))
-                   (invoke-restart 'muffle-warning))))
+  (handler-bind (((or warning style-warning) #'muffle-warning))
     (operate 'test-op "sod-test")))
 
 ;;;----- That's all, folks --------------------------------------------------