1 (***********************************************************************)
3 (* MLTk, Tcl/Tk interface of Objective Caml *)
5 (* Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis *)
6 (* projet Cristal, INRIA Rocquencourt *)
7 (* Jacques Garrigue, Kyoto University RIMS *)
9 (* Copyright 2002 Institut National de Recherche en Informatique et *)
10 (* en Automatique and Kyoto University. All rights reserved. *)
11 (* This file is distributed under the terms of the GNU Library *)
12 (* General Public License, with the special exception on linking *)
13 (* described in file LICENSE found in the Objective Caml source tree. *)
15 (***********************************************************************)
21 let version = "$Id: frx_lbutton.ml 4745 2002-04-26 12:16:26Z furuse $"
24 * Simulate a button with a bitmap AND a label
27 let rec sort_options but lab com = function
29 |(Command f as o)::l -> sort_options (o::but) lab com l
30 |(Bitmap b as o)::l -> sort_options (o::but) lab com l
31 |(Text t as o)::l -> sort_options but (o::lab) com l
32 |o::l -> sort_options but lab (o::com) l
34 let create parent options =
35 let but,lab,com = sort_options [] [] [] options in
36 let f = Frame.create parent com in
37 let b = Button.create f (but@com)
38 and l = Label.create f (lab@com) in
40 bind l [[],ButtonPressDetail 1] (BindSet ([],(function _ -> Button.invoke b)));
43 let configure f options =
44 let but,lab,com = sort_options [] [] [] options in
45 match Pack.slaves f with
47 Frame.configure f com;
48 Button.configure b (but@com);
49 Label.configure l (lab@com)
50 | _ -> raise (Invalid_argument "lbutton configure")