1----------------------------------------------------------------------- 2-- GtkAda - Ada95 binding for Gtk+/Gnome -- 3-- -- 4-- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet -- 5-- Copyright (C) 2000-2013, AdaCore -- 6-- -- 7-- This library is free software; you can redistribute it and/or -- 8-- modify it under the terms of the GNU General Public -- 9-- License as published by the Free Software Foundation; either -- 10-- version 2 of the License, or (at your option) any later version. -- 11-- -- 12-- This library is distributed in the hope that it will be useful, -- 13-- but WITHOUT ANY WARRANTY; without even the implied warranty of -- 14-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- 15-- General Public License for more details. -- 16-- -- 17-- You should have received a copy of the GNU General Public -- 18-- License along with this library; if not, write to the -- 19-- Free Software Foundation, Inc., 59 Temple Place - Suite 330, -- 20-- Boston, MA 02111-1307, USA. -- 21-- -- 22-- As a special exception, if other files instantiate generics from -- 23-- this unit, or you link this unit with other files to produce an -- 24-- executable, this unit does not by itself cause the resulting -- 25-- executable to be covered by the GNU General Public License. This -- 26-- exception does not however invalidate any other reasons why the -- 27-- executable file might be covered by the GNU Public License. -- 28----------------------------------------------------------------------- 29 30pragma Style_Checks (Off); 31pragma Warnings (Off, "*is already use-visible*"); 32with Glib.Type_Conversion_Hooks; use Glib.Type_Conversion_Hooks; 33with Interfaces.C.Strings; use Interfaces.C.Strings; 34 35package body Gtk.Radio_Action is 36 package Type_Conversion is new Glib.Type_Conversion_Hooks.Hook_Registrator 37 (Get_Type'Access, Gtk_Radio_Action_Record); 38 pragma Unreferenced (Type_Conversion); 39 40 ------------- 41 -- Gtk_New -- 42 ------------- 43 44 procedure Gtk_New 45 (Action : out Gtk_Radio_Action; 46 Name : UTF8_String; 47 Label : UTF8_String := ""; 48 Tooltip : UTF8_String := ""; 49 Stock_Id : UTF8_String := ""; 50 Value : Gint) 51 is 52 begin 53 Action := new Gtk_Radio_Action_Record; 54 Gtk.Radio_Action.Initialize (Action, Name, Label, Tooltip, Stock_Id, Value); 55 end Gtk_New; 56 57 ---------------- 58 -- Initialize -- 59 ---------------- 60 61 procedure Initialize 62 (Action : access Gtk_Radio_Action_Record'Class; 63 Name : UTF8_String; 64 Label : UTF8_String := ""; 65 Tooltip : UTF8_String := ""; 66 Stock_Id : UTF8_String := ""; 67 Value : Gint) 68 is 69 function Internal 70 (Name : Interfaces.C.Strings.chars_ptr; 71 Label : Interfaces.C.Strings.chars_ptr; 72 Tooltip : Interfaces.C.Strings.chars_ptr; 73 Stock_Id : Interfaces.C.Strings.chars_ptr; 74 Value : Gint) return System.Address; 75 pragma Import (C, Internal, "gtk_radio_action_new"); 76 Tmp_Name : Interfaces.C.Strings.chars_ptr := New_String (Name); 77 Tmp_Label : Interfaces.C.Strings.chars_ptr := New_String (Label); 78 Tmp_Tooltip : Interfaces.C.Strings.chars_ptr := New_String (Tooltip); 79 Tmp_Stock_Id : Interfaces.C.Strings.chars_ptr := New_String (Stock_Id); 80 Tmp_Return : System.Address; 81 begin 82 Tmp_Return := Internal (Tmp_Name, Tmp_Label, Tmp_Tooltip, Tmp_Stock_Id, Value); 83 Free (Tmp_Name); 84 Free (Tmp_Label); 85 Free (Tmp_Tooltip); 86 Free (Tmp_Stock_Id); 87 Set_Object (Action, Tmp_Return); 88 end Initialize; 89 90 ----------------------- 91 -- Get_Current_Value -- 92 ----------------------- 93 94 function Get_Current_Value 95 (Action : access Gtk_Radio_Action_Record) return Gint 96 is 97 function Internal (Action : System.Address) return Gint; 98 pragma Import (C, Internal, "gtk_radio_action_get_current_value"); 99 begin 100 return Internal (Get_Object (Action)); 101 end Get_Current_Value; 102 103 --------------- 104 -- Get_Group -- 105 --------------- 106 107 function Get_Group 108 (Action : access Gtk_Radio_Action_Record) 109 return Gtk.Widget.Widget_SList.GSList 110 is 111 function Internal (Action : System.Address) return System.Address; 112 pragma Import (C, Internal, "gtk_radio_action_get_group"); 113 Tmp_Return : Gtk.Widget.Widget_SList.GSList; 114 begin 115 Gtk.Widget.Widget_SList.Set_Object (Tmp_Return, Internal (Get_Object (Action))); 116 return Tmp_Return; 117 end Get_Group; 118 119 ----------------------- 120 -- Set_Current_Value -- 121 ----------------------- 122 123 procedure Set_Current_Value 124 (Action : access Gtk_Radio_Action_Record; 125 Current_Value : Gint) 126 is 127 procedure Internal (Action : System.Address; Current_Value : Gint); 128 pragma Import (C, Internal, "gtk_radio_action_set_current_value"); 129 begin 130 Internal (Get_Object (Action), Current_Value); 131 end Set_Current_Value; 132 133 --------------- 134 -- Set_Group -- 135 --------------- 136 137 procedure Set_Group 138 (Action : access Gtk_Radio_Action_Record; 139 Group : Gtk.Widget.Widget_SList.GSList) 140 is 141 procedure Internal (Action : System.Address; Group : System.Address); 142 pragma Import (C, Internal, "gtk_radio_action_set_group"); 143 begin 144 Internal (Get_Object (Action), Gtk.Widget.Widget_SList.Get_Object (Group)); 145 end Set_Group; 146 147end Gtk.Radio_Action; 148