2 * ----------------------------------------------------------------------
10 let empty_record = new element_impl (Pxp_yacc.default_extension);;
11 let empty_dnode = new data_impl Pxp_yacc.default_extension;;
13 class context the_filename the_obj_dtd the_index the_root the_topframe =
15 val filename = the_filename
16 val obj_dtd = the_obj_dtd
17 val node_index = the_index
18 val mutable obj = empty_record # create_element
19 the_obj_dtd (T_element "record") []
21 val topframe = the_topframe
22 val mutable wdg = None
24 val mutable history = ( [| |] : string array )
34 method private leave_node =
37 | Some w -> Tk.destroy w
41 method private enter_node =
42 let where = history.(index) in
44 try node_index # find where with
45 Not_found -> failwith ("Mask not found: " ^ where) in
46 let w = n # extension # create_widget topframe self in
47 Tk.pack [w] (n # extension # pack_opts @ [ Tk.Expand true] );
62 if index < Array.length history - 1 then
71 assert (index <= Array.length history);
73 let persisting_history =
74 if index < Array.length history then
75 Array.sub history 0 (index+1)
79 history <- Array.concat [ persisting_history; [| where |] ];
80 index <- Array.length history - 1;
85 if index < Array.length history then
91 (* read, write the slots of object *)
93 method search_slot name =
95 match n # node_type with
97 if n # required_string_attribute "name" = name then
101 search_list (n # sub_nodes)
110 (try search x with Not_found -> search_list l')
116 method get_slot name =
117 let d = (self # search_slot name) # data in
120 method set_slot name value =
121 let dtd = obj # dtd in
123 let n = self # search_slot name in
128 let e_string = empty_record # create_element dtd (T_element "string")
130 let dnode = empty_dnode # create_data dtd value in
131 e_string # add_node dnode;
132 e_string # local_validate();
133 obj # add_node e_string;
134 assert(self # get_slot name = value)
136 (* load, save object *)
140 if Sys.file_exists filename then begin
141 obj <- parse_content_entity
148 print_string "New file!\n";
154 let fd = open_out filename in
157 let re1 = Str.regexp "&" in
158 let re2 = Str.regexp "<" in
159 let re3 = Str.regexp "'" in
160 let re4 = Str.regexp ">" in
162 let s1 = Str.global_replace re1 "&" s in
163 let s2 = Str.global_replace re2 "<" s1 in
164 let s3 = Str.global_replace re3 "'" s2 in
165 let s4 = Str.global_replace re2 ">" s1 in
169 let rec iterate (n : 'node extension node as 'node) =
170 match n # node_type with
172 output_string fd (protect (n # data))
174 output_string fd ("<" ^ name ^ "\n");
175 let anames = n # attribute_names in
178 let aval = n # attribute aname in
182 aname ^ "='" ^ protect s ^ "'\n"
184 aname ^ "='" ^ String.concat " " (List.map protect l) ^ "'\n"
190 output_string fd ">";
191 List.iter iterate (n # sub_nodes);
192 output_string fd ("</" ^ name ^ "\n>");
197 output_string fd "<?xml version='1.0' encoding='ISO-8859-1'?>\n";
209 (* ======================================================================
213 * Revision 1.1 2000/11/17 09:57:31 lpadovan
216 * Revision 1.7 2000/08/30 15:58:49 gerd
219 * Revision 1.6 2000/07/23 20:25:05 gerd
220 * Update because of API change: local_validate.
222 * Revision 1.5 2000/07/16 19:36:03 gerd
225 * Revision 1.4 2000/07/08 22:03:11 gerd
226 * Updates because of PXP interface changes.
228 * Revision 1.3 2000/06/04 20:29:19 gerd
229 * Updates because of renamed PXP modules.
231 * Revision 1.2 2000/05/30 00:09:08 gerd
234 * Revision 1.1 1999/08/21 19:11:05 gerd