
with Ada.Text_IO;  use Ada.Text_IO;
with Glib;         use Glib;
with Gtk.Window;   use Gtk.Window;
with Gtk.Main;     use Gtk.Main;
with Gtk.Enums;    use Gtk.Enums;
with Gtk.Button;   use Gtk.Button;
with Gtk.Box;      use Gtk.Box;
with Gtk.Handlers; use Gtk.Handlers;
with Gtkada.Handlers; use Gtkada.Handlers;
with Gtk.Widget;   use Gtk.Widget;

procedure Test_Handlers is

   type My_Data3 is record
      Button : Gtk_Widget;
      Object : Gtk_Widget;
      Id     : Handler_Id;
   end record;
   type My_Data3_Access is access My_Data3;

   package User_Callback is new Gtk.Handlers.User_Callback
     (Gtk_Widget_Record, Gtk_Widget);
   package User_Callback3 is new Gtk.Handlers.User_Callback
     (Gtk_Widget_Record, My_Data3_Access);

   procedure My_Destroy (Button : access Gtk_Widget_Record'Class) is
   begin
      Put_Line ("My_Destroy");
      Destroy (Button);
   end My_Destroy;

   procedure My_Destroy2
     (Button : access Gtk_Widget_Record'Class;
      Data   : Gtk_Widget) is
   begin
      Put_Line ("My_Destroy2");
      Destroy (Data);
   end My_Destroy2;

   procedure My_Destroy3
     (Button : access Gtk_Widget_Record'Class;
      Data   : My_Data3_Access) is
   begin
      Put_Line ("My_Destroy3");
      Destroy (Data.Button);
      Disconnect (Data.Object, Data.Id);
   end My_Destroy3;

   Win              : Gtk_Window;
   Button1, Button2 : Gtk_Button;
   Vbox, Hbox       : Gtk_Box;
   Id               : Handler_Id;
   Data3            : My_Data3_Access;
begin
   Gtk.Main.Init;

   Gtk_New (Win, Window_Toplevel);

   Gtk_New_Vbox (Vbox);
   Add (Win, Vbox);

   --  Using object_connect.
   --  The callback is automatically destroyed when button2 is destroyed, so
   --  you can press button1 as many times as you want, no problem
   Gtk_New_Hbox (Hbox);
   Pack_Start (Vbox, Hbox);
   Gtk_New (Button1, "button1, object connect");
   Pack_Start (Hbox, Button1);
   Gtk_New (Button2, "button2");
   Pack_Start (Hbox, Button2);

   Widget_Callback.Object_Connect
     (Button1, "clicked",
      Widget_Callback.To_Marshaller (My_Destroy'Unrestricted_Access),
      Button2);

   --  Using user callback.
   --  The callback is not destroyed when Button2 is destroyed. As a result,
   --  the second time you press button1, you get a critical error.
   Gtk_New_Hbox (Hbox);
   Pack_Start (Vbox, Hbox);
   Gtk_New (Button1, "button1, user data");
   Pack_Start (Hbox, Button1);
   Gtk_New (Button2, "button2");
   Pack_Start (Hbox, Button2);

   User_Callback.Connect
     (Button1, "clicked",
      User_Callback.To_Marshaller (My_Destroy2'Unrestricted_Access),
      Gtk_Widget (Button2));

   --  Using user callback, with complex protection
   --  Note that memory allocated for Data3 is not freed.
   --  The callback makes sure that the callback is properly unregistered, but
   --  is heavy to put in place
   Gtk_New_Hbox (Hbox);
   Pack_Start (Vbox, Hbox);
   Gtk_New (Button1, "button1, protected user data");
   Pack_Start (Hbox, Button1);
   Gtk_New (Button2, "button2");
   Pack_Start (Hbox, Button2);

   Data3 := new My_Data3' (Object => Gtk_Widget (Button1),
                           Button => Gtk_Widget (Button2),
                           Id     => (Null_Handler_Id, null));
   Id := User_Callback3.Connect
     (Button1, "clicked",
      User_Callback3.To_Marshaller (My_Destroy3'Unrestricted_Access),
      Data3);
   Data3.Id := Id;

   --  Using user callback, simple protection.
   --  This is the same example as 2, but we automatically register the fact
   --  that when button2 is destroyed, the callback should also be destroyed.
   Gtk_New_Hbox (Hbox);
   Pack_Start (Vbox, Hbox);
   Gtk_New (Button1, "button1, watch user data");
   Pack_Start (Hbox, Button1);
   Gtk_New (Button2, "button2");
   Pack_Start (Hbox, Button2);

   Id := User_Callback.Connect
     (Button1, "clicked",
      User_Callback.To_Marshaller (My_Destroy2'Unrestricted_Access),
      Gtk_Widget (Button2));
   Add_Watch (Id, Button2);

   Show_All (Win);
   Gtk.Main.Main;
end Test_Handlers;
