(* $Id$ * ---------------------------------------------------------------------- * *) open Tk open Pxp_types open Pxp_document open Pxp_yacc open Ds_context open Ds_style let installdir = try Sys.getenv "DATASHEETS" with Not_found -> "/opt/xmlforms/lib" let style_sysid = ref "" let object_dtd_sysid = Filename.concat installdir "ds-object.dtd" let object_dtd_root = "record" let rec print_error e = print_endline (string_of_exn e) ;; let run f arg1 arg2 = try f arg1 arg2 with e -> print_error e ;; let edit filename cmd = (* read in style definition *) let index = new hash_index in let style = parse_document_entity ~id_index:(index :> 'ext index) default_config (from_file !style_sysid) tag_map in let root = style # root in root # extension # prepare (index :> 'ext index); let obj_dtd = parse_dtd_entity default_config (from_file object_dtd_sysid) in obj_dtd # set_root object_dtd_root; let topframe = openTk() in let context = new context filename obj_dtd index root topframe in Toplevel.configure topframe [ Width (Centimeters 20.0); Height (Centimeters 12.0); ]; Pack.propagate_set topframe false; Wm.title_set topframe cmd; context # goto (root # extension # start_node_name); mainLoop() ;; let main() = let cmd = Filename.basename Sys.argv.(0) in match Sys.argv with [| _; filename |] -> style_sysid := Filename.concat installdir (cmd ^ "-style.xml"); run edit filename cmd | _ -> prerr_endline ("usage: " ^ cmd ^ " filename"); exit(1) ;; main();; (* ====================================================================== * History: * * $Log$ * Revision 1.1 2000/11/17 09:57:32 lpadovan * Initial revision * * Revision 1.6 2000/07/16 19:36:03 gerd * Updated. * * Revision 1.5 2000/07/08 22:03:11 gerd * Updates because of PXP interface changes. * * Revision 1.4 2000/06/04 20:29:19 gerd * Updates because of renamed PXP modules. * * Revision 1.3 2000/05/01 16:48:45 gerd * Using the new error formatter. * * Revision 1.2 1999/12/17 21:34:29 gerd * The name of the root element is set to "record" in the * object_dtd; otherwise the parser would not check that the root * element is the right element. * * Revision 1.1 1999/08/21 19:11:05 gerd * Initial revision. * * *)