]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/uwobo/src/ocaml/uwobo_engine.ml
removed .cvswrappers
[helm.git] / helm / uwobo / src / ocaml / uwobo_engine.ml
index 0bc5afcba4522a38abac2f0590a3acecee502ab3..aad4f971b8d8032bc712a447e8ea145f801837b7 100644 (file)
@@ -1,27 +1,29 @@
-
-(* Copyright (C) 2002, HELM Team.
- * 
- * This file is part of HELM, an Hypertextual, Electronic
- * Library of Mathematics, developed at the Computer Science
- * Department, University of Bologna, Italy.
- * 
- * HELM is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- * 
- * HELM is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
+(*
+ * Copyright (C) 2003:
+ *    Stefano Zacchiroli <zack@cs.unibo.it>
+ *    for the HELM Team http://helm.cs.unibo.it/
+ *
+ *  This file is part of HELM, an Hypertextual, Electronic
+ *  Library of Mathematics, developed at the Computer Science
+ *  Department, University of Bologna, Italy.
+ *
+ *  HELM is free software; you can redistribute it and/or
+ *  modify it under the terms of the GNU General Public License
+ *  as published by the Free Software Foundation; either version 2
+ *  of the License, or (at your option) any later version.
+ *
+ *  HELM is distributed in the hope that it will be useful,
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ *  GNU General Public License for more details.
+ *
+ *  You should have received a copy of the GNU General Public License
+ *  along with HELM; if not, write to the Free Software
+ *  Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ *  MA  02111-1307, USA.
  *
- * You should have received a copy of the GNU General Public License
- * along with HELM; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- * MA  02111-1307, USA.
- * 
- * For details, see the HELM World-Wide-Web page,
- * http://cs.unibo.it/helm/.
+ *  For details, see the HELM World-Wide-Web page,
+ *  http://helm.cs.unibo.it/
  *)
 
 open Printf;;
@@ -37,9 +39,21 @@ let xslNS = Gdome.domString "http://www.w3.org/1999/XSL/Transform"
 let outputS = Gdome.domString "output"
 let q_outputS = Gdome.domString "xsl:output"
 
+let default_properties = [] (* no default properties *)
+
+  (** apply an output property to an xslt stylesheet *)
+let apply_property logger (element: Gdome.element) (name, value) =
+  if Uwobo_common.is_supported_property name then begin
+    logger#log `Debug (sprintf "Setting property: %s = %s" name value);
+    element#setAttribute (Gdome.domString name) (Gdome.domString value)
+  end else
+    raise (Unsupported_property name)
+
   (** set a list of output properties in an xslt stylesheet, return a copy of
   the given stylesheet modified as needed, given stylesheet wont be changed by
-  this operation *)
+  this operation.
+  Before applying "props" properties applies a set of default properties as
+  defined in "default_properties" *)
 let apply_properties logger last_stylesheet props =
   let last_stylesheet =
     new Gdome.document_of_node (last_stylesheet#cloneNode ~deep:true)
@@ -55,17 +69,9 @@ let apply_properties logger last_stylesheet props =
         elt
     | Some node -> new Gdome.element_of_node node)
   in
-  let apply_property (name, value) =
-    if Uwobo_common.is_supported_property name then begin
-        logger#log `Debug (sprintf "Setting property: %s = %s" name value);
-        output_element#setAttribute
-          (Gdome.domString name)
-          (Gdome.domString value)
-      end
-    else
-      raise (Unsupported_property name)
-  in
-  List.iter apply_property props;
+  List.iter
+    (apply_property logger (output_element :> Gdome.element))
+    (default_properties @ props);
   last_stylesheet
 
   (** given a Gdome.document representing an XSLT stylesheet and an output
@@ -86,7 +92,8 @@ let get_property name (document: Gdome.document) =
 let apply
   ~(logger: Uwobo_logger.sysLogger)
   ~(styles: Uwobo_styles.styles)
-  ~keys ~params ~props ~input =
+  ~keys ~params ~props ~input
+  =
     (* "p_" prefix means "processed" *)
   let (p_stylesheets, last_stylesheet) = styles#get keys in
   logger#log `Debug "Creating input document ...";
@@ -99,10 +106,8 @@ let apply
           let params =
             List.map (fun (key,value) -> (key, "'" ^ value ^ "'")) (params key)
           in
-          logger#log
-            `Debug
-            (sprintf
-              "Gdome_xslt.applyStylesheet params=%s"
+          logger#log `Debug
+            (sprintf "Gdome_xslt.applyStylesheet params=%s"
               (String.concat ", " (List.map (fun (k,v) -> k^": "^v) params)));
           let res = Gdome_xslt.applyStylesheet ~source ~stylesheet ~params in
           if save_intermediate_results then begin
@@ -120,8 +125,7 @@ let apply
       input
       p_stylesheets
   in
-    (* used to retrieve serialization options *)
-  let last_stylesheet =
+  let last_stylesheet = (* used to retrieve serialization options *)
     try
       apply_properties logger last_stylesheet props
     with Unsupported_property prop ->
@@ -129,9 +133,7 @@ let apply
   in
   let p_last_stylesheet = Gdome_xslt.processStylesheet last_stylesheet in
   ((fun outchan ->                              (* serialization function *)
-      Gdome_xslt.saveResultToChannel
-        ~outchan
-        ~result
+      Gdome_xslt.saveResultToChannel ~outchan ~result
         ~stylesheet:p_last_stylesheet),
    (get_property "media-type" last_stylesheet), (* media-type *)
    (get_property "encoding" last_stylesheet))   (* encoding *)