1------------------------------------------------------------------------------
2--                                                                          --
3--      Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet       --
4--                     Copyright (C) 2000-2015, AdaCore                     --
5--                                                                          --
6-- This library is free software;  you can redistribute it and/or modify it --
7-- under terms of the  GNU General Public License  as published by the Free --
8-- Software  Foundation;  either version 3,  or (at your  option) any later --
9-- version. This library is distributed in the hope that it will be useful, --
10-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
11-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
12--                                                                          --
13-- As a special exception under Section 7 of GPL version 3, you are granted --
14-- additional permissions described in the GCC Runtime Library Exception,   --
15-- version 3.1, as published by the Free Software Foundation.               --
16--                                                                          --
17-- You should have received a copy of the GNU General Public License and    --
18-- a copy of the GCC Runtime Library Exception along with this program;     --
19-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
20-- <http://www.gnu.org/licenses/>.                                          --
21--                                                                          --
22------------------------------------------------------------------------------
23
24pragma Style_Checks (Off);
25pragma Warnings (Off, "*is already use-visible*");
26with Ada.Unchecked_Conversion;
27with Glib.Type_Conversion_Hooks; use Glib.Type_Conversion_Hooks;
28with Glib.Values;                use Glib.Values;
29with Gtk.Arguments;              use Gtk.Arguments;
30with Gtkada.Bindings;            use Gtkada.Bindings;
31pragma Warnings(Off);  --  might be unused
32with Interfaces.C.Strings;       use Interfaces.C.Strings;
33pragma Warnings(On);
34
35package body Gtk.Radio_Action is
36
37   package Type_Conversion_Gtk_Radio_Action is new Glib.Type_Conversion_Hooks.Hook_Registrator
38     (Get_Type'Access, Gtk_Radio_Action_Record);
39   pragma Unreferenced (Type_Conversion_Gtk_Radio_Action);
40
41   -------------
42   -- Gtk_New --
43   -------------
44
45   procedure Gtk_New
46      (Action   : out Gtk_Radio_Action;
47       Name     : UTF8_String;
48       Label    : UTF8_String := "";
49       Tooltip  : UTF8_String := "";
50       Stock_Id : UTF8_String := "";
51       Value    : Gint)
52   is
53   begin
54      Action := new Gtk_Radio_Action_Record;
55      Gtk.Radio_Action.Initialize (Action, Name, Label, Tooltip, Stock_Id, Value);
56   end Gtk_New;
57
58   --------------------------
59   -- Gtk_Radio_Action_New --
60   --------------------------
61
62   function Gtk_Radio_Action_New
63      (Name     : UTF8_String;
64       Label    : UTF8_String := "";
65       Tooltip  : UTF8_String := "";
66       Stock_Id : UTF8_String := "";
67       Value    : Gint) return Gtk_Radio_Action
68   is
69      Action : constant Gtk_Radio_Action := new Gtk_Radio_Action_Record;
70   begin
71      Gtk.Radio_Action.Initialize (Action, Name, Label, Tooltip, Stock_Id, Value);
72      return Action;
73   end Gtk_Radio_Action_New;
74
75   ----------------
76   -- Initialize --
77   ----------------
78
79   procedure Initialize
80      (Action   : not null access Gtk_Radio_Action_Record'Class;
81       Name     : UTF8_String;
82       Label    : UTF8_String := "";
83       Tooltip  : UTF8_String := "";
84       Stock_Id : UTF8_String := "";
85       Value    : Gint)
86   is
87      function Internal
88         (Name     : Interfaces.C.Strings.chars_ptr;
89          Label    : Interfaces.C.Strings.chars_ptr;
90          Tooltip  : Interfaces.C.Strings.chars_ptr;
91          Stock_Id : Interfaces.C.Strings.chars_ptr;
92          Value    : Gint) return System.Address;
93      pragma Import (C, Internal, "gtk_radio_action_new");
94      Tmp_Name     : Interfaces.C.Strings.chars_ptr := New_String (Name);
95      Tmp_Label    : Interfaces.C.Strings.chars_ptr;
96      Tmp_Tooltip  : Interfaces.C.Strings.chars_ptr;
97      Tmp_Stock_Id : Interfaces.C.Strings.chars_ptr;
98      Tmp_Return   : System.Address;
99   begin
100      if not Action.Is_Created then
101         if Label = "" then
102            Tmp_Label := Interfaces.C.Strings.Null_Ptr;
103         else
104            Tmp_Label := New_String (Label);
105         end if;
106         if Tooltip = "" then
107            Tmp_Tooltip := Interfaces.C.Strings.Null_Ptr;
108         else
109            Tmp_Tooltip := New_String (Tooltip);
110         end if;
111         if Stock_Id = "" then
112            Tmp_Stock_Id := Interfaces.C.Strings.Null_Ptr;
113         else
114            Tmp_Stock_Id := New_String (Stock_Id);
115         end if;
116         Tmp_Return := Internal (Tmp_Name, Tmp_Label, Tmp_Tooltip, Tmp_Stock_Id, Value);
117         Free (Tmp_Stock_Id);
118         Free (Tmp_Tooltip);
119         Free (Tmp_Label);
120         Free (Tmp_Name);
121         Set_Object (Action, Tmp_Return);
122      end if;
123   end Initialize;
124
125   -----------------------
126   -- Get_Current_Value --
127   -----------------------
128
129   function Get_Current_Value
130      (Action : not null access Gtk_Radio_Action_Record) return Gint
131   is
132      function Internal (Action : System.Address) return Gint;
133      pragma Import (C, Internal, "gtk_radio_action_get_current_value");
134   begin
135      return Internal (Get_Object (Action));
136   end Get_Current_Value;
137
138   ---------------
139   -- Get_Group --
140   ---------------
141
142   function Get_Group
143      (Action : not null access Gtk_Radio_Action_Record)
144       return Gtk.Widget.Widget_SList.GSlist
145   is
146      function Internal (Action : System.Address) return System.Address;
147      pragma Import (C, Internal, "gtk_radio_action_get_group");
148      Tmp_Return : Gtk.Widget.Widget_SList.GSlist;
149   begin
150      Gtk.Widget.Widget_SList.Set_Object (Tmp_Return, Internal (Get_Object (Action)));
151      return Tmp_Return;
152   end Get_Group;
153
154   ----------------
155   -- Join_Group --
156   ----------------
157
158   procedure Join_Group
159      (Action       : not null access Gtk_Radio_Action_Record;
160       Group_Source : access Gtk_Radio_Action_Record'Class)
161   is
162      procedure Internal
163         (Action       : System.Address;
164          Group_Source : System.Address);
165      pragma Import (C, Internal, "gtk_radio_action_join_group");
166   begin
167      Internal (Get_Object (Action), Get_Object_Or_Null (GObject (Group_Source)));
168   end Join_Group;
169
170   -----------------------
171   -- Set_Current_Value --
172   -----------------------
173
174   procedure Set_Current_Value
175      (Action        : not null access Gtk_Radio_Action_Record;
176       Current_Value : Gint)
177   is
178      procedure Internal (Action : System.Address; Current_Value : Gint);
179      pragma Import (C, Internal, "gtk_radio_action_set_current_value");
180   begin
181      Internal (Get_Object (Action), Current_Value);
182   end Set_Current_Value;
183
184   ---------------
185   -- Set_Group --
186   ---------------
187
188   procedure Set_Group
189      (Action : not null access Gtk_Radio_Action_Record;
190       Group  : Gtk.Widget.Widget_SList.GSlist)
191   is
192      procedure Internal (Action : System.Address; Group : System.Address);
193      pragma Import (C, Internal, "gtk_radio_action_set_group");
194   begin
195      Internal (Get_Object (Action), Gtk.Widget.Widget_SList.Get_Object (Group));
196   end Set_Group;
197
198   use type System.Address;
199
200   function Cb_To_Address is new Ada.Unchecked_Conversion
201     (Cb_Gtk_Radio_Action_Gtk_Radio_Action_Void, System.Address);
202   function Address_To_Cb is new Ada.Unchecked_Conversion
203     (System.Address, Cb_Gtk_Radio_Action_Gtk_Radio_Action_Void);
204
205   function Cb_To_Address is new Ada.Unchecked_Conversion
206     (Cb_GObject_Gtk_Radio_Action_Void, System.Address);
207   function Address_To_Cb is new Ada.Unchecked_Conversion
208     (System.Address, Cb_GObject_Gtk_Radio_Action_Void);
209
210   procedure Connect
211      (Object  : access Gtk_Radio_Action_Record'Class;
212       C_Name  : Glib.Signal_Name;
213       Handler : Cb_Gtk_Radio_Action_Gtk_Radio_Action_Void;
214       After   : Boolean);
215
216   procedure Connect_Slot
217      (Object  : access Gtk_Radio_Action_Record'Class;
218       C_Name  : Glib.Signal_Name;
219       Handler : Cb_GObject_Gtk_Radio_Action_Void;
220       After   : Boolean;
221       Slot    : access Glib.Object.GObject_Record'Class := null);
222
223   procedure Marsh_GObject_Gtk_Radio_Action_Void
224      (Closure         : GClosure;
225       Return_Value    : Glib.Values.GValue;
226       N_Params        : Glib.Guint;
227       Params          : Glib.Values.C_GValues;
228       Invocation_Hint : System.Address;
229       User_Data       : System.Address);
230   pragma Convention (C, Marsh_GObject_Gtk_Radio_Action_Void);
231
232   procedure Marsh_Gtk_Radio_Action_Gtk_Radio_Action_Void
233      (Closure         : GClosure;
234       Return_Value    : Glib.Values.GValue;
235       N_Params        : Glib.Guint;
236       Params          : Glib.Values.C_GValues;
237       Invocation_Hint : System.Address;
238       User_Data       : System.Address);
239   pragma Convention (C, Marsh_Gtk_Radio_Action_Gtk_Radio_Action_Void);
240
241   -------------
242   -- Connect --
243   -------------
244
245   procedure Connect
246      (Object  : access Gtk_Radio_Action_Record'Class;
247       C_Name  : Glib.Signal_Name;
248       Handler : Cb_Gtk_Radio_Action_Gtk_Radio_Action_Void;
249       After   : Boolean)
250   is
251   begin
252      Unchecked_Do_Signal_Connect
253        (Object      => Object,
254         C_Name      => C_Name,
255         Marshaller  => Marsh_Gtk_Radio_Action_Gtk_Radio_Action_Void'Access,
256         Handler     => Cb_To_Address (Handler),--  Set in the closure
257         After       => After);
258   end Connect;
259
260   ------------------
261   -- Connect_Slot --
262   ------------------
263
264   procedure Connect_Slot
265      (Object  : access Gtk_Radio_Action_Record'Class;
266       C_Name  : Glib.Signal_Name;
267       Handler : Cb_GObject_Gtk_Radio_Action_Void;
268       After   : Boolean;
269       Slot    : access Glib.Object.GObject_Record'Class := null)
270   is
271   begin
272      Unchecked_Do_Signal_Connect
273        (Object      => Object,
274         C_Name      => C_Name,
275         Marshaller  => Marsh_GObject_Gtk_Radio_Action_Void'Access,
276         Handler     => Cb_To_Address (Handler),--  Set in the closure
277         Slot_Object => Slot,
278         After       => After);
279   end Connect_Slot;
280
281   -----------------------------------------
282   -- Marsh_GObject_Gtk_Radio_Action_Void --
283   -----------------------------------------
284
285   procedure Marsh_GObject_Gtk_Radio_Action_Void
286      (Closure         : GClosure;
287       Return_Value    : Glib.Values.GValue;
288       N_Params        : Glib.Guint;
289       Params          : Glib.Values.C_GValues;
290       Invocation_Hint : System.Address;
291       User_Data       : System.Address)
292   is
293      pragma Unreferenced (Return_Value, N_Params, Invocation_Hint, User_Data);
294      H   : constant Cb_GObject_Gtk_Radio_Action_Void := Address_To_Cb (Get_Callback (Closure));
295      Obj : constant Glib.Object.GObject := Glib.Object.Convert (Get_Data (Closure));
296   begin
297      H (Obj, Gtk.Radio_Action.Gtk_Radio_Action (Unchecked_To_Object (Params, 1)));
298      exception when E : others => Process_Exception (E);
299   end Marsh_GObject_Gtk_Radio_Action_Void;
300
301   --------------------------------------------------
302   -- Marsh_Gtk_Radio_Action_Gtk_Radio_Action_Void --
303   --------------------------------------------------
304
305   procedure Marsh_Gtk_Radio_Action_Gtk_Radio_Action_Void
306      (Closure         : GClosure;
307       Return_Value    : Glib.Values.GValue;
308       N_Params        : Glib.Guint;
309       Params          : Glib.Values.C_GValues;
310       Invocation_Hint : System.Address;
311       User_Data       : System.Address)
312   is
313      pragma Unreferenced (Return_Value, N_Params, Invocation_Hint, User_Data);
314      H   : constant Cb_Gtk_Radio_Action_Gtk_Radio_Action_Void := Address_To_Cb (Get_Callback (Closure));
315      Obj : constant Gtk_Radio_Action := Gtk_Radio_Action (Unchecked_To_Object (Params, 0));
316   begin
317      H (Obj, Gtk.Radio_Action.Gtk_Radio_Action (Unchecked_To_Object (Params, 1)));
318      exception when E : others => Process_Exception (E);
319   end Marsh_Gtk_Radio_Action_Gtk_Radio_Action_Void;
320
321   ----------------
322   -- On_Changed --
323   ----------------
324
325   procedure On_Changed
326      (Self  : not null access Gtk_Radio_Action_Record;
327       Call  : Cb_Gtk_Radio_Action_Gtk_Radio_Action_Void;
328       After : Boolean := False)
329   is
330   begin
331      Connect (Self, "changed" & ASCII.NUL, Call, After);
332   end On_Changed;
333
334   ----------------
335   -- On_Changed --
336   ----------------
337
338   procedure On_Changed
339      (Self  : not null access Gtk_Radio_Action_Record;
340       Call  : Cb_GObject_Gtk_Radio_Action_Void;
341       Slot  : not null access Glib.Object.GObject_Record'Class;
342       After : Boolean := False)
343   is
344   begin
345      Connect_Slot (Self, "changed" & ASCII.NUL, Call, After, Slot);
346   end On_Changed;
347
348end Gtk.Radio_Action;
349