X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Fuwobo%2Fuwobo_styles.ml;h=3aa33877bfc479adaace3ef43fb357caded38262;hb=494b643b84826b1030b63fa1c224e52842a76e4b;hp=4fb2cbf31a63ab6c205493846500d89476c2f3c9;hpb=fc967a62e29b445633102bc1d65ab7645405e288;p=helm.git diff --git a/helm/uwobo/uwobo_styles.ml b/helm/uwobo/uwobo_styles.ml index 4fb2cbf31..3aa33877b 100644 --- a/helm/uwobo/uwobo_styles.ml +++ b/helm/uwobo/uwobo_styles.ml @@ -27,85 +27,59 @@ *) 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 *)