l4/pkg/ocaml/contrib/otherlibs/labltk/builtin/dialog.ml

   1 ##ifdef CAMLTK
   2
   3 let create ?name parent title mesg bitmap def buttons =
   4   let w = Widget.new_atom "toplevel" ~parent ?name in
   5   let res = tkEval [|TkToken"tk_dialog";
   6                      cCAMLtoTKwidget widget_any_table w;
   7                      TkToken title;
   8                      TkToken mesg;
   9                      cCAMLtoTKbitmap bitmap;
  10                      TkToken (string_of_int def);
  11                      TkTokenList (List.map (function x -> TkToken x) buttons)|]
  12    in
  13     int_of_string res
  14 ;;
  15
  16 let create_named parent name title mesg bitmap def buttons =
  17   let w = Widget.new_atom "toplevel" ~parent ~name in
  18   let res = tkEval [|TkToken"tk_dialog";
  19                      cCAMLtoTKwidget widget_any_table w;
  20                      TkToken title;
  21                      TkToken mesg;
  22                      cCAMLtoTKbitmap bitmap;
  23                      TkToken (string_of_int def);
  24                      TkTokenList (List.map (function x -> TkToken x) buttons)|]
  25    in
  26     int_of_string res
  27 ;;
  28
  29 ##else
  30
  31 let create ~parent ~title ~message ~buttons ?name
  32     ?(bitmap = `Predefined "") ?(default = -1) () =
  33   let w = Widget.new_atom "toplevel" ?name ~parent in
  34   let res = tkEval [|TkToken"tk_dialog";
  35                      cCAMLtoTKwidget w;
  36                      TkToken title;
  37                      TkToken message;
  38                      cCAMLtoTKbitmap bitmap;
  39                      TkToken (string_of_int default);
  40                      TkTokenList (List.map ~f:(fun x -> TkToken x) buttons)|]
  41    in
  42     int_of_string res
  43 ;;
  44
  45 ##endif