--
-- @filename : adadoc_tree-list.adb
-- @author Julien Burdy & Vincent Decorges
-- @date 10.4.02
-- @brief Management of the tree (Tree structure and operations)
--
-- History  :
-- Date     Modification               Author
--
with Ada.Tags; use Ada.Tags;
with Ada.Unchecked_Deallocation;

package body AdaDoc_Tree.List is

   --Liberate Object token class object
   procedure Free is new Ada.Unchecked_Deallocation(Node_Type, Node_Ptr_Type);

   --
   -- Name    : Insert
   -- Purpose : Insert a node to the parse tree
   --
   -- in out  : Tree : The parse tree
   -- in      : Object : the content of the node
   --
   procedure Insert (Tree   : in out Tree_Type;
                     Object : in Object_Token_Ptr) is

      Element : Node_Type := (Object, null);

   begin

      --Insert to head
      if Tree.Head = null then
         Tree.Head := new Node_Type'(Element);
         Tree.Tail := Tree.Head;
      --Insert to tail
      else
         Tree.Tail.Next := new Node_Type'(Element);
         Tree.Tail := Tree.Tail.Next;
      end if;
   end Insert;

   --
   -- Name    : Is_Empty
   -- Purpose : Return true if the list is empty
   --
   -- in      : Tree : The parse tree
   -- return  : Boolean
   --
   function Is_Empty (Tree : Tree_Type) return Boolean is

   begin
      return Tree.Head = null;
   end Is_Empty;

   --
   -- Name    : Exist
   -- Purpose : Return true if a Tag_Name object exist in the tree
   --
   -- in      : Node : The node to begin
   -- in      : Tag_Name : The tag of the type
   -- return  : Boolean
   --
   function Exist (Node : Node_Ptr_Type; Tag_Name : String) return Boolean is

      Ptr_Current : Node_Ptr_Type := Node;

   begin
      --Search an object of class tag_name in the list from the node
      while Ptr_Current /= null loop

         if Expanded_Name(Ptr_Current.Element'Tag) = Tag_Name then
            return True;
         end if;
         Ptr_Current := Ptr_Current.Next;

      end loop;

      --Not find return false
      return False;

   end Exist;

   --
   -- Name    : Exist
   -- Purpose : Return true if a Tag_Name object exist in the tree
   --
   -- in      : Tree : The parse tree
   -- in      : Tag_Name : The tag of the type
   -- return  : Boolean
   --
   function Exist (Tree : Tree_Type; Tag_Name : String) return Boolean is

   begin
    --Search an object of class tag_name in the list
    return Exist(Tree.Head, Tag_Name);

   end Exist;

   --
   -- Name    : Find_Next
   -- Purpose : Return a pointer on the object to find
   --           or null if not find
   --
   -- in      : Tree : The parse tree
   -- in      : Tag_Name : First search criteria
   -- out     : Object found. Null if not found
   --
   procedure Find_Next (Tree : in out Tree_Type;
                        Tag_Name : in String;
                        Object : out Object_Token_Ptr) is

      Tmp_Object : Object_Token_Ptr;

   begin

      Find_Next(Tree, Tag_Name, "", Tmp_Object);
      Object := Tmp_Object;

   end Find_Next;

   --
   -- Name    : Find_Next
   -- Purpose : Return a pointer on the object to find
   --           or null if not find
   --
   -- in      : Tree : The parse tree
   -- in      : Tag_Name : First search criteria
   -- in      : Tag_Name2 : Second search criteria
   -- out     : Object found. Null if not found
   --
   procedure Find_Next (Tree : in out Tree_Type;
                        Tag_Name : in String;
                        Tag_Name2 : in String;
                        Object : out Object_Token_Ptr) is

      Ptr_Current : Node_Ptr_Type := Tree.Head;
      Ptr_Pred : Node_Ptr_Type := null;

      --Remove the element from the list
      procedure Remove_Element (Tree : in out Tree_Type;
                                Element : in Node_Ptr_Type;
                                Element_Pred : in Node_Ptr_Type) is

         Tmp_Ptr : Node_Ptr_Type := Element;

      begin
         --Element in the head of the list
         if Element = Tree.Head then
            Tree.Head := Element.Next;
         --In the tail
         elsif Element = Tree.Tail then
            Tree.Tail := Element_Pred;
            Element_Pred.Next := null;
         --In the list
         else
            Element_Pred.Next := Element.Next;
         end if;

         free(Tmp_Ptr);

      end Remove_Element;

      Second_Criteria : Unbounded_String := To_Unbounded_String(Tag_Name2);

   begin

      if Tag_Name2 = "" then
         Second_Criteria := To_Unbounded_String(Tag_Name);
      end if;

      --Search the element
      while Ptr_Current /= null loop

         if Expanded_Name(Ptr_Current.Element'Tag) = Tag_Name or else
            Expanded_Name(Ptr_Current.Element'Tag) = To_String(Second_Criteria) then
            Object := Ptr_Current.Element;
            Remove_Element(Tree, Ptr_Current, Ptr_Pred);
            return;
         end if;
         Ptr_Pred := Ptr_Current;
         Ptr_Current := Ptr_Current.Next;
      end loop;

      --Not find return null
      Object := null;

   end Find_Next;

   --
   -- Name    : Empty
   -- Purpose : Free the list
   --
   -- in out  : Tree : The parse tree
   --
   procedure Empty (Tree : in out Tree_Type) is

      Tmp_Ptr : Node_Ptr_Type;
      Current_Ptr : Node_Ptr_Type := Tree.Head;

   begin

      while Current_Ptr /= null loop
         Tmp_Ptr := Current_Ptr.Next;

         --Liberate the element. It will call explicity
         --its finalize method
         free(Current_Ptr.Element);
         free(Current_Ptr);
         Current_Ptr := Tmp_Ptr;
      end loop;

      Tree.Head := null;
      Tree.Tail := null;

   end Empty;

end AdaDoc_Tree.List;