+++ /dev/null
-(******************************************************************************)
-(* *)
-(* 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 xml = "style-configuration.xml" in
- let tmp_xml = Configuration.tmp_dir ^ "/" ^ xml in
- let request_xml = Configuration.getter_url ^ "getstyleconf?uri=" ^ xml in
- ClientHTTP.get_and_save request_xml tmp_xml ;
- tmp_xml
-
-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 (PxpUriResolver.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
- match n#attribute "key" with
- Pxp_types.Value s -> s
- | _ -> raise Impossible
- with
- Not_found -> n#data
- in
- 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" ->
- begin
- match n#attribute "key" with
- Pxp_types.Value s -> s
- | _ -> raise Impossible
- end
- | _ -> raise Impossible
- )
- n#sub_nodes
- in
- let apply_name =
- match n#attribute "name" with
- Pxp_types.Value s -> s
- | _ -> raise Impossible
- in Hashtbl.add applies apply_name keys
- | _ -> raise Impossible
- )
- ((xml_document ())#root#sub_nodes)
-;;
-
-let style_of_key key =
- Hashtbl.find styles key
-
-let key_list_of_mode_name name =
- Hashtbl.find applies name
-;;
-