with Gdk.Color;   use Gdk.Color;
with Gtkada.MDI;  use Gtkada.MDI;
with Gtk.Window;  use Gtk.Window;
with Gtk.Enums;   use Gtk.Enums;
with Gtk.Main;    use Gtk.Main;
with Gtk.Button;  use Gtk.Button;
with Gtk.Box;     use Gtk.Box;
with Gtk.Label;   use Gtk.Label;
with Gtk.Menu_Bar; use Gtk.Menu_Bar;
with Gtk.Menu_Item; use Gtk.Menu_Item;
with Gtk.Style;   use Gtk.Style;
with Gtkada.Handlers; use Gtkada.Handlers;
with Gtk.Widget;  use Gtk.Widget;
with Gtk.Scrolled_Window; use Gtk.Scrolled_Window;
with Gtk.Text; use Gtk.Text;

with Ada.Text_IO; use Ada.Text_IO;

procedure Test_MDI is

   Win : Gtk_Window;
   MDI : MDI_Window;
   Child1 : Gtk_Window;
   Child2, Child1_1, Child3 : Gtk_Button;
   Cascade : Gtk_Button;
   Box : Gtk_Box;
   Color : Gdk_Color;
   Style : Gtk_Style;
   C : MDI_Child;
   Scrolled : Gtk_Scrolled_Window;
   Text : Gtk_Text;
   Menu_Bar : Gtk_Menu_Bar;
   Menu_Item : Gtk_Menu_Item;

   function Test_Delete (Win : access Gtk_Widget_Record'Class) return Boolean;
   procedure Report_Destroy (Widget : access Gtk_Widget_Record'Class);
   procedure Dock_Left (Widget : access Gtk_Widget_Record'Class);
   procedure Dock_Right (Widget : access Gtk_Widget_Record'Class);
   procedure Dock_Top (Widget : access Gtk_Widget_Record'Class);
   procedure Dock_Bottom (Widget : access Gtk_Widget_Record'Class);
   procedure MDI_Destroyed (Widget : access Gtk_Widget_Record'Class);

   procedure MDI_Destroyed (Widget : access Gtk_Widget_Record'Class) is
   begin
      Gtk.Main.Main_Quit;
   end MDI_Destroyed;

   function Test_Delete (Win : access Gtk_Widget_Record'Class)
      return Boolean is
   begin
      if Gtk_Widget (Win) = Gtk_Widget (Child1) then
         pragma Assert
           (Gtk_Widget (Get_Child (Gtk_Window (Win))) = Gtk_Widget (Child1_1));
         null;
      end if;
      return False;
   end Test_Delete;

   procedure Dock_Left (Widget : access Gtk_Widget_Record'Class) is
      C : MDI_Child := Get_Focus_Child (MDI_Window (Widget));
   begin
      if C /= null then
         Set_Dock_Side (C, Left);
      end if;
   end Dock_Left;

   procedure Dock_Right (Widget : access Gtk_Widget_Record'Class) is
      C : MDI_Child := Get_Focus_Child (MDI_Window (Widget));
   begin
      if C /= null then
         Set_Dock_Side (C, Right);
      end if;
   end Dock_Right;

   procedure Dock_Top (Widget : access Gtk_Widget_Record'Class) is
      C : MDI_Child := Get_Focus_Child (MDI_Window (Widget));
   begin
      if C /= null then
         Set_Dock_Side (C, Top);
      end if;
   end Dock_Top;

   procedure Dock_Bottom (Widget : access Gtk_Widget_Record'Class) is
      C : MDI_Child := Get_Focus_Child (MDI_Window (Widget));
   begin
      if C /= null then
         Set_Dock_Side (C, Bottom);
      end if;
   end Dock_Bottom;

   procedure Report_Destroy (Widget : access Gtk_Widget_Record'Class) is
   begin
      Put_Line ("Widget is being destroyed");
   end Report_Destroy;

   MDI_Background_Color : constant String := "#666666";
   --  <preferences> Background color to use for the MDI window

begin
   Gtk.Main.Init;
   Gtk_New (Win, Window_Toplevel);

   Gtk_New_Vbox (Box, Homogeneous => False);
   Add (Win, Box);

   Gtk_New (Menu_Bar);
   Pack_Start (Box, Menu_Bar, Expand => False, Fill => False);

   Gtk_New (MDI);
   Set_USize (MDI, 300, 300);
   Pack_Start (Box, MDI);
   Widget_Callback.Connect
     (MDI, "destroy",
      Widget_Callback.To_Marshaller (MDI_Destroyed'Unrestricted_Access));
   Set_Priorities (MDI, (Left => 20, Bottom => 10, others => 2));

   Gtk_New (Menu_Item, "Window");
   Set_Submenu (Menu_Item, Create_Menu (MDI));
   Append (Menu_Bar, Menu_Item);

   Color := Parse (MDI_Background_Color);
   Alloc (Get_Default_Colormap, Color);
   Style := Copy (Get_Style (MDI));
   Set_Background (Style, State_Normal, Color);
   Set_Style (MDI, Style);

   --------------------------
   -- Child1: a Gtk_Window --
   --------------------------

   Gtk_New (Child1, Window_Toplevel);
   Set_Title (Child1, "child1");

   Gtk_New (Child1_1, "child1");
   Widget_Callback.Connect
     (Child1, "destroy",
      Widget_Callback.To_Marshaller (Report_Destroy'Unrestricted_Access));

   Add (Child1, Child1_1);
   C := Put (MDI, Child1);

   Return_Callback.Connect
     (Child1, "delete_event",
      Return_Callback.To_Marshaller (Test_Delete'Unrestricted_Access));
   Widget_Callback.Connect
     (Child1_1, "destroy",
      Widget_Callback.To_Marshaller (Report_Destroy'Unrestricted_Access));

   -------------------------------
   -- Child2: a standard widget --
   -------------------------------

   Gtk_New (Child2, "Child2");
   C := Put (MDI, Child2);
   Set_Title (C, "child2");
   Set_Dock_Side (C, Left);
   Dock_Child (C);

   Return_Callback.Connect
     (Child2, "delete_event",
      Return_Callback.To_Marshaller (Test_Delete'Unrestricted_Access));
   Widget_Callback.Connect
     (Child2, "destroy",
      Widget_Callback.To_Marshaller (Report_Destroy'Unrestricted_Access));

   ------------------------------
   -- Child3: initially docked --
   ------------------------------

   Gtk_New (Child3, "Child3");
   C := Put (MDI, Child3);
   Set_Title (C, "child3");
   Set_Dock_Side (C, Bottom);
   Dock_Child (C);
   Set_Title (C, "new title");
   Widget_Callback.Connect
     (Child3, "destroy",
      Widget_Callback.To_Marshaller (Report_Destroy'Unrestricted_Access));
   Return_Callback.Connect
     (Child3, "delete_event",
      Return_Callback.To_Marshaller (Test_Delete'Unrestricted_Access));

   --------------------------------
   -- Child4: initially floating --
   --------------------------------

   Gtk_New (Child3, "Child4");
   C := Put (MDI, Child3);
   Set_Title (C, "child4");
   Float_Child (C, True);
   Widget_Callback.Connect
     (Child3, "destroy",
      Widget_Callback.To_Marshaller (Report_Destroy'Unrestricted_Access));
   Return_Callback.Connect
     (Child3, "delete_event",
      Return_Callback.To_Marshaller (Test_Delete'Unrestricted_Access));

   -----------------------------
   -- Child5: has a scrollbar --
   -----------------------------

   Gtk_New (Scrolled);
   Gtk_New (Text);
   Add (Scrolled, Text);
   Insert (Text, Chars => "A" & ASCII.LF & "B" & ASCII.LF
           & "C" & ASCII.LF & "D" & ASCII.LF & "E" & ASCII.LF
           & "F" & ASCII.LF & "G" & ASCII.LF & "H" & ASCII.LF);
   C := Put (MDI, Scrolled);
   Set_Title (C, "scrolled");
   Widget_Callback.Connect
     (Scrolled, "destroy",
      Widget_Callback.To_Marshaller (Report_Destroy'Unrestricted_Access));
   Return_Callback.Connect
     (Child3, "delete_event",
      Return_Callback.To_Marshaller (Test_Delete'Unrestricted_Access));

   Set_Dock_Side (C, Bottom);
   Dock_Child (C);

   -------------
   -- Buttons --
   -------------

   Gtk_New (Cascade, "Set Dock_Left");
   Pack_Start (Box, Cascade, Expand => False, Fill => True);
   Widget_Callback.Object_Connect
     (Cascade, "clicked",
      Widget_Callback.To_Marshaller (Dock_Left'Unrestricted_Access),
      MDI);

   Gtk_New (Cascade, "Set Dock_Right");
   Pack_Start (Box, Cascade, Expand => False, Fill => True);
   Widget_Callback.Object_Connect
     (Cascade, "clicked",
      Widget_Callback.To_Marshaller (Dock_Right'Unrestricted_Access),
      MDI);

   Gtk_New (Cascade, "Set Dock_Top");
   Pack_Start (Box, Cascade, Expand => False, Fill => True);
   Widget_Callback.Object_Connect
     (Cascade, "clicked",
      Widget_Callback.To_Marshaller (Dock_Top'Unrestricted_Access),
      MDI);

   Gtk_New (Cascade, "Set Dock_Bottom");
   Pack_Start (Box, Cascade, Expand => False, Fill => True);
   Widget_Callback.Object_Connect
     (Cascade, "clicked",
      Widget_Callback.To_Marshaller (Dock_Bottom'Unrestricted_Access),
      MDI);

--   Maximize_Children (MDI);
   Show_All (Win);
   Gtk.Main.Main;
end Test_MDI;

