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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
(* $Id: ds_app.ml,v 1.7 2001/07/02 22:50:43 gerd Exp $
* ----------------------------------------------------------------------
*
*)
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 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();;
(* ======================================================================
* History:
*
* $Log: ds_app.ml,v $
* Revision 1.7 2001/07/02 22:50:43 gerd
* Ported from camltk to labltk.
*
* 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.
*
*
*)
|
