----------------------------------------------------------------------- -- GtkAda - Ada95 binding for Gtk+/Gnome -- -- -- -- Copyright (C) 2006-2010, AdaCore -- -- -- -- This library is free software; you can redistribute it and/or -- -- modify it under the terms of the GNU General Public -- -- License as published by the Free Software Foundation; either -- -- version 2 of the License, or (at your option) any later version. -- -- -- -- This library is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- -- General Public License for more details. -- -- -- -- You should have received a copy of the GNU General Public -- -- License along with this library; if not, write to the -- -- Free Software Foundation, Inc., 59 Temple Place - Suite 330, -- -- Boston, MA 02111-1307, USA. -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- ----------------------------------------------------------------------- with Gtkada.Bindings; use Gtkada.Bindings; with Glib.Object; use Glib.Object; with System; use System; package body Glib.Types is ---------------- -- Implements -- ---------------- package body Implements is --------------- -- To_Object -- --------------- function To_Object (Interf : Interface_Type) return Object_Type is Stub : Object_Type_Record; begin return Object_Type (Get_User_Data (System.Address (Interf), Stub)); end To_Object; ------------------ -- To_Interface -- ------------------ function To_Interface (Object : access Object_Type_Record'Class) return Interface_Type is begin return Interface_Type (Get_Object (Object)); end To_Interface; end Implements; --------------- -- To_Object -- --------------- function To_Object (Interf : GType_Interface) return Glib.Object.GObject is Stub : GObject_Record; begin return Get_User_Data (System.Address (Interf), Stub); end To_Object; ---------------- -- Interfaces -- ---------------- function Interfaces (T : GType) return GType_Array is use GType_Arrays; function Internal (T : GType; N_Ifaces : access Guint) return Unbounded_Array_Access; pragma Import (C, Internal, "g_type_interfaces"); N : aliased Guint; Output : constant Unbounded_Array_Access := Internal (T, N'Access); Result : constant GType_Array := To_Array (Output, N); begin -- Do says we should free, but doing so results in double deallocation -- G_Free (Output); return Result; end Interfaces; ------------------ -- Is_Interface -- ------------------ function Is_Interface (T : GType) return Boolean is function Internal (T : GType) return Gboolean; pragma Import (C, Internal, "ada_g_type_is_interface"); begin return Boolean'Val (Internal (T)); end Is_Interface; ---------- -- Is_A -- ---------- function Is_A (T : GType; Is_A_Type : GType) return Boolean is function Internal (T1, T2 : GType) return Gboolean; pragma Import (C, Internal, "g_type_is_a"); begin return Boolean'Val (Internal (T, Is_A_Type)); end Is_A; end Glib.Types;