-------------------------------------------------------------------------------
--
--  This file is part of AdaBrowse.
--
-- <STRONG>Copyright (c) 2002 by Thomas Wolf.</STRONG>
-- <BLOCKQUOTE>
--    AdaBrowse 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, or (at your option) any
--    later version. AdaBrowse is distributed in the hope that it will be
--    useful, but <EM>without any warranty</EM>; without even the implied
--    warranty of <EM>merchantability or fitness for a particular purpose.</EM>
--    See the GNU General Public License for  more details. You should have
--    received a copy of the GNU General Public License with this distribution,
--    see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
--    Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
--    USA.
-- </BLOCKQUOTE>
--
-- <DL><DT><STRONG>
-- Author:</STRONG><DD>
--   Thomas Wolf  (TW)
--   <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
--
-- <DL><DT><STRONG>
-- Purpose:</STRONG><DD>
--   Keeps a list of known filename/unitname pairs.</DL>
--
-- <!--
-- Revision History
--
--   09-JUL-2003   TW  Initial version
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

with GAL.ADT.Hash_Tables;
with GAL.Support.Hashing;
with GAL.Storage.Standard;

pragma Elaborate_All (GAL.ADT.Hash_Tables);

with Util.Pathes;
with Util.Strings;

package body AD.Known_Units is

   package ASU renames Ada.Strings.Unbounded;

   --  All right. We need several different access methods:
   --  case sensitive first, then case insensitive. Exact match, and
   --  basename match. We hash on the greatest common denominator: the
   --  case insensitive base name.

   Prefix           : Boolean := False;
   Case_Insensitive : Boolean := False;

   function Equal
     (Left, Right : in String)
     return Boolean
   is
      function Match
        (Left, Right : in String)
        return Boolean
      is
      begin
         if not Case_Insensitive then
            return Left = Right;
         else
            return Util.Strings.Equal (Left, Right);
         end if;
      end Match;

      use Util.Pathes;

   begin --  Equal
      if Prefix then
         return Match (Base_Name (Left), Base_Name (Right));
      else
         return Match (Left, Right);
      end if;
   end Equal;

   function Hash
     (S : in String)
     return GAL.Support.Hashing.Hash_Type
   is
      use Util.Pathes;
   begin
      return GAL.Support.Hashing.Hash_Case_Insensitive (Base_Name (S));
   end Hash;

   type Unit_Desc is
      record
         File, Path, Unit : ASU.Unbounded_String;
      end record;

   package Units is
      new GAL.ADT.Hash_Tables
       (Key_Type => String,
        Item     => Unit_Desc,
        Memory   => GAL.Storage.Standard,
        Hash     => Hash,
        "="      => Equal);

   Known : Units.Hash_Table;

   procedure Add
     (File_Name : in String;
      Unit_Name : in String)
   is
      New_Entry : Unit_Desc;
      The_Name : constant String := Util.Pathes.Name (File_Name);
   begin
      Prefix := False; Case_Insensitive := False;
      New_Entry.File := ASU.To_Unbounded_String (The_Name);
      New_Entry.Path := ASU.To_Unbounded_String (Util.Pathes.Path (File_Name));
      New_Entry.Unit := ASU.To_Unbounded_String (Unit_Name);
      Units.Insert (Known, The_Name, New_Entry);
   exception
      when Units.Duplicate_Key =>
         null;
   end Add;

   procedure Find
     (Given_File_Name  : in     String;
      Stored_File_Name :    out Ada.Strings.Unbounded.Unbounded_String;
      Stored_Path      :    out Ada.Strings.Unbounded.Unbounded_String;
      Unit_Name        :    out Ada.Strings.Unbounded.Unbounded_String)
   is
      procedure Get
        (Key   : in     String;
         Found :    out Boolean)
      is
         Item  : Unit_Desc;
      begin
         Item := Units.Retrieve (Known, Key);
         Stored_File_Name := Item.File;
         Stored_Path      := Item.Path;
         Unit_Name        := Item.Unit;
         Found            := True;
      exception
         when Units.Not_Found =>
            Found := False;
      end Get;

      Found : Boolean;

      use Util.Pathes;

      The_Name : constant String := Name (Given_File_Name);

   begin
      Stored_File_Name := ASU.Null_Unbounded_String;
      Unit_Name        := ASU.Null_Unbounded_String;
      if not Units.Is_Empty (Known) then
         for B in Boolean loop
            Prefix := False; Case_Insensitive := B;
            Get (The_Name, Found);
            if Found then return; end if;
            Get (Replace_Extension (The_Name, "ads"), Found);
            if Found then return; end if;
            Prefix := True;
            Get (Base_Name (The_Name), Found);
            if Found then return; end if;
         end loop;
      end if;
   end Find;

begin
   Units.Set_Resize (Known, 0.75);
   declare
      Linear_Growth : GAL.Support.Hashing.Linear_Growth_Policy (50);
   begin
      Units.Set_Growth_Policy (Known, Linear_Growth);
   end;
end AD.Known_Units;
