1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
(* $Id$
* ----------------------------------------------------------------------
*
*)
open Tk
open Pxp_types
open Pxp_document
open Pxp_tree_parser
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 =
Pxp_dtd_parser.parse_dtd_entity
default_config
(from_file object_dtd_sysid)
in
obj_dtd # set_root object_dtd_root;
let topframe = openTk() in
let topframe_frame = Frame.create ~borderwidth:0 topframe in
let context = new context filename obj_dtd index root topframe_frame in
Toplevel.configure ~width:(Tk.pixels (`Cm 20.0))
~height:(Tk.pixels (`Cm 12.0)) topframe;
Pack.propagate_set topframe false;
Wm.title_set topframe cmd;
pack [topframe_frame];
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();;
|
