1------------------------------------------------------------------------------
2--                  GtkAda - Ada95 binding for Gtk+/Gnome                   --
3--                                                                          --
4--                     Copyright (C) 2001-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
24with Glib.Object; use Glib.Object;
25with Glib.Values; use Glib.Values;
26
27package body Glib.Properties is
28
29   procedure Get
30     (Object : System.Address; Name : Glib.Property; Value : in out GValue);
31   procedure Get
32     (Object : System.Address; Name : String; Value : in out GValue);
33   pragma Import (C, Get, "g_object_get_property");
34   --  Internal function to get the properties
35
36   procedure Set
37     (Object : System.Address; Name : String; Value : in out GValue);
38   pragma Import (C, Set, "g_object_set_property");
39   --  Internal function to set the properties
40
41   ------------------
42   -- Get_Property --
43   ------------------
44
45   procedure Get_Property
46     (Object : access Glib.Object.GObject_Record'Class;
47      Name   : String;
48      Value  : in out Glib.Values.GValue)
49   is
50   begin
51      Get (Get_Object (Object), Name & ASCII.NUL, Value);
52   end Get_Property;
53
54   ------------------
55   -- Set_Property --
56   ------------------
57
58   procedure Set_Property
59     (Object : access Glib.Object.GObject_Record'Class;
60      Name   : String;
61      Value  : in out Glib.Values.GValue)
62   is
63   begin
64      Set (Get_Object (Object), Name & ASCII.NUL, Value);
65   end Set_Property;
66
67   ------------------
68   -- Set_Property --
69   ------------------
70
71   procedure Set_Property
72     (Object : access GObject_Record'Class;
73      Name   : Property_String_WO;
74      Value  : String)
75   is
76      procedure Internal
77        (Object : System.Address;
78         Name   : Property;
79         Value  : String);
80      pragma Import (C, Internal, "ada_g_object_set_string");
81   begin
82      Internal (Get_Object (Object), Property (Name), Value & ASCII.NUL);
83   end Set_Property;
84
85   ------------------
86   -- Set_Property --
87   ------------------
88
89   procedure Set_Property
90     (Object : access GObject_Record'Class;
91      Name   : Property_String;
92      Value  : String) is
93   begin
94      Set_Property (Object, Property_String_WO (Name), Value);
95   end Set_Property;
96
97   ------------------
98   -- Get_Property --
99   ------------------
100
101   function Get_Property
102     (Object : access Glib.Object.GObject_Record'Class;
103      Name   : Property_String_RO) return String
104   is
105      Value : GValue;
106   begin
107      Init (Value, GType_String);
108      Get (Get_Object (Object), Property (Name), Value);
109      declare
110         S : constant String := Get_String (Value);
111      begin
112         Unset (Value);
113         return S;
114      end;
115   end Get_Property;
116
117   ------------------
118   -- Get_Property --
119   ------------------
120
121   function Get_Property
122     (Object : access Glib.Object.GObject_Record'Class;
123      Name   : Property_String) return String is
124   begin
125      return Get_Property (Object, Property_String_RO (Name));
126   end Get_Property;
127
128   ------------------
129   -- Set_Property --
130   ------------------
131
132   procedure Set_Property
133     (Object : access Glib.Object.GObject_Record'Class;
134      Name   : Property_Boolean;
135      Value  : Boolean)
136   is
137      procedure Internal
138        (Object : System.Address;
139         Name   : Property;
140         Value  : Gint);
141      pragma Import (C, Internal, "ada_g_object_set_int");
142
143   begin
144      Internal (Get_Object (Object), Property (Name), Boolean'Pos (Value));
145   end Set_Property;
146
147   ------------------
148   -- Get_Property --
149   ------------------
150
151   function Get_Property
152     (Object : access Glib.Object.GObject_Record'Class;
153      Name : Property_Boolean) return Boolean
154   is
155      Value : GValue;
156      B : Boolean;
157   begin
158      Init (Value, GType_Boolean);
159      Get (Get_Object (Object), Property (Name), Value);
160      B := Get_Boolean (Value);
161      Unset (Value);
162      return B;
163   end Get_Property;
164
165   ------------------
166   -- Set_Property --
167   ------------------
168
169   procedure Set_Property
170     (Object : access Glib.Object.GObject_Record'Class;
171      Name   : Property_Object;
172      Value  : access Glib.Object.GObject_Record'Class) is
173   begin
174      Set_Property
175         (Object, Property_Address (Name),
176          Get_Object_Or_Null (GObject (Value)));
177   end Set_Property;
178
179   ------------------
180   -- Get_Property --
181   ------------------
182
183   function Get_Property
184     (Object : access Glib.Object.GObject_Record'Class;
185      Name : Property_Object) return Glib.Object.GObject
186   is
187      Value : GValue;
188      Addr  : System.Address;
189      Stub  : GObject_Record;
190   begin
191      Init (Value, GType_Object);
192      Get (Get_Object (Object), Property (Name), Value);
193      Addr := Get_Address (Value);
194      Unset (Value);
195      return Get_User_Data (Addr, Stub);
196   end Get_Property;
197
198   ------------------
199   -- Set_Property --
200   ------------------
201
202   procedure Set_Property
203     (Object : access Glib.Object.GObject_Record'Class;
204      Name   : Property_Object_WO;
205      Value  : access Glib.Object.GObject_Record'Class) is
206   begin
207      Set_Property
208         (Object, Property_Address (Name),
209          Get_Object_Or_Null (GObject (Value)));
210   end Set_Property;
211
212   ------------------
213   -- Set_Property --
214   ------------------
215
216   procedure Set_Property
217     (Object : access Glib.Object.GObject_Record'Class;
218      Name   : Property_Address;
219      Value  : System.Address)
220   is
221      procedure Internal
222        (Object : System.Address;
223         Name   : Property;
224         Value  : System.Address);
225      pragma Import (C, Internal, "ada_g_object_set_ptr");
226
227   begin
228      Internal (Get_Object (Object), Property (Name), Value);
229   end Set_Property;
230
231   ------------------
232   -- Get_Property --
233   ------------------
234
235   function Get_Property
236     (Object : access Glib.Object.GObject_Record'Class;
237      Name : Property_Address) return System.Address
238   is
239      Value : GValue;
240      A     : System.Address;
241   begin
242      Init (Value, GType_Pointer);
243      Get (Get_Object (Object), Property (Name), Value);
244      A := Get_Address (Value);
245      Unset (Value);
246      return A;
247   end Get_Property;
248
249   ------------------
250   -- Set_Property --
251   ------------------
252
253   procedure Set_Property
254     (Object : access Glib.Object.GObject_Record'Class;
255      Name   : Property_Float;
256      Value  : Gfloat)
257   is
258      procedure Internal
259        (Object : System.Address;
260         Name   : Property;
261         Value  : Gfloat);
262      pragma Import (C, Internal, "ada_g_object_set_float");
263
264   begin
265      Internal (Get_Object (Object), Property (Name), Value);
266   end Set_Property;
267
268   ------------------
269   -- Get_Property --
270   ------------------
271
272   function Get_Property
273     (Object : access Glib.Object.GObject_Record'Class;
274      Name   : Property_Float) return Gfloat
275   is
276      Value : GValue;
277      A     : Gfloat;
278   begin
279      Init (Value, GType_Float);
280      Get (Get_Object (Object), Property (Name), Value);
281      A := Get_Float (Value);
282      Unset (Value);
283      return A;
284   end Get_Property;
285
286   ------------------
287   -- Set_Property --
288   ------------------
289
290   procedure Set_Property
291     (Object : access Glib.Object.GObject_Record'Class;
292      Name   : Property_Double;
293      Value  : Gdouble)
294   is
295      procedure Internal
296        (Object : System.Address;
297         Name   : Property;
298         Value  : Gdouble);
299      pragma Import (C, Internal, "ada_g_object_set_double");
300   begin
301      Internal (Get_Object (Object), Property (Name), Value);
302   end Set_Property;
303
304   ------------------
305   -- Get_Property --
306   ------------------
307
308   function Get_Property
309     (Object : access Glib.Object.GObject_Record'Class;
310      Name : Property_Double) return Gdouble
311   is
312      Value : GValue;
313      A     : Gdouble;
314   begin
315      Init (Value, GType_Double);
316      Get (Get_Object (Object), Property (Name), Value);
317      A := Get_Double (Value);
318      Unset (Value);
319      return A;
320   end Get_Property;
321
322   ------------------
323   -- Set_Property --
324   ------------------
325
326   procedure Set_Property
327     (Object : access Glib.Object.GObject_Record'Class;
328      Name   : Property_C_Proxy;
329      Value  : C_Proxy)
330   is
331      procedure Internal
332        (Object : System.Address;
333         Name   : Property;
334         Value  : C_Proxy);
335      pragma Import (C, Internal, "ada_g_object_set_ptr");
336   begin
337      Internal (Get_Object (Object), Property (Name), Value);
338   end Set_Property;
339
340   ------------------
341   -- Get_Property --
342   ------------------
343
344   function Get_Property
345     (Object : access Glib.Object.GObject_Record'Class;
346      Name : Property_C_Proxy) return C_Proxy
347   is
348      Value : GValue;
349      A     : C_Proxy;
350   begin
351      Init (Value, GType_Object);
352      Get (Get_Object (Object), Property (Name), Value);
353      A := Get_Proxy (Value);
354      Unset (Value);
355      return A;
356   end Get_Property;
357
358   ------------------
359   -- Set_Property --
360   ------------------
361
362   procedure Set_Property
363     (Object : access Glib.Object.GObject_Record'Class;
364      Name   : Property_Interface;
365      Value  : Glib.Types.GType_Interface)
366   is
367      procedure Internal
368        (Object : System.Address;
369         Name   : Property;
370         Value  : Glib.Types.GType_Interface);
371      pragma Import (C, Internal, "ada_g_object_set_ptr");
372   begin
373      Internal (Get_Object (Object), Property (Name), Value);
374   end Set_Property;
375
376   ------------------
377   -- Get_Property --
378   ------------------
379
380   function Get_Property
381     (Object : access Glib.Object.GObject_Record'Class;
382      Name : Property_Interface) return Glib.Types.GType_Interface
383   is
384      Value : GValue;
385      A     : Glib.Types.GType_Interface;
386   begin
387      Init (Value, GType_Object);
388      Get (Get_Object (Object), Property (Name), Value);
389      A := Glib.Types.GType_Interface (Get_Address (Value));
390      Unset (Value);
391      return A;
392   end Get_Property;
393
394end Glib.Properties;
395