1-----------------------------------------------------------------------
2--          GtkAda - Ada95 binding for the Gimp Toolkit              --
3--                                                                   --
4--                  Copyright (C) 2008-2013, AdaCore                 --
5--                                                                   --
6-- This library is free software; you can redistribute it and/or     --
7-- modify it under the terms of the GNU General Public               --
8-- License as published by the Free Software Foundation; either      --
9-- version 2 of the License, or (at your option) any later version.  --
10--                                                                   --
11-- This library is distributed in the hope that it will be useful,   --
12-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --
13-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
14-- General Public License for more details.                          --
15--                                                                   --
16-- You should have received a copy of the GNU General Public         --
17-- License along with this library; if not, write to the             --
18-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
19-- Boston, MA 02111-1307, USA.                                       --
20--                                                                   --
21-- As a special exception, if other files instantiate generics from  --
22-- this unit, or you link this unit with other files to produce an   --
23-- executable, this  unit  does not  by itself cause  the resulting  --
24-- executable to be covered by the GNU General Public License. This  --
25-- exception does not however invalidate any other reasons why the   --
26-- executable file  might be covered by the  GNU Public License.     --
27-----------------------------------------------------------------------
28
29with Interfaces.C.Strings;
30with System;
31
32with Glib.Object;
33
34package body Gtkada.Abstract_Tree_Model is
35
36   use type Gtk.Tree_Model.Gtk_Tree_Iter;
37
38   type Gtk_Tree_Iter_Access is access all Gtk.Tree_Model.Gtk_Tree_Iter;
39   pragma Convention (C, Gtk_Tree_Iter_Access);
40
41   type GInterface_Info is record
42      interface_init     : System.Address := System.Null_Address;
43      interface_finalize : System.Address := System.Null_Address;
44      interface_data     : System.Address := System.Null_Address;
45   end record;
46   pragma Convention (C, GInterface_Info);
47
48   type GTypeInterface is record
49      g_type          : Glib.GType;
50      g_instance_type : Glib.GType;
51   end record;
52   pragma Convention (C, GTypeInterface);
53
54   type GtkTreeModelInterface is record
55      g_type                : GTypeInterface;
56      row_changed           : System.Address := System.Null_Address;
57      row_inserted          : System.Address := System.Null_Address;
58      row_has_child_toggled : System.Address := System.Null_Address;
59      row_deleted           : System.Address := System.Null_Address;
60      rows_reordered        : System.Address := System.Null_Address;
61      get_flags             : System.Address := System.Null_Address;
62      get_n_columns         : System.Address := System.Null_Address;
63      get_column_type       : System.Address := System.Null_Address;
64      get_iter              : System.Address := System.Null_Address;
65      get_path              : System.Address := System.Null_Address;
66      get_value             : System.Address := System.Null_Address;
67      iter_next             : System.Address := System.Null_Address;
68      iter_children         : System.Address := System.Null_Address;
69      iter_has_child        : System.Address := System.Null_Address;
70      iter_n_children       : System.Address := System.Null_Address;
71      iter_nth_child        : System.Address := System.Null_Address;
72      iter_parent           : System.Address := System.Null_Address;
73      ref_node              : System.Address := System.Null_Address;
74      unref_node            : System.Address := System.Null_Address;
75   end record;
76   pragma Convention (C, GtkTreeModelInterface);
77
78   procedure Tree_Model_Interface_Init (Iface : in out GtkTreeModelInterface);
79   pragma Convention (C, Tree_Model_Interface_Init);
80
81   function Dispatch_Get_Flags
82     (Tree_Model : System.Address) return Gtk.Tree_Model.Tree_Model_Flags;
83   pragma Convention (C, Dispatch_Get_Flags);
84
85   function Dispatch_Get_N_Columns
86     (Tree_Model : System.Address) return Glib.Gint;
87   pragma Convention (C, Dispatch_Get_N_Columns);
88
89   function Dispatch_Get_Column_Type
90     (Tree_Model : System.Address;
91      Index      : Glib.Gint) return Glib.GType;
92   pragma Convention (C, Dispatch_Get_Column_Type);
93
94   function Dispatch_Get_Iter
95     (Tree_Model : System.Address;
96      Iter       : access Gtk.Tree_Model.Gtk_Tree_Iter;
97      Path       : Gtk.Tree_Model.Gtk_Tree_Path) return Glib.Gboolean;
98   pragma Convention (C, Dispatch_Get_Iter);
99
100   function Dispatch_Get_Path
101     (Tree_Model : System.Address;
102      Iter       : Gtk.Tree_Model.Gtk_Tree_Iter)
103      return Gtk.Tree_Model.Gtk_Tree_Path;
104   pragma Convention (C, Dispatch_Get_Path);
105
106   procedure Dispatch_Get_Value
107     (Tree_Model : System.Address;
108      Iter       : Gtk.Tree_Model.Gtk_Tree_Iter;
109      Column     : Glib.Gint;
110      Value      : out Glib.Values.GValue);
111   pragma Convention (C, Dispatch_Get_Value);
112
113   function Dispatch_Iter_Next
114     (Tree_Model : System.Address;
115      Iter       : access Gtk.Tree_Model.Gtk_Tree_Iter) return Glib.Gboolean;
116   pragma Convention (C, Dispatch_Iter_Next);
117
118   function Dispatch_Iter_Children
119     (Tree_Model : System.Address;
120      Iter       : access Gtk.Tree_Model.Gtk_Tree_Iter;
121      Parent     : Gtk_Tree_Iter_Access)
122      return Glib.Gboolean;
123   pragma Convention (C, Dispatch_Iter_Children);
124
125   function Dispatch_Iter_Has_Child
126     (Tree_Model : System.Address;
127      Iter       : Gtk.Tree_Model.Gtk_Tree_Iter)
128      return Glib.Gboolean;
129   pragma Convention (C, Dispatch_Iter_Has_Child);
130
131   function Dispatch_Iter_N_Children
132     (Tree_Model : System.Address;
133      Iter       : Gtk_Tree_Iter_Access)
134      return Glib.Gint;
135   pragma Convention (C, Dispatch_Iter_N_Children);
136
137   function Dispatch_Iter_Nth_Child
138     (Tree_Model : System.Address;
139      Iter       : access Gtk.Tree_Model.Gtk_Tree_Iter;
140      Parent     : Gtk_Tree_Iter_Access;
141      N          : Glib.Gint) return Glib.Gboolean;
142   pragma Convention (C, Dispatch_Iter_Nth_Child);
143
144   function Dispatch_Iter_Parent
145     (Tree_Model : System.Address;
146      Iter       : access Gtk.Tree_Model.Gtk_Tree_Iter;
147      Child      : Gtk.Tree_Model.Gtk_Tree_Iter)
148      return Glib.Gboolean;
149   pragma Convention (C, Dispatch_Iter_Parent);
150
151   procedure Dispatch_Ref_Node
152     (Tree_Model : System.Address;
153      Iter       : Gtk.Tree_Model.Gtk_Tree_Iter);
154   pragma Convention (C, Dispatch_Ref_Node);
155
156   procedure Dispatch_Unref_Node
157     (Tree_Model : System.Address;
158      Iter       : Gtk.Tree_Model.Gtk_Tree_Iter);
159   pragma Convention (C, Dispatch_Unref_Node);
160
161   Class_Record : Glib.Object.GObject_Class := Glib.Object.Uninitialized_Class;
162   Info         : constant GInterface_Info  :=
163     (interface_init => Tree_Model_Interface_Init'Address,
164      others         => System.Null_Address);
165
166   ------------------------------
167   -- Dispatch_Get_Column_Type --
168   ------------------------------
169
170   function Dispatch_Get_Column_Type
171     (Tree_Model : System.Address;
172      Index      : Glib.Gint)
173      return Glib.GType
174   is
175      Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record;
176
177   begin
178      return
179        Gtk.Tree_Model.Get_Column_Type
180          (Gtk.Tree_Model.Gtk_Tree_Model
181               (Glib.Object.Get_User_Data (Tree_Model, Stub)),
182           Index);
183   end Dispatch_Get_Column_Type;
184
185   ------------------------
186   -- Dispatch_Get_Flags --
187   ------------------------
188
189   function Dispatch_Get_Flags
190     (Tree_Model : System.Address)
191      return Gtk.Tree_Model.Tree_Model_Flags
192   is
193      Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record;
194
195   begin
196      return
197        Gtk.Tree_Model.Get_Flags
198          (Gtk.Tree_Model.Gtk_Tree_Model
199               (Glib.Object.Get_User_Data (Tree_Model, Stub)));
200   end Dispatch_Get_Flags;
201
202   -----------------------
203   -- Dispatch_Get_Iter --
204   -----------------------
205
206   function Dispatch_Get_Iter
207     (Tree_Model : System.Address;
208      Iter       : access Gtk.Tree_Model.Gtk_Tree_Iter;
209      Path       : Gtk.Tree_Model.Gtk_Tree_Path) return Glib.Gboolean
210   is
211      Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record;
212
213   begin
214      Iter.all :=
215        Gtk.Tree_Model.Get_Iter
216          (Gtk.Tree_Model.Gtk_Tree_Model
217               (Glib.Object.Get_User_Data (Tree_Model, Stub)),
218           Path);
219
220      if Iter.all = Gtk.Tree_Model.Null_Iter then
221         return 0;
222
223      else
224         return 1;
225      end if;
226   end Dispatch_Get_Iter;
227
228   -----------------------
229   -- Dispatch_Get_Path --
230   -----------------------
231
232   function Dispatch_Get_Path
233     (Tree_Model : System.Address;
234      Iter       : Gtk.Tree_Model.Gtk_Tree_Iter)
235      return Gtk.Tree_Model.Gtk_Tree_Path
236   is
237      Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record;
238
239   begin
240      return
241        Gtk.Tree_Model.Get_Path
242          (Gtk.Tree_Model.Gtk_Tree_Model
243               (Glib.Object.Get_User_Data (Tree_Model, Stub)),
244           Iter);
245   end Dispatch_Get_Path;
246
247   ----------------------------
248   -- Dispatch_Get_N_Columns --
249   ----------------------------
250
251   function Dispatch_Get_N_Columns
252     (Tree_Model : System.Address)
253      return Glib.Gint
254   is
255      Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record;
256
257   begin
258      return
259        Gtk.Tree_Model.Get_N_Columns
260          (Gtk.Tree_Model.Gtk_Tree_Model
261               (Glib.Object.Get_User_Data (Tree_Model, Stub)));
262   end Dispatch_Get_N_Columns;
263
264   ------------------------
265   -- Dispatch_Get_Value --
266   ------------------------
267
268   procedure Dispatch_Get_Value
269     (Tree_Model : System.Address;
270      Iter       : Gtk.Tree_Model.Gtk_Tree_Iter;
271      Column     : Glib.Gint;
272      Value      : out Glib.Values.GValue)
273   is
274      Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record;
275
276   begin
277      Gtk.Tree_Model.Get_Value
278        (Gtk.Tree_Model.Gtk_Tree_Model
279           (Glib.Object.Get_User_Data (Tree_Model, Stub)),
280         Iter,
281         Column,
282         Value);
283   end Dispatch_Get_Value;
284
285   ----------------------------
286   -- Dispatch_Iter_Children --
287   ----------------------------
288
289   function Dispatch_Iter_Children
290     (Tree_Model : System.Address;
291      Iter       : access Gtk.Tree_Model.Gtk_Tree_Iter;
292      Parent     : Gtk_Tree_Iter_Access)
293      return Glib.Gboolean
294   is
295      Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record;
296      Real_Parent : Gtk.Tree_Model.Gtk_Tree_Iter;
297   begin
298      --  Gtk should normally never pass null to that function. Unfortunately,
299      --  When using e.g. PyGtk, Parent may be null, probably due to a bug.
300      --  Using a null parent and passing Null_Iter in this case is a
301      --  workaround to that problem.
302      if Parent /= null then
303         Real_Parent := Parent.all;
304      else
305         Real_Parent := Gtk.Tree_Model.Null_Iter;
306      end if;
307
308      Iter.all :=
309        Gtk.Tree_Model.Children
310          (Gtk.Tree_Model.Gtk_Tree_Model
311               (Glib.Object.Get_User_Data (Tree_Model, Stub)),
312           Real_Parent);
313
314      if Iter.all = Gtk.Tree_Model.Null_Iter then
315         return 0;
316
317      else
318         return 1;
319      end if;
320   end Dispatch_Iter_Children;
321
322   -----------------------------
323   -- Dispatch_Iter_Has_Child --
324   -----------------------------
325
326   function Dispatch_Iter_Has_Child
327     (Tree_Model : System.Address;
328      Iter       : Gtk.Tree_Model.Gtk_Tree_Iter)
329      return Glib.Gboolean
330   is
331      Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record;
332
333   begin
334      if Gtk.Tree_Model.Has_Child
335        (Gtk.Tree_Model.Gtk_Tree_Model
336           (Glib.Object.Get_User_Data (Tree_Model, Stub)),
337         Iter)
338      then
339         return 1;
340
341      else
342         return 0;
343      end if;
344   end Dispatch_Iter_Has_Child;
345
346   ------------------------------
347   -- Dispatch_Iter_N_Children --
348   ------------------------------
349
350   function Dispatch_Iter_N_Children
351     (Tree_Model : System.Address;
352      Iter       : Gtk_Tree_Iter_Access)
353      return Glib.Gint
354   is
355      Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record;
356
357   begin
358      if Iter = null then
359         return
360           Gtk.Tree_Model.N_Children
361             (Gtk.Tree_Model.Gtk_Tree_Model
362                  (Glib.Object.Get_User_Data (Tree_Model, Stub)),
363              Gtk.Tree_Model.Null_Iter);
364
365      else
366         return
367           Gtk.Tree_Model.N_Children
368             (Gtk.Tree_Model.Gtk_Tree_Model
369                  (Glib.Object.Get_User_Data (Tree_Model, Stub)),
370              Iter.all);
371      end if;
372   end Dispatch_Iter_N_Children;
373
374   ------------------------
375   -- Dispatch_Iter_Next --
376   ------------------------
377
378   function Dispatch_Iter_Next
379     (Tree_Model : System.Address;
380      Iter       : access Gtk.Tree_Model.Gtk_Tree_Iter) return Glib.Gboolean
381   is
382      Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record;
383
384   begin
385      Gtk.Tree_Model.Next
386        (Gtk.Tree_Model.Gtk_Tree_Model
387           (Glib.Object.Get_User_Data (Tree_Model, Stub)),
388         Iter.all);
389
390      if Iter.all = Gtk.Tree_Model.Null_Iter then
391         return 0;
392
393      else
394         return 1;
395      end if;
396   end Dispatch_Iter_Next;
397
398   -----------------------------
399   -- Dispatch_Iter_Nth_Child --
400   -----------------------------
401
402   function Dispatch_Iter_Nth_Child
403     (Tree_Model : System.Address;
404      Iter       : access Gtk.Tree_Model.Gtk_Tree_Iter;
405      Parent     : Gtk_Tree_Iter_Access;
406      N          : Glib.Gint) return Glib.Gboolean
407   is
408      Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record;
409
410   begin
411      --  Parent can be null, GtkAda assume it can't.
412
413      if Parent = null then
414         Iter.all :=
415           Gtk.Tree_Model.Nth_Child
416             (Gtk.Tree_Model.Gtk_Tree_Model
417                  (Glib.Object.Get_User_Data (Tree_Model, Stub)),
418              Gtk.Tree_Model.Null_Iter,
419              N);
420
421      else
422         Iter.all :=
423           Gtk.Tree_Model.Nth_Child
424             (Gtk.Tree_Model.Gtk_Tree_Model
425                  (Glib.Object.Get_User_Data (Tree_Model, Stub)),
426              Parent.all,
427              N);
428      end if;
429
430      if Iter.all = Gtk.Tree_Model.Null_Iter then
431         return 0;
432
433      else
434         return 1;
435      end if;
436   end Dispatch_Iter_Nth_Child;
437
438   --------------------------
439   -- Dispatch_Iter_Parent --
440   --------------------------
441
442   function Dispatch_Iter_Parent
443     (Tree_Model : System.Address;
444      Iter       : access Gtk.Tree_Model.Gtk_Tree_Iter;
445      Child      : Gtk.Tree_Model.Gtk_Tree_Iter)
446      return Glib.Gboolean
447   is
448      Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record;
449
450   begin
451      Iter.all :=
452        Gtk.Tree_Model.Parent
453          (Gtk.Tree_Model.Gtk_Tree_Model
454               (Glib.Object.Get_User_Data (Tree_Model, Stub)),
455           Child);
456
457      if Iter.all = Gtk.Tree_Model.Null_Iter then
458         return 0;
459
460      else
461         return 1;
462      end if;
463   end Dispatch_Iter_Parent;
464
465   -----------------------
466   -- Dispatch_Ref_Node --
467   -----------------------
468
469   procedure Dispatch_Ref_Node
470     (Tree_Model : System.Address;
471      Iter       : Gtk.Tree_Model.Gtk_Tree_Iter)
472   is
473      Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record;
474
475   begin
476      Gtk.Tree_Model.Ref_Node
477        (Gtk.Tree_Model.Gtk_Tree_Model
478           (Glib.Object.Get_User_Data (Tree_Model, Stub)),
479         Iter);
480   end Dispatch_Ref_Node;
481
482   -------------------------
483   -- Dispatch_Unref_Node --
484   -------------------------
485
486   procedure Dispatch_Unref_Node
487     (Tree_Model : System.Address;
488      Iter       : Gtk.Tree_Model.Gtk_Tree_Iter)
489   is
490      Stub : Gtk.Tree_Model.Gtk_Tree_Model_Record;
491
492   begin
493      Gtk.Tree_Model.Unref_Node
494        (Gtk.Tree_Model.Gtk_Tree_Model
495           (Glib.Object.Get_User_Data (Tree_Model, Stub)),
496         Iter);
497   end Dispatch_Unref_Node;
498
499   ---------------
500   -- Get_Flags --
501   ---------------
502
503   function Get_Flags
504     (Self : access Gtk_Abstract_Tree_Model_Record)
505      return Gtk.Tree_Model.Tree_Model_Flags
506   is
507      pragma Unreferenced (Self);
508      --  This parameter is used for call dispatching.
509
510   begin
511      return 0;
512   end Get_Flags;
513
514   ----------------
515   -- Initialize --
516   ----------------
517
518   procedure Initialize (Self : access Gtk_Abstract_Tree_Model_Record'Class) is
519      use type Glib.Object.GObject_Class;
520      Empty : Interfaces.C.Strings.chars_ptr_array (1 .. 0);
521
522      procedure Init_Interface
523        (Class : Glib.GType;
524         Iface : Glib.GType;
525         Info  : GInterface_Info);
526      pragma Import (C, Init_Interface, "g_type_add_interface_static");
527
528      Initialized : constant Boolean :=
529        Class_Record /= Glib.Object.Uninitialized_Class;
530
531   begin
532      Glib.Object.Initialize (Self);
533
534      Glib.Object.Initialize_Class_Record
535        (Self,
536         Empty,
537         Class_Record,
538         "GtkAdaAbstractTreeModel");
539
540      if not Initialized then
541         Init_Interface
542           (Glib.Object.Type_From_Class (Class_Record),
543            Gtk.Tree_Model.Get_Type,
544            Info);
545      end if;
546   end Initialize;
547
548   --------------
549   -- Ref_Node --
550   --------------
551
552   procedure Ref_Node
553     (Self : access Gtk_Abstract_Tree_Model_Record;
554      Iter : Gtk.Tree_Model.Gtk_Tree_Iter)
555   is
556   begin
557      null;
558   end Ref_Node;
559
560   -------------------------------
561   -- Tree_Model_Interface_Init --
562   -------------------------------
563
564   procedure Tree_Model_Interface_Init
565     (Iface : in out GtkTreeModelInterface)
566   is
567   begin
568      Iface.get_flags       := Dispatch_Get_Flags'Address;
569      Iface.get_n_columns   := Dispatch_Get_N_Columns'Address;
570      Iface.get_column_type := Dispatch_Get_Column_Type'Address;
571      Iface.get_iter        := Dispatch_Get_Iter'Address;
572      Iface.get_path        := Dispatch_Get_Path'Address;
573      Iface.get_value       := Dispatch_Get_Value'Address;
574      Iface.iter_next       := Dispatch_Iter_Next'Address;
575      Iface.iter_children   := Dispatch_Iter_Children'Address;
576      Iface.iter_has_child  := Dispatch_Iter_Has_Child'Address;
577      Iface.iter_n_children := Dispatch_Iter_N_Children'Address;
578      Iface.iter_nth_child  := Dispatch_Iter_Nth_Child'Address;
579      Iface.iter_parent     := Dispatch_Iter_Parent'Address;
580      Iface.ref_node        := Dispatch_Ref_Node'Address;
581      Iface.unref_node      := Dispatch_Unref_Node'Address;
582   end Tree_Model_Interface_Init;
583
584   ----------------
585   -- Unref_Node --
586   ----------------
587
588   procedure Unref_Node
589     (Self : access Gtk_Abstract_Tree_Model_Record;
590      Iter : Gtk.Tree_Model.Gtk_Tree_Iter)
591   is
592   begin
593      null;
594   end Unref_Node;
595
596end Gtkada.Abstract_Tree_Model;
597