helm/DEVEL/pxp/pxp/examples/xmlforms/ds_app.ml

   1 (* $Id$
   2  * ----------------------------------------------------------------------
   3  *
   4  *)
   5
   6 open Tk
   7 open Pxp_types
   8 open Pxp_document
   9 open Pxp_yacc
  10 open Ds_context
  11 open Ds_style
  12
  13
  14 let installdir       =
  15   try Sys.getenv "DATASHEETS" with
  16       Not_found -> "/opt/xmlforms/lib"
  17 let style_sysid      = ref ""
  18 let object_dtd_sysid = Filename.concat installdir "ds-object.dtd"
  19 let object_dtd_root  = "record"
  20
  21
  22 let rec print_error e =
  23   print_endline (string_of_exn e)
  24 ;;
  25
  26
  27 let run f arg1 arg2 =
  28   try f arg1 arg2 with
  29       e -> print_error e
  30 ;;
  31
  32
  33 let edit filename cmd =
  34   (* read in style definition *)
  35   let index = new hash_index in
  36   let style =
  37     parse_document_entity
  38       ~id_index:(index :> 'ext index)
  39       default_config
  40       (from_file !style_sysid)
  41       tag_map
  42   in
  43   let root = style # root in
  44   root # extension # prepare (index :> 'ext index);
  45
  46   let obj_dtd =
  47     parse_dtd_entity
  48       default_config
  49       (from_file object_dtd_sysid)
  50   in
  51   obj_dtd # set_root object_dtd_root;
  52
  53   let topframe = openTk() in
  54   let context = new context filename obj_dtd index root topframe in
  55
  56   Toplevel.configure topframe [ Width (Centimeters 20.0);
  57                                 Height (Centimeters 12.0);
  58                               ];
  59   Pack.propagate_set topframe false;
  60   Wm.title_set topframe cmd;
  61   context # goto (root # extension # start_node_name);
  62   mainLoop()
  63 ;;
  64
  65
  66 let main() =
  67   let cmd = Filename.basename Sys.argv.(0) in
  68   match Sys.argv with
  69       [| _; filename |] ->
  70         style_sysid := Filename.concat installdir (cmd ^ "-style.xml");
  71         run edit filename cmd
  72     | _ ->
  73         prerr_endline ("usage: " ^ cmd ^ " filename");
  74         exit(1)
  75 ;;
  76
  77 main();;
  78
  79 (* ======================================================================
  80  * History:
  81  *
  82  * $Log$
  83  * Revision 1.1  2000/11/17 09:57:32  lpadovan
  84  * Initial revision
  85  *
  86  * Revision 1.6  2000/07/16 19:36:03  gerd
  87  *      Updated.
  88  *
  89  * Revision 1.5  2000/07/08 22:03:11  gerd
  90  *      Updates because of PXP interface changes.
  91  *
  92  * Revision 1.4  2000/06/04 20:29:19  gerd
  93  *      Updates because of renamed PXP modules.
  94  *
  95  * Revision 1.3  2000/05/01 16:48:45  gerd
  96  *      Using the new error formatter.
  97  *
  98  * Revision 1.2  1999/12/17 21:34:29  gerd
  99  *      The name of the root element is set to "record" in the
 100  * object_dtd; otherwise the parser would not check that the root
 101  * element is the right element.
 102  *
 103  * Revision 1.1  1999/08/21 19:11:05  gerd
 104  *      Initial revision.
 105  *
 106  *
 107  *)