1 files changed, 45 insertions, 0 deletions
diff --git a/ocaml-binary-annot/otherlibs/labltk/builtin/dialog.ml b/ocaml-binary-annot/otherlibs/labltk/builtin/dialog.ml
new file mode 100644
index 0000000000..e6654d8c46
--- /dev/null
+++ b/ocaml-binary-annot/otherlibs/labltk/builtin/dialog.ml
@@ -0,0 +1,45 @@
+##ifdef CAMLTK
+
+let create ?name parent title mesg bitmap def buttons =
+  let w = Widget.new_atom "toplevel" ~parent ?name in
+  let res = tkEval [|TkToken"tk_dialog";
+                     cCAMLtoTKwidget widget_any_table w;
+                     TkToken title;
+                     TkToken mesg;
+                     cCAMLtoTKbitmap bitmap;
+                     TkToken (string_of_int def);
+                     TkTokenList (List.map (function x -> TkToken x) buttons)|]
+   in
+    int_of_string res
+;;
+
+let create_named parent name title mesg bitmap def buttons =
+  let w = Widget.new_atom "toplevel" ~parent ~name in
+  let res = tkEval [|TkToken"tk_dialog";
+                     cCAMLtoTKwidget widget_any_table w;
+                     TkToken title;
+                     TkToken mesg;
+                     cCAMLtoTKbitmap bitmap;
+                     TkToken (string_of_int def);
+                     TkTokenList (List.map (function x -> TkToken x) buttons)|]
+   in
+    int_of_string res
+;;
+
+##else
+
+let create ~parent ~title ~message ~buttons ?name
+    ?(bitmap = `Predefined "") ?(default = -1) () =
+  let w = Widget.new_atom "toplevel" ?name ~parent in
+  let res = tkEval [|TkToken"tk_dialog";
+                     cCAMLtoTKwidget w;
+                     TkToken title;
+                     TkToken message;
+                     cCAMLtoTKbitmap bitmap;
+                     TkToken (string_of_int default);
+                     TkTokenList (List.map ~f:(fun x -> TkToken x) buttons)|]
+   in
+    int_of_string res
+;;
+
+##endif