------------------------------------------------------------------------------
--                                                                          --
--                 GBManager - Win32 COM Binding Manager                    --
--                                                                          --
--                     G B M A N A G E R _ T R E E                          --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                                                                          --
--                 Copyright (C) 1999 - 2005 David Botton                   --
--                                                                          --
-- This is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion. It 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  distributed with this;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- More information about GWINDOWS and the most current public version can  --
-- be located on the web at http://www.adapower.com/gwindows                --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Finalization;
with Ada.Unchecked_Deallocation;
with GWindows.Message_Boxes; use GWindows.Message_Boxes;

with GWindows.Base;
with GWindows.Windows;
with GWindows.Static_Controls;
with GWindows.GStrings;
with GWindows.GStrings.IO;
with GWindows.GStrings.Unbounded;
with GWindows.Registry;
with GWindows.Application;
with GWindows.Cursors;

with GBManager_Lib;
with GWindows.List_Boxes;

--  GNATCOM tool components
with Bind_COM;
with COM_Scope;
with Source_Buffer;

package body GBManager_Tree is

   task type Wait_Task_type(
                            Wait_Win : access GWindows.Windows.Window_Type;
                            Control  : access GBManager_Tree_Control_Type
                           )
   is
      entry Wait_Start;
   end Wait_Task_type;
   task body Wait_Task_type
   is
      use GWindows.Windows;
      use GWindows.Static_Controls;

      Label    : Label_Type;
   begin
      accept Wait_Start;
      Create_As_Dialog (
                        Wait_Win.all,
                        "Wait...",
                        Width => 200,
                        Height => 75
                       );
      Center (Wait_Win.all, Controlling_Parent (Control.all).all);
      Create (
              Label,
              Wait_Win.all,
              "Binding in progress",
              0,
              0,
              180, 30,
              Alignment => Center
             );
      Center (Label);
      Disable (Wait_Win.all);
      GWindows.Application.Show_Modal (Wait_Win.all);
   end Wait_Task_type;

   ---------------
   -- On_Create --
   ---------------

   procedure On_Create (Window : in out GBManager_Tree_Control_Type) is
      use GWindows.Common_Controls;
      use GWindows.GStrings.Unbounded;

      type Version_Type is record
         Version  : GWindows.GString_Unbounded;
         Name     : GWindows.GString_Unbounded;
         Location : GWindows.GString_Unbounded;
      end record;
      type Versions_type is array (Natural range <>) of Version_Type;
      type Versions_type_Ptr is access Versions_type;
      procedure Free is
        new Ada.Unchecked_Deallocation(
                                       Versions_type, Versions_type_Ptr
                                      );
      type Lib_Record_Type is new Ada.Finalization.Controlled with
         record
            Library_Name : GWindows.GString_Unbounded;
            Lib_ID : GWindows.GString_Unbounded;
            bWin64 : Boolean := False;
            Versions_Array : Versions_type_Ptr;
         end record;
      overriding procedure Initialize (Object : in out Lib_Record_Type);
      overriding procedure Adjust (Object : in out Lib_Record_Type);
      overriding procedure Finalize (Object : in out Lib_Record_Type);
      procedure Initialize (Object : in out Lib_Record_Type) is
      begin
         Object.Versions_Array := null;
      end Initialize;
      procedure Adjust (Object : in out Lib_Record_Type) is
         New_Array : Versions_type_Ptr;
      begin
         if Object.Versions_Array /= null then
            New_Array := new Versions_type (Object.Versions_Array'Range);
            for I in Object.Versions_Array'Range loop
               New_Array(I).Version  := Object.Versions_Array(I).Version;
               New_Array(I).Name     := Object.Versions_Array(I).Name;
               New_Array(I).Location := Object.Versions_Array(I).Location;
            end loop;
            Object.Versions_Array := New_Array;
         end if;
      end Adjust;
      procedure Finalize (Object : in out Lib_Record_Type) is
      begin
         Free(Object.Versions_Array);
      end Finalize;
      type Lib_Records_Type is array (Natural range <>) of Lib_Record_Type;
      Key_List : GWindows.Registry.Key_Name_Array :=
        GBManager_Lib.List_Type_Libraries;
      Lib_records : Lib_Records_Type ( Key_List'Range );
      Aux_Lib_Record : Lib_Record_Type;
      Root_Node : Tree_Item_Node;
   begin
      Insert_Item (Window, "Type Libraries", 0, Root_Node, As_A_Root);
      Focus (Window);

      for I in Key_List'Range loop
         Lib_records(I).Lib_ID := Key_List(I);
         declare
            Lib_ID  : constant GWindows.GString := To_String (Key_List (I));
            Versions : GWindows.Registry.Key_Name_Array :=
              GBManager_Lib.List_Type_Library_Versions (Lib_ID);
--              Versions_Array : Versions_type ( Versions'Range );
         begin
            Lib_records(I).Versions_Array := new Versions_type ( Versions'Range );
            for J in Versions'Range loop
               Lib_records(I).Versions_Array(J).Version := Versions(J);
               Lib_records(I).Versions_Array(J).Name := To_Unbounded_String
                 (
                  GBManager_Lib.Type_Library_Name(
                                                  Lib_ID,
                                                  To_String(Versions(J))
                                                 )
                 );
               Lib_records(I).Versions_Array(J).Location := To_Unbounded_String
                 (
                  GBManager_Lib.Type_Library_Location(
                                                      Lib_ID,
                                                      To_String(Versions(J))
                                                     )
                 );
               if Lib_records(I).Versions_Array(J).Location /= "" then
                  Lib_records(I).bWin64 := True;
                  if Lib_records(I).Versions_Array(J).Name /= "" then
                     Lib_records(I).Library_Name := Lib_records(I).Versions_Array(J).Name;
                  end if;
               end if;
               Lib_records(I).bWin64 := Lib_records(I).bWin64 Or (Lib_records(I).Versions_Array(J).Location /= "");
            end loop;
         end;
      end loop;
      for I in Key_List'First .. Key_List'Last - 1 loop
         for J in I + 1 .. Key_List'Last loop
            if Lib_records(I).Library_Name > Lib_records(J).Library_Name then
               Aux_Lib_Record := Lib_records(I);
               Lib_records(I) := Lib_records(J);
               Lib_records(J) := Aux_Lib_Record;
            end if;
         end loop;
      end loop;
      for N in Key_List'Range loop
         if Lib_records(N).bWin64 then
            declare
               Lib_ID  : constant GWindows.GString := To_String (Key_List (N));
               Node     : Tree_Item_Node;
               LNode    : Tree_Item_Node;
               LINode   : Tree_Item_Node;
            begin
               Insert_Item (Window,
                            To_String(Lib_records(N).Library_Name),
                            Root_Node,
                            Node,
                            Sort
                           );
               Insert_Item (Window, "LIBID", Node, LNode, Last);
               Insert_Item (Window, Lib_ID, LNode, LINode, Last);

               for NN in Lib_records(N).Versions_Array'Range loop
                  if Lib_records(N).Versions_Array(NN).Location /= "" then
                     declare
                        Version : constant GWindows.GString := To_String(Lib_records(N).Versions_Array(NN).Version);
                        VNode   : Tree_Item_Node;
                        ANode   : Tree_Item_Node;
                     begin
                        Insert_Item (Window, Version, Node, VNode, Last);
                        Insert_Item (Window,
                                     "Name: " & To_String(Lib_records(N).Versions_Array(NN).Name),
                                     VNode,
                                     ANode,
                                     Last
                                    );
                        Insert_Item (Window,
                                     "Location: " & To_String(Lib_records(N).Versions_Array(NN).Location),
                                     VNode,
                                     ANode,
                                     Last
                                    );
                     end;
                  end if;
               end loop;
            exception
               when others =>
                  GWindows.GStrings.IO.Put_Line
                    ("Error inserting LIBID :" & Lib_ID);
            end;
            end if;
         Expand (Window, Root_Node);
      end loop;
   end On_Create;

   ---------------------
   -- On_Double_Click --
   ---------------------

   procedure On_Double_Click (Control : in out GBManager_Tree_Control_Type)
   is
   begin
      Do_Binding (Control);
   end On_Double_Click;

   ---------------
   -- On_Return --
   ---------------

   procedure On_Return (Control : in out GBManager_Tree_Control_Type)
   is
   begin
      Do_Binding (Control);
   end On_Return;

   ----------------
   -- Do_Binding --
   ----------------

   procedure Do_Binding (Control : in out GBManager_Tree_Control_Type)
   is
      use GWindows.Common_Controls;

      Current_Node : Tree_Item_Node := Selected_Item (Control);
      LNode        : Tree_Item_Node;
      Node_Text    : constant GWindows.GString := Text (Control, Current_Node);
   begin
      if Node_Text'Length > 10 then
         Current_Node := Get_Parent_Item (Control, Current_Node);
      end if;
      if Current_Node /= 0 and then Current_Node /= Get_Root_Item (Control)
        and then Text (Control, Current_Node) /= "LIBID"
      then
         LNode := Get_First_Child_Item (Control, Current_Node);
         LNode := Get_Next_Item (Control, LNode);
         declare
            use GWindows.GStrings;

            File_Text : constant GWindows.GString := Text (Control, LNode);
            File_Name : constant String := To_String
               (File_Text (File_Text'First + 10 .. File_Text'Last));
            Prefix  : GWindows.GString_Unbounded;
            Success : Boolean;
         begin
            Input_Box (
                       Controlling_Parent (Control).all,
                       "Bind Library",
                       "Please enter base package name to use",
                       Prefix,
                       Success,
                       Width => 300,
                       Height => 150
                      );
            if Success then
               declare
                  use GWindows.Windows;
                  use GWindows.Cursors;

                  Wait_Win : aliased Window_Type;
                  Wait_Task : Wait_Task_type (Wait_Win'Access, Control'Access);
               begin
                  Set_Cursor (Load_System_Cursor (IDC_WAIT));
                  Wait_Task.Wait_Start;
                  GBManager_Lib.Change_To_Binding_Location;
                  Bind_COM.Bind (
                                 File_Name,
                                 To_String (To_GString_From_Unbounded (Prefix))
                                );
                  Set_Cursor (Load_System_Cursor (IDC_ARROW));
                  Close (Wait_Win);
               end;
            end if;
         end;
      end if;
   end Do_Binding;

   -------------
   -- Do_Look --
   -------------

   procedure Do_Look (Control : in out GBManager_Tree_Control_Type)
   is
      use GWindows.Common_Controls;

      Current_Node : Tree_Item_Node := Selected_Item (Control);
      Node_Text    : constant GWindows.GString := Text (Control, Current_Node);
   begin
      if Node_Text'Length > 10 then
         Current_Node := Get_Parent_Item (Control, Current_Node);
      end if;

      if Current_Node /= 0 and then Current_Node /= Get_Root_Item (Control)
        and then Text (Control, Current_Node) /= "LIBID"
      then
         declare
            use GWindows.GStrings;

            LNode   : Tree_Item_Node;
         begin
            LNode := Get_First_Child_Item (Control, Current_Node);
            LNode := Get_Next_Item (Control, LNode);

            declare
               use GWindows.Windows;
               use GWindows.List_Boxes;
               use GWindows.Cursors;

               procedure Write_Line (S : String);
               --  Output lines to text box

               File_Text : constant GWindows.GString := Text (Control, LNode);
               File_Name : constant String :=
                 To_String
                 (File_Text (File_Text'First + 10 .. File_Text'Last));
               Buffer    : aliased Source_Buffer.Source_Buffer_Type;
               LWin      : constant Window_Access := new Window_Type;
               LBox      : constant List_Box_Access := new List_Box_Type;

               procedure Write_Line (S : String)
               is
               begin
                  GWindows.List_Boxes.Add
                    (LBox.all, To_GString_From_String (S));
               end Write_Line;

               procedure Dump_Buffer is
                  new Source_Buffer.Write_Buffer (Write_Line);

            begin
               GWindows.Windows.Create
                 (LWin.all, To_GString_From_String (File_Name),
                  Is_Dynamic => True);
               GWindows.List_Boxes.Create
                 (LBox.all, LWin.all, 1, 1, 1, 1,
                  Sort => False,
                  Is_Dynamic => True);

               Vertical_Scroll_Bar (LBox.all, True);

               Dock (LBox.all, GWindows.Base.Fill);
               Dock_Children (LWin.all);
               Visible (LWin.all);

               Set_Cursor (Load_System_Cursor (IDC_WAIT));
               COM_Scope.Write (File_Name, Buffer);
               Dump_Buffer (Buffer);

               Set_Cursor (Load_System_Cursor (IDC_ARROW));
            end;
         end;
      end if;
   end Do_Look;

begin
   null;
end GBManager_Tree;

