X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Fpxp%2Fpxp%2Fexamples%2Fxmlforms%2Fds_app.ml;fp=helm%2FDEVEL%2Fpxp%2Fpxp%2Fexamples%2Fxmlforms%2Fds_app.ml;h=55589ea59b7b0e3726018cd2f622e7c96d537554;hb=c03d2c1fdab8d228cb88aaba5ca0f556318bebc5;hp=0000000000000000000000000000000000000000;hpb=758057e85325f94cd88583feb1fdf6b038e35055;p=helm.git

diff --git a/helm/DEVEL/pxp/pxp/examples/xmlforms/ds_app.ml b/helm/DEVEL/pxp/pxp/examples/xmlforms/ds_app.ml
new file mode 100644
index 000000000..55589ea59
--- /dev/null
+++ b/helm/DEVEL/pxp/pxp/examples/xmlforms/ds_app.ml
@@ -0,0 +1,107 @@
+(* $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.
+ *
+ *
+ *)