+ (** {2 LibXSLT logging} *)
+
+type xslt_msg =
+ | LibXsltErrorMsg of string
+ | LibXsltDebugMsg of string
+;;
+
+let string_of_xslt_msg = function
+ | LibXsltErrorMsg msg -> "LibXSLT ERROR: " ^ msg
+ | LibXsltDebugMsg msg -> "LibXSLT DEBUG: " ^ msg
+;;
+
+type xslt_msg_mode =
+ | LibXsltMsgIgnore
+ | LibXsltMsgComment
+ | LibXsltMsgEmbed
+;;
+
+class libXsltLogger =
+ let is_libxslt_error = function LibXsltErrorMsg _ -> true | _ -> false in
+ let is_libxslt_debug = function LibXsltDebugMsg _ -> true | _ -> false in
+ let flatten_libxslt_msg = function
+ | LibXsltErrorMsg msg -> msg
+ | LibXsltDebugMsg msg -> msg
+ in
+ object (self)
+
+ initializer
+ Gdome_xslt.setErrorCallback
+ (Some (fun msg -> self#appendMsg (LibXsltErrorMsg msg)));
+ Gdome_xslt.setDebugCallback
+ (Some (fun msg -> self#appendMsg (LibXsltDebugMsg msg)))
+
+ val mutable libXsltMsgs = [] (** libxslt's error and debugging messages *)
+
+ (* libxslt's error and debugging messages handling *)
+
+ method private appendMsg msg = libXsltMsgs <- msg :: libXsltMsgs
+
+ method clearMsgs = libXsltMsgs <- []
+ method clearErrorMsgs =
+ libXsltMsgs <- List.filter is_libxslt_debug libXsltMsgs
+ method clearDebugMsgs =
+ libXsltMsgs <- List.filter is_libxslt_error libXsltMsgs
+
+ method msgs = libXsltMsgs
+ method errorMsgs =
+ List.map flatten_libxslt_msg (List.filter is_libxslt_error libXsltMsgs)
+ method debugMsgs =
+ List.map flatten_libxslt_msg (List.filter is_libxslt_debug libXsltMsgs)
+
+ end
+;;