*)
open Printf;;
+open Uwobo_common;;
exception Stylesheet_not_found of string ;;
exception Stylesheet_already_in of string ;;
-type xslt_msg =
- | LibXsltErrorMsg of string
- | LibXsltDebugMsg of string
-;;
-type log = xslt_msg list ;;
-
class styles =
object (self)
(* INVARIANT: 'stylesheets' and 'uris' are in sync *)
- initializer
- Gdome_xslt.setErrorCallback
- (Some (fun msg -> self#appendMsg (LibXsltErrorMsg msg)));
- Gdome_xslt.setDebugCallback
- (Some (fun msg -> self#appendMsg (LibXsltDebugMsg msg)))
-
-
val mutable stylesheets = [] (** association list: key -> Gdome.document *)
val mutable uris = [] (** association list: key -> uri *)
- val mutable libXsltMsgs = [] (** libxslt's error and debugging messages *)
val domImpl = Gdome.domImplementation ()
(** process an XSLT stylesheet *)
method private process uri =
let dom = domImpl#createDocumentFromURI ~uri () in
- ignore (Gdome_xslt.processStylesheet dom); (* fills libXsltMsgs in case
- of errors *)
+ ignore (Gdome_xslt.processStylesheet dom); (* produce libXSLT messages in
+ case of errors *)
dom
- (* libxslt's error and debugging messages handling *)
-
- method private appendMsg msg = libXsltMsgs <- msg :: libXsltMsgs
- method private clearMsgs = libXsltMsgs <- []
-
(* stylesheets management *)
method add key uri =
if (List.mem_assoc key uris) then
raise (Stylesheet_already_in key)
else begin
- self#clearMsgs;
uris <- (key, uri) :: uris;
- stylesheets <- (key, self#process uri) :: stylesheets;
- libXsltMsgs
+ stylesheets <- (key, self#process uri) :: stylesheets
end
- method remove key : log =
+ method remove key =
if not (List.mem_assoc key uris) then
raise (Stylesheet_not_found key)
else begin
uris <- List.remove_assoc key uris;
- stylesheets <- List.remove_assoc key stylesheets;
- [] (* no XSLT action -> no logs *)
+ stylesheets <- List.remove_assoc key stylesheets
end
- method removeAll : log =
+ method removeAll =
uris <- [];
- stylesheets <- [];
- [] (* no XSLT action -> no logs *)
+ stylesheets <- []
method reload key =
(try
- self#clearMsgs;
let uri = List.assoc key uris in
stylesheets <-
- (key, self#process uri) :: (List.remove_assoc key stylesheets);
- libXsltMsgs
+ (key, self#process uri) :: (List.remove_assoc key stylesheets)
with Not_found ->
raise (Stylesheet_not_found key))
method reloadAll =
- self#clearMsgs;
- stylesheets <- List.map (fun (key, uri) -> (key, self#process uri)) uris;
- libXsltMsgs
+ stylesheets <- List.map (fun (key, uri) -> (key, self#process uri)) uris
(* stylesheets usage *)