2
2
-- GtkAda - Ada95 binding for Gtk+/Gnome --
4
4
-- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet --
5
-- Copyright (C) 2000-2008, AdaCore --
6
7
-- This library is free software; you can redistribute it and/or --
7
8
-- modify it under the terms of the GNU General Public --
25
25
with System.Assertions; use System.Assertions;
26
26
with Unchecked_Deallocation;
28
with Glib.Values; use Glib.Values;
28
with Glib.Values; use Glib.Values;
30
30
package body Gtk.Handlers is
32
32
function Count_Arguments
33
(Object : access GObject_Record'Class; Signal : String)
33
(Object : access GObject_Record'Class; Signal : Glib.Signal_Name)
35
35
-- Convenience function that returns the number of arguments for this
38
38
function Do_Signal_Connect
39
(Object : Glib.Object.GObject;
41
Marshaller : System.Address;
42
Handler : System.Address;
43
Func_Data : System.Address;
44
Destroy : System.Address;
46
Slot_Object : System.Address := System.Null_Address;
39
(Object : Glib.Object.GObject;
40
Name : Glib.Signal_Name;
41
Marshaller : System.Address;
42
Handler : System.Address;
43
Func_Data : System.Address;
44
Destroy : System.Address;
46
Slot_Object : System.Address := System.Null_Address;
47
47
Expect_Return_Value : Boolean) return Handler_Id;
48
48
-- Internal function used to connect the signal.
49
49
-- Expect_Return_Value should be true if the user is connecting a function
50
50
-- to the signal, False if he is connecting a procedure
52
52
function G_Signal_Parse_Name
53
(Detailed_Signal : String;
53
(Detailed_Signal : Glib.Signal_Name;
55
55
Signal_Id_P : access Signal_Id;
56
56
Detail_P : access GQuark;
69
69
pragma Import (C, Disconnect_Internal, "g_signal_handler_disconnect");
70
70
-- Internal version of Disconnect
72
function Signal_Lookup (Name : String; IType : GType) return Signal_Id;
72
function Signal_Lookup
73
(Name : Glib.Signal_Name; IType : GType) return Signal_Id;
73
74
pragma Import (C, Signal_Lookup, "g_signal_lookup");
75
76
procedure Set_Value (Value : GValue; Val : System.Address);
101
102
---------------------
103
104
function Count_Arguments
104
(Object : access GObject_Record'Class; Signal : String)
105
(Object : access GObject_Record'Class; Signal : Glib.Signal_Name)
107
108
Q : Signal_Query;
108
109
Id : constant Signal_Id :=
109
Lookup (Get_Type (Object), Signal & ASCII.NUL);
110
Lookup (Get_Type (Object), String (Signal) & ASCII.NUL);
112
113
if Id = Invalid_Signal_Id then
122
123
-----------------------
124
125
function Do_Signal_Connect
125
(Object : Glib.Object.GObject;
127
Marshaller : System.Address;
128
Handler : System.Address;
129
Func_Data : System.Address;
130
Destroy : System.Address;
132
Slot_Object : System.Address := System.Null_Address;
126
(Object : Glib.Object.GObject;
127
Name : Glib.Signal_Name;
128
Marshaller : System.Address;
129
Handler : System.Address;
130
Func_Data : System.Address;
131
Destroy : System.Address;
133
Slot_Object : System.Address := System.Null_Address;
133
134
Expect_Return_Value : Boolean) return Handler_Id
135
136
function Internal
136
(Instance : System.Address;
140
After : Gint := 0) return Gulong;
137
(Instance : System.Address;
141
After : Gint := 0) return Gulong;
141
142
pragma Import (C, Internal, "g_signal_connect_closure_by_id");
143
144
use type System.Address;
145
Signal : aliased Signal_Id;
146
Detail : aliased GQuark;
146
Signal : aliased Signal_Id;
147
Detail : aliased GQuark;
151
152
-- When the handler is destroyed, for instance because Object is
164
165
if Success = 0 or else Signal = Invalid_Signal_Id then
165
166
Raise_Assert_Failure
166
("Trying to connect to unknown signal (""" & Name
167
("Trying to connect to unknown signal (""" & String (Name)
167
168
& """) on type " & Type_Name (Get_Type (Object)));
171
172
if Expect_Return_Value then
172
173
if Return_Type (Q) = GType_None then
173
174
Raise_Assert_Failure
174
("Handlers for """ & Name & """ on a "
175
("Handlers for """ & String (Name) & """ on a "
175
176
& Type_Name (Get_Type (Object))
176
177
& " should be procedures");
180
181
if Return_Type (Q) /= GType_None then
181
182
Raise_Assert_Failure
182
("Handlers for """ & Name & """ on a "
183
("Handlers for """ & String (Name) & """ on a "
183
184
& Type_Name (Get_Type (Object))
184
185
& " should be functions");
526
527
function Emit_By_Name
527
528
(Object : access Widget_Type'Class;
529
Name : Glib.Signal_Name;
529
530
Param : Gdk.Event.Gdk_Event) return Return_Type
531
532
procedure Internal
532
533
(Object : System.Address;
534
Name : Glib.Signal_Name;
534
535
Param : System.Address;
536
537
pragma Import (C, Internal, "ada_g_signal_emit_by_name_ptr_ptr");
866
867
function Emit_By_Name
867
868
(Object : access Widget_Type'Class;
869
Name : Glib.Signal_Name;
869
870
Param : Gdk.Event.Gdk_Event) return Return_Type
871
872
procedure Internal
872
873
(Object : System.Address;
874
Name : Glib.Signal_Name;
874
875
Param : System.Address;
876
877
pragma Import (C, Internal, "ada_g_signal_emit_by_name_ptr_ptr");
1191
1192
procedure Emit_By_Name
1192
1193
(Object : access Widget_Type'Class;
1194
Name : Glib.Signal_Name;
1194
1195
Param : Gdk.Event.Gdk_Event)
1196
1197
procedure Internal
1197
1198
(Object : System.Address;
1199
Name : Glib.Signal_Name;
1199
1200
Param : System.Address);
1200
1201
pragma Import (C, Internal, "ada_g_signal_emit_by_name_ptr");
1523
1524
procedure Emit_By_Name
1524
1525
(Object : access Widget_Type'Class;
1526
Name : Glib.Signal_Name;
1526
1527
Param : Gdk.Event.Gdk_Event)
1528
1529
procedure Internal
1529
1530
(Object : System.Address;
1531
Name : Glib.Signal_Name;
1531
1532
Param : System.Address);
1532
1533
pragma Import (C, Internal, "ada_g_signal_emit_by_name_ptr");
added
removed
src/gtk-handlers.adb
