1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
(**************************************************************************)
(* Lablgtk - Examples *)
(* *)
(* This code is in the public domain. *)
(* You may freely copy parts of it in your application. *)
(* *)
(**************************************************************************)
module C = Gobject.Closure
let add_closure argv =
Printf.eprintf "invoking overridden ::add closure, %d args, " argv.C.nargs ;
let typ = C.get_type argv 1 in
Printf.eprintf "widget %s\n" (Gobject.Type.name typ) ;
flush stderr ;
GtkSignal.chain_from_overridden argv
let derived_frame_name = "GtkFrameCaml"
let derived_frame_gtype =
lazy begin
let parent = Gobject.Type.from_name "GtkFrame" in
let t = Gobject.Type.register_static ~parent ~name:derived_frame_name in
GtkSignal.override_class_closure GtkContainers.Container.S.add t
(C.create add_closure) ;
t
end
let create_derived_frame =
GtkBin.Frame.make_params []
~cont:(fun pl ->
GContainer.pack_container pl
~create:(fun pl ->
ignore (Lazy.force derived_frame_gtype) ;
new GBin.frame (GtkObject.make derived_frame_name pl : Gtk.frame Gtk.obj)))
let main =
GMain.init ();
let w = GWindow.window ~title:"Overriding signals demo" () in
w#connect#destroy GMain.quit ;
let f = create_derived_frame ~label:"Talking frame" ~packing:w#add () in
let l = GMisc.label ~markup:"This is the <b>GtkFrame</b>'s content" ~packing:f#add () in
w#show () ;
GMain.main ()
|
