Support for automatic stylesheet configuration retrieval started

diff --git a/helm/interface/Makefile.in b/helm/interface/Makefile.in
index 2e92fd82be5209443ca88ca55a638924640c1c54..a6e9eae908ae939e6a08b6147bbfb570c140cc71 100644 (file)
--- 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 d78e0b36101a9f0e19bd624e5236576714c05aaf..df5f61b89099b15aca9a744b7ae2bfb28c050c35 100644 (file)
--- 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 85e64117b6be0fe66366d4eaea95c811364e8617..50ec96380990cee1f16a7ed6e8c65f52754c3583 100644 (file)
--- 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 (file)
index 0000000..753a808
--- /dev/null
+++ b/helm/interface/styleConfiguration.ml
@@ -0,0 +1,85 @@
+(******************************************************************************)
+(*                                                                            *)
+(*                               PROJECT HELM                                 *)
+(*                                                                            *)
+(*                Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>               *)
+(*                                 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 3d3690f395154b8c76bd680e7700c736db3a3039..63d0c1fa592e04eb1a502e10d436c04e4379c13b 100644 (file)
--- 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;;