--
-- @filename adadoc_tree-comment.adb
-- @author Julien Burdy & Vincent Decorges
-- @date 17.6.02
-- @brief Abstract machin to stock the comment
--
-- History  :
-- Date     Modification               Author
--
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Dict_TDA;

package body AdaDoc_Tree.Comment is

   --
   -- Name    : Init
   -- Purpose : Initalize the abstract machine
   --
   -- in      : Mode : Functional mode of the abstract machine
   --                  when before : the comment are before the instruction
   --                  when after : the comment are after the instuction
   -- in      : Dict_Tag : Dictonary of possible tags in the header
   -- in      : Extract : Try to extract only the header if false
   --
   procedure Init (Mode : in Mode_Type := Before;
                   Dict_Tag : Dict_TDA.Dict_Type;
                   Extract : Boolean := False) is

   begin
      Comment_Machine.Mode := Mode;
      Comment_Machine.Dict_Tag := Dict_Tag;
      Comment_Machine.Extract := Extract;
   end Init;

   --
   -- Name    : Add_To_Buffer
   -- Purpose : Add a comment to the buffer
   --
   -- in      : Item : String to add
   --
   procedure Add_To_Buffer (Item : in String) is

   begin

      --More than one line we add ¶ to mark the skip line
      if Comment_Machine.Buffer /= Null_Unbounded_String then
         Comment_Machine.Buffer := Comment_Machine.Buffer & '¶';
      end if;

      --Add comment to buffer
      Comment_Machine.Buffer := Comment_Machine.Buffer &
                                To_Unbounded_String(Item(3..Item'Last));

   end Add_To_Buffer;

   --
   -- Name    : Clear_Buffer
   -- Purpose : Clear the buffer
   --
   procedure Clear_Buffer is

   begin

      Comment_Machine.Buffer := Null_Unbounded_String;

   end Clear_Buffer;

   --
   -- Name    : Mark_Instruction
   -- Purpose : Call when an instruction occur
   --
   -- in      : Key : line where the occurance is
   --
   procedure Mark_Instruction (Key : String) is

      Buffer_Tmp : String := To_String(Comment_Machine.Buffer);

   begin

      --Treat the header
      if Comment_Machine.In_Header then

         declare

            --Treat the tags in the header
            procedure Treat_Tag ( Key : in String; Value : in String) is

               Position_Key : Natural := 1;     --Position of the tag
               Position_Return_Line : Natural;  --Position of skip line

            begin

               --More than one occurance of the tag is possible
               loop
                  --Search tag
                  Position_Key := Index(Buffer_Tmp(Position_Key..Buffer_Tmp'Last),
                                  '@' & Key);

                  --We have not found the tag
                  exit when Position_Key = 0;

                  --Next to the tag
                  Position_Key := Index_Non_Blank(Buffer_Tmp(Position_Key +
                                  Key'Length + 1..Buffer_Tmp'Last));

                  Position_Return_Line := Index(Buffer_Tmp(
                                          Position_Key..Buffer_Tmp'Last), "¶");

                  --We more than 1 line in the buffer
                  if Position_Return_Line /= 0 then
                     Position_Return_Line := Position_Return_Line -1;
                  --We have 1 line in the buffer or we are on the last line
                  else
                     Position_Return_Line := Buffer_Tmp'Last;
                  end if;

                  --It is the first occurance of the tag
                  if not Dict_TDA.Exist(Comment_Machine.Dict_Header, Key) then
                     Dict_TDA.Insert(Comment_Machine.Dict_Header, Key,
                                     Buffer_Tmp(Position_Key..Position_Return_Line));

                  --More then one occurance
                  else
                     --Concatenation with the previous comment
                     Dict_TDA.Update(Comment_Machine.Dict_Header, Key,
                                     Dict_TDA.Value_Of(Comment_Machine.Dict_Header, Key) &
                                     '¶' &
                                     Buffer_Tmp(Position_Key..Position_Return_Line));
                  end if;

               end loop;
            end Treat_Tag;

            procedure Treat_Header is new Dict_TDA.Run_Through(Treat_Tag);

         begin
            --Treat Header
            Treat_Header(Comment_Machine.Dict_Tag);
         end;
         --No more header after this point
         Comment_Machine.In_Header := False;

      --General comment
      else

         case Comment_Machine.Mode is

            when Before =>
               --If the buffer is not empty insert the comment in the dictonary
               --(key is the number of the line where the instruction is)
               if Comment_Machine.Buffer /= Null_Unbounded_String then
                  Dict_TDA.Insert(Comment_Machine.Dict_Comment, Key,
                  Buffer_Tmp(1..Buffer_Tmp'Last));
               end if;

            -- Not yet implemented!!
            when After =>
               null;
         end case;
      end if;

      Clear_Buffer;

   end Mark_Instruction;

   --
   -- Name    : Return_Comment
   -- Purpose : return the comment associate to the key
   --
   -- in      : Key : line where the occurance is
   -- return  : The comment
   --
   function Return_Comment (Key : in String) return String is

      Tmp_String : String := Dict_TDA.Value_Of(Comment_Machine.Dict_Comment, Key);

   begin


      --To prevent to repeat the comment if an other declaration
      --is in the same line
      Dict_TDA.Delete(Comment_Machine.Dict_Comment, Key);

      return Tmp_String;

   end Return_Comment;

   --
   -- Name    : Exist
   -- Purpose : True if a comment exist for the key
   --
   -- in      : Key : line where the occurance is
   -- return  : True if exist
   --
   function Exist (Key : String) return Boolean is

   begin

      if Comment_Machine.Extract then
         return Dict_TDA.Exist(Comment_Machine.Dict_Comment, Key);
      else
         return False;
      end if;

   end Exist;

   --
   -- Name    : Return_Header_Comment
   -- Purpose : return the comment associate to the tags in the header
   -- return  : a dico with the comment associate to the tags
   --
   function Return_Header_Comment return Dict_TDA.Dict_Type is

   begin
      return Comment_Machine.Dict_Header;
   end Return_Header_Comment;

   --
   -- Name    : Delete
   -- Purpose : Clean the abstract machine
   --
   procedure Delete is

   begin

      Dict_TDA.Empty(Comment_Machine.Dict_Comment);
      Dict_TDA.Empty(Comment_Machine.Dict_Header);

   end Delete;

end AdaDoc_Tree.Comment;