X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fuwobo%2Fsrc%2Focaml%2Fuwobo_engine.ml;fp=helm%2Fuwobo%2Fsrc%2Focaml%2Fuwobo_engine.ml;h=0000000000000000000000000000000000000000;hb=869549224eef6278a48c16ae27dd786376082b38;hp=75e4669bf0d0ac251bd0d959c0cc8dc2930e7890;hpb=89262281b6e83bd2321150f81f1a0583645eb0c8;p=helm.git diff --git a/helm/uwobo/src/ocaml/uwobo_engine.ml b/helm/uwobo/src/ocaml/uwobo_engine.ml deleted file mode 100644 index 75e4669bf..000000000 --- a/helm/uwobo/src/ocaml/uwobo_engine.ml +++ /dev/null @@ -1,123 +0,0 @@ - -(* 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. - * - * 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/. - *) - -open Printf;; -open Uwobo_common;; - -exception Unsupported_property of string;; - -let xslNS = Gdome.domString "http://www.w3.org/1999/XSL/Transform" -let outputS = Gdome.domString "output" -let q_outputS = Gdome.domString "xsl:output" - - (** 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 *) -let apply_properties logger last_stylesheet props = - let last_stylesheet = - new Gdome.document_of_node (last_stylesheet#cloneNode ~deep:true) - in - let output_element = - let node_list = last_stylesheet#getElementsByTagNameNS xslNS outputS in - (match node_list#item 0 with - | None -> (* no xsl:output element, create it from scratch *) - logger#log `Debug "Creating xsl:output node ..."; - let elt = last_stylesheet#createElementNS (Some xslNS) q_outputS in - let root = last_stylesheet#get_documentElement in - ignore (root#appendChild (elt :> Gdome.node)); - 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; - last_stylesheet - - (** given a Gdome.document representing an XSLT stylesheet and an output - property return 'Some value' where 'value' is the property value, or None if - it's not defined *) -let get_property name (document: Gdome.document) = - let node_list = document#getElementsByTagNameNS xslNS outputS in - match node_list#item 0 with - | None -> None - | Some node -> - let element = new Gdome.element_of_node node in - let domName = Gdome.domString name in - if element#hasAttribute domName then - Some (element#getAttribute domName)#to_string - else - None - -let apply - ~(logger: Uwobo_logger.sysLogger) - ~(styles: Uwobo_styles.styles) - ~keys ~params ~props ~input = - (* "p_" prefix means "processed" *) - let (p_stylesheets, last_stylesheet) = styles#get keys in - logger#log `Debug "Creating input document ..."; - let result = (* Gdome.document *) - List.fold_left - (fun source (key, stylesheet) -> - logger#log `Debug (sprintf "Applying stylesheet %s ..." key); - try - let params = - List.map (fun (key,value) -> (key, "'" ^ value ^ "'")) (params key) - in - 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 - res - with e -> raise (Uwobo_failure (Printexc.to_string e))) - input - p_stylesheets - in - (* used to retrieve serialization options *) - let last_stylesheet = - try - apply_properties logger last_stylesheet props - with Unsupported_property prop -> - raise (Uwobo_failure (sprintf "Unsupported property: %s" prop)) - in - let p_last_stylesheet = Gdome_xslt.processStylesheet last_stylesheet in - ((fun outchan -> (* serialization function *) - Gdome_xslt.saveResultToChannel - ~outchan - ~result - ~stylesheet:p_last_stylesheet), - (get_property "media-type" last_stylesheet), (* media-type *) - (get_property "encoding" last_stylesheet)) (* encoding *) -