patch

[helm.git] / helm / uwobo / uwobo_styles.ml

diff --git a/helm/uwobo/uwobo_styles.ml b/helm/uwobo/uwobo_styles.ml
index 9f954f63dda211dc3bae558aaf32dfebc746fbb2..3aa33877bfc479adaace3ef43fb357caded38262 100644 (file)
--- a/helm/uwobo/uwobo_styles.ml
+++ b/helm/uwobo/uwobo_styles.ml
@@ -27,40 +27,28 @@
  *)
 
 open Printf;;
+open Uwobo_common;;
 
-exception Stylesheet_not_found of string;;
-exception Stylesheet_already_in of string;;
+exception Stylesheet_not_found of string ;;
+exception Stylesheet_already_in of string ;;
 
 class styles =
   object (self)
     (* INVARIANT: 'stylesheets' and 'uris' are in sync *)
 
-    val mutable stylesheets = []
-    val mutable uris = []
+    val mutable stylesheets = []  (** association list: key -> Gdome.document *)
+    val mutable uris = []         (** association list: key -> uri *)
+
     val domImpl = Gdome.domImplementation ()
 
       (** process an XSLT stylesheet *)
-    method private process uri = domImpl#createDocumentFromURI ~uri ()
+    method private process uri =
+      let dom = domImpl#createDocumentFromURI ~uri () in
+      ignore (Gdome_xslt.processStylesheet dom);  (* produce libXSLT messages in
+                                                  case of errors *)
+      dom
 
-    method get keys =
-      let rev_keys = List.rev keys in
-      let last_key = List.hd rev_keys in
-      let p_stylesheets =
-        List.fold_left
-          (fun collected_styles key ->
-            let (key, stylesheet) =
-              try
-                List.find (fun (k, _) -> k = key) stylesheets
-              with Not_found -> raise (Stylesheet_not_found key)
-            in
-            (key, Gdome_xslt.processStylesheet stylesheet)::collected_styles)
-          []
-          rev_keys
-      in
-      let last_stylesheet =
-        snd (List.find (fun (k, _) -> k = last_key) stylesheets)
-      in
-      (p_stylesheets, last_stylesheet)
+    (* stylesheets management *)
 
     method add key uri =
       if (List.mem_assoc key uris) then
@@ -78,13 +66,9 @@ class styles =
         stylesheets <- List.remove_assoc key stylesheets
       end
 
-    method removeAll = uris <- []; stylesheets <- []
-
-    method list =
-      List.map
-        (fun (key, uri) ->
-          sprintf "key = %s, uri = %s" key (List.assoc key uris))
-        uris
+    method removeAll =
+      uris <- [];
+      stylesheets <- []
 
     method reload key =
       (try
@@ -97,5 +81,35 @@ class styles =
     method reloadAll =
       stylesheets <- List.map (fun (key, uri) -> (key, self#process uri)) uris
 
+    (* stylesheets usage *)
+
+    method keys = List.map fst uris
+
+    method list =
+      List.map
+        (fun (key, uri) ->
+          sprintf "key = %s, uri = %s" key (List.assoc key uris))
+        uris
+
+    method get keys =
+      let rev_keys = List.rev keys in
+      let last_key = List.hd rev_keys in
+      let p_stylesheets =
+        List.fold_left
+          (fun collected_styles key ->
+            let (key, stylesheet) =
+              try
+                List.find (fun (k, _) -> k = key) stylesheets
+              with Not_found -> raise (Stylesheet_not_found key)
+            in
+            (key, Gdome_xslt.processStylesheet stylesheet)::collected_styles)
+          []
+          rev_keys
+      in
+      let last_stylesheet =
+        snd (List.find (fun (k, _) -> k = last_key) stylesheets)
+      in
+      (p_stylesheets, last_stylesheet)
+
   end