From e43bd9558b80d9d92db3f39b5f77a2fa184fb467 Mon Sep 17 00:00:00 2001
Message-Id: <e43bd9558b80d9d92db3f39b5f77a2fa184fb467.1715338619.git.mdw@distorted.org.uk>
From: Mark Wooding <mdw@chiark.greenend.org.uk>
Date: Sun, 26 Mar 2017 15:16:18 +0100
Subject: [PATCH] src/**/*.lisp: Use convenience functions to invoke restarts.
Organization: Straylight/Edgeware

From: Mark Wooding <mdw@distorted.org.uk>

Introduce a new function `noted' to invoke the `noted' restart.  Fiddle
other code to do the right thing.
---
 doc/SYMBOLS                |  2 +-
 doc/misc.tex               |  6 ++++--
 src/parser/floc-proto.lisp | 13 +++++++++----
 src/pset-test.lisp         |  5 ++---
 src/sod-test.asd.in        |  5 +----
 src/sod.asd.in             |  5 +----
 6 files changed, 18 insertions(+), 18 deletions(-)

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 07fedc1..f77f549 100644
--- 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 3f3cf76..e77d512 100644
--- 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 f65ed73..3a11123 100644
--- 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 4218251..c31bd76 100644
--- 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 1a5fa59..c65f4dc 100644
--- 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 f88ea25..4a1c341 100644
--- 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 --------------------------------------------------
-- 
[mdw]