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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
with Ada.Text_IO; use Ada.Text_IO;
with Glib; use Glib;
with Gtk.Window; use Gtk.Window;
with Gtk.Main; use Gtk.Main;
with Gtk.Enums; use Gtk.Enums;
with Gtk.Button; use Gtk.Button;
with Gtk.Box; use Gtk.Box;
with Gtk.Handlers; use Gtk.Handlers;
with Gtkada.Handlers; use Gtkada.Handlers;
with Gtk.Widget; use Gtk.Widget;
procedure Test_Handlers is
type My_Data3 is record
Button : Gtk_Widget;
Object : Gtk_Widget;
Id : Handler_Id;
end record;
type My_Data3_Access is access My_Data3;
package User_Callback is new Gtk.Handlers.User_Callback
(Gtk_Widget_Record, Gtk_Widget);
package User_Callback3 is new Gtk.Handlers.User_Callback
(Gtk_Widget_Record, My_Data3_Access);
procedure My_Destroy (Button : access Gtk_Widget_Record'Class) is
begin
Put_Line ("My_Destroy");
Destroy (Button);
end My_Destroy;
procedure My_Destroy2
(Button : access Gtk_Widget_Record'Class;
Data : Gtk_Widget) is
begin
Put_Line ("My_Destroy2");
Destroy (Data);
end My_Destroy2;
procedure My_Destroy3
(Button : access Gtk_Widget_Record'Class;
Data : My_Data3_Access) is
begin
Put_Line ("My_Destroy3");
Destroy (Data.Button);
Disconnect (Data.Object, Data.Id);
end My_Destroy3;
Win : Gtk_Window;
Button1, Button2 : Gtk_Button;
Vbox, Hbox : Gtk_Box;
Id : Handler_Id;
Data3 : My_Data3_Access;
begin
Gtk.Main.Init;
Gtk_New (Win, Window_Toplevel);
Gtk_New_Vbox (Vbox);
Add (Win, Vbox);
-- Using object_connect.
-- The callback is automatically destroyed when button2 is destroyed, so
-- you can press button1 as many times as you want, no problem
Gtk_New_Hbox (Hbox);
Pack_Start (Vbox, Hbox);
Gtk_New (Button1, "button1, object connect");
Pack_Start (Hbox, Button1);
Gtk_New (Button2, "button2");
Pack_Start (Hbox, Button2);
Widget_Callback.Object_Connect
(Button1, "clicked",
Widget_Callback.To_Marshaller (My_Destroy'Unrestricted_Access),
Button2);
-- Using user callback.
-- The callback is not destroyed when Button2 is destroyed. As a result,
-- the second time you press button1, you get a critical error.
Gtk_New_Hbox (Hbox);
Pack_Start (Vbox, Hbox);
Gtk_New (Button1, "button1, user data (will crash)");
Pack_Start (Hbox, Button1);
Gtk_New (Button2, "button2");
Pack_Start (Hbox, Button2);
Id := User_Callback.Connect
(Button1, "clicked",
User_Callback.To_Marshaller (My_Destroy2'Unrestricted_Access),
Gtk_Widget (Button2));
-- Using user callback, with complex protection
-- Note that memory allocated for Data3 is not freed.
-- The callback makes sure that the callback is properly unregistered, but
-- is heavy to put in place
Gtk_New_Hbox (Hbox);
Pack_Start (Vbox, Hbox);
Gtk_New (Button1, "button1, protected user data");
Pack_Start (Hbox, Button1);
Gtk_New (Button2, "button2");
Pack_Start (Hbox, Button2);
Data3 := new My_Data3'(Object => Gtk_Widget (Button1),
Button => Gtk_Widget (Button2),
Id => (Null_Handler_Id, null));
Id := User_Callback3.Connect
(Button1, "clicked",
User_Callback3.To_Marshaller (My_Destroy3'Unrestricted_Access),
Data3);
Data3.Id := Id;
-- Using user callback, simple protection.
-- This is the same example as 2, but we automatically register the fact
-- that when button2 is destroyed, the callback should also be destroyed.
Gtk_New_Hbox (Hbox);
Pack_Start (Vbox, Hbox);
Gtk_New (Button1, "button1, watch user data");
Pack_Start (Hbox, Button1);
Gtk_New (Button2, "button2");
Pack_Start (Hbox, Button2);
Id := User_Callback.Connect
(Button1, "clicked",
User_Callback.To_Marshaller (My_Destroy2'Unrestricted_Access),
Gtk_Widget (Button2));
Add_Watch (Id, Button2);
Show_All (Win);
Gtk.Main.Main;
end Test_Handlers;
|
