--
-- @filename : adadoc_tree.adb
-- @author Julien Burdy & Vincent Decorges
-- @date 10.4.02
-- @brief Data structure to make a tree for the parser
--
-- History  :
-- Date     Modification               Author
--
with Ada.Tags; use Ada.Tags;

with Dict_TDA;
with Xml_Writer; --Tools to write xml
with AdaDoc_Tree.Comment; --Abstract machine to extract the comment

package body AdaDoc_Tree is

   --
   -- Name    : Convert_Mode
   -- Purpose : Convert the mode of a parameter in string
   --
   -- in      : Self : Mode of the parameter
   -- return  : A string
   --
   function Convert_Mode (Self : Mode_Token) return String is

   begin

      case Self.Mode is
         when In_Mode => return "in";
         when Out_Mode => return "out";
         when In_Out_Mode => return "in out";
         when Access_Mode => return "access";
      end case;
   end Convert_Mode;

   --
   -- Name    : Concat
   -- Purpose : Concatanation of a list of identifier
   --
   -- in      : Self : The list to concatanate
   -- return  : An unbounded string
   --
   function Concat (Self : Def_ID_S_Token) return Unbounded_String is

      Concat_String : Unbounded_String := Self.Str;
      Tmp_Def_Ptr : Def_ID_S_Token_Ptr := Self.Next_ID;

   begin

      while Tmp_Def_Ptr /= null loop
            Concat_String := Concat_String & ", " & Tmp_Def_Ptr.Str;
            Tmp_Def_Ptr := Tmp_Def_Ptr.Next_ID;
      end loop;

      return Concat_String;

   end Concat;

   --
   -- Name    : Concat
   -- Purpose : Concatanation of a list of discriminant
   --
   -- in      : Self : The list to concatanate
   -- return  : An unbounded string
   --
   function Concat (Self : Discriminant_Token) return Unbounded_String is

      Concat_String : Unbounded_String;

      Tmp_Def_Ptr : Def_ID_S_Token_Ptr := Self.Def_ID_S;
      Object_Ptr : Component_Token_Ptr := Self.Next_Component;

   begin

      --Add bracket
      if Self.Type_Def = Null_Unbounded_String then
         Concat_String := '(' & Concat(Self.Def_ID_S.all);
      else
         Concat_String := '(' & Concat(Self.Def_ID_S.all) & " : " & Self.Type_Def &
                          " := " & Self.Init;

      end if;

      --Run through the list
      while Object_Ptr /= null loop

         Concat_String := Concat_String & Concat(Object_Ptr.Def_ID_S.all) & " : " &
                          Object_Ptr.Type_Def & " := " & Object_Ptr.Init;

         Object_Ptr := Object_Ptr.Next_Component;

      end loop;
      --Add final bracket
      Concat_String := Concat_String & ')';

      return Concat_String;

   end Concat;

   --
   -- Name    : Concat
   -- Purpose : Concatanation of a list of parameters
   --
   -- in      : Self : The list to concatanate
   -- return  : An unbounded string
   --
   function Concat (Self : Parameters_Token) return Unbounded_String is

      Concat_String : Unbounded_String := Concat(Self.Def_ID_S.all) & " : "
                                          & Convert_Mode(Self.Mode.all)
                                          & ' ' & Self.Type_Param;

      Object_Ptr : Parameters_Token_Ptr := Self.Next;

   begin

      if Self.Init /= Null_Unbounded_String then
         Concat_String := Concat_String & " := " & Self.Init;
      end if;

      while Object_Ptr /= null loop

         --With default value
         if Object_Ptr.Init /= Null_Unbounded_String then

            Concat_String := Concat_String & "; " & Concat(Object_Ptr.Def_ID_S.all) &
                             " : " & Convert_Mode(Object_Ptr.Mode.all) &
                             " " & Object_Ptr.Type_Param & " := " & Object_Ptr.Init;
         --Without
         else
            Concat_String := Concat_String & "; " & Concat(Object_Ptr.Def_ID_S.all) &
                             " : " & Convert_Mode(Object_Ptr.Mode.all) & " " &
                             Object_Ptr.Type_Param;
         end if;

         Object_Ptr := Object_Ptr.Next;

      end loop;

      return Concat_String;

   end Concat;

   --For each Token we provide a method to write is xml code
   --
   -- Name    : Put_Xml
   -- Purpose : Write xml code for the object
   --
   -- in      : Self : the object
   -- in      : File : file to write in
   --
   procedure Put_Xml (Self : in Object_Token; File : in File_Type) is
   begin
      null;
   end Put_Xml;

   procedure Put_Xml (Node : in Generic_Para_Token_Ptr; File : File_Type) is

      Tmp_Ptr : Generic_Para_Token_Ptr := Node;

      --To know if a category of Generic_Para_Token exist
      function Exist (Node : Generic_Para_Token_Ptr; Tag_Name : String) return Boolean is

         Tmp_Ptr : Generic_Para_Token_Ptr := Node;

      begin

         --Run through the list
         while Tmp_Ptr /= null loop

            if Expanded_Name(Tmp_Ptr.all'Tag) = Tag_Name then
               return True;
            end if;

            Tmp_Ptr := Tmp_Ptr.Next_Para;

         end loop;

         return False;
      end Exist;

   begin


      --Write Objects
      if Exist(Node, "ADADOC_TREE.GENERIC_PARAM_TOKEN") then

         Xml_Writer.Create_Tag(File, "Objects", Dict_TDA.Empty_Dict);

         --Run through the list of GENERIC_PARAM_TOKEN
         while Tmp_Ptr /= null loop

            if Expanded_Name(Tmp_Ptr.all'Tag) = "ADADOC_TREE.GENERIC_PARAM_TOKEN" then
               Put_Xml(Tmp_Ptr.all, File);
            end if;
            Tmp_Ptr := Tmp_Ptr.Next_Para;
         end loop;
         Xml_Writer.Close_Tag(File, "Objects");

      end if;

      Tmp_Ptr := Node;

      --Write type
      if Exist(Node, "ADADOC_TREE.GENERIC_TYPE_PARA_TOKEN") then

         Xml_Writer.Create_Tag(File, "Types", Dict_TDA.Empty_Dict);
         while Tmp_Ptr /= null loop

            if Expanded_Name(Tmp_Ptr.all'Tag) = "ADADOC_TREE.GENERIC_TYPE_PARA_TOKEN" then
               Put_Xml(Tmp_Ptr.all, File);
            end if;
            Tmp_Ptr := Tmp_Ptr.Next_Para;
         end loop;
         Xml_Writer.Close_Tag(File, "Types");

      end if;

      Tmp_Ptr := Node;

       --Write sub-program, package
      if Exist(Node, "ADADOC_TREE.GENERIC_PROC_PARA_TOKEN") or else
         Exist(Node, "ADADOC_TREE.GENERIC_FUN_PARA_TOKEN")
         or else Exist(Node, "ADADOC_TREE.GENERIC_PACKAGE_TOKEN") then

         Xml_Writer.Create_Tag(File, "PackagesSubprograms", Dict_TDA.Empty_Dict);
         while Tmp_Ptr /= null loop

            if Expanded_Name(Tmp_Ptr.all'Tag) = "ADADOC_TREE.GENERIC_PROC_PARA_TOKEN"
               or else
               Expanded_Name(Tmp_Ptr.all'Tag) = "ADADOC_TREE.GENERIC_FUN_PARA_TOKEN"
               or else
               Expanded_Name(Tmp_Ptr.all'Tag) = "ADADOC_TREE.GENERIC_PACKAGE_TOKEN" then

               Put_Xml(Tmp_Ptr.all, File);

            end if;
            Tmp_Ptr := Tmp_Ptr.Next_Para;
         end loop;
         Xml_Writer.Close_Tag(File, "PackagesSubprograms");

      end if;

   end Put_Xml;


   procedure Put_Xml (Self : in With_Clause_Token; File : File_Type) is

      Ptr_Tmp : Def_ID_S_Token_Ptr := Self.Name_S;
      Dict : Dict_TDA.Dict_Type;

   begin
      --We associate the comment if exist
      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      --Because we can have "with clause1, clause2, ..., clausen"
      --In xml we write a new clause tag for each of this clause
      while Ptr_Tmp /= null loop
         Dict_TDA.Update(Dict, "name", To_String(Ptr_Tmp.Str));
         Xml_Writer.Create_Tag(File, "Clause", Dict);
         Xml_Writer.Close_Tag(File, "Clause");
         Ptr_Tmp := Ptr_Tmp.Next_ID;
      end loop;

      Dict_TDA.Empty(Dict);

   end Put_Xml;

   procedure Put_Xml (Self : in Package_Spec_Token; File : in File_Type) is
      Dict : Dict_TDA.Dict_Type;

      File_Name : String := Name(File);
      Ind_Last : Positive := File_Name'Last;
      Ind_First : Positive;

      procedure Write_Comment (Key : in String; Value : in String) is

      begin

         Dict_TDA.Insert(Dict, Key, Value);

      end Write_Comment;

      procedure Write_Tags is new Dict_TDA.Run_Through(Write_Comment);

   begin

      -- search the name and extension separation
      while Ind_Last > File_Name'First-1 and then File_Name(Ind_Last) /= '.' loop
         Ind_Last := Ind_Last - 1;
      end loop;

      Ind_First := Ind_Last - 1;

      while Ind_First > File_Name'First-1 and then (File_Name(Ind_First) /= '\' and
                                                  File_Name(Ind_First) /= '/') loop

         Ind_First := Ind_First - 1;
      end loop;

      Dict_TDA.Insert(Dict, "file", File_Name(Ind_First+1..Ind_Last-1));
      Write_Tags(AdaDoc_Tree.Comment.Return_Header_Comment);
      Dict_TDA.Insert(Dict, "name", To_String(Self.Name));

      Xml_Writer.Begin_File(File, Dict);
      Dict_TDA.Empty(Dict);

   end Put_Xml;

   --Generic Parameters
   procedure Put_Xml (Self : in Generic_Param_Token; File : in File_Type) is

      Ptr_Tmp : Def_ID_S_Token_Ptr := Self.Def_ID_S;
      Dict : Dict_TDA.Dict_Type;

   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      Dict_TDA.Insert(Dict, "mode", Convert_Mode(Self.Mode.all));
      Dict_TDA.Insert(Dict, "type", To_String(Self.Type_Param));

      if Self.Init /= Null_Unbounded_String then
         Dict_TDA.Insert(Dict, "init", To_String(Self.Init));
      end if;

      while Ptr_Tmp /= null loop
         Dict_TDA.Update(Dict, "name", To_String(Ptr_Tmp.Str));
         Xml_Writer.Create_Tag(File, "Object", Dict);
         Xml_Writer.Close_Tag(File, "Object");
         Ptr_Tmp := Ptr_Tmp.Next_ID;
      end loop;

      Dict_TDA.Empty(Dict);
   end Put_Xml;

   procedure Put_Xml (Self : in Generic_Type_Para_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;
      Tmp_String : Unbounded_String;
   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      if Self.Discriminant /= null then
         Dict_TDA.Insert(Dict, "discriminant", To_String(Concat(Self.Discriminant.all)));
      end if;

      Dict_TDA.Insert(Dict, "declaration", To_String(Self.Type_Def));

      Dict_TDA.Insert(Dict, "name", To_String(Self.name));

      Xml_Writer.Create_Tag(File, "TypeDef", Dict);
      Xml_Writer.Close_Tag(File, "TypeDef");

      Dict_TDA.Empty(Dict);
   end Put_Xml;

   procedure Put_Xml (Self : in Generic_Package_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;

   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      Dict_TDA.Insert(Dict, "instanciation", To_String(Self.Instanciation));

      Xml_Writer.Create_Tag(File, "PackageOrSubprogram", Dict);
      Xml_Writer.Close_Tag(File, "PackageOrSubprogram");
      Dict_TDA.Empty(Dict);

   end Put_Xml;

   procedure Put_Xml (Self : in Generic_Proc_Para_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;
      Tmp_String : Unbounded_String;

   begin

      Tmp_String := "with procedure " & Self.Name;

      if Self.Parameters /= null then
         Tmp_String := Tmp_String & " (" & Concat(Self.Parameters.all) & ")";
      end if;

      if Self.Subp_Default /= Null_Unbounded_String then
         Tmp_String := Tmp_String & " is " & Self.Subp_Default;
      end if;

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      Dict_TDA.Insert(Dict, "name", To_String(Tmp_String));

      Xml_Writer.Create_Tag(File, "PackageOrSubprogram", Dict);
      Xml_Writer.Close_Tag(File, "PackageOrSubprogram");

      Dict_TDA.Empty(Dict);

   end Put_Xml;

   procedure Put_Xml (Self : in Generic_Fun_Para_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;
      Tmp_String : Unbounded_String;

   begin

      Tmp_String := "with function " & Self.Name;

      if Self.Parameters /= null then
         Tmp_String := Tmp_String & " (" & Concat(Self.Parameters.all) & ")";
      end if;

      Tmp_String := Tmp_String & " return " & Self.Return_Type;

      if Self.Subp_Default /= Null_Unbounded_String then
         Tmp_String := Tmp_String & " is " & Self.Subp_Default;
      end if;

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      Dict_TDA.Insert(Dict, "name", To_String(Tmp_String));

      Xml_Writer.Create_Tag(File, "PackageOrSubprogram", Dict);
      Xml_Writer.Close_Tag(File, "PackageOrSubprogram");

      Dict_TDA.Empty(Dict);

   end Put_Xml;

   procedure Put_Xml (Self : in Simple_Type_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;

   begin


      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      Dict_TDA.Insert(Dict, "declaration", To_String(Self.Declaration_Part));

      if Self.Discriminant_Part /= null then
         Dict_TDA.Insert(Dict, "discriminant",
                         To_String(Concat(Self.Discriminant_Part.all)));
      end if;

      Dict_TDA.Insert(Dict, "name", To_String(Self.Name));

      Xml_Writer.Create_Tag(File, "TypeDef", Dict);
      Xml_Writer.Close_Tag(File, "TypeDef");

      Dict_TDA.Empty(Dict);


   end Put_Xml;

   procedure Put_Xml (Self : in Subtype_Decl_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;

   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      Dict_TDA.Insert(Dict, "declaration", To_String(Self.Declaration_Part));
      Dict_TDA.Insert(Dict, "subtype", "true");

      Dict_TDA.Insert(Dict, "name", To_String(Self.Name));

      Xml_Writer.Create_Tag(File, "TypeDef", Dict);
      Xml_Writer.Close_Tag(File, "TypeDef");

      Dict_TDA.Empty(Dict);


   end Put_Xml;

   procedure Put_Xml (Self : in Derived_Type_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;

   begin

      Dict_TDA.Insert(Dict, "declaration", To_String(Self.Declaration_Part));
      Dict_TDA.Insert(Dict, "tagged", "true");

      if Self.Inheritance /= Null_Unbounded_String then
         Dict_TDA.Insert(Dict, "inheritance", To_String(Self.Inheritance));
      end if;

      if Self.Discriminant_Part /= null then
         Dict_TDA.Insert(Dict, "discriminant",
                         To_String(Concat(Self.Discriminant_Part.all)));
      end if;

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      Dict_TDA.Insert(Dict, "name", To_String(Self.Name));

      Xml_Writer.Create_Tag(File, "TypeDef", Dict);
      Xml_Writer.Close_Tag(File, "TypeDef");

      Dict_TDA.Empty(Dict);

   end Put_Xml;

   procedure Put_Xml (Self : in Parameters_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;
      Ptr_Tmp : Def_ID_S_Token_Ptr;
      Curent_Parameters : Parameters_Token := Self;

   begin
      loop


         if AdaDoc_Tree.Comment.Exist(Natural'Image(Curent_Parameters.Line_Number)) then
            Dict_TDA.Insert(Dict, "comment",
                            AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                            (Curent_Parameters.Line_Number)));
         end if;

         Dict_TDA.Insert(Dict, "mode", Convert_Mode(Curent_Parameters.Mode.all));
         Dict_TDA.Insert(Dict, "type", To_String(Curent_Parameters.Type_Param));

         if Curent_Parameters.Init /= Null_Unbounded_String then
            Dict_TDA.Insert(Dict, "init", To_String(Curent_Parameters.Init));
         end if;

         Ptr_Tmp := Curent_Parameters.Def_ID_S;
         while Ptr_Tmp /= null loop
            Dict_TDA.Update(Dict, "name", To_String(Ptr_Tmp.Str));
            Xml_Writer.Create_Tag(File, "Parameter", Dict);
            Xml_Writer.Close_Tag(File, "Parameter");
            Ptr_Tmp := Ptr_Tmp.Next_ID;
         end loop;

         Dict_TDA.Empty(Dict);

         exit when Curent_Parameters.Next = null;
         Curent_Parameters := Parameters_Token(Curent_Parameters.Next.all);

      end loop;
   end Put_Xml;


   procedure Put_Xml (Self : in Procedure_Decl_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;

   begin

      if Self.Is_Abstract then
         Dict_TDA.Insert(Dict, "abstract", "true");
      end if;

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      Dict_TDA.Insert(Dict, "name", To_String(Self.Name));

      Xml_Writer.Create_Tag(File, "Procedure", Dict);
      Dict_TDA.Empty(Dict);

      if Self.Is_Generic then
         Xml_Writer.Create_Tag(File, "SubpGenericParameters", Dict);
         Put_Xml(Self.Generic_Part, File);
         Xml_Writer.Close_Tag(File, "SubpGenericParameters");
      end if;

      if Self.Parameters /= null then
         Xml_Writer.Create_Tag(File, "Parameters", Dict);
         Put_Xml(Self.Parameters.all, File);
         Xml_Writer.Close_Tag(File, "Parameters");
      end if;

      Xml_Writer.Close_Tag(File, "Procedure");
   end Put_Xml;

   procedure Put_Xml (Self : in Function_Decl_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;

   begin


      Dict_TDA.Insert(Dict, "return", To_String(Self.Return_Type));

      if Self.Is_Abstract then
         Dict_TDA.Insert(Dict, "abstract", "true");
      end if;

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      Dict_TDA.Insert(Dict, "name", To_String(Self.Name));

      Xml_Writer.Create_Tag(File, "Function", Dict);
      Dict_TDA.Empty(Dict);

      if Self.Is_Generic then
         Xml_Writer.Create_Tag(File, "SubpGenericParameters", Dict);
         Put_Xml(Self.Generic_Part.all, File);
         Xml_Writer.Close_Tag(File, "SubpGenericParameters");
      end if;

      if Self.Parameters /= null then
         Xml_Writer.Create_Tag(File, "Parameters", Dict);
         Put_Xml(Self.Parameters.all, File);
         Xml_Writer.Close_Tag(File, "Parameters");
      end if;

      Xml_Writer.Close_Tag(File, "Function");
   end Put_Xml;

   procedure Put_Xml (Self : in Object_Declaration_Token; File : in File_Type) is

      Ptr_Tmp : Def_ID_S_Token_Ptr := Self.Def_ID_S;
      Dict : Dict_TDA.Dict_Type;

   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      if Self.Subtype_Def /= Null_Unbounded_String then
         Dict_TDA.Insert(Dict, "type", To_String(Self.Subtype_Def));
      end if;

      if Self.Qualifier.Qualifier(Constant_Qualifier) then
         Dict_TDA.Insert(Dict, "constant", "true");
      end if;

      if Self.Qualifier.Qualifier(Aliased_Qualifier) then
         Dict_TDA.Insert(Dict, "aliased", "true");
      end if;

      if Self.Init /= Null_Unbounded_String then
         Dict_TDA.Insert(Dict, "init", To_String(Self.Init));
      end if;

      while Ptr_Tmp /= null loop
         Dict_TDA.Update(Dict, "name", To_String(Ptr_Tmp.Str));
         Xml_Writer.Create_Tag(File, "Object", Dict);
         Xml_Writer.Close_Tag(File, "Object");
         Ptr_Tmp := Ptr_Tmp.Next_ID;
      end loop;

      Dict_TDA.Empty(Dict);

   end Put_Xml;

   procedure Put_Xml (Self : in Exception_Declaration_Token; File : in File_Type) is

      Ptr_Tmp : Def_ID_S_Token_Ptr := Self.Def_ID_S;
      Dict : Dict_TDA.Dict_Type;

   begin

      while Ptr_Tmp /= null loop

         if AdaDoc_Tree.Comment.Exist(Natural'Image(Ptr_Tmp.Line_Number)) then
            Dict_TDA.Update(Dict, "comment",
                            AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                            (Ptr_Tmp.Line_Number)));
         end if;

         Dict_TDA.Update(Dict, "name", To_String(Ptr_Tmp.Str));
         Xml_Writer.Create_Tag(File, "Exception", Dict);
         Xml_Writer.Close_Tag(File, "Exception");
         Ptr_Tmp := Ptr_Tmp.Next_ID;
      end loop;

      Dict_TDA.Empty(Dict);

   end Put_Xml;

   procedure Put_Xml (Self : in Component_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;
      Ptr_Tmp : Def_ID_S_Token_Ptr;
      Curent_Component : Component_Token := Self;

   begin
      loop

         if AdaDoc_Tree.Comment.Exist(Natural'Image(Curent_Component.Line_Number)) then
            Dict_TDA.Insert(Dict, "comment",
                            AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                            (Curent_Component.Line_Number)));
         end if;

         if Curent_Component.Init /= Null_Unbounded_String then
            Dict_TDA.Insert(Dict, "init", To_String(Curent_Component.Init));
         end if;

         Dict_TDA.Insert(Dict, "type", To_String(Curent_Component.Type_Def));

         Ptr_Tmp := Curent_Component.Def_ID_S;
         while Ptr_Tmp /= null loop
            Dict_TDA.Update(Dict, "name", To_String(Ptr_Tmp.Str));
            Xml_Writer.Create_Tag(File, "Object", Dict);
            Xml_Writer.Close_Tag(File, "Object");
            Ptr_Tmp := Ptr_Tmp.Next_ID;
         end loop;

         Dict_TDA.Empty(Dict);

         exit when Curent_Component.Next_Component = null;
         Curent_Component := Component_Token(Curent_Component.Next_Component.all);

      end loop;

   End Put_Xml;


   procedure Put_Xml (Self : in Variant_Choice_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;
      Current_Choice : Variant_Choice_Token := Self;

   begin

      loop

         if AdaDoc_Tree.Comment.Exist(Natural'Image(Current_Choice.Line_Number)) then
            Dict_TDA.Insert(Dict, "comment",
                            AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                            (Current_Choice.Line_Number)));
         end if;

         Dict_TDA.Insert(Dict, "choice", To_String(Current_Choice.Choice));
         Xml_Writer.Create_Tag(File, "Choice", Dict);

         if Current_Choice.Component_List /= null then
            Put_Xml(Current_Choice.Component_List.all, File);
         end if;

         Dict_TDA.Empty(Dict);
         Xml_Writer.Close_Tag(File, "Choice");

         exit when Current_Choice.Next_Variant_Choice = null;

         Current_Choice := Current_Choice.Next_Variant_Choice.all;
      end loop;

   end Put_Xml;

   procedure Put_Xml (Self : in Variant_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;

   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      Dict_TDA.Insert(Dict, "discriminant", To_String(Self.Discriminant));
      Xml_Writer.Create_Tag(File, "VariantPart", Dict);
      Put_Xml(Self.Choice.all, File);
      Xml_Writer.Close_Tag(File, "VariantPart");

      Dict_TDA.Empty(Dict);
   end Put_Xml;

   procedure Put_Xml (Self : in Component_List_Token; File : in File_Type) is

   begin

      if Self.Component_Part /= null then
         Xml_Writer.Create_Tag(File, "Components", Dict_TDA.Empty_Dict);
         Put_Xml(Self.Component_Part.all, File);
         Xml_Writer.Close_Tag(File, "Components");
      end if;

      if Self.Variant_Part /= null then
         Put_Xml(Self.Variant_Part.all, File);
      end if;

   end Put_Xml;

   procedure Put_Xml (Self : in Record_Type_Token; File : File_Type) is

      Dict : Dict_TDA.Dict_Type;

   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      if Self.Null_Record then
         Dict_TDA.Insert(Dict, "null", "true");
      end if;

      --if tagged
      if Self.Poo_Part /= null then

         Dict_TDA.Insert(Dict, "tagged", "true");

         if Self.Poo_Part.Is_Limited then
            Dict_TDA.Insert(Dict, "limited", "true");
         end if;

         if Self.Poo_Part.Is_Abstract then
            Dict_TDA.Insert(Dict, "abstract", "true");
         end if;

         if Self.Poo_Part.Inheritance /= Null_Unbounded_String then
            Dict_TDA.Insert(Dict, "inheritance", To_String(Self.Poo_Part.Inheritance));
         end if;
      end if;

      Dict_TDA.Insert(Dict, "name", To_String(Self.Name));

      Xml_Writer.Create_Tag(File, "Record", Dict);
      Dict_TDA.Empty(Dict);

      if Self.Discriminant_Part /= null then
         Xml_Writer.Create_Tag(File, "Discriminants", Dict_TDA.Empty_Dict);
         Put_Xml(Self.Discriminant_Part.all, File);
         Xml_Writer.Close_Tag(File, "Discriminants");
      end if;

      if Self.Component_List /= null then
         Put_Xml(Self.Component_List.all, File);
      end if;
      Xml_Writer.Close_Tag(File, "Record");



   end Put_Xml;

   --Generic Instanciation
   procedure Put_Xml (Self : in Generic_Pkg_Inst_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;

   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      Dict_TDA.Insert(Dict, "name", To_String(Self.Instanciation));

      Xml_Writer.Create_Tag(File, "GenericInstanciation", Dict);
      Dict_TDA.Empty(Dict);
      Xml_Writer.Close_Tag(File, "GenericInstanciation");

   end Put_Xml;

   procedure Put_Xml (Self : in Generic_Subp_Inst_Token; File : File_Type) is

      Dict : Dict_TDA.Dict_Type;
      Tmp_String : Unbounded_String;
      Is_Function : Boolean := False;

   begin

      if Expanded_Name(Self.Subprog_Spec.all'Tag) =
         "ADADOC_TREE.PROCEDURE_DECL_TOKEN" then
         Tmp_String := To_Unbounded_String("procedure ");
      else
         Is_Function := True;
         Tmp_String := To_Unbounded_String("function ");
      end if;

      Tmp_String := Tmp_String & Self.Subprog_Spec.Name;

      if Self.Subprog_Spec.Parameters /= null then
         Tmp_String := Tmp_String & "(" & Concat(Self.Subprog_Spec.Parameters.all) & ") ";
      end if;

      if Is_Function and then
         Function_Decl_Token(Self.Subprog_Spec.all).Return_Type /= Null_Unbounded_String
         then

         Tmp_String := Tmp_String & " return " &
                       Function_Decl_Token(Self.Subprog_Spec.all).Return_Type;
      end if;

      Tmp_String := Tmp_String & ' ' & Self.Instanciation;

      Dict_TDA.Insert(Dict, "name", To_String(Tmp_String));

      Xml_Writer.Create_Tag(File, "GenericInstanciation", Dict);
      Dict_TDA.Empty(Dict);
      Xml_Writer.Close_Tag(File, "GenericInstanciation");

   end Put_Xml;

   --Pragma
   procedure Put_Xml (Self : in Pragma_Decl_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;

   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      if Self.Decl /= Null_Unbounded_String then
         Dict_TDA.Insert(Dict, "args", To_String(Self.Decl));
      end if;

      Dict_TDA.Insert(Dict, "name", To_String(Self.Name));

      Xml_Writer.Create_Tag(File, "Pragma", Dict);
      Dict_TDA.Empty(Dict);
      Xml_Writer.Close_Tag(File, "Pragma");

   end Put_Xml;


   procedure Put_Xml (Self : in Entry_Decl_Token; File : in File_Type) is
      Dict : Dict_TDA.Dict_Type;
   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      if Self.Family /= Null_Unbounded_String then
         Dict_TDA.Insert(Dict, "family", To_String(Self.Family));
      end if;

      Dict_TDA.Insert(Dict, "name", To_String(Self.Name));

      Xml_Writer.Create_Tag(File, "Entry", Dict);
      Dict_TDA.Empty(Dict);

      if Self.Parameters /= null then
         Xml_Writer.Create_Tag(File, "Parameters", Dict_TDA.Empty_Dict);
         Put_Xml(Self.Parameters.all, File);
         Xml_Writer.Close_Tag(File, "Parameters");
      end if;

      Xml_Writer.Close_Tag(File, "Entry");

   end Put_Xml;


   --Write a list of entry
   procedure Put_Xml (Self : in Entry_Decl_List_Ptr; File : in File_Type) is
      Tmp : Entry_Decl_List_Ptr := Self;
   begin

      Xml_Writer.Create_Tag(File, "Entries", Dict_TDA.Empty_Dict);

      while Tmp /= null loop
         Put_Xml(Tmp.all, File);
         Tmp := Tmp.Next;
      end loop;

      Xml_Writer.Close_Tag(File, "Entries");

   end Put_Xml;


   procedure Put_Xml ( Self : in Task_Decl_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;

   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      Dict_TDA.Insert(Dict, "name", To_String(Self.Name));


      Xml_Writer.Create_Tag(File, "Task", Dict);
      Dict_TDA.Empty(Dict);

      --Put the disriminant
      if Self.Discriminant /= null then
         Xml_Writer.Create_Tag(File, "Discriminants", Dict_TDA.Empty_Dict);
         Put_Xml(Component_Token(Self.Discriminant.all), File);
         Xml_Writer.Close_Tag(File, "Discriminants");
      end if;

      --Put the entries
      if Self.Entries /= null then
         Put_Xml(Self.Entries, File);
      end if;

      ----Put the private entries
      if Self.Private_Entries /= null then
         Xml_Writer.Create_Tag(File, "TaskPrivate", Dict_TDA.Empty_Dict);
         Put_Xml(Self.Private_Entries, File);
         Xml_Writer.Close_Tag(File, "TaskPrivate");
      end if;

      Xml_Writer.Close_Tag(File, "Task");

   end Put_Xml;

   procedure Put_Xml (Self : in Protected_Object_List_Ptr; File : in File_Type) is

   begin

      if Self.Next /= null then
         Put_Xml(Self.Next, File);
      end if;


      Put_Xml(Self.Item.all, File);


   end Put_Xml;

   procedure Put_Xml (Self : in Protected_Private_Object_List_Ptr;
                      File : in File_Type) is

   begin

      if Self.Next /= null then
         Put_Xml(Protected_Private_Object_List_Ptr(Self.Next), File);
      end if;

      if Self.Item /= null then
         Put_Xml(Self.Item.all, File);
      else
         Put_Xml(Self.Private_Comp.all , File);
      end if;


   end Put_Xml;

   procedure Put_Xml (Self : in Protected_Decl_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;

   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      Dict_TDA.Insert(Dict, "name", To_String(Self.Name));


      Xml_Writer.Create_Tag(File, "ProtectedObject", Dict);
      Dict_TDA.Empty(Dict);

      --Put the disriminant
      if Self.Discriminant /= null then
         Xml_Writer.Create_Tag(File, "Discriminants", Dict_TDA.Empty_Dict);
         Put_Xml(Component_Token(Self.Discriminant.all), File);
         Xml_Writer.Close_Tag(File, "Discriminants");
      end if;

      --Put the entries, and subprogram
      if Self.Prot_Op /= null then
         Put_Xml(Self.Prot_Op, File);
      end if;

      ----Put the private entries
      if Self.Prot_Op_Private /= null then
         Xml_Writer.Create_Tag(File, "ProtectedPrivate", Dict_TDA.Empty_Dict);
         Put_Xml(Self.Prot_Op_Private, File);
         Xml_Writer.Close_Tag(File, "ProtectedPrivate");
      end if;

      Xml_Writer.Close_Tag(File, "ProtectedObject");
   end Put_Xml;

   procedure Put_Xml (Self : in Rep_Clause_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;
   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;


      Dict_TDA.Insert(Dict, "name", To_String(Self.Def));
      Xml_Writer.Create_Tag(File, "Clause", Dict);
      Dict_TDA.Empty(Dict);
      Xml_Writer.Close_Tag(File, "Clause");

   end Put_Xml;

   procedure Put_Xml (Self : in Renames_Exception_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;
      Ptr_Tmp : Def_ID_S_Token_Ptr := Self.Def_ID_S;
      Tmp_String : String := " : exception renames " & To_String(Self.Rename);
   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;



      while Ptr_Tmp /= null loop
         Dict_TDA.Update(Dict, "name", To_String(Ptr_Tmp.Str) & Tmp_String);
         Xml_Writer.Create_Tag(File, "Rename", Dict);
         Dict_TDA.Empty(Dict);
         Xml_Writer.Close_Tag(File, "Rename");
         Ptr_Tmp := Ptr_Tmp.Next_ID;
      end loop;

   end Put_Xml;

   procedure Put_Xml (Self : in Renames_Object_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;
      Ptr_Tmp : Def_ID_S_Token_Ptr := Self.Def_ID_S;
      Tmp_String : String := " : " & To_String(Self.Subtype_Ind) & " renames " &
                   To_String(Self.Rename);
   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      if Self.Qualifier.Qualifier(Constant_Qualifier) then
         Tmp_String := " constant" & Tmp_String;
      end if;

      if Self.Qualifier.Qualifier(Aliased_Qualifier) then
         Tmp_String := " aliased" & Tmp_String;
      end if;


      while Ptr_Tmp /= null loop
         Dict_TDA.Update(Dict, "name", To_String(Ptr_Tmp.Str) & Tmp_String);
         Xml_Writer.Create_Tag(File, "Rename", Dict);
         Dict_TDA.Empty(Dict);
         Xml_Writer.Close_Tag(File, "Rename");
         Ptr_Tmp := Ptr_Tmp.Next_ID;
      end loop;

   end Put_Xml;

   procedure Put_Xml (Self : in Renames_Package_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;

   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;


      Dict_TDA.Update(Dict, "name", "package " & To_String(Self.Name) &
                      " renames " & To_String(Self.Rename));
      Xml_Writer.Create_Tag(File, "Rename", Dict);
      Dict_TDA.Empty(Dict);
      Xml_Writer.Close_Tag(File, "Rename");

   end Put_Xml;

   procedure Put_Xml (Self : in Renames_Generic_Package_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;

   begin

      if AdaDoc_Tree.Comment.Exist(Natural'Image(Self.Line_Number)) then
         Dict_TDA.Insert(Dict, "comment",
                         AdaDoc_Tree.Comment.Return_Comment(Natural'Image
                         (Self.Line_Number)));
      end if;

      Dict_TDA.Update(Dict, "name", "generic package " & To_String(Self.Name)
                      & " renames " & To_String(Self.Rename));
      Xml_Writer.Create_Tag(File, "Rename", Dict);
      Dict_TDA.Empty(Dict);
      Xml_Writer.Close_Tag(File, "Rename");


   end Put_Xml;

   procedure Put_Xml (Self : in Renames_Subp_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;
      Tmp_String : Unbounded_String;
      Is_Function : Boolean := False;

   begin

      if Expanded_Name(Self.Subprog_Spec.all'Tag) =
         "ADADOC_TREE.PROCEDURE_DECL_TOKEN" then
         Tmp_String := To_Unbounded_String("procedure ");
      else
         Is_Function := True;
         Tmp_String := To_Unbounded_String("function ");
      end if;

      Tmp_String := Tmp_String & Self.Subprog_Spec.Name;

      if Self.Subprog_Spec.Parameters /= null then
         Tmp_String := Tmp_String & "(" & Concat(Self.Subprog_Spec.Parameters.all) & ") ";
      end if;

      if Is_Function then
         Tmp_String := Tmp_String & " return " &
                       Function_Decl_Token(Self.Subprog_Spec.all).Return_Type;
      end if;


      Dict_TDA.Update(Dict, "name", To_String(Tmp_String & " renames " &
                      Self.Rename));
      Xml_Writer.Create_Tag(File, "Rename", Dict);
      Dict_TDA.Empty(Dict);
      Xml_Writer.Close_Tag(File, "Rename");


   end Put_Xml;

   procedure Put_Xml (Self : in Renames_Generic_Subp_Token; File : in File_Type) is

      Dict : Dict_TDA.Dict_Type;
      Tmp_String : Unbounded_String;
      Is_Function : Boolean := False;

   begin

      if Expanded_Name(Self.Subprog_Spec.all'Tag) =
         "ADADOC_TREE.PROCEDURE_DECL_TOKEN" then
         Tmp_String := To_Unbounded_String("procedure ");
      else
         Is_Function := True;
         Tmp_String := To_Unbounded_String("function ");
      end if;

      Tmp_String := Tmp_String & Self.Subprog_Spec.Name;

      if Self.Subprog_Spec.Parameters /= null then
         Tmp_String := Tmp_String & "(" & Concat(Self.Subprog_Spec.Parameters.all) & ") ";
      end if;

      if Is_Function then
         Tmp_String := Tmp_String & " return " &
                       Function_Decl_Token(Self.Subprog_Spec.all).Return_Type;
      end if;


      Dict_TDA.Update(Dict, "name", To_String(" generic " & Tmp_String &
                      " renames " & Self.Rename));
      Xml_Writer.Create_Tag(File, "Rename", Dict);
      Dict_TDA.Empty(Dict);
      Xml_Writer.Close_Tag(File, "Rename");


   end Put_Xml;

end AdaDoc_Tree;