-------------------------------------------------------------------------------
--
--  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>
--   Handling of "pathes": prefix URLs defined for cross-references.</DL>
--
-- <!--
-- Revision History
--
--   05-FEB-2002   TW  Initial version.
--   04-JUL-2002   TW  Added exceptions to exclusion and no_xrefs.
--   05-JUL-2002   TW  Changed the semantics for these exclusions: we now do
--                     longest prefix matches, too, so that Exclude = System.A
--                     Include = System., System.Address_To_Access_Conversions
--                     will include all children of System, except those
--                     starting with an A, but again except the package
--                     System.Address_To_Access_Conversions.
--   20-AUG-2002   TW  Created from former AD.Pathes.
--   28-AUG-2002   TW  Correction for repeated key definitions.
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

with Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;

with Util.Strings;

package body AD.Exclusions is

   package ASU renames Ada.Strings.Unbounded;

   use Util.Strings;

   type Exclusion;
   type Exclusion_Ptr is access Exclusion;
   type Exclusion is
      record
         Key      : ASU.Unbounded_String;
         Next     : Exclusion_Ptr;
         Excluded : Boolean;
      end record;

   procedure Free is
      new Ada.Unchecked_Deallocation (Exclusion, Exclusion_Ptr);

   procedure Add
     (Anchor   : in out Exclusion_Ptr;
      Key      : in     String;
      Excluded : in     Boolean)
   is
      use type ASU.Unbounded_String;

      P, Q : Exclusion_Ptr;
      K    : ASU.Unbounded_String := ASU.To_Unbounded_String (Key);
   begin
      P := Anchor;
      while P /= null loop
         exit when Key'Length > ASU.Length (P.Key);
         if K = P.Key then
            P.Excluded := Excluded;
            return;
         end if;
         Q := P; P := P.Next;
      end loop;
      if Q = null then
         Anchor := new Exclusion'(K, P, Excluded);
      else
         Q.Next := new Exclusion'(K, P, Excluded);
      end if;
      --  The list is ordered by key length, earlier keys first.
   end Add;

   function Is_Excluded
     (Unit   : in String;
      Anchor : in Exclusion_Ptr)
     return Boolean
   is
      P : Exclusion_Ptr := Anchor;
   begin
      while P /= null loop
         if Is_Prefix (Unit, ASU.To_String (P.Key)) then
            return P.Excluded;
         end if;
         P := P.Next;
      end loop;
      return False;
   end Is_Excluded;

   ----------------------------------------------------------------------------

   Excl_Anchor : Exclusion_Ptr;

   procedure Add_Exclusion
     (Key : in String)
   is
   begin
      Add (Excl_Anchor, To_Lower (Key), True);
   end Add_Exclusion;

   procedure Add_Exclusion_Exception
     (Key : in String)
   is
   begin
      Add (Excl_Anchor, To_Lower (Key), False);
   end Add_Exclusion_Exception;

   function Is_Excluded
     (Unit_Name : in String)
     return Boolean
   is
   begin
      return Is_Excluded (To_Lower (Unit_Name), Excl_Anchor);
   end Is_Excluded;

   function Skip
     (Unit_Name : in String)
     return Boolean
   is
   begin
      return Is_Excluded (Unit_Name) or else No_XRef (Unit_Name);
   end Skip;

   procedure Clear
     (Anchor : in out Exclusion_Ptr;
      Flag   : in     Boolean)
   is
      P, Q, R : Exclusion_Ptr;
   begin
      P := Anchor; Q := null;
      while P /= null loop
         R := P;
         if P.Excluded = Flag then
            if Q = null then
               Anchor := P.Next;
            else
               Q.Next := P.Next;
            end if;
         else
            Q := P;
         end if;
         P := P.Next;
         if R.Excluded = Flag then
            Free (R);
         end if;
      end loop;
   end Clear;

   procedure Clear_Exclusions
   is
   begin
      Clear (Excl_Anchor, True);
   end Clear_Exclusions;

   procedure Clear_Exclusion_Exceptions
   is
   begin
      Clear (Excl_Anchor, False);
   end Clear_Exclusion_Exceptions;

   ----------------------------------------------------------------------------

   No_XRefs : Exclusion_Ptr;

   procedure Add_No_XRef
     (Key : in String)
   is
   begin
      Add (No_XRefs, To_Lower (Key), True);
   end Add_No_XRef;

   procedure Add_No_XRef_Exception
     (Key : in String)
   is
   begin
      Add (No_XRefs,  To_Lower (Key), False);
   end Add_No_XRef_Exception;

   function No_XRef
     (Unit_Name : in String)
     return Boolean
   is
   begin
      return Is_Excluded (To_Lower (Unit_Name), No_XRefs);
   end No_XRef;

end AD.Exclusions;
