From: Luca Padovani Date: Tue, 6 Feb 2001 16:06:55 +0000 (+0000) Subject: Support for automatic stylesheet configuration retrieval started X-Git-Tag: v0_1_2~132 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=dd2af791135cedf4e558ff8629ceca044a0d11d3;p=helm.git Support for automatic stylesheet configuration retrieval started --- diff --git a/helm/interface/Makefile.in b/helm/interface/Makefile.in index 2e92fd82b..a6e9eae90 100644 --- a/helm/interface/Makefile.in +++ b/helm/interface/Makefile.in @@ -36,7 +36,7 @@ DEPOBJS = experiment.ml cicCache.ml cicCache.mli cicPp.ml cicPp.mli \ cicCooking.ml cicCooking.mli cicFindParameters.ml theoryCache.ml \ fix_params.ml cic2Xml.ml xml.ml uriManager.ml uriManager.mli \ cicSubstitution.ml cicSubstitution.mli \ - mmlinterface.ml configuration.ml \ + mmlinterface.ml configuration.ml styleConfiguration.ml \ xsltProcessor.ml deannotate.ml cicXPath.ml pxpUriResolver.ml \ annotationParser.ml annotationParser2.ml annotation2Xml.ml \ cicAnnotationHinter.ml diff --git a/helm/interface/configuration.ml.in b/helm/interface/configuration.ml.in index d78e0b361..df5f61b89 100644 --- a/helm/interface/configuration.ml.in +++ b/helm/interface/configuration.ml.in @@ -72,8 +72,19 @@ let _ = ((xml_document ())#root#sub_nodes) ;; +(* try to read a configuration variable, given its name into the + * configuration.xml file and its name into the shell environment. + * The shell variable, if present, has precedence over configuration.xml + *) +let read_configuration_var xml_name env_name = + try + Sys.getenv env_name + with + Not_found -> Hashtbl.find vars xml_name + let helm_dir = Hashtbl.find vars "helm_dir";; let dtd_dir = Hashtbl.find vars "dtd_dir";; +let style_dir = read_configuration_var "style_dir" "HELM_STYLE_DIR";; let servers_file = Hashtbl.find vars "servers_file";; let uris_dbm = Hashtbl.find vars "uris_dbm";; let dest = Hashtbl.find vars "dest";; @@ -81,5 +92,6 @@ let indexname = Hashtbl.find vars "indexname";; let tmpdir = Hashtbl.find vars "tmpdir";; let helm_dir = Hashtbl.find vars "helm_dir";; let getter_url = Hashtbl.find vars "getter_url";; +let processor_url = read_configuration_var "processor_url" "HELM_PROCESSOR_URL" let _ = Hashtbl.clear vars;; diff --git a/helm/interface/getter.ml b/helm/interface/getter.ml index 85e64117b..50ec96380 100644 --- a/helm/interface/getter.ml +++ b/helm/interface/getter.ml @@ -145,6 +145,10 @@ let get_file uri = fn ;; +let raw_get uri = + let msg = new Http_client.get uri in + msg#get_req_body + (* get : uri -> filename *) (* If uri is the URI of an annotation, the annotated object is processed *) let get uri = diff --git a/helm/interface/styleConfiguration.ml b/helm/interface/styleConfiguration.ml new file mode 100644 index 000000000..753a808ea --- /dev/null +++ b/helm/interface/styleConfiguration.ml @@ -0,0 +1,85 @@ +(******************************************************************************) +(* *) +(* PROJECT HELM *) +(* *) +(* Claudio Sacerdoti Coen *) +(* 28/12/2000 *) +(* *) +(* This is the parser that reads the configuration file of helm *) +(* *) +(******************************************************************************) + +let filename = + try + Sys.getenv "HELM_STYLECONFIGURATION_PATH" + with + Not_found -> + let tmp_filename = C.tmpdir ^ "/style-configuration.xml" in + if Sys.file_exists tmp_filename then tmp_filename + else begin + let styleconf = Getter.raw_get "getstyleconf" in + let out_channel = open_out tmp_filename in + output_string out_channel styleconf; + close_out out_channel; + tmp_filename + end + +exception Warnings;; + +class warner = + object + method warn w = + print_endline ("WARNING: " ^ w) ; + (raise Warnings : unit) + end +;; + +let xml_document () = + let module Y = Pxp_yacc in + try + let config = {Y.default_config with Y.warner = new warner} in + Y.parse_document_entity config (Y.from_file filename) Y.default_spec + with + e -> + print_endline (Pxp_types.string_of_exn e) ; + raise e +;; + +exception Impossible;; + +let styles = Hashtbl.create 13;; +let applies = Hashtbl.create 13;; + +(* we trust the xml file to be valid because of the validating xml parser *) +let _ = + List.iter + (function + n -> + match n#node_type with + Pxp_document.T_element "style" -> + let key = + try + n#attribute "key" + with + Not_found -> n#data + Hashtbl.add styles key n#data + | Pxp_document.T_element "apply" -> + let keys = List.map + (function n -> + match n#node_type with + Pxp_document.T_element "style-ref" -> n#attribute "key" + | _ -> raise Impossible + ) + n#sub_nodes + in + Hashtbl.add applies (n#attribute "name") keys + | _ -> raise Impossible + ) + ((xml_document ())#root#sub_nodes) +;; + +let style_of_key key = + Hashtbl.lookup styles key + +let key_list_of_mode_name name = + Hashtbl.lookup applies name diff --git a/helm/interface/xsltProcessor.ml b/helm/interface/xsltProcessor.ml index 3d3690f39..63d0c1fa5 100644 --- a/helm/interface/xsltProcessor.ml +++ b/helm/interface/xsltProcessor.ml @@ -26,6 +26,12 @@ exception XsltProcessorCouldNotSend;; exception XsltProcessorCouldNotReceive;; +let initialize l = + List.iter + (function (name,key) -> + client_add (Configuration.getter_url ^ "getxslt?uri=" ^ name ^ "?key=" ^ key) + ) + let portserver = 12345;; let portclient = 12346;; let time_to_wait = 10;;