]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/uwobo/uwobo_styles.ml
- redesigned error and warning handling for libxslt
[helm.git] / helm / uwobo / uwobo_styles.ml
index 4fb2cbf31a63ab6c205493846500d89476c2f3c9..3aa33877bfc479adaace3ef43fb357caded38262 100644 (file)
  *)
 
 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 *)