-----------------------------------------------------------------------
--               GtkAda - Ada95 binding for Gtk+/Gnome               --
--                                                                   --
--   Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet   --
--                 Copyright (C) 2000-2004 ACT-Europe                --
--                                                                   --
-- 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.                                       --
--                                                                   --
-- As a special exception, if other files instantiate generics from  --
-- this unit, or you link this unit with other files to produce an   --
-- executable, this  unit  does not  by itself cause  the resulting  --
-- executable to be covered by the GNU General Public License. This  --
-- exception does not however invalidate any other reasons why the   --
-- executable file  might be covered by the  GNU Public License.     --
-----------------------------------------------------------------------

with Unchecked_Conversion;
with Unchecked_Deallocation;
with Glib.Object; use Glib.Object;
with Glib.Values; use Glib.Values;
with Glib; use Glib;
with Gtk.Widget;
with System;

package body Gtk.Handlers is

   function Type_Of_Return
     (Object : access GObject_Record'Class; Signal : String)
      return Glib.GType;
   --  Convenience function that groups together a call to Lookup, Query and
   --  Return_Type.

   function Count_Arguments
     (Object : access GObject_Record'Class; Signal : String)
      return Guint;
   --  Convenience function that returns the number of arguments for this
   --  signal

   function Do_Signal_Connect
     (Object      : Glib.Object.GObject;
      Name        : String;
      Marshaller  : System.Address;
      Handler     : System.Address;
      Func_Data   : System.Address;
      Destroy     : System.Address;
      After       : Boolean;
      Slot_Object : System.Address := System.Null_Address) return Handler_Id;
   --  Internal function used to connect the signal.

   procedure Disconnect_Internal (Obj : System.Address; Id : Signal_Id);
   pragma Import (C, Disconnect_Internal, "g_signal_handler_disconnect");
   --  Internal version of Disconnect

   function Signal_Lookup (Name : String; IType : GType) return Guint;
   pragma Import (C, Signal_Lookup, "g_signal_lookup");

   procedure Set_Value (Value : GValue; Val : System.Address);
   pragma Import (C, Set_Value, "ada_gvalue_set");
   --  Function used internally to specify the value returned by a callback.

   --------------------------------
   -- Glib.Closure small binding --
   --------------------------------

   function CClosure_New
     (Callback  : System.Address;
      User_Data : System.Address;
      Destroy   : System.Address) return GClosure;
   pragma Import (C, CClosure_New, "g_cclosure_new");

   procedure Set_Marshal (Closure : GClosure; Marshaller : System.Address);
   pragma Import (C, Set_Marshal, "g_closure_set_marshal");

   function Get_Data (Closure : GClosure) return System.Address;
   pragma Import (C, Get_Data, "ada_gclosure_get_data");

   procedure Watch_Closure (Object : System.Address; Closure : GClosure);
   pragma Import (C, Watch_Closure, "g_object_watch_closure");
   --  The closure will be destroyed when Object is destroyed.

   --------------------
   -- Type_Of_Return --
   --------------------

   function Type_Of_Return
     (Object : access GObject_Record'Class; Signal : String)
      return Glib.GType
   is
      Q  : Signal_Query;
      Id : constant Signal_Id :=
        Lookup (Get_Type (Object), Signal & ASCII.NUL);

   begin
      if Id = Invalid_Signal_Id or else Id = Null_Signal_Id then
         return GType_Invalid;
      else
         Query (Id, Q);
         return Return_Type (Q);
      end if;
   end Type_Of_Return;

   ---------------------
   -- Count_Arguments --
   ---------------------

   function Count_Arguments
     (Object : access GObject_Record'Class; Signal : String)
      return Guint
   is
      Q : Signal_Query;
      Id : constant Signal_Id :=
        Lookup (Get_Type (Object), Signal & ASCII.Nul);
   begin
      if Id = Invalid_Signal_Id then
         return 0;
      else
         Query (Id, Q);
         return Params (Q)'Length;
      end if;
   end Count_Arguments;

   -----------------------
   -- Do_Signal_Connect --
   -----------------------

   function Do_Signal_Connect
     (Object      : Glib.Object.GObject;
      Name        : String;
      Marshaller  : System.Address;
      Handler     : System.Address;
      Func_Data   : System.Address;
      Destroy     : System.Address;
      After       : Boolean;
      Slot_Object : System.Address := System.Null_Address) return Handler_Id
   is
      function Internal
        (Instance  : System.Address;
         Id        : Guint;
         Detail    : GQuark := Unknown_Quark;
         Closure   : GClosure;
         After     : Gint := 0) return Signal_Id;
      pragma Import (C, Internal, "g_signal_connect_closure_by_id");

      use type System.Address;
      Id      : Handler_Id;
      Signal  : Guint;

   begin
      --  When the handler is destroyed, for instance because Object is
      --  destroyed, then the closure is destroyed as well, and Destroy gets
      --  called.
      --  The closure is invoked when the signal is emitted. As a result,
      --  Handler is called, with Func_Data as a parameter.

      Id.Closure := CClosure_New (Handler, Func_Data, Destroy);
      Set_Marshal (Id.Closure, Marshaller);
      Signal := Signal_Lookup (Name & ASCII.NUL, Get_Type (Object));

      pragma Assert (Signal /= 0,
                     "Trying to connect to unknown signal");

      Id.Signal := Internal
        (Get_Object (Object),
         Id      => Signal,
         Closure => Id.Closure,
         After   => Boolean'Pos (After));

      --  If we have connected with Object_Connect, we want to automatically
      --  disconnect the signal as well.

      if Slot_Object /= System.Null_Address then
         Watch_Closure (Slot_Object, Id.Closure);
      end if;

      return Id;
   end Do_Signal_Connect;

   ---------------
   -- Add_Watch --
   ---------------

   procedure Add_Watch
     (Id : Handler_Id; Object : access Glib.Object.GObject_Record'Class) is
   begin
      pragma Assert (Id.Closure /= null);
      Watch_Closure (Get_Object (Object), Id.Closure);
   end Add_Watch;

   ---------------------
   -- Return_Callback --
   ---------------------

   package body Return_Callback is

      function To_Handler is new Unchecked_Conversion
        (Gtk.Marshallers.General_Handler, Handler);
      function To_General_Handler is new Unchecked_Conversion
        (Handler, Gtk.Marshallers.General_Handler);
      function To_Address is new Unchecked_Conversion
        (Handler, System.Address);
      function To_Address is new Unchecked_Conversion
        (Marshallers.Handler_Proxy, System.Address);

      type Acc is access all Widget_Type'Class;
      --  This type has to be declared at library level, otherwise
      --  Program_Error might be raised when trying to cast from the
      --  parameter of Marshaller to another type.

      type Data_Type_Record is record
         Func     : Handler;
         --  User's callback

         Proxy    : Marshallers.Handler_Proxy := null;
         --  Handler_Proxy to use

         Object   : Acc := null;
         --  Slot Object for Object_Connect
      end record;
      type Data_Type_Access is access all Data_Type_Record;
      pragma Convention (C, Data_Type_Access);
      --  Data passed to the C handler

      function Convert is new Unchecked_Conversion
        (Data_Type_Access, System.Address);
      function Convert is new Unchecked_Conversion
        (System.Address, Data_Type_Access);

      procedure Free_Data (Data : Data_Type_Access);
      pragma Convention (C, Free_Data);
      --  Free the memory associated with the callback's data

      procedure First_Marshaller
        (Closure         : GClosure;
         Return_Value    : GValue;
         N_Params        : Guint;
         Params          : System.Address;
         Invocation_Hint : System.Address;
         User_Data       : System.Address);
      pragma Convention (C, First_Marshaller);
      --  First level marshaller. This is the function that is actually
      --  called by gtk+. It then calls the Ada functions as required.

      -------------
      -- Connect --
      -------------

      procedure Connect
        (Widget : access Widget_Type'Class;
         Name   : String;
         Marsh  : Marshallers.Marshaller;
         After  : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Connect (Widget, Name, Marsh, After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      procedure Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Marsh       : Marshallers.Marshaller;
         Slot_Object : access Widget_Type'Class;
         After       : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Object_Connect (Widget, Name, Marsh, Slot_Object, After);
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      procedure Connect
        (Widget : access Widget_Type'Class;
         Name   : String;
         Cb     : Handler;
         After  : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Connect (Widget, Name, Cb, After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      procedure Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Cb          : Handler;
         Slot_Object : access Widget_Type'Class;
         After       : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Object_Connect (Widget, Name, Cb, Slot_Object, After);
      end Object_Connect;

      ---------------
      -- Free_Data --
      ---------------

      procedure Free_Data (Data : Data_Type_Access) is
         procedure Internal is new Unchecked_Deallocation
           (Data_Type_Record, Data_Type_Access);
         D : Data_Type_Access := Data;

      begin
         Internal (D);
      end Free_Data;

      ----------------------
      -- First_Marshaller --
      ----------------------

      procedure First_Marshaller
        (Closure         : GClosure;
         Return_Value    : GValue;
         N_Params        : Guint;
         Params          : System.Address;
         Invocation_Hint : System.Address;
         User_Data       : System.Address)
      is
         pragma Unreferenced (Invocation_Hint, User_Data);

         use type Marshallers.Handler_Proxy;

         Data   : constant Data_Type_Access := Convert (Get_Data (Closure));
         Stub   : Widget_Type;
         pragma Warnings (Off, Stub);

         Value  : aliased Return_Type;
         Values : GValues;

      begin
         if Data.Func = null then
            return;
         end if;

         Values := Make_Values (N_Params, Params);

         if Data.Object = null then
            if Data.Proxy /= null then
               Value :=
                 Data.Proxy
                   (Acc (Get_User_Data (Get_Address (Nth (Values, 0)), Stub)),
                    Values, To_General_Handler (Data.Func));
            else
               Value :=
                 Data.Func
                   (Acc (Get_User_Data (Get_Address (Nth (Values, 0)), Stub)),
                    Values);
            end if;
         else
            if Data.Proxy /= null then
               Value :=
                 Data.Proxy
                   (Data.Object, Values, To_General_Handler (Data.Func));
            else
               Value := Data.Func (Data.Object, Values);
            end if;
         end if;

         Set_Value (Return_Value, Value'Address);
      end First_Marshaller;

      -------------
      -- Connect --
      -------------

      function Connect
        (Widget  : access Widget_Type'Class;
         Name    : String;
         Marsh   : Marshallers.Marshaller;
         After   : Boolean := False) return Handler_Id
      is
         D : constant Data_Type_Access :=
           new Data_Type_Record'
             (Func     => To_Handler (Marsh.Func),
              Proxy    => Marsh.Proxy,
              Object   => null);
      begin
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_Invalid,
            "Invalid signal for this widget");
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_None,
            "Handlers for this signal should return a value.");

         return Do_Signal_Connect
           (Glib.Object.GObject (Widget),
            Name,
            First_Marshaller'Address,
            To_Address (Marsh.Proxy),
            Convert (D),
            Free_Data'Address,
            After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      function Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Marsh       : Marshallers.Marshaller;
         Slot_Object : access Widget_Type'Class;
         After       : Boolean := False) return Handler_Id
      is
         D : constant Data_Type_Access :=
           new Data_Type_Record'
             (Func     => To_Handler (Marsh.Func),
              Proxy    => Marsh.Proxy,
              Object   => Acc (Slot_Object));

      begin
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_Invalid,
            "Invalid signal for this widget");
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_None,
            "Handlers for this signal should return a value.");

         return Do_Signal_Connect
           (Glib.Object.GObject (Widget),
            Name,
            First_Marshaller'Address,
            To_Address (Marsh.Proxy),
            Convert (D),
            Free_Data'Address,
            After,
            Get_Object (Slot_Object));
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      function Connect
        (Widget  : access Widget_Type'Class;
         Name    : String;
         Cb      : Handler;
         After   : Boolean := False) return Handler_Id
      is
         D : constant Data_Type_Access :=
           new Data_Type_Record'
             (Func     => Cb,
              Proxy    => null,
              Object   => null);

      begin
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_Invalid,
            "Invalid signal for this widget");
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_None,
            "Handlers for this signal should return a value.");

         return Do_Signal_Connect
           (Glib.Object.GObject (Widget),
            Name,
            First_Marshaller'Address,
            To_Address (Cb),
            Convert (D),
            Free_Data'Address,
            After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      function Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Cb          : Handler;
         Slot_Object : access Widget_Type'Class;
         After       : Boolean := False) return Handler_Id
      is
         D : constant Data_Type_Access :=
           new Data_Type_Record'
             (Func     => Cb,
              Proxy    => null,
              Object   => Acc (Slot_Object));

      begin
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_Invalid,
            "Invalid signal for this widget");
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_None,
            "Handlers for this signal should return a value.");

         return Do_Signal_Connect
           (Glib.Object.GObject (Widget),
            Name,
            First_Marshaller'Address,
            To_Address (Cb),
            Convert (D),
            Free_Data'Address,
            After,
            Get_Object (Slot_Object));
      end Object_Connect;

      ------------------
      -- Emit_By_Name --
      ------------------

      function Emit_By_Name
        (Object : access Widget_Type'Class;
         Name   : String;
         Param  : Gdk.Event.Gdk_Event) return Return_Type
      is
         procedure Internal
           (Object : System.Address;
            Name   : String;
            Param  : System.Address;
            Ret    : out Gint);
         pragma Import (C, Internal, "g_signal_emit_by_name");

         B : Gint;
      begin
         pragma Assert (Count_Arguments (Object, Name) = 1);
         Internal
           (Get_Object (Object), Name & ASCII.NUL,
            Gdk.Event.To_Address (Param), B);
         return Return_Type'Val (B);
      end Emit_By_Name;

   end Return_Callback;

   --------------------------
   -- User_Return_Callback --
   --------------------------

   package body User_Return_Callback is

      function To_Handler is new Unchecked_Conversion
        (Gtk.Marshallers.General_Handler, Handler);
      function To_General_Handler is new Unchecked_Conversion
        (Handler, Gtk.Marshallers.General_Handler);
      function To_Address is new Unchecked_Conversion
        (Handler, System.Address);
      function To_Address is new Unchecked_Conversion
        (Marshallers.Handler_Proxy, System.Address);

      type Acc is access all Widget_Type'Class;
      --  This type has to be declared at library level, otherwise
      --  Program_Error might be raised when trying to cast from the
      --  parameter of Marshaller to another type.

      type User_Access is access User_Type;
      type Data_Type_Record is record
         Func  : Handler;
         --  User's callback

         Proxy : Marshallers.Handler_Proxy := null;
         --  Handler_Proxy to use

         User  : User_Access := null;
         Object   : Acc := null;
         --  Slot Object for Object_Connect
      end record;
      type Data_Type_Access is access all Data_Type_Record;
      pragma Convention (C, Data_Type_Access);
      --  Data passed to the C handler

      function Convert is new Unchecked_Conversion
        (Data_Type_Access, System.Address);
      function Convert is new Unchecked_Conversion
        (System.Address, Data_Type_Access);

      procedure Free_Data (Data : Data_Type_Access);
      pragma Convention (C, Free_Data);
      --  Free the memory associated with the callback's data

      procedure First_Marshaller
        (Closure         : GClosure;
         Return_Value    : GValue;
         N_Params        : Guint;
         Params          : System.Address;
         Invocation_Hint : System.Address;
         User_Data       : System.Address);
      pragma Convention (C, First_Marshaller);
      --  First level marshaller. This is the function that is actually
      --  called by gtk+. It then calls the Ada functions as required.

      ---------------
      -- Free_Data --
      ---------------

      procedure Free_Data (Data : Data_Type_Access) is
         procedure Internal is new Unchecked_Deallocation
           (Data_Type_Record, Data_Type_Access);
         procedure Internal2 is new Unchecked_Deallocation
           (User_Type, User_Access);
         D : Data_Type_Access := Data;

      begin
         Internal2 (D.User);
         Internal (D);
      end Free_Data;

      ----------------------
      -- First_Marshaller --
      ----------------------

      procedure First_Marshaller
        (Closure         : GClosure;
         Return_Value    : GValue;
         N_Params        : Guint;
         Params          : System.Address;
         Invocation_Hint : System.Address;
         User_Data       : System.Address)
      is
         pragma Unreferenced (Invocation_Hint, User_Data);

         use type Marshallers.Handler_Proxy;

         Data   : constant Data_Type_Access := Convert (Get_Data (Closure));
         Stub   : Widget_Type;
         pragma Warnings (Off, Stub);
         Value  : aliased Return_Type;
         Values : GValues;

      begin
         if Data.Func = null then
            return;
         end if;

         Values := Make_Values (N_Params, Params);

         if Data.Object /= null then
            if Data.Proxy /= null then
               Value := Data.Proxy
                 (Data.Object, Values, To_General_Handler (Data.Func),
                  Data.User.all);
            else
               Value := Data.Func (Data.Object, Values, Data.User.all);
            end if;

         elsif Data.Proxy /= null then
            Value := Data.Proxy
              (Acc (Get_User_Data (Get_Address (Nth (Values, 0)), Stub)),
               Values, To_General_Handler (Data.Func), Data.User.all);
         else
            Value := Data.Func
              (Acc (Get_User_Data (Get_Address (Nth (Values, 0)), Stub)),
               Values, Data.User.all);
         end if;

         Set_Value (Return_Value, Value'Address);
      end First_Marshaller;

      -------------
      -- Connect --
      -------------

      procedure Connect
        (Widget    : access Widget_Type'Class;
         Name      : String;
         Marsh     : Marshallers.Marshaller;
         User_Data : User_Type;
         After     : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Connect (Widget, Name, Marsh, User_Data, After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      procedure Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Marsh       : Marshallers.Marshaller;
         Slot_Object : access Widget_Type'Class;
         User_Data   : User_Type;
         After       : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Object_Connect
           (Widget, Name, Marsh, Slot_Object, User_Data, After);
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      procedure Connect
        (Widget    : access Widget_Type'Class;
         Name      : String;
         Cb        : Handler;
         User_Data : User_Type;
         After     : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Connect (Widget, Name, Cb, User_Data, After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      procedure Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Cb          : Handler;
         Slot_Object : access Widget_Type'Class;
         User_Data   : User_Type;
         After       : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Object_Connect
           (Widget, Name, Cb, Slot_Object, User_Data, After);
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      function Connect
        (Widget    : access Widget_Type'Class;
         Name      : String;
         Marsh     : Marshallers.Marshaller;
         User_Data : User_Type;
         After     : Boolean := False)
        return Handler_Id
      is
         D : constant Data_Type_Access := new Data_Type_Record'
           (Func     => To_Handler (Marsh.Func),
            Proxy    => Marsh.Proxy,
            User     => new User_Type'(User_Data),
            Object   => null);
      begin
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_Invalid,
            "Invalid signal for this widget");
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_None,
            "Handlers for this signal should return a value.");

         return Do_Signal_Connect
           (Glib.Object.GObject (Widget),
            Name,
            First_Marshaller'Address,
            To_Address (Marsh.Proxy),
            Convert (D),
            Free_Data'Address,
            After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      function Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Marsh       : Marshallers.Marshaller;
         Slot_Object : access Widget_Type'Class;
         User_Data   : User_Type;
         After       : Boolean := False) return Handler_Id
      is
         D : constant Data_Type_Access := new Data_Type_Record'
           (Func     => To_Handler (Marsh.Func),
            Proxy    => Marsh.Proxy,
            User     => new User_Type'(User_Data),
            Object   => Acc (Slot_Object));
      begin
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_Invalid,
            "Invalid signal for this widget");
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_None,
            "Handlers for this signal should return a value.");

         return Do_Signal_Connect
           (Glib.Object.GObject (Widget),
            Name,
            First_Marshaller'Address,
            To_Address (Marsh.Proxy),
            Convert (D),
            Free_Data'Address,
            After,
            Get_Object (Slot_Object));
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      function Connect
        (Widget    : access Widget_Type'Class;
         Name      : String;
         Cb        : Handler;
         User_Data : User_Type;
         After     : Boolean := False) return Handler_Id
      is
         D : constant Data_Type_Access := new Data_Type_Record'
           (Func     => Cb,
            Proxy    => null,
            User     => new User_Type'(User_Data),
            Object   => null);
      begin
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_Invalid,
            "Invalid signal for this widget");
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_None,
            "Handlers for this signal should return a value.");

         return Do_Signal_Connect
           (Glib.Object.GObject (Widget),
            Name,
            First_Marshaller'Address,
            To_Address (Cb),
            Convert (D),
            Free_Data'Address,
            After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      function Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Cb          : Handler;
         Slot_Object : access Widget_Type'Class;
         User_Data   : User_Type;
         After       : Boolean := False) return Handler_Id
      is
         D : constant Data_Type_Access := new Data_Type_Record'
           (Func     => Cb,
            Proxy    => null,
            User     => new User_Type'(User_Data),
            Object   => Acc (Slot_Object));
      begin
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_Invalid,
            "Invalid signal for this widget");
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_None,
            "Handlers for this signal should return a value.");

         return Do_Signal_Connect
           (Glib.Object.GObject (Widget),
            Name,
            First_Marshaller'Address,
            To_Address (Cb),
            Convert (D),
            Free_Data'Address,
            After,
            Get_Object (Slot_Object));
      end Object_Connect;

      ------------------
      -- Emit_By_Name --
      ------------------

      function Emit_By_Name
        (Object : access Widget_Type'Class;
         Name   : String;
         Param  : Gdk.Event.Gdk_Event) return Return_Type
      is
         procedure Internal
           (Object : System.Address;
            Name   : String;
            Param  : System.Address;
            Ret    : out Gint);
         pragma Import (C, Internal, "g_signal_emit_by_name");

         B : Gint;
      begin
         pragma Assert (Count_Arguments (Object, Name) = 1);
         Internal
           (Get_Object (Object), Name & ASCII.NUL,
            Gdk.Event.To_Address (Param), B);
         return Return_Type'Val (B);
      end Emit_By_Name;

   end User_Return_Callback;

   --------------
   -- Callback --
   --------------

   package body Callback is

      function To_Handler is new Unchecked_Conversion
        (Gtk.Marshallers.General_Handler, Handler);
      function To_General_Handler is new Unchecked_Conversion
        (Handler, Gtk.Marshallers.General_Handler);
      function To_Address is new Unchecked_Conversion
        (Handler, System.Address);
      function To_Address is new Unchecked_Conversion
        (Marshallers.Handler_Proxy, System.Address);

      type Acc is access all Widget_Type'Class;
      --  This type has to be declared at library level, otherwise
      --  Program_Error might be raised when trying to cast from the
      --  parameter of Marshaller to another type.

      type Data_Type_Record is record
         Func   : Handler;             --  User's callback
         Proxy  : Marshallers.Handler_Proxy := null;  --  Handler_Proxy to use
         Object : Acc := null;         --  Slot Object for Object_Connect
      end record;
      type Data_Type_Access is access all Data_Type_Record;
      pragma Convention (C, Data_Type_Access);
      --  Data passed to the C handler

      function Convert is new Unchecked_Conversion
        (Data_Type_Access, System.Address);
      function Convert is new Unchecked_Conversion
        (System.Address, Data_Type_Access);

      procedure Free_Data (Data : Data_Type_Access);
      pragma Convention (C, Free_Data);
      --  Free the memory associated with the callback's data

      procedure First_Marshaller
        (Closure         : GClosure;
         Return_Value    : GValue;
         N_Params        : Guint;
         Params          : System.Address;
         Invocation_Hint : System.Address;
         User_Data       : System.Address);
      pragma Convention (C, First_Marshaller);
      --  First level marshaller. This is the function that is actually
      --  called by gtk+. It then calls the Ada functions as required.

      ---------------
      -- Free_Data --
      ---------------

      procedure Free_Data (Data : Data_Type_Access) is
         procedure Internal is new Unchecked_Deallocation
           (Data_Type_Record, Data_Type_Access);
         D : Data_Type_Access := Data;

      begin
         Internal (D);
      end Free_Data;

      ----------------------
      -- First_Marshaller --
      ----------------------

      procedure First_Marshaller
        (Closure         : GClosure;
         Return_Value    : GValue;
         N_Params        : Guint;
         Params          : System.Address;
         Invocation_Hint : System.Address;
         User_Data       : System.Address)
      is
         pragma Unreferenced (Invocation_Hint, User_Data, Return_Value);

         use type Marshallers.Handler_Proxy;

         Data   : constant Data_Type_Access := Convert (Get_Data (Closure));
         Stub   : Widget_Type;
         pragma Warnings (Off, Stub);

         Values : GValues;

      begin
         if Data.Func = null then
            return;
         end if;

         Values := Make_Values (N_Params, Params);

         if Data.Object = null then
            if Data.Proxy /= null then
               Data.Proxy
                 (Acc (Get_User_Data (Get_Address (Nth (Values, 0)), Stub)),
                  Values, To_General_Handler (Data.Func));
            else
               Data.Func
                 (Acc (Get_User_Data (Get_Address (Nth (Values, 0)), Stub)),
                  Values);
            end if;
         else
            if Data.Proxy /= null then
               Data.Proxy
                 (Data.Object, Values, To_General_Handler (Data.Func));
            else
               Data.Func (Data.Object, Values);
            end if;
         end if;
      end First_Marshaller;

      -------------
      -- Connect --
      -------------

      procedure Connect
        (Widget : access Widget_Type'Class;
         Name   : String;
         Marsh  : Marshallers.Marshaller;
         After  : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Connect (Widget, Name, Marsh, After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      procedure Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Marsh       : Marshallers.Marshaller;
         Slot_Object : access Widget_Type'Class;
         After       : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Object_Connect (Widget, Name, Marsh, Slot_Object, After);
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      procedure Connect
        (Widget : access Widget_Type'Class;
         Name   : String;
         Cb     : Handler;
         After  : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Connect (Widget, Name, Cb, After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      procedure Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Cb          : Handler;
         Slot_Object : access Widget_Type'Class;
         After       : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Object_Connect (Widget, Name, Cb, Slot_Object, After);
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      function Connect
        (Widget  : access Widget_Type'Class;
         Name    : String;
         Marsh   : Marshallers.Marshaller;
         After   : Boolean := False)
        return Handler_Id
      is
         D : constant Data_Type_Access :=
           new Data_Type_Record'
             (Func  => To_Handler (Marsh.Func),
              Proxy => Marsh.Proxy,
              Object => null);

      begin
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_Invalid,
            "Invalid signal for this widget");
         pragma Assert
           (Type_Of_Return (Widget, Name) = GType_None,
            "Handlers for this signal should return a value.");

         return Do_Signal_Connect
           (Glib.Object.GObject (Widget),
            Name,
            First_Marshaller'Address,
            To_Address (Marsh.Proxy),
            Convert (D),
            Free_Data'Address,
            After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      function Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Marsh       : Marshallers.Marshaller;
         Slot_Object : access Widget_Type'Class;
         After       : Boolean := False) return Handler_Id
      is
         D : constant Data_Type_Access :=
           new Data_Type_Record'
             (Func  => To_Handler (Marsh.Func),
              Proxy => Marsh.Proxy,
              Object => Acc (Slot_Object));

      begin
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_Invalid,
            "Invalid signal for this widget");
         pragma Assert
           (Type_Of_Return (Widget, Name) = GType_None,
            "Handlers for this signal should return a value.");

         return Do_Signal_Connect
           (Glib.Object.GObject (Widget),
            Name,
            First_Marshaller'Address,
            To_Address (Marsh.Proxy),
            Convert (D),
            Free_Data'Address,
            After,
            Get_Object (Slot_Object));
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      function Connect
        (Widget  : access Widget_Type'Class;
         Name    : String;
         Cb      : Handler;
         After   : Boolean := False)
        return Handler_Id
      is
         D : constant Data_Type_Access :=
           new Data_Type_Record'(Func => Cb, Proxy => null, Object => null);

      begin
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_Invalid,
            "Invalid signal for this widget");
         pragma Assert
           (Type_Of_Return (Widget, Name) = GType_None,
            "Handlers for this signal should not return a value.");

         return Do_Signal_Connect
           (Glib.Object.GObject (Widget),
            Name,
            First_Marshaller'Address,
            To_Address (Cb),
            Convert (D),
            Free_Data'Address,
            After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      function Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Cb          : Handler;
         Slot_Object : access Widget_Type'Class;
         After       : Boolean := False) return Handler_Id
      is
         D : constant Data_Type_Access :=
           new Data_Type_Record'
             (Func   => Cb,
              Proxy  => null,
              Object => Acc (Slot_Object));

      begin
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_Invalid,
            "Invalid signal for this widget");
         pragma Assert
           (Type_Of_Return (Widget, Name) = GType_None,
            "Handlers for this signal should not return a value.");

         return Do_Signal_Connect
           (Glib.Object.GObject (Widget),
            Name,
            First_Marshaller'Address,
            To_Address (Cb),
            Convert (D),
            Free_Data'Address,
            After,
            Get_Object (Slot_Object));
      end Object_Connect;

      ------------------
      -- Emit_By_Name --
      ------------------

      procedure Emit_By_Name
        (Object : access Widget_Type'Class;
         Name   : String;
         Param  : Gdk.Event.Gdk_Event)
      is
         procedure Internal
           (Object : System.Address;
            Name   : String;
            Param  : System.Address;
            Last   : System.Address := System.Null_Address);
         pragma Import (C, Internal, "g_signal_emit_by_name");
      begin
         pragma Assert (Count_Arguments (Object, Name) = 1);
         Internal
           (Get_Object (Object), Name & ASCII.NUL,
            Gdk.Event.To_Address (Param));
      end Emit_By_Name;

   end Callback;

   -------------------
   -- User_Callback --
   -------------------

   package body User_Callback is

      function To_Handler is new Unchecked_Conversion
        (Gtk.Marshallers.General_Handler, Handler);
      function To_General_Handler is new Unchecked_Conversion
        (Handler, Gtk.Marshallers.General_Handler);
      function To_Address is new Unchecked_Conversion
        (Handler, System.Address);
      function To_Address is new Unchecked_Conversion
        (Marshallers.Handler_Proxy, System.Address);

      type Acc is access all Widget_Type'Class;
      --  This type has to be declared at library level, otherwise
      --  Program_Error might be raised when trying to cast from the
      --  parameter of Marshaller to another type.

      type User_Access is access User_Type;
      type Data_Type_Record is record
         Func   : Handler;
         --  User's callback

         Proxy  : Marshallers.Handler_Proxy := null;
         --  Handler_Proxy to use

         User   : User_Access := null;
         Object : Acc := null;
         --  Slot_Object for Object_Connect
      end record;
      type Data_Type_Access is access all Data_Type_Record;
      pragma Convention (C, Data_Type_Access);
      --  Data passed to the C handler

      function Convert is new Unchecked_Conversion
        (Data_Type_Access, System.Address);
      function Convert is new Unchecked_Conversion
        (System.Address, Data_Type_Access);

      procedure Free_Data (Data : Data_Type_Access);
      pragma Convention (C, Free_Data);
      --  Free the memory associated with the callback's data

      procedure First_Marshaller
        (Closure         : GClosure;
         Return_Value    : GValue;
         N_Params        : Guint;
         Params          : System.Address;
         Invocation_Hint : System.Address;
         User_Data       : System.Address);
      pragma Convention (C, First_Marshaller);
      --  First level marshaller. This is the function that is actually
      --  called by gtk+. It then calls the Ada functions as required.

      ---------------
      -- Free_Data --
      ---------------

      procedure Free_Data (Data : Data_Type_Access) is
         procedure Internal is new Unchecked_Deallocation
           (Data_Type_Record, Data_Type_Access);
         procedure Internal2 is new Unchecked_Deallocation
           (User_Type, User_Access);
         D : Data_Type_Access := Data;
      begin
         Internal2 (D.User);
         Internal (D);
      end Free_Data;

      ----------------------
      -- First_Marshaller --
      ----------------------

      procedure First_Marshaller
        (Closure         : GClosure;
         Return_Value    : GValue;
         N_Params        : Guint;
         Params          : System.Address;
         Invocation_Hint : System.Address;
         User_Data       : System.Address)
      is
         pragma Unreferenced (Invocation_Hint, User_Data, Return_Value);

         use type Marshallers.Handler_Proxy;

         Data   : constant Data_Type_Access := Convert (Get_Data (Closure));
         Stub   : Widget_Type;
         pragma Warnings (Off, Stub);
         Values : GValues;

      begin
         if Data.Func = null then
            return;
         end if;

         Values := Make_Values (N_Params, Params);

         if Data.Object /= null then
            if Data.Proxy /= null then
               Data.Proxy
                 (Data.Object, Values, To_General_Handler (Data.Func),
                  Data.User.all);
            else
               Data.Func (Data.Object, Values, Data.User.all);
            end if;

         elsif Data.Proxy /= null then
            Data.Proxy
              (Acc (Get_User_Data (Get_Address (Nth (Values, 0)), Stub)),
               Values, To_General_Handler (Data.Func), Data.User.all);
         else
            Data.Func
              (Acc (Get_User_Data (Get_Address (Nth (Values, 0)), Stub)),
               Values, Data.User.all);
         end if;
      end First_Marshaller;

      -------------
      -- Connect --
      -------------

      procedure Connect
        (Widget    : access Widget_Type'Class;
         Name      : String;
         Marsh     : Marshallers.Marshaller;
         User_Data : User_Type;
         After     : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Connect (Widget, Name, Marsh, User_Data, After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      procedure Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Marsh       : Marshallers.Marshaller;
         Slot_Object : access Widget_Type'Class;
         User_Data   : User_Type;
         After       : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Object_Connect
           (Widget, Name, Marsh, Slot_Object, User_Data, After);
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      procedure Connect
        (Widget    : access Widget_Type'Class;
         Name      : String;
         Cb        : Handler;
         User_Data : User_Type;
         After     : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Connect (Widget, Name, Cb, User_Data, After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      procedure Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Cb          : Handler;
         Slot_Object : access Widget_Type'Class;
         User_Data   : User_Type;
         After       : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Object_Connect
           (Widget, Name, Cb, Slot_Object, User_Data, After);
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      function Connect
        (Widget    : access Widget_Type'Class;
         Name      : String;
         Marsh     : Marshallers.Marshaller;
         User_Data : User_Type;
         After     : Boolean := False) return Handler_Id
      is
         D : constant Data_Type_Access := new Data_Type_Record'
           (Func   => To_Handler (Marsh.Func),
            Proxy  => Marsh.Proxy,
            User   => new User_Type'(User_Data),
            Object => null);
      begin
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_Invalid,
            "Invalid signal for this widget");
         pragma Assert
           (Type_Of_Return (Widget, Name) = GType_None,
            "Handlers for this signal should not return a value.");

         return Do_Signal_Connect
           (Glib.Object.GObject (Widget),
            Name,
            First_Marshaller'Address,
            To_Address (Marsh.Proxy),
            Convert (D),
            Free_Data'Address,
            After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      function Object_Connect
        (Widget      : access GObject_Record'Class;
         Name        : String;
         Marsh       : Marshallers.Marshaller;
         Slot_Object : access Widget_Type'Class;
         User_Data   : User_Type;
         After       : Boolean := False) return Handler_Id
      is
         D : constant Data_Type_Access := new Data_Type_Record'
           (Func  => To_Handler (Marsh.Func),
            Proxy => Marsh.Proxy,
            User  => new User_Type'(User_Data),
            Object => Acc (Slot_Object));
      begin
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_Invalid,
            "Invalid signal for this widget");
         pragma Assert
           (Type_Of_Return (Widget, Name) = GType_None,
            "Handlers for this signal should not return a value.");

         return Do_Signal_Connect
           (Glib.Object.GObject (Widget),
            Name,
            First_Marshaller'Address,
            To_Address (Marsh.Proxy),
            Convert (D),
            Free_Data'Address,
            After,
            Get_Object (Slot_Object));
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      function Connect
        (Widget    : access Widget_Type'Class;
         Name      : String;
         Cb        : Handler;
         User_Data : User_Type;
         After     : Boolean := False) return Handler_Id
      is
         D : constant Data_Type_Access := new Data_Type_Record'
           (Func   => Cb,
            Proxy  => null,
            User   => new User_Type'(User_Data),
            Object => null);

      begin
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_Invalid,
            "Invalid signal for this widget");
         pragma Assert
           (Type_Of_Return (Widget, Name) = GType_None,
            "Handlers for this signal should not return a value.");

         return Do_Signal_Connect
           (Glib.Object.GObject (Widget),
            Name,
            First_Marshaller'Address,
            To_Address (Cb),
            Convert (D),
            Free_Data'Address,
            After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      function Object_Connect
        (Widget      : access GObject_Record'Class;
         Name        : String;
         Cb          : Handler;
         Slot_Object : access Widget_Type'Class;
         User_Data   : User_Type;
         After       : Boolean := False) return Handler_Id
      is
         D : constant Data_Type_Access := new Data_Type_Record'
           (Func   => Cb,
            Proxy  => null,
            User   => new User_Type'(User_Data),
            Object => Acc (Slot_Object));
      begin
         pragma Assert
           (Type_Of_Return (Widget, Name) /= GType_Invalid,
            "Invalid signal for this widget");
         pragma Assert
           (Type_Of_Return (Widget, Name) = GType_None,
            "Handlers for this signal should not return a value.");

         return Do_Signal_Connect
           (Glib.Object.GObject (Widget),
            Name,
            First_Marshaller'Address,
            To_Address (Cb),
            Convert (D),
            Free_Data'Address,
            After,
            Get_Object (Slot_Object));
      end Object_Connect;

      ------------------
      -- Emit_By_Name --
      ------------------

      procedure Emit_By_Name
        (Object : access Widget_Type'Class;
         Name   : String;
         Param  : Gdk.Event.Gdk_Event)
      is
         procedure Internal
           (Object : System.Address;
            Name   : String;
            Param  : System.Address;
            Last   : System.Address := System.Null_Address);
         pragma Import (C, Internal, "g_signal_emit_by_name");

      begin
         pragma Assert (Count_Arguments (Object, Name) = 1);
         Internal
           (Get_Object (Object), Name & ASCII.NUL,
            Gdk.Event.To_Address (Param));
      end Emit_By_Name;

   end User_Callback;

   -------------------------------------
   -- User_Return_Callback_With_Setup --
   -------------------------------------

   package body User_Return_Callback_With_Setup is

      -------------
      -- Connect --
      -------------

      procedure Connect
        (Widget    : access Widget_Type'Class;
         Name      : String;
         Marsh     : Internal_Cb.Marshallers.Marshaller;
         User_Data : User_Type;
         After     : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Connect (Widget, Name, Marsh, User_Data, After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      procedure Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Marsh       : Internal_Cb.Marshallers.Marshaller;
         Slot_Object : access Widget_Type'Class;
         User_Data   : User_Type;
         After       : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Object_Connect
           (Widget, Name, Marsh, Slot_Object, User_Data, After);
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      procedure Connect
        (Widget    : access Widget_Type'Class;
         Name      : String;
         Cb        : Handler;
         User_Data : User_Type;
         After     : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Connect (Widget, Name, Cb, User_Data, After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      procedure Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Cb          : Handler;
         Slot_Object : access Widget_Type'Class;
         User_Data   : User_Type;
         After       : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Object_Connect
           (Widget, Name, Cb, Slot_Object, User_Data, After);
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      function Connect
        (Widget    : access Widget_Type'Class;
         Name      : String;
         Marsh     : Internal_Cb.Marshallers.Marshaller;
         User_Data : User_Type;
         After     : Boolean := False) return Handler_Id
      is
         Id : constant Handler_Id := Internal_Cb.Connect
           (Widget, Name, Marsh, User_Data, After);
      begin
         Setup (User_Data, Id);
         return Id;
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      function Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Marsh       : Internal_Cb.Marshallers.Marshaller;
         Slot_Object : access Widget_Type'Class;
         User_Data   : User_Type;
         After       : Boolean := False) return Handler_Id
      is
         Id : constant Handler_Id := Internal_Cb.Object_Connect
           (Widget, Name, Marsh, Slot_Object, User_Data, After);
      begin
         Setup (User_Data, Id);
         return Id;
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      function Connect
        (Widget    : access Widget_Type'Class;
         Name      : String;
         Cb        : Handler;
         User_Data : User_Type;
         After     : Boolean := False) return Handler_Id
      is
         Id : constant Handler_Id := Internal_Cb.Connect
           (Widget, Name, Cb, User_Data, After);
      begin
         Setup (User_Data, Id);
         return Id;
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      function Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Cb          : Handler;
         Slot_Object : access Widget_Type'Class;
         User_Data   : User_Type;
         After       : Boolean := False) return Handler_Id
      is
         Id : constant Handler_Id := Internal_Cb.Object_Connect
           (Widget, Name, Cb, Slot_Object, User_Data, After);
      begin
         Setup (User_Data, Id);
         return Id;
      end Object_Connect;

   end User_Return_Callback_With_Setup;

   ------------------------------
   -- User_Callback_With_Setup --
   ------------------------------

   package body User_Callback_With_Setup is

      -------------
      -- Connect --
      -------------

      procedure Connect
        (Widget    : access Widget_Type'Class;
         Name      : String;
         Marsh     : Internal_Cb.Marshallers.Marshaller;
         User_Data : User_Type;
         After     : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Connect (Widget, Name, Marsh, User_Data, After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      procedure Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Marsh       : Internal_Cb.Marshallers.Marshaller;
         Slot_Object : access Widget_Type'Class;
         User_Data   : User_Type;
         After       : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Object_Connect
           (Widget, Name, Marsh, Slot_Object, User_Data, After);
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      procedure Connect
        (Widget    : access Widget_Type'Class;
         Name      : String;
         Cb        : Handler;
         User_Data : User_Type;
         After     : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Connect (Widget, Name, Cb, User_Data, After);
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      procedure Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Cb          : Handler;
         Slot_Object : access Widget_Type'Class;
         User_Data   : User_Type;
         After       : Boolean := False)
      is
         Id : Handler_Id;
         pragma Warnings (Off, Id);
      begin
         Id := Object_Connect
           (Widget, Name, Cb, Slot_Object, User_Data, After);
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      function Connect
        (Widget    : access Widget_Type'Class;
         Name      : String;
         Marsh     : Internal_Cb.Marshallers.Marshaller;
         User_Data : User_Type;
         After     : Boolean := False) return Handler_Id
      is
         Id : constant Handler_Id := Internal_Cb.Connect
           (Widget, Name, Marsh, User_Data, After);
      begin
         Setup (User_Data, Id);
         return Id;
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      function Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Marsh       : Internal_Cb.Marshallers.Marshaller;
         Slot_Object : access Widget_Type'Class;
         User_Data   : User_Type;
         After       : Boolean := False) return Handler_Id
      is
         Id : constant Handler_Id := Internal_Cb.Object_Connect
           (Widget, Name, Marsh, Slot_Object, User_Data, After);
      begin
         Setup (User_Data, Id);
         return Id;
      end Object_Connect;

      -------------
      -- Connect --
      -------------

      function Connect
        (Widget    : access Widget_Type'Class;
         Name      : String;
         Cb        : Handler;
         User_Data : User_Type;
         After     : Boolean := False) return Handler_Id
      is
         Id : constant Handler_Id := Internal_Cb.Connect
           (Widget, Name, Cb, User_Data, After);
      begin
         Setup (User_Data, Id);
         return Id;
      end Connect;

      --------------------
      -- Object_Connect --
      --------------------

      function Object_Connect
        (Widget      : access Glib.Object.GObject_Record'Class;
         Name        : String;
         Cb          : Handler;
         Slot_Object : access Widget_Type'Class;
         User_Data   : User_Type;
         After       : Boolean := False) return Handler_Id
      is
         Id : constant Handler_Id := Internal_Cb.Object_Connect
           (Widget, Name, Cb, Slot_Object, User_Data, After);
      begin
         Setup (User_Data, Id);
         return Id;
      end Object_Connect;

   end User_Callback_With_Setup;

   ----------------
   -- Disconnect --
   ----------------

   procedure Disconnect
     (Object : access Glib.Object.GObject_Record'Class;
      Id     : in out Handler_Id) is
   begin
      if Id.Signal /= Null_Signal_Id then
         Disconnect_Internal (Obj => Get_Object (Object), Id  => Id.Signal);
         Id.Signal := Null_Signal_Id;
      end if;
   end Disconnect;

   -----------------------
   -- Emit_Stop_By_Name --
   -----------------------

   procedure Emit_Stop_By_Name
     (Object : access Glib.Object.GObject_Record'Class;
      Name   : String)
   is
      procedure Internal
        (Object : System.Address;
         Signal_Id : Guint;
         Detail : GQuark := Unknown_Quark);
      pragma Import (C, Internal, "g_signal_stop_emission");
   begin
      Internal
        (Get_Object (Object),
         Signal_Lookup (Name & ASCII.NUL, Get_Type (Object)));
   end Emit_Stop_By_Name;

   -------------------
   -- Handler_Block --
   -------------------

   procedure Handler_Block
     (Obj : access Glib.Object.GObject_Record'Class;
      Id  : Handler_Id)
   is
      procedure Internal (Obj : System.Address; Id : Signal_Id);
      pragma Import (C, Internal, "g_signal_handler_block");

   begin
      Internal (Obj => Get_Object (Obj), Id  => Id.Signal);
   end Handler_Block;

   ----------------------
   -- Handlers_Destroy --
   ----------------------

   procedure Handlers_Destroy (Obj : access Glib.Object.GObject_Record'Class)
   is
      procedure Internal (Obj : System.Address);
      pragma Import (C, Internal, "g_signal_handlers_destroy");

   begin
      Internal (Obj => Get_Object (Obj));
   end Handlers_Destroy;

   ---------------------
   -- Handler_Unblock --
   ---------------------

   procedure Handler_Unblock
     (Obj : access Glib.Object.GObject_Record'Class;
      Id  : Handler_Id)
   is
      procedure Internal (Obj : System.Address; Id : Signal_Id);
      pragma Import (C, Internal, "g_signal_handler_unblock");
   begin
      Internal (Obj => Get_Object (Obj), Id  => Id.Signal);
   end Handler_Unblock;

end Gtk.Handlers;

--  Design of the package:
--
--  The callback package should accomodate the following:
--  * Sometimes, the user does not want to get the handler_id.  Thus, we give
--    the two versions of Connect, either as a procedure or a function.
--  * Some gtk+ signals expect a handler that returns a value, whereas others
--    return nothing. The simplest here is to have two kinds of packages, one
--    for each case.  The standard gtk+ signals (up to 1.2) have the following
--    possible return values: gboolean, gchar*, gint, guint, void
--  * The first argument to a handler is always a Gtk Object.  since GtkAda is
--    full object oriented, we could simply have the first parameter be a
--    GObject'Class, but this would require in most cases an explicit cast
--    from the user. It is nice to give the opportunity to have a specific
--    type.
--  * The standard callbacks can have any number of arguments (or even
--    none). These arguments depend on the signal type, and the widget type.
--    The only possibility to cover all the cases is to pass these arguments as
--    an array. The package Marshallers provides a convenient interface between
--    these general callbacks and a more usual implementation.
--  * The user can specify some Data to be passed to the handler.  Or there
--    can be none. Once again, we create two versions of the standard packages.
--
--  How the callbacks work:
--     --------      --------------------      ---------------------
--     | Gtk+ |  ->  | First_Marshaller |  ->  | User's Marshaller |
--     --------      --------------------      ---------------------
--                                   \                 |
--                                    \  or            V
--                                     \       -------------------
--                                      \--->  | User's Callback |
--                                             -------------------
--
--  First_Marshaller is an internal function defined in this package. It
--  creates its own user data to memorize both the User's Marshaller (if any),
--  User's Callback, and the User's Data (if any). It then calls the
--  appropriate function in the user's code.
--  The user_data of First_Marshaller is automatically deallocated when the
--  callback is disconnected or the widget is killed, using some capabilities
--  of gtk+ itself.
