Simnple Error Handling Function.

[ajb@kerri.oz.au (Anthony Berglas)]

Here is a simple error handling macro, adapted from
wfs and David Cogen.   I am posting it as it seams
likely that others will want something similar.

;;; Basic Error Handliing Function for KCL.
;;; wfs@cs.utexas.edu has a much more complicated one from which this
;;; was cut that allows stacked error handlers that cope with
;;; different conditions, and does not call any of them if none match.
;;;
;;; ajb@kerri.iti.oz  March 1990
;;;

(In-Package 'UE)
(Provide 'Ute-Err)
(Export '(Eval-Without-Error Error-Occured))

(Defmacro Eval-Without-Error 
          (Body &Optional (Error-Function '#'Simple-Error-Fn))
"Evaluates BODY and returns its result.  If an error occurs Applys
ERROR-FUNCTION to the same parameters as si::Universal-Error-Handler
and returns its result, the default error-function simply prints a
message and returns ERROR-OCCURED." 
   `(Block No-Error
       (Let ((Hold-Universal-Error-Handler
	         #'Si::Universal-Error-Handler))
	  (Apply ,Error-Function
	     (Catch 'An-Error
		 (Unwind-Protect
		    (Progn
			(Setf (Symbol-Function 'Si::Universal-Error-Handler)
			      #'Our-Universal-Error-Handler)
			(RETURN-FROM No-Error ,BODY))
		    (Setf (Symbol-Function 'Si::Universal-Error-Handler)
			  Hold-Universal-Error-Handler)))) )))


(Defun Simple-Error-Fn
          (Name Correctable Function Cont-Format Error-Format &Rest Args)  
   (Format *Error-Output*
      (Format Nil "~%(Trapped Error ~S,~
          ~:[~*~;~%   If Continued ~S,~]~%   Error ~S"
	      Name Correctable Cont-Format Error-Format)
      Args) ; Yes, the blody Args are joined together for Cont and Error!!!
   'Error-Occured)


(Defun Our-Universal-Error-Handler (&Rest Args)
  (Throw 'An-Error Args))

;;;; --- End ---

Anthony.