helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/examples/xmhtml/test.ml

   1 (* $Id$ *)
   2
   3 let test_string2 = String.concat ~sep:"" [
   4   "<html>\n";
   5   "<head><title>The Gtk/XmHTML test</title></head>\n";
   6   "This is the Gtk/XmHTML test program<p>\n";
   7   "You can invoke this program with a command line argument, like this:\n";
   8   "<hr>";
   9   "<tt>./xtest filename.html</tt>";
  10   "<hr>";
  11   "Click here to load a different <a href=\"nothing\">test message</a>";
  12   "</html>";
  13 ]
  14
  15 let read_file file =
  16   let ic = open_in file in
  17   let b = Buffer.create 16384 and s = String.create 1024 and len = ref 0 in
  18   while len := input ic ~buf:s ~pos:0 ~len:1024; !len > 0 do
  19     Buffer.add_substring b s ~pos:0 ~len:!len
  20   done;
  21   Buffer.contents b
  22
  23 open GMain
  24
  25 let _ =
  26   let w = GWindow.window ~width:600 ~height:500 () in
  27   w#connect#destroy ~callback:Main.quit;
  28   let source =
  29     if Array.length Sys.argv > 1 then begin
  30       Sys.chdir (Filename.dirname Sys.argv.(1));
  31       read_file (Filename.basename Sys.argv.(1))
  32     end
  33     else test_string2 in
  34   let html = GHtml.xmhtml ~source ~packing:w#add () in
  35   html#set_anchor_buttons false;
  36   html#set_anchor_underline [`SINGLE;`DASHED];
  37   w#show ();
  38   Main.main ()