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