--
-- @filename module-stronghelp.adb
-- @author Bent Bracke
-- @date 13.01.04
-- @brief AdaDoc Stronghelp writer
--
-- History  :
-- Date     Modification               Author
--
with Ada.Text_IO;            use Ada.Text_IO;
with Ada.Strings.Unbounded;  use Ada.Strings.Unbounded;
with Ada.Strings.Maps;       use Ada.Strings.Maps;

package body Module.Stronghelp is

   procedure Remove_EndLF (Content : in out Unbounded_String) is
       Len : Natural := Ada.Strings.Unbounded.Length(Content);
       Last : Character;
   begin
       loop
          if Len < 3 then
             exit;
          end if;
          Last := Element(Content,Len);
          if Last = ASCII.LF then
             if Element(Content,Len-1)= ASCII.LF then
                Content := To_Unbounded_String(Ada.Strings.Unbounded.Slice(Content,1,Len-1));
             else
                exit;
             end if;
          else
             exit;
          end if;
          Len := Ada.Strings.Unbounded.Length(Content);
       end loop;
   end Remove_EndLF;

   procedure Remove_3rdLF (Content : in out Unbounded_String) is
       Len        : Natural;
       Index      : Natural;
       new_string : Unbounded_String;
   begin
       loop
          Len   := Ada.Strings.Unbounded.Length(Content);
          Index := Ada.Strings.Unbounded.Index(Content,ASCII.LF & ASCII.LF & ASCII.LF);
          if Len < 2 then
             exit;
          end if;

          if Index > 0 then
             new_string := To_Unbounded_String(Ada.Strings.Unbounded.Slice(Content,1,Index));
             if Len > Index+2 then
                Append(new_string,Ada.Strings.Unbounded.Slice(Content,Index+2,Len));
             end if;
             Content := new_string;
          else
             exit;
          end if;
       end loop;
   end Remove_3rdLF;

   procedure Remove_StartSpace (Content : in out Unbounded_String) is
       Len        : Natural;
       Index      : Natural;
       new_string : Unbounded_String;
   begin
       loop
          Len   := Ada.Strings.Unbounded.Length(Content);
          Index := Ada.Strings.Unbounded.Index(Content,ASCII.LF & ' ');

          if Len < 2 then
             exit;
          end if;

          if Index > 0 then
             new_string := To_Unbounded_String(Ada.Strings.Unbounded.Slice(Content,1,Index));
             if Len > Index+2 then
                Append(new_string,Ada.Strings.Unbounded.Slice(Content,Index+2,Len));
             end if;   
             Content := new_string;
          else
             exit;
          end if;
       end loop;
   end Remove_StartSpace;

   
   File : Ada.Text_IO.File_Type; -- File to write Stronghelp to

   type Chapter is
   record
   Exist  : Boolean := false;
   Content: Unbounded_String;
   Header : Unbounded_String;
   Default: Boolean := false;
   Comment: Boolean := false;
   Link   : Unbounded_String;
   Name   : Unbounded_String;
   Mode   : Boolean := false;
   end record;

   Page : array (Element_Type'Range) of Chapter;

   Current_Clause_Type : Element_Type;
   Current_Object_Type : Element_Type;
   Second_Object_Type  : Element_Type;
   
   A_Record_Content : Unbounded_String;
   A_Record_Comment : Boolean := false;
   A_Record_Default : Boolean := false;
   A_Record_Mode    : Boolean := false;
   
   A_Record_Choice  : Unbounded_String;
   A_Record_Variant : Unbounded_String;

   A_Subprogram_Header  : Unbounded_String;
   A_Subprogram_Content : Unbounded_String;
   A_Subprogram_Comment : Boolean := false;
   A_Subprogram_Default : Boolean := false;
   A_Subprogram_Mode    : Boolean := false;

   A_Type_Content      : Unbounded_String;
   
   Page_Name   : Unbounded_String;
   Page_Comment: Unbounded_String;
   Page_Tags   : Unbounded_String;

   Is_Tags : Boolean := false;

   -- Scan for characters which are reserved for StrongHelp commands
   -- and prefix them with an escape character '\'
   function Cleanse_String (source : in string) return string is

      temp  : unbounded_string := To_Unbounded_String(source);
      index : integer          := 0;
      res   : unbounded_string;
      
   begin
   
      index := Ada.strings.unbounded.index(temp,To_Set("<>#{}_/*"));
      while index > 0 loop
      
         if index > 1 then
            res := res & Ada.Strings.Unbounded.Head(temp,index-1)
                       & To_Unbounded_String("\")
                       & Ada.Strings.Unbounded.Element(temp,index);
         else
            res := res & To_Unbounded_String("\") & Ada.Strings.Unbounded.Element(temp,index);
         end if;
         temp:= To_Unbounded_String(Slice(temp,index+1,Length(temp)));
         index := Ada.strings.unbounded.index(temp,To_Set("<>#{}_/*"));

      end loop;

      return To_String(res & temp);
   end cleanse_string;

   --
   -- Purpose : Overload of the Text_IO put to replace some symbols.
   --
   -- Item : Item to put.
   --
   procedure Put(Item: String) is

      String_Tmp : Unbounded_String := To_Unbounded_String(Item);

   begin -- Replacement of some symbols

      while Index(String_Tmp, "¶") /= 0 loop
         Replace_Slice (String_Tmp, Index(String_Tmp, "¶"),
                        Index(String_Tmp, "¶"), "" & ASCII.LF);
      end loop;

      Ada.Text_IO.Put(To_String(String_Tmp));

   end Put;

   --
   -- Purpose : Overload of the Text_IO Put_Line.
   --
   -- Item : Item to put.
   --
   procedure Put_Line(Item: String) is
   begin
      Put(Item);
      Ada.Text_IO.New_Line;
   end Put_Line;


   --------------
   -- A_Choice --
   --------------
   -- Receive notification of each variant part choice.
   procedure A_Choice (Self : Object; Atts : Dict_Type; Its_Value : String) is
      dummy : Unbounded_String;
   begin
      Append(dummy,ASCII.LF & "{/}Variant part{/} => " & Cleanse_String(Its_Value));
      if Exist(Atts,"comment") then
         Append(dummy,"\t" & Cleanse_String(Value_Of(Atts,"comment")));
      end if;
      Append(dummy,ASCII.LF);
      Append(A_Record_Choice,dummy);
   end A_Choice;


   --------------
   -- A_Clause --
   --------------
   -- Receive notification of each clause.
   procedure A_Clause (Self : Object; Atts : Dict_Type; Its_Value : String) is
      dummy : Unbounded_String;
   begin
      Append (dummy,Cleanse_String(Its_Value));
      if Exist(Atts,"comment") then
         Page(Current_Clause_Type).Comment := true;
         Append(dummy,"\t" & Cleanse_String(Value_Of(Atts,"comment")));
      end if;
      Append(dummy,ASCII.LF);
      Append(Page(Current_Clause_Type).Content,dummy);
   end A_Clause;



   ----------------
   -- A_Function --
   ----------------
   -- Receive notification of each function.
   procedure A_Function (Self : Object; Atts : Dict_Type;
                         Its_Name, Its_Return_Type : String; In_Prot_Obj : Boolean) is

      dummy : Unbounded_String;

   begin
      Append(dummy,"#Line" & ASCII.LF);
      Append(dummy,"#Tab" & ASCII.LF);
      Append(dummy,"{fH5}" & Cleanse_String(Its_Name));
      Append(dummy,"{f}\t");
      Append(dummy,"{*}Return{*} : " & Cleanse_String(Its_Return_Type) & ASCII.LF);

      if Exist(Atts,"comment") then
         Append(dummy,ASCII.LF);
         Append(dummy,Cleanse_String(Value_Of(Atts,"comment") & ASCII.LF));
      end if;
      Append(A_Subprogram_Header,dummy);
   end A_Function;


   ------------------------
   -- A_Generic_Instance --
   ------------------------
   -- Receive notification of each generic instance.
   procedure A_Generic_Instance (Self : Object;  Atts : Dict_Type; Its_Name : String) is
      dummy : Unbounded_String;
   begin
      Append(dummy,Cleanse_String(Its_Name));
      if Exist(Atts,"comment") then
         Append(dummy,"\t" & Cleanse_String(Value_Of(Atts,"comment")));
      end if;
      Append(dummy,ASCII.LF);
      Append(Page(Is_GenericInstanciations).Content,dummy);
   end A_Generic_Instance;


   ------------------------------
   -- A_Package_Subprogram_Gen --
   ------------------------------
   -- Receive notification of each generic package or subprogram.
   procedure A_Package_Subprogram_Gen (Self : Object; Atts : Dict_Type;
                                       Its_Name : String) is
      dummy : Unbounded_String;
   begin
      Append(dummy,Cleanse_String(Its_Name));
      if Exist(Atts,"comment") then
         Append(dummy,"\t" & Cleanse_String(Value_Of(Atts,"comment")));
      end if;
      Append(dummy,ASCII.LF);
      Append(Page(Is_PackagesSubprograms).Content,dummy);
   end A_Package_Subprogram_Gen;


   -----------------
   -- A_Parameter --
   -----------------
   -- Receive notification of each parameter (procedure, function, entry).
   procedure A_Parameter (Self : Object; Atts : Dict_Type;
                          Its_Name, Its_Type, Its_Mode : String) is
      dummy : Unbounded_String;
   begin
      Append (dummy,Cleanse_String(Its_Name));
      Append (dummy,"\t" & Cleanse_String(Its_Type));

      if Its_Mode'Length > 0 then
         A_Subprogram_Mode := true;
         Append(dummy,"\t" & Cleanse_String(Its_Mode));
      else
         Append(dummy,"\t");
      end if;
      if Exist(Atts,"init") then
         A_Subprogram_Default := true;
         Append (dummy,"\t" & Cleanse_String(Value_Of(Atts,"init")));
      else
         Append(dummy,"\t");
      end if;
      if Exist(Atts,"comment") then
         A_Subprogram_Comment := true;
         Append(dummy,"\t" & Cleanse_String(Value_Of(Atts,"comment")));
      else
         Append(dummy," \t");
      end if;
      Append(dummy,ASCII.LF);
      Append(A_Subprogram_Content,dummy);
   end A_Parameter;


   -----------------
   -- A_Procedure --
   -----------------
   -- Receive notification of each procedure.
   procedure A_Procedure (Self : Object; Atts : Dict_Type; Its_Name : String;
                          In_Prot_Obj : Boolean) is
      dummy : Unbounded_String;
   begin
      Append(dummy,"#Line" & ASCII.LF);
      Append(dummy,"#Tab" & ASCII.LF);
      Append(dummy,"#fH5:" & Cleanse_String(Its_Name) & ASCII.LF);

      if Exist(Atts,"comment") then
         Append(dummy,ASCII.LF);
         Append(dummy,Cleanse_String(Value_Of(Atts,"comment")) & ASCII.LF);
      end if;
      Append(A_Subprogram_Header,dummy);
   end A_Procedure;


   --------------
   -- A_Record --
   --------------
   -- Receive notification of each record.
   procedure A_Record (Self : Object; Atts : Dict_Type; Its_Name : String) is
      dummy : Unbounded_String;
   begin

      Append(dummy,"#Line" & ASCII.LF);
      Append(dummy,"#Tab" & ASCII.LF);
      Append(dummy,"#fH5:" & Cleanse_String(Its_Name) & ASCII.LF);
      Append(dummy,"{*}is{*}\t:\t");

      if Exist(Atts,"null") then
         Append(dummy,"null ");
      end if;
      if Exist(Atts,"limited") then
         Append(dummy,"limited ");
      end if;
      if Exist(Atts,"private") then
         Append(dummy,"private ");
      end if;
      if Exist(Atts,"abstract") then
         Append(dummy,"abstract ");
      end if;
      if Exist(Atts,"tagged") then
         Append(dummy,"tagged record");
      else
         Append(dummy,"record");
      end if;
      Append(dummy,ASCII.LF);

      if Exist(Atts,"inheritance") then
         Append(dummy,"{*}Extends{*}\t:\t");
         Append(dummy,Cleanse_String(Value_Of(Atts,"inheritance")));
         Append(dummy,ASCII.LF);
      end if;
      Append(dummy,"#Tab" & ASCII.LF);

      if Exist(Atts,"comment") then
         Append(dummy,Cleanse_String(Value_Of(Atts,"comment")));
      end if;
      Append(dummy,ASCII.LF);

      if Ada.Strings.Unbounded.Length(Page(Is_Records).Content) > 2 then
         Remove_EndLF(Page(Is_Records).Content);
      end if;
      Append(Page(Is_Records).Content,dummy);
   end A_Record;

   --------------
   -- A_Rename --
   --------------
   -- Receive notification of each rename.
   procedure A_Rename (Self : Object; Atts : Dict_Type; Its_Name : String) is
      dummy : Unbounded_String;
   begin
      Append(dummy,Cleanse_String(Its_Name));
      if Exist(Atts,"comment") then
         Page(Is_Renames).Comment := true;
         Append(dummy,"\t" & Cleanse_String(Value_Of(Atts,"comment")));
      end if;
      Append(dummy,ASCII.LF);
      Append(Page(Is_Renames).Content,dummy);
   end A_Rename;

   --
   -- Purpose : Receive notification of each task.
   --
   -- Self     : Object itself.
   -- Atts     : The attributs dictionary of the XML current element.
   -- Its_Name : the task name
   --
   procedure A_Task (Self : Object; Atts : Dict_Type; Its_Name : String) is
      dummy : Unbounded_String;
   begin
      Append(dummy,Cleanse_String(Its_Name));
      if Exist(Atts,"comment") then
         Page(Is_Tasks).Comment := true;
         Append(dummy,"\t" & Cleanse_String(Value_Of(Atts,"comment")));
      end if;
      Append(dummy,ASCII.LF);
      Append(Page(Is_Tasks).Content,dummy);

   end A_Task;


   -----------------------
   -- A_Type_Definition --
   -----------------------
   -- Receive notification of each type definition.
   procedure A_Type_Definition (Self : Object; Atts : Dict_Type;
                                Its_Name, Its_Def : String) is
      dummy : Unbounded_String;

   begin
      Append(dummy,Cleanse_String(Its_Name));
      Append(dummy,"\t" & Cleanse_String(Its_Def));
      if Exist(Atts,"comment") then
         Page(Is_Types).Comment := true;
         Append(dummy,"\t" & Cleanse_String(Value_Of(Atts,"comment")));
      else
         Append(dummy,"\t");
      end if;
      Append(dummy,ASCII.LF);
      if Current_Object_Type = Is_GenericParameters then
         Append(Page(Is_Types).Content,dummy);
      else
         Append(A_Type_Content,dummy);
      end if;
   end A_Type_Definition;


   --
   -- Purpose : Receive notification of each protected type.
   --
   -- Self     : Object itself.
   -- Atts     : The attributs dictionary of the XML current element.
   -- Its_Name : the protected object name
   --
   procedure A_Protected_Object (Self : Object; Atts : Dict_Type; Its_Name : String) is
       dummy : Unbounded_String;
   begin

      Append(dummy,Cleanse_String(Its_Name));
      if Exist (Atts,"comment") then
         Page(Is_ProtectedObject).Comment := true;
         Append(dummy,"\t" & Cleanse_String(Value_Of(Atts,"comment")));
      end if;                                                             
      Append(dummy,ASCII.LF);
      Append(Page(Is_Objects).Content,dummy);

   end A_Protected_Object;

   --------------------
   -- A_Variant_Part --
   --------------------
   -- Receive notification of each variant part.
   procedure A_Variant_Part (Self : Object; Atts : Dict_Type; Its_Discriminant : String)
   is
      dummy : Unbounded_String;
   begin
   
      Append(dummy,ASCII.LF & "{_}Variant part{_}: " & Cleanse_String(Its_Discriminant));
      if Exist(Atts,"comment") then
         Append(dummy,"\t" & Cleanse_String(Value_Of(Atts,"comment")));
      end if;
      Append(dummy,ASCII.LF);
      Append(A_Record_Variant,dummy);
   end A_Variant_Part;


   --------------
   -- An_Entry --
   --------------
   -- Receive notification of each entry.
   procedure An_Entry (Self : Object; Atts : Dict_Type; Its_Name : String) is
      dummy : Unbounded_String;
   begin
      Append(dummy,Cleanse_String(Its_Name));
      if Exist(Atts,"comment") then
         Append(dummy,"\t" & Cleanse_String(Value_Of(Atts,"comment")));
      end if;
      Append(dummy,ASCII.LF);
      Append(A_Record_Content,dummy);
   end An_Entry;


   ------------------
   -- An_Exception --
   ------------------
   -- Receive notification of each exception.
   procedure An_Exception (Self : Object; Atts : Dict_Type; Its_Name : String) is
      dummy : Unbounded_String;
   begin
      Append(dummy,Cleanse_String(Its_Name) & "\t");
      if Exist (Atts,"comment") then
         Page(Is_Exceptions).Comment := true;
         Append(dummy,Cleanse_String(Value_Of(Atts,"comment")));
      end if;
      Append(dummy,ASCII.LF);
      Append(Page(Is_Exceptions).Content,dummy);
   end An_Exception;

   --------------
   -- A_Pragma --
   --------------
   -- Receive notification of each pragma.
   procedure A_Pragma (Self : Object; Atts : Dict_Type; Its_Name : String) is
      dummy : Unbounded_String;
   begin

      Append(dummy,Cleanse_String(Its_Name));
      if Exist(Atts,"args") then
         Append(dummy,"\t" & Cleanse_String(Value_Of(Atts,"args")));
      else                                                                
         Append(dummy," \t");
      end if;                                                             
      if Exist (Atts,"comment") then
         Page(Is_Pragmas).Comment := true;
         Append(dummy,"\t" & Cleanse_String(Value_Of(Atts,"comment")));
      end if;                                                             
      Append(dummy,ASCII.LF);
      Append(Page(Is_Pragmas).Content,dummy);
   end A_Pragma;


   ---------------
   -- An_Object --
   ---------------
   -- Receive notification of each object.
   procedure An_Object (Self : Object; Atts : Dict_Type; Its_Name,
                        Its_Type : String; Is_Component : Boolean) is

      dummy : Unbounded_String;
   begin
      Append (dummy,Cleanse_String(Its_Name));
      if Exist(Atts,"constant") then
         Append(dummy,"\tconstant ");
         Append (dummy,Cleanse_String(Its_Type));
      else
         Append (dummy,"\t" & Cleanse_String(Its_Type));
      end if;
      
      if Exist(Atts,"mode") then
         if Is_Component then
            A_Record_Mode := true;
         else
            Page(Second_Object_Type).Mode := true;
         end if;
         Append (dummy,"\t" & Cleanse_String(Value_Of(Atts,"mode")));

      end if;

      if Exist(Atts,"init") then
         if Is_Component then
            A_Record_Default := true;
         else
            Page(Second_Object_Type).Default := true;
         end if;
         Append (dummy,"\t" & Cleanse_String(Value_Of(Atts,"init")));
      else
         Append(dummy,"\t");
      end if;
      if Exist(Atts,"comment") then
         if Is_Component then
            A_Record_Comment := true;
         else
            Page(Second_Object_Type).Comment := true;
         end if;
         Append(dummy,"\t" & Cleanse_String(Value_Of(Atts,"comment")));
      else
         Append(dummy,"\t");
      end if;
      Append(dummy,ASCII.LF);
      if Is_Component then
         Append(A_Record_Content,dummy);
      else
         Append(Page(Second_Object_Type).Content,dummy);
      end if;
      
   end An_Object;


   --------------------
   -- Begin_Document --
   --------------------
   -- Receive notification of the beginning of a document.
   -- This callback will be called only once.
   procedure Begin_Document (Self : Object;
                             Package_Name : String;
                             Atts, Tags: Dict_Type) is

      procedure Write_Tag (Title, Value : String) is
      begin
         Append(Page_Tags,Cleanse_String(Title) & "\t:\t");
         Append(Page_Tags,Cleanse_String(Value) & ASCII.LF);
      end Write_Tag;

      procedure Write_Tags is new Run_Through(Write_Tag);

   begin

      Ada.Text_IO.Create(File, Name => Value_Of(Atts, "file") & ".sh");
      Ada.Text_IO.Set_Output(File);

      Page_Name := To_Unbounded_String(Package_Name);
      if Exist(Atts, "comment") then
         Page_Comment := To_Unbounded_String(Cleanse_String(Value_Of(Atts,"comment")));
      end if;

      if not Is_Empty(Tags) then
         Write_Tags(Tags);
         Is_Tags := true;
      end if;
      
   end Begin_Document;

   ------------------
   -- End_Document --
   ------------------
   -- Receive notification of the end of a document.
   -- This callback will be called only once.
   procedure End_Document (Self : Object) is
      

   begin

      Put_Line (To_String(Page_Name));
      Put_Line ("# StrongHelp by AdaDoc (c)2002 Julien Burdy & Vincent Decorges");
      Put_Line ("# http://adadoc.sf.net");
      Put_Line ("#Parent !Root");
      Put_Line ("#fH3:" & Cleanse_String(To_String(Page_Name)));
      Put_Line ("#Line");
      Put_Line ("#Tab");
      Put_Line ("#Wrap off");
      Put_Line ("#Table Columns 3");

      for Element in Page'Range loop
         if Page(Element).Exist then
            Put_Line ("¸ <" & To_String(Page(Element).Name) & "=>." & To_String(Page(Element).Name) & ">");
         end if;
      end loop;

      Put_Line ("#EndTable");
      Put_Line ("#Wrap");

      -- Print comment
      if Ada.Strings.Unbounded.Length(Page_Comment) > 0 then
         Put_Line ("#Line");
         Put_Line ("#Tab");
         Put_line(To_String(Page_Comment));
      end if;

      -- Print tags
      if Is_Tags then
         Put_line("#Line");
         Put_Line ("#Tab");
         Put (To_String(Page_Tags));
      end if;

      -- Remove 'last' linefeed
      for Element in reverse Page'Range loop

          if Page(Element).Exist then
             declare
                Len : Natural;
             begin
             
                Len := Ada.Strings.Unbounded.Length(Page(Element).Content);
                if Ada.Strings.Unbounded.Element(Page(Element).Content,Len) = ASCII.LF then
                   Page(Element).Content := To_Unbounded_String(Slice (Page(Element).Content,1,Len-1));
                end if;
             end;
             exit;
          end if;

      end loop;

      -- Print page elements to file
      for Element in Page'Range loop

         if Page(Element).Exist then
            Remove_EndLF(Page(Element).Content);
            Remove_StartSpace(Page(Element).Content);
            Remove_3rdLF(Page(Element).Content);
            Put(To_String(Page(Element).Content));
         end if;

      end loop;

      Ada.Text_IO.Set_Output(Ada.Text_IO.Standard_Output);
      Ada.Text_IO.Close(File);

      Put_Line("StrongHelp is Done!");
   end End_Document;

   -----------------
   -- End_Element --
   -----------------
   -- Receive notification of the end of each elements (Module.Element_Type).
   --
   procedure End_Element (Self : Object; Element : Element_Type) is
      Dummy : Unbounded_String;

      procedure Add_Header (Name : String) is
      begin
         Page(Element).Exist := true;
         Append(dummy,"#Subpage " & Name & ASCII.LF);
         Append(dummy,Page_Name);
         Append(dummy," : ");
         Append(dummy,Name & ASCII.LF);
         Append(dummy,"#fH3:" & Name & ASCII.LF);
         Page(Element).Name := To_Unbounded_String(Name);
      end Add_Header;

      procedure Add_SubHeader (Name : String) is
      begin
         Append (dummy,"#Line" & ASCII.LF);
         Append (dummy,"#fH5:" & Name & ASCII.LF);
         Append (dummy,"#Tab" & ASCII.LF);
         Append (dummy,"{*}Name{*}");
      end Add_SubHeader;

      procedure Remove_ExcessTab (Content : in out Unbounded_String;
                                  Comment : in Boolean) is

         Search_String : String := "\t" & ASCII.LF;
         Index         : Natural;
         new_string    : Unbounded_String;
         len           : Natural;
      begin
         if not Comment then
            Index := Ada.Strings.Unbounded.Index(Content,Search_String);
            while Index > 0 loop
               Append(new_string,Ada.Strings.Unbounded.Slice(Content,1,Index-1));
               Append(new_string,Ada.Strings.Unbounded.Slice(Content,Index+2,Index+2));
               len := Ada.Strings.Unbounded.Length(Content);
               if len > Index+2 then
                  Content := To_Unbounded_String(Slice(Content,Index+3,len));
               else
                  Content := To_Unbounded_String("");
               end if;
               Index := Ada.Strings.Unbounded.Index(Content,Search_String);
            end loop;
            Content := new_string;
         end if;
      end Remove_ExcessTab;

   begin

      -- Put_Line("# End_Element: " & Element_Type'image(Element));

      case Element is

      when Is_GenericParameters =>
         Add_Header("Generics");
         Page(Element).Content := dummy & Page(Element).Content;
      
      when Is_GenericInstanciations =>
         Add_SubHeader("Generic Instantiations");
         if Page(Element).Comment then
            Append (dummy,"\t{*}Comment{*}");
         end if;
         Append(dummy,ASCII.LF);
         Page(Element).Content := dummy & Page(Element).Content;
         Append(Page(Is_GenericParameters).Content,Page(Element).Content);

      when Is_PackagesSubprograms =>
         Add_SubHeader("Generic parameters");
         if Page(Element).Comment then
            Append (dummy,"\t{*}Comment{*}");
         end if;
         Append(dummy,ASCII.LF);
         Page(Element).Content := dummy & Page(Element).Content;
         Append(Page(Is_GenericParameters).Content,Page(Element).Content);

      when Is_Objects =>
         Add_SubHeader("Objects");

         Append(dummy,"\t{*}Type{*}");
         if Page(Element).Mode then
            Append(dummy,"\t{*}Mode{*}");
         end if;
          if Page(Element).Default then
            Append(dummy,"\t{*}Default{*}");
         end if;
         if Page(Element).Comment then
            Append (dummy,"\t{*}Comment{*}");
         end if;
         Append(dummy,ASCII.LF);
         Page(Element).Content := dummy & Page(Element).Content;
         Append(Page(Is_GenericParameters).Content,Page(Element).Content);

      when Is_Records =>
         Add_Header("Records");
         if Ada.Strings.Unbounded.Length(Page(Is_Records).Content) > 2 then
            Remove_EndLF(Page(Is_Records).Content);
         end if;
         Page(Element).Content := dummy & Page(Element).Content;

      when Is_Subprograms =>
         Add_Header("Subprograms");
         Append(dummy,A_Subprogram_Header); -- Add header in case the subprogram has no parameters
         Page(Element).Content := dummy & Page(Element).Content;

      when Is_Parameters =>
         Append(A_Subprogram_Content,ASCII.LF);         
         Append(dummy,"#Tab" & ASCII.LF);
         Append(dummy,"{*}Parameter{*}");
         Append(dummy,"\t{*}Type{*}");
         if A_Subprogram_Mode then
            Append(dummy,"\t{*}Mode{*}");
         end if;
         if A_Subprogram_Default then
            Append(dummy,"\t{*}Default{*}");
         end if;   
         if A_Subprogram_Comment then
            Append(dummy,"\t{*}Comment{*}");
         end if;
         Append(dummy,ASCII.LF);
         Remove_ExcessTab(A_Subprogram_Content,A_Subprogram_Comment);
         Remove_EndLF(A_Subprogram_Content);
         Append(dummy,A_Subprogram_Content);
         Append(A_Subprogram_Header,dummy);
         Append(Page(Is_Subprograms).Content,A_Subprogram_Header);

         A_Subprogram_Comment := false;
         A_Subprogram_Default := false;
         A_Subprogram_Mode    := false;
         A_Subprogram_Content := To_Unbounded_STring("");
         A_Subprogram_Header  := To_Unbounded_STring("");

      when Is_Discriminants =>

         Append(dummy,"#Tab" & ASCII.LF);
         Append(dummy,"{*}Discriminant{*}\t");
         Append(dummy,"{*}Type{*}\t");
         if Page(Element).Default then
            Append(dummy,"{*}Default{*}\t");
         end if;   
         if Page(Element).Comment then
            Append(dummy,"{*}Comment{*}");
         end if;
         Append(dummy,ASCII.LF);
         Append(dummy,Page(Element).Content);
         Append(Page(Is_Records).Content,dummy);
         Page(Element).Content := To_Unbounded_String("");
         Page(Element).Comment    := false;
         Page(Element).Default    := false;

      when Is_Components =>
         Append(dummy,"#Tab" & ASCII.LF);
         Append(dummy,"{*}Component{*}\t");
         Append(dummy,"{*}Type{*}\t");
         if A_Record_Default then
            Append(dummy,"{*}Default{*}\t");
         end if;   
         if A_Record_Comment then
            Append(dummy,"{*}Comment{*}");
         end if;
         Append(dummy,ASCII.LF);
         Append(Page(Is_Records).Content,ASCII.LF);
         Remove_EndLF(Page(Is_Records).Content);
         Remove_ExcessTab(A_Record_Content,A_Record_Comment);
         Remove_ExcessTab(A_Record_Content,A_Record_Default);         
         Append(dummy,A_Record_Content);
         Append(Page(Is_Records).Content,A_Record_Variant);
         Append(Page(Is_Records).Content,A_Record_Choice);
         Append(Page(Is_Records).Content,dummy);

         A_Record_Comment := false;
         A_Record_Default := false;
         A_Record_Content := To_Unbounded_STring("");
         A_Record_Choice  := To_Unbounded_STring("");
         A_Record_Variant := To_Unbounded_STring("");
         
      when Is_Clauses =>
         Add_Header("Clauses");         
         Page(Element).Content := dummy & Page(Element).Content;

      when Is_UseClauses =>
         Add_SubHeader("Use Clauses");
         if Page(Element).Comment then
            Append (dummy,"\t{*}Comment{*}");
         end if;
         Append(dummy,ASCII.LF);
         Page(Element).Content := dummy & Page(Element).Content;
         Append(Page(Is_Clauses).Content,Page(Element).Content);

      when Is_UseTypeClauses =>
         Add_SubHeader("Use Type Clauses");
         if Page(Element).Comment then
            Append (dummy,"\t{*}Comment{*}");
         end if;
         Append(dummy,ASCII.LF);
         Page(Element).Content := dummy & Page(Element).Content;
         Append(Page(Is_Clauses).Content,Page(Element).Content);

      when Is_ContextClauses =>
         Add_SubHeader("Context Clauses");
         if Page(Element).Comment then
            Append (dummy,"\t{*}Comment{*}");
         end if;
         Append(dummy,ASCII.LF);
         Page(Element).Content := dummy & Page(Element).Content;
         Append(Page(Is_Clauses).Content,Page(Element).Content);

      when Is_RepClauses =>
         Add_SubHeader("Representation Clauses");
         if Page(Element).Comment then
            Append (dummy,"\t{*}Comment{*}");
         end if;
         Append(dummy,ASCII.LF);
         Page(Element).Content := dummy & Page(Element).Content;
         Append(Page(Is_Clauses).Content,Page(Element).Content);

      when Is_Renames =>
         Add_Header("Renames");
         Append(dummy,"#Line" & ASCII.LF);
         Append(dummy,"{*}Names{*}\t");
         if Page(Element).Comment then
            Append (dummy,"{*}Comment{*}");
         end if;
         Append(dummy,ASCII.LF);
         Append(dummy,"#Wrap off" & ASCII.LF);
         Page(Element).Content := dummy & Page(Element).Content;
         Append(Page(Element).Content,"#Wrap" & ASCII.LF);

      when Is_Tasks =>
         Add_Header("Tasks");
         Append(dummy,"#Line" & ASCII.LF);
         Append(dummy,"{*}Names{*}\t");
         if Page(Element).Comment then
            Append (dummy,"{*}Comment{*}");
         end if;
         Append(dummy,ASCII.LF);
         Page(Element).Content := dummy & Page(Element).Content;

      when Is_Pragmas =>
         Add_Header("Pragmas");
         Append(dummy,"#Line" & ASCII.LF);
         Append(dummy,"#Wrap off" & ASCII.LF);
         Append(dummy,"{*}Names{*}\t");
         Append(dummy,"{*}Args{*}\t");
         if Page(Element).Comment then
            Append (dummy,"{*}Comment{*}");
         end if;
         Append(dummy,ASCII.LF);
         Page(Element).Content := dummy & Page(Element).Content;
         Append(Page(Element).Content,"#Wrap" & ASCII.LF);
         
      when Is_BasicObjects =>
         Add_Header("Basic Objects");
         Append(dummy,"#Line" & ASCII.LF);
         Append(dummy,"{*}Names{*}\t");
         Append(dummy,"{*}Type{*}\t");
         if Page(Element).Default then
            Append(dummy,"{*}Default{*}\t");
         end if;
         if Page(Element).Comment then
            Append (dummy,"{*}Comment{*}");
         end if;
         Append(dummy,ASCII.LF);
         Page(Element).Content := dummy & Page(Element).Content;

      when Is_Exceptions =>
         Add_Header("Exceptions");
         Append(dummy,"#Line" & ASCII.LF);
         Append(dummy,"{*}Names{*}\t");
         if Page(Element).Comment then
            Append (dummy,"{*}Comment{*}");
         end if;
         Append(dummy,ASCII.LF);
         Page(Element).Content := dummy & Page(Element).Content;

      when Is_Types =>
         if Current_Object_Type = Is_GenericParameters then
            Add_SubHeader("Types");
         else
            Add_Header("Types");
            Append(dummy,"#Line" & ASCII.LF);
            Append(dummy,"{*}Names{*}");
         end if;

         Append(dummy,"\t{*}Declaration{*}");
         if Page(Element).Mode then
            Append (dummy,"\t{*}Mode{*}");
         end if;
         if Page(Element).Default then
            Append(dummy,"\t{*}Default{*}");
         end if;
         if Page(Element).Comment then
            Append (dummy,"\t{*}Comment{*}");
         end if;
         Append(dummy,ASCII.LF);
         Remove_ExcessTab(Page(Element).Content,Page(Element).Comment);
         Page(Element).Content := dummy & Page(Element).Content;

         if Current_Object_Type = Is_GenericParameters then

            Append(Page(Is_GenericParameters).Content,Page(Element).Content);
            Page(Element).Content := To_Unbounded_String("");
         else
            Remove_ExcessTab(A_Type_Content,Page(Element).Comment);
            Page(Element).Content := dummy & A_Type_Content;
            A_Type_Content := To_Unbounded_String("");
         end if;
         
      when Is_ProtectedObject => null;
      when others => null;
      end case;

   end End_Element;

   -----------------
   -- Start_Group --
   -----------------
   -- Receive notification of the beginning of a group of elements.
   procedure Start_Group (Self : Object; Group : Element_Type) is
   begin

      -- Put_Line("# Start_Group: " & Element_Type'image(Group));

      case Group is
      when Is_ContextClauses | Is_UseClauses | Is_UseTypeClauses | Is_RepClauses => Current_Clause_Type := Group;
      when Is_GenericParameters | Is_Definitions => Current_Object_Type := Group;
      when Is_BasicObjects | Is_Objects => Second_Object_Type := Group;
      when others => null;
      end case;
   end Start_Group;

end Module.Stronghelp;

