-----------------------------------------------------------------------
--               GtkAda - Ada95 binding for Gtk+/Gnome               --
--                                                                   --
--   Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet   --
--                Copyright (C) 2000-2003 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 System;
with Gtk.Menu_Item;  use Gtk.Menu_Item;
with Gtk.Menu_Shell; use Gtk.Menu_Shell;
with Glib.Type_Conversion_Hooks;
pragma Elaborate_All (Glib.Type_Conversion_Hooks);
with Interfaces.C.Strings; use Interfaces.C.Strings;

package body Gtk.Menu is

   function Type_Conversion (Type_Name : String) return GObject;
   --  This function is used to implement a minimal automated type conversion
   --  without having to drag the whole Gtk.Type_Conversion package for the
   --  most common widgets.

   ----------------------
   -- Attach_To_Widget --
   ----------------------

   procedure Attach_To_Widget
     (Menu          : access Gtk_Menu_Record;
      Attach_Widget : access Gtk.Widget.Gtk_Widget_Record'Class;
      Detacher      : Gtk_Menu_Detach_Func)
   is
      procedure Internal
        (Menu          : System.Address;
         Attach_Widget : System.Address;
         Detacher      : Gtk_Menu_Detach_Func);
      pragma Import (C, Internal, "gtk_menu_attach_to_widget");

   begin
      Internal (Get_Object (Menu), Get_Object (Attach_Widget), Detacher);
   end Attach_To_Widget;

   ------------
   -- Detach --
   ------------

   procedure Detach (Menu : access Gtk_Menu_Record) is
      procedure Internal (Menu : System.Address);
      pragma Import (C, Internal, "gtk_menu_detach");

   begin
      Internal (Get_Object (Menu));
   end Detach;

   ---------------------
   -- Get_Accel_Group --
   ---------------------

   function Get_Accel_Group
     (Menu : access Gtk_Menu_Record) return Accel_Group.Gtk_Accel_Group
   is
      function Internal
        (Menu : System.Address) return System.Address;
      pragma Import (C, Internal, "gtk_menu_get_accel_group");

      Stub : Accel_Group.Gtk_Accel_Group_Record;

   begin
      return Accel_Group.Gtk_Accel_Group
        (Get_User_Data_Fast (Internal (Get_Object (Menu)), Stub));
   end Get_Accel_Group;

   ----------------
   -- Get_Active --
   ----------------

   function Get_Active
     (Menu : access Gtk_Menu_Record) return Gtk.Menu_Item.Gtk_Menu_Item
   is
      function Internal (Menu : System.Address) return System.Address;
      pragma Import (C, Internal, "gtk_menu_get_active");

      Stub : Gtk.Menu_Item.Gtk_Menu_Item_Record;

   begin
      return Gtk.Menu_Item.Gtk_Menu_Item
        (Get_User_Data (Internal (Get_Object (Menu)), Stub));
   end Get_Active;

   -----------------------
   -- Get_Attach_Widget --
   -----------------------

   function Get_Attach_Widget
     (Menu : access Gtk_Menu_Record) return Gtk.Widget.Gtk_Widget
   is
      function Internal (Menu : System.Address) return System.Address;
      pragma Import (C, Internal, "gtk_menu_get_attach_widget");

   begin
      return Gtk.Widget.Convert (Internal (Get_Object (Menu)));
   end Get_Attach_Widget;

   -----------------------
   -- Get_Tearoff_State --
   -----------------------

   function Get_Tearoff_State (Menu : access Gtk_Menu_Record) return Boolean is
      function Internal (Menu : System.Address) return Gboolean;
      pragma Import (C, Internal, "gtk_menu_get_tearoff_state");

   begin
      return Internal (Get_Object (Menu)) /= 0;
   end Get_Tearoff_State;

   ---------------
   -- Get_Title --
   ---------------

   function Get_Title (Menu : access Gtk_Menu_Record) return UTF8_String is
      function Internal (Menu : System.Address) return chars_ptr;
      pragma Import (C, Internal, "gtk_menu_get_title");

   begin
      return Value (Internal (Get_Object (Menu)));
   end Get_Title;

   -------------
   -- Gtk_New --
   -------------

   procedure Gtk_New (Widget : out Gtk_Menu) is
   begin
      Widget := new Gtk_Menu_Record;
      Gtk.Menu.Initialize (Widget);
   end Gtk_New;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize (Widget : access Gtk_Menu_Record'Class) is
      function Internal return System.Address;
      pragma Import (C, Internal, "gtk_menu_new");

   begin
      Set_Object (Widget, Internal);
   end Initialize;

   -------------
   -- Popdown --
   -------------

   procedure Popdown (Menu : access Gtk_Menu_Record) is
      procedure Internal (Menu : System.Address);
      pragma Import (C, Internal, "gtk_menu_popdown");

   begin
      Internal (Get_Object (Menu));
   end Popdown;

   -------------------
   -- Reorder_Child --
   -------------------

   procedure Reorder_Child
     (Menu     : access Gtk_Menu_Record;
      Child    : access Gtk.Widget.Gtk_Widget_Record'Class;
      Position : Gint)
   is
      procedure Internal
        (Menu     : System.Address;
         Child    : System.Address;
         Position : Gint);
      pragma Import (C, Internal, "gtk_menu_reorder_child");

   begin
      Internal (Get_Object (Menu), Get_Object (Child), Position);
   end Reorder_Child;

   ----------------
   -- Reposition --
   ----------------

   procedure Reposition (Menu : access Gtk_Menu_Record) is
      procedure Internal (Menu : System.Address);
      pragma Import (C, Internal, "gtk_menu_reposition");

   begin
      Internal (Get_Object (Menu));
   end Reposition;

   ---------------------
   -- Set_Accel_Group --
   ---------------------

   procedure Set_Accel_Group
      (Menu    : access Gtk_Menu_Record;
       Accel   : Gtk.Accel_Group.Gtk_Accel_Group)
   is
      procedure Internal
        (Menu        : System.Address;
         Accel_Group : System.Address);
      pragma Import (C, Internal, "gtk_menu_set_accel_group");

   begin
      Internal (Get_Object (Menu), Get_Object (Accel));
   end Set_Accel_Group;

   --------------------
   -- Set_Accel_Path --
   --------------------

   procedure Set_Accel_Path
     (Menu       : access Gtk_Menu_Record;
      Accel_Path : UTF8_String)
   is
      procedure Internal (Menu : System.Address; Accel_Path : UTF8_String);
      pragma Import (C, Internal, "gtk_menu_set_accel_path");

   begin
      Internal (Get_Object (Menu), Accel_Path & ASCII.NUL);
   end Set_Accel_Path;

   ----------------
   -- Set_Active --
   ----------------

   procedure Set_Active (Menu : access Gtk_Menu_Record; Index : Guint) is
      procedure Internal (Menu : System.Address; Index : Guint);
      pragma Import (C, Internal, "gtk_menu_set_active");

   begin
      Internal (Get_Object (Menu), Index);
   end Set_Active;

   ---------------
   -- Set_Title --
   ---------------

   procedure Set_Title (Menu : access Gtk_Menu_Record; Title : UTF8_String) is
      procedure Internal (Menu : System.Address; Title : UTF8_String);
      pragma Import (C, Internal, "gtk_menu_set_title");

   begin
      Internal (Get_Object (Menu), Title & ASCII.NUL);
   end Set_Title;

   -----------------------
   -- Set_Tearoff_State --
   -----------------------

   procedure Set_Tearoff_State
     (Menu     : access Gtk_Menu_Record;
      Torn_Off : Boolean)
   is
      procedure Internal (Menu : System.Address; Torn_Off : Gboolean);
      pragma Import (C, Internal, "gtk_menu_set_tearoff_state");

   begin
      Internal (Get_Object (Menu), Boolean'Pos (Torn_Off));
   end Set_Tearoff_State;

   -----------
   -- Popup --
   -----------

   procedure Popup
     (Menu              : access Gtk_Menu_Record;
      Parent_Menu_Shell : Gtk.Menu_Shell.Gtk_Menu_Shell := null;
      Parent_Menu_Item  : Gtk.Menu_Item.Gtk_Menu_Item := null;
      Func              : Gtk_Menu_Position_Func := null;
      Button            : Guint := 1;
      Activate_Time     : Guint32 := 0)
   is
      procedure Internal
        (Menu          : System.Address;
         Parent_M      : System.Address;
         Parent_I      : System.Address;
         Func          : Gtk_Menu_Position_Func;
         Data          : System.Address;
         Button        : Guint;
         Activate_Time : Guint32);
      pragma Import (C, Internal, "gtk_menu_popup");

      Parent_Shell : System.Address := System.Null_Address;
      Parent_Item  : System.Address := System.Null_Address;

   begin
      if Parent_Menu_Shell /= null then
         Parent_Shell := Get_Object (Parent_Menu_Shell);
      end if;

      if Parent_Menu_Item /= null then
         Parent_Item := Get_Object (Parent_Menu_Item);
      end if;

      Internal (Get_Object (Menu), Parent_Shell, Parent_Item,
                Func, System.Null_Address, Button, Activate_Time);
   end Popup;

   ---------------------------------------
   -- User_Menu_Popup (generic package) --
   ---------------------------------------

   package body User_Menu_Popup is

      -----------
      -- Popup --
      -----------

      procedure Popup
        (Menu              : access Gtk_Menu_Record;
         Data              : access Data_Type;
         Parent_Menu_Shell : Gtk.Menu_Shell.Gtk_Menu_Shell := null;
         Parent_Menu_Item  : Gtk.Menu_Item.Gtk_Menu_Item := null;
         Func              : Gtk_Menu_Position_Func := null;
         Button            : Guint := 1;
         Activate_Time     : Guint32 := 0)
      is
         procedure Internal
           (Menu          : System.Address;
            Parent_M      : System.Address;
            Parent_I      : System.Address;
            Func          : Gtk_Menu_Position_Func;
            Data          : System.Address;
            Button        : Guint;
            Activate_Time : Guint32);
         pragma Import (C, Internal, "gtk_menu_popup");

         Parent_Shell : System.Address := System.Null_Address;
         Parent_Item  : System.Address := System.Null_Address;

      begin
         if Parent_Menu_Shell /= null then
            Parent_Shell := Get_Object (Parent_Menu_Shell);
         end if;

         if Parent_Menu_Item /= null then
            Parent_Item := Get_Object (Parent_Menu_Item);
         end if;

         Internal
           (Get_Object (Menu),
            Parent_Shell,
            Parent_Item,
            Func,
            Data.all'Address,
            Button,
            Activate_Time);
      end Popup;
   end User_Menu_Popup;

   ---------------------
   -- Type_Conversion --
   ---------------------

   function Type_Conversion (Type_Name : String) return GObject is
   begin
      if Type_Name = "GtkMenu" then
         return new Gtk_Menu_Record;
      else
         return null;
      end if;
   end Type_Conversion;

begin
   Glib.Type_Conversion_Hooks.Add_Hook (Type_Conversion'Access);
end Gtk.Menu;
