For reporting extra information about errors.
enclosing-condition-with-location class
enclosing-condition-with-location-type generic
enclosing-error-with-location class
+ enclosing-information-with-location class
enclosing-warning-with-location class
error-with-location function class
file-location generic class
file-location-filename function
file-location-line function
file-location-p function
+ info function
+ info-with-location function
+ information class
+ information-with-location class
make-condition-with-location function
make-file-location function
+ noted
simple-condition-with-location class
simple-error-with-location class
+ simple-information class
+ simple-information-with-location class
simple-warning-with-location class
warn-with-location function
warning-with-location class
condition-with-location
enclosing-condition-with-location [enclosing-condition]
enclosing-error-with-location [cl:error]
+ enclosing-information-with-location [information]
enclosing-warning-with-location [cl:warning]
error-with-location [cl:error]
simple-error-with-location [cl:simple-error]
+ information-with-location [information]
+ simple-information-with-location [simple-information]
simple-condition-with-location [cl:simple-condition]
warning-with-location [cl:warning]
simple-warning-with-location [cl:simple-warning]
enclosing-condition
enclosing-condition-with-location [condition-with-location]
enclosing-error-with-location [cl:error]
+ enclosing-information-with-location [information]
enclosing-warning-with-location [cl:warning]
+ information
+ enclosing-information-with-location [enclosing-condition-with-location]
+ information-with-location [condition-with-location]
+ simple-information-with-location [simple-information]
+ simple-information [cl:simple-condition]
+ simple-information-with-location [information-with-location]
cl:serious-condition
cl:error
enclosing-error-with-location [enclosing-condition-with-location]
simple-condition-with-location [condition-with-location]
cl:simple-error [cl:error]
simple-error-with-location [error-with-location]
+ simple-information [information]
+ simple-information-with-location [information-with-location]
cl:simple-warning [cl:warning]
simple-warning-with-location [warning-with-location]
cl:warning
cl:condition
cl:error
cl:warning
+ information
expand-parser-form
t (eql cl:and) t
t (eql cl:list) t
default-slot macro
define-access-wrapper macro
define-on-demand-slot macro
+ designated-condition function
dosequence macro
sb-mop:eql-specializer class
sb-mop:eql-specializer-object generic
@[[ :read-only @<read-only-flag> @]]}
\end{describe}
+\begin{describe}{fun}
+ {designated-condition
+ \=@<default-type> @<datum> @<arguments> \\
+ \>\&key :allow-pointless-arguments
+ \nlret @<condition>}
+\end{describe}
+
\begin{describe}{mac}
{default-slot (@<instance> @<slot> @[@<slot-names>@]) \\ \ind
@<form>^*}
{enclosed-condition @<enclosing-condition> @> @<condition>}
\end{describe}
+\begin{describe}{cls}{information (condition) \&key}
+\end{describe}
+
+\begin{describe}{cls}
+ {simple-information (simple-condition information) \\ \ind
+ \&key :format-control :format-arguments}
+\end{describe}
+
+\begin{describe}{fun}{info @<datum> \&rest @<arguments> @> @<flag>}
+\end{describe}
+
+\begin{describe}{rst}{noted}
+\end{describe}
+
\begin{describe}{fun}{cerror* @<datum> \&rest @<arguments>}
\end{describe}
{warning-with-location (condition-with-location warning) \\ \>
\&key :location}
\dhead{cls}
+ {information-with-location (condition-with-location information) \\ \>
+ \&key :location}
+ \dhead{cls}
{enclosing-error-with-location
(enclosing-error-with-location error) \\ \>
\&key :condition :location}
(enclosing-condition-with-location warning) \\ \>
\&key :condition :location}
\dhead{cls}
+ {enclosing-information-with-location
+ (enclosing-condition-with-location information) \\ \>
+ \&key :condition :location}
+ \dhead{cls}
{simple-condition-with-location
(condition-with-location simple-condition) \\ \>
\&key :format-control :format-arguments :location}
\dhead{cls}
{simple-warning-with-location
(warning-with-location simple-warning) \\ \>
+ \&key :format-control :format-arguments :location}
+ \dhead{cls}
+ {simple-information-with-location
+ (information-with-location simple-information) \\ \>
\&key :format-control :format-arguments :location}}
\end{describe*}
\definedescribecategory{be-meth}{before method}
\definedescribecategory{af-meth}{after method}
\definedescribecategory{cls}{class}
+\definedescribecategory{rst}{restart}
\definedescribecategory{ty}{type}
\definedescribecategory{type}{type}
\definedescribecategory{mac}{macro}
(condition-with-location enclosing-condition)
())
+(export 'information)
+(define-condition information (condition)
+ ())
+
(export 'error-with-location)
(define-condition error-with-location (condition-with-location error)
())
(define-condition warning-with-location (condition-with-location warning)
())
+(export 'information-with-location)
+(define-condition information-with-location
+ (condition-with-location information)
+ ())
+
(export 'enclosing-error-with-location)
(define-condition enclosing-error-with-location
(enclosing-condition-with-location error)
(enclosing-condition-with-location warning)
())
+(export 'enclosing-information-with-location)
+(define-condition enclosing-information-with-location
+ (enclosing-condition-with-location information)
+ ())
+
(export 'simple-condition-with-location)
(define-condition simple-condition-with-location
(condition-with-location simple-condition)
(warning-with-location simple-warning)
())
+(export 'simple-information)
+(define-condition simple-information (simple-condition information)
+ ())
+
+(export '(info noted))
+(defun info (datum &rest arguments)
+ "Report some useful diagnostic information.
+
+ Establish a simple restart named `noted', and signal the condition of type
+ `information' designated by DATUM and ARGUMENTS. Return non-nil if the
+ restart was invoked, otherwise nil."
+ (restart-case
+ (signal (designated-condition 'simple-information datum arguments))
+ (noted () :report "Noted." t)))
+
+(export 'simple-information-with-location)
+(define-condition simple-information-with-location
+ (information-with-location simple-information)
+ ())
+
;;;--------------------------------------------------------------------------
;;; Reporting errors.
with-location' suitable to enclose CONDITION.")
(:method ((condition error)) 'enclosing-error-with-location)
(:method ((condition warning)) 'enclosing-warning-with-location)
+ (:method ((condition information)) 'enclosing-information-with-location)
(:method ((condition condition)) 'enclosing-condition-with-location))
(export 'make-condition-with-location)
'simple-warning-with-location
floc datum arguments)))
+(export 'info-with-location)
+(defun info-with-location (floc datum &rest arguments)
+ "Report some information with attached location information."
+ (info (apply #'make-condition-with-location
+ 'simple-information-with-location
+ floc datum arguments)))
+
(defun my-cerror (continue-string datum &rest arguments)
"Like standard `cerror', but robust against sneaky changes of conditions.
(file-location warning)
warning)
(incf warnings)
- (invoke-restart 'muffle-warning))))
+ (invoke-restart 'muffle-warning)))
+ (information (lambda (info)
+ (format *error-output* "~&~A: Info: ~A~%"
+ (file-location info)
+ info)
+ (invoke-restart 'noted))))
(values (funcall thunk)
errors
warnings)))
(setf (,to object) value))))))
;;;--------------------------------------------------------------------------
+;;; Condition and error utilities.
+
+(export 'designated-condition)
+(defun designated-condition (default-type datum arguments
+ &key allow-pointless-arguments)
+ "Return the condition designated by DATUM and ARGUMENTS.
+
+ DATUM and ARGUMENTS together are a `condition designator' of (some
+ supertype of) DEFAULT-TYPE; return the condition so designated."
+ (typecase datum
+ (condition
+ (unless (or allow-pointless-arguments (null arguments))
+ (error "Argument list provided with specific condition"))
+ datum)
+ (symbol
+ (apply #'make-condition datum arguments))
+ ((or string function)
+ (make-condition default-type
+ :format-control datum
+ :format-arguments arguments))
+ (t
+ (error "Unexpected condition designator datum ~S" datum))))
+
+;;;--------------------------------------------------------------------------
;;; CLOS hacking.
(export 'default-slot)
~mdw / sod / commitdiff