-------------------------------------------------------------------------------
--
--  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>
--   Traversal of the ASIS tree and HTML generation.</DL>
--
-- <!--
-- Revision History
--
--   02-FEB-2002   TW  First release.
--   07-FEB-2002   TW  Finally got the renaming unwinding for renamed
--                     exceptions to work. It appears that ASIS-for-GNAT 3.14p
--                     has another bug in 'Corresponding_Base_Entity', which
--                     makes it not work across generic instantiations.
--   12-FEB-2002   TW  First version completely taking apart the source, i.e.,
--                     it splits everything into a sequence of items and
--                     then processes that instead of just traversing the
--                     whole tree and writing out everything plus everything
--                     between the last source chunk written and the current
--                     source chunk.
--   17-FEB-2002   TW  Added indices and grouping together of items. AdaBrowse
--                     now writes any rep clauses or pragmas right after the
--                     item they refer to.
--   18-FEB-2002   TW  Corrected a rather nasty and hard-to-find bug in the
--                     generation of cross-refs for entities within formal
--                     packages.
--   20-FEB-2002   TW  Moved all the 'Write*' procedures to new package
--                     AD.Writers.
--   26-FEB-2002   TW  Added handling for incomplete type declarations in
--                     writing the type summary. Also added the cross-ref from
--                     the incomplete declaration to the full declaration.
--   04-MAR-2002   TW  Added another work-around for a bug in ASIS-for-GNAT,
--                     which sometimes returns only the last name component
--                     for child units that are subprogram instantiations.
--   03-APR-2002   TW  Makes now entries for type and procedure indices.
--   26-APR-2002   TW  Work-around for ASIS-for-GNAT bug in generic parameter
--                     associations.
--   30-APR-2002   TW  Uses new AD.Format to emit formatted comments now.
--   22-NOV-2002   TW  Added support for AD.Options.Private_Too.
--   30-MAY-2003   TW  Added handling of private library units. (Until now, the
--                     "private" was missing in the output!)
--   04-JUN-2003   TW  Regularized handling of private parts. (The "-private"
--                     option now applies to task and protected types, too.)
--   30-JUN-2003   TW  New index management.
--   08-JUL-2003   TW  Added support for special crossrefs and indices to
--                     pragmas and rep clauses.
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

with Ada.Exceptions;
with Ada.Strings.Wide_Unbounded;

with Asis.Iterator;
pragma Elaborate_All (Asis.Iterator);
with Asis.Compilation_Units;
with Asis.Declarations;
with Asis.Elements;
with Asis.Expressions;
with Asis.Text;

with Asis2.Container_Elements;
with Asis2.Declarations;
with Asis2.Naming;
with Asis2.Spans;
with Asis2.Text;

with AD.Crossrefs;
with AD.Descriptions;
with AD.Filters;
with AD.Indices;
with AD.Item_Lists;
with AD.Messages.Inline;
with AD.Options;
with AD.Predicates;
with AD.Queries;
with AD.Text_Utilities;
with AD.Writers;

with GAL.Sorting;
with GAL.Support;

package body AD.Scanner is

   package A_D renames Asis.Declarations;
   package A_T renames Asis.Text;

   package WASU renames Ada.Strings.Wide_Unbounded;

   use AD.Descriptions;
   use AD.Item_Lists;
   use AD.Printers;
   use AD.Text_Utilities;
   use AD.Writers;

   use Asis;
   use Asis.Compilation_Units;
   use Asis.Declarations;
   use Asis.Elements;
   use Asis.Expressions;
   use Asis.Text;

   use Asis2.Naming;
   use Asis2.Spans;

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

   function Smaller_Name
     (Left, Right : in Asis.Declaration)
     return Boolean
   is
      L   : constant Defining_Name := Get_Name (Left);
      R   : constant Defining_Name := Get_Name (Right);

      L_S : constant Wide_String :=
        Asis2.Text.To_Lower (Name_Definition_Image (L));
      R_S : constant Wide_String :=
        Asis2.Text.To_Lower (Name_Definition_Image (R));

   begin
      if L_S = R_S then
         --  Sort by position!
         return Start (Get_Span (L)) < Start (Get_Span (R));
      else
         return L_S < R_S;
      end if;
   end Smaller_Name;

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

   type Scan_State is new AD.Writers.Write_State with
      record
         Reporter     : aliased AD.Messages.Inline.Error_Reporter;
         Traverse_Top : Asis.Element := Nil_Element;
         --  The top element in a traversal. We use this in 'Post_Visit' to
         --  omit a newline on the very last line of an element. This helps
         --  avoid unnecessary empty lines between an items.
      end record;

   --  Note: originally, I had a 'Traverse_Level : Natural' component that
   --  counted the nesting depth within 'Traverse' (Inc in 'Pre', dec in
   --  'Post'). However, this turned out to fail for ASIS-for-GNAT 3.14p: in
   --  a declaration, it would call only 'Pre' for the defining name, but
   --  never call 'Post', with the result that I ended up with a nesting
   --  depth of 1 at the very end, and thus couldn't reliably determine when
   --  to omit that dreaded newline. Hence the above approach with storing the
   --  whole element: if in 'Post' the current element equals 'Traverse_Top',
   --  we're at the end.
   --
   --  Note that the ASIS behavior of not calling 'Post' is not an error, it
   --  is the defined behavior of Asis.Iterator.Traverse_Element! 'Pre'
   --  handles the defining name by calling 'Handle_Defining_Name', which
   --  sets the control to 'Abandon_Children', and in such a case, the
   --  standard iterator doesn't call the corresponding 'Post'... I think this
   --  is a lousy spec, but if it's the standard, I can't change it.

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

   procedure Write_Comment
     (Element : in     Asis.Element;
      Span    : in     A_T.Span;
      State   : in out Scan_State)
   is
      --  'Span' comprises all comment lines. Starts at column 1 and ends
      --  at the end of the last line.
   begin
      if Is_Nil (Span) then return; end if;
      begin
         AD.Printers.Write_Comment
           (State.The_Printer, A_T.Lines (Element, Span));
      exception
         when E : AD.Filters.Recursive_Expansion =>
            Ada.Exceptions.Raise_Exception
              (AD.Filters.Recursive_Expansion'Identity,
               Ada.Exceptions.Exception_Message (E) &
               " (in comment from lines" &
               Asis.Text.Line_Number'Image (Span.First_Line) & " to" &
               Asis.Text.Line_Number'Image (Span.Last_Line) & ") in unit " &
               To_String
                 (Full_Unit_Name
                    (Enclosing_Compilation_Unit (State.Unit))));
      end;
   end Write_Comment;

   procedure Write_Comments
     (Element : in     Asis.Element;
      List    : in     Comment_Ptr;
      State   : in out Scan_State)
   is
      P : Comment_Ptr := List;
   begin
      while P /= null loop
         Write_Comment (Element, P.Span, State);
         P := P.Next;
      end loop;
   end Write_Comments;

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

   procedure Handle_Defining_Name
     (Element   : in     Declaration;
      Control   : in out Traverse_Control;
      State     : in out Scan_State;
      Do_Anchor : in     Boolean := True);

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

   procedure Post_Visit
     (Element : in     Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Scan_State)
   is
      --  Write anything of that element that hasn't been written yet.
   begin
      if Control = Terminate_Immediately then null; end if;
      --  The above if serves only to silence GNAT -gnatwa. 'Control' can never
      --  be Terminate_Immediately here!
      Write (Element, State);
      if not Is_Equal (State.Traverse_Top, Element) then
         Terminate_Line (State);
      end if;
   end Post_Visit;

   procedure Pre_Visit
     (Element : in     Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Scan_State);

   procedure Traverse is
      new Asis.Iterator.Traverse_Element (Scan_State, Pre_Visit, Post_Visit);
   --  Our main traversal routine, which does most of the job. We just handle
   --  a few elements specially (anything that might deserve a cross-reference
   --  or an anchor), the rest is just skipped. Note that we never see a
   --  declaration in 'Traverse', these are handled explicitly in procedure
   --  'Handle_Declaration' below. We just use 'Traverse' to traverse and
   --  crossref the contents of a declaration (or a pragma) itself.

   procedure Pre_Visit
     (Element : in     Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Scan_State)
   is
      --  Handle anything that needs handling; just keep traversing for all
      --  other elements. They'll be written eventually when the stuff before
      --  some element we're handling is written (see AD.Writers), or in
      --  'Post_Visit' above.
   begin
      case Element_Kind (Element) is
         when An_Expression =>
            case Expression_Kind (Element) is
               when An_Identifier =>
                  --  Only generate a cross-ref if it isn't the selector name
                  --  of a named parameter association.
                  declare
                     Cont : constant Asis.Element :=
                       Enclosing_Element (Element);
                  begin
                     if Element_Kind (Cont) /= An_Association
                        or else
                        Association_Kind (Cont) /= A_Parameter_Association
                        or else
                        not Is_Equal (Element, Formal_Parameter (Cont))
                     then
                        Write_Reference (Element, State);
                        Terminate_Line (State);
                     end if;
                     --  else don't do anything, it'll be written as part of
                     --  some 'Write_Before' call later on.
                  end;

               when An_Operator_Symbol |
                    An_Enumeration_Literal =>
                  Write_Reference (Element, State);
                  Terminate_Line (State);

               when An_Attribute_Reference =>
                  --  Needs to be handled separately because the attribute is
                  --  to be formatted specially.
                  Control := Continue;
                  Traverse (Prefix (Element), Control, State);
                  Write_Attribute
                    (Attribute_Designator_Identifier (Element), State);
                  Terminate_Line (State);
                  Control := Abandon_Children;

               when A_Function_Call =>
                  --  Need to handle function calls of dyadic operators that
                  --  are inlined (as in "A + B") specially. We traverse first
                  --  the function name ("+", in this case), and then the
                  --  parameters. But this screws up the text sequence!
                  if not Is_Prefix_Call (Element) and then
                     Expression_Kind (Prefix (Element)) = An_Operator_Symbol
                  then
                     --  Attention: In ASIS-for-GNAT 3.14p, Is_Prefix_Call
                     --  returns False for a unary operator as in "(- A)",
                     --  although that always is a prefix call!
                     --
                     --  We therefore need to check the number of parameters
                     --  below, even though it should be clear that any
                     --  non-prefix call must have exactly two parameters!
                     declare
                        Params : constant Association_List :=
                          Function_Call_Parameters (Element);
                     begin
                        if Params'Last = Params'First + 1 then
                           --  We have exactly two parameters! (And it can't
                           --  be a named notation, se we need only care about
                           --  the actual parameters.)
                           Control := Continue;
                           Traverse
                             (Actual_Parameter (Params (Params'First)),
                              Control, State);
                           Control := Continue;
                           Traverse (Prefix (Element), Control, State);
                           Control := Continue;
                           Traverse
                             (Actual_Parameter (Params (Params'First + 1)),
                              Control, State);
                           Control := Abandon_Children;
                        end if;
                     end;
                  end if;

               when others =>
                  null;

            end case;

         when A_Defining_Name =>
            --  Only generate an anchor if the defining name is not a
            --  parameter name of some subprogram or entry!
            declare
               Decl : constant Asis.Element :=
                 Asis2.Declarations.Enclosing_Declaration (Element);
            begin
               Handle_Defining_Name
                 (Element, Control, State,
                  Declaration_Kind (Decl) /= A_Parameter_Specification);
               Terminate_Line (State);
            end;

         when An_Association =>
            case Association_Kind (Element) is
               when A_Generic_Association =>
                  --  Work-around for another ASIS-for-GNAT 3.14p bug: if
                  --  we let 'Traverse_Element' handle this itself, it
                  --  crashes sometimes!! So far observed only for one case
                  --  where the formal was an operator symbol, but just to be
                  --  on the safe side, we also guard the actual parameter.
                  Control := Continue;
                  declare
                     Formal : Asis.Element;
                  begin
                     begin
                        Formal := Formal_Parameter (Element);
                     exception
                        when others =>
                           AD.Printers.Inline_Error
                             (State.The_Printer,
                              "ASIS crash on generic formal parameter!");
                           Formal := Nil_Element;
                     end;
                     if not Is_Nil (Formal) then
                        Traverse (Formal, Control, State);
                     end if;
                  end;
                  Control := Continue;
                  declare
                     Actual : Asis.Expression;
                  begin
                     begin
                        Actual := Actual_Parameter (Element);
                     exception
                        when others =>
                           AD.Printers.Inline_Error
                             (State.The_Printer,
                              "ASIS crash on generic actual parameter!");
                           Actual := Nil_Element;
                     end;
                     if not Is_Nil (Actual) then
                        Traverse (Actual, Control, State);
                     end if;
                  end;
                  --  Note: even if ASIS crashes and we don't traverse part
                  --  of the association, its program text will still be
                  --  written in 'Post_Visit'. It just won't have cross-
                  --  references.
                  Control := Abandon_Children;

               when others =>
                  --  Nothing to do.
                  null;
            end case;

         when A_Pragma =>
            --  Generate an anchor...
            Write_Special_Anchor (Element, State);
            --  ...and then just continue...

         when A_Clause =>
            case Representation_Clause_Kind (Element) is
               when An_Attribute_Definition_Clause |
                    An_Enumeration_Representation_Clause |
                    A_Record_Representation_Clause =>
                  Write_Special_Anchor (Element, State);
               when others =>
                  null;
            end case;

         when others =>
            --  Nothing to do.
            null;

      end case;
   end Pre_Visit;

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

   procedure Add_To_Index
     (State       : in out Scan_State;
      Element     : in     Asis.Element;
      Is_Private  : in     Boolean)
   is
   begin
      case Element_Kind (Element) is
         when A_Declaration =>
            if not Is_Private or else AD.Options.Private_Too then
               --  Special cases for types. There can be some funny cases:
               --  (1) An incomplete type declaration: if there's a full
               --      declaration for it, don't do anything: we'll process
               --      the full declaration later. If there's no full decl,
               --      (implies 'Is_Private'), then do it.
               --  (2) Is_Private is True and there's a public view of the
               --      type: don't generate an index entry, we'll have one
               --      for the public view already!
               if Declaration_Kind (Element) = An_Incomplete_Type_Declaration
                  and then
                  not Is_Nil (Corresponding_Type_Declaration (Element))
               then
                  --  We have an incomplete type declaration, and there is
                  --  a full type declaration. Note that both the incomplete
                  --  and the full decl are either in the public or in the
                  --  private part. There cannot be an incomplete decl in
                  --  the public part, and the corresponding full decl in
                  --  the private part.
                  return;
               elsif Is_Private and then AD.Predicates.Is_Type (Element) then
                  declare
                     Other : constant Declaration :=
                       Corresponding_Type_Declaration (Element);
                  begin
                     if not Is_Nil (Other) and then
                        Declaration_Kind (Other) /=
                        An_Incomplete_Type_Declaration
                     then
                        --  We're in the private part, and there exists a
                        --  public view of the type.
                        return;
                     end if;
                  end;
               end if;
               declare
                  Names : constant Asis.Name_List := A_D.Names (Element);
                  XRef  : AD.Crossrefs.Cross_Reference;
               begin
                  for I in Names'Range loop
                     declare
                        Name : Asis.Defining_Name := Names (I);
                     begin
                        --  Special case for constants: if there is a
                        --  corresponding deferred constant declaration,
                        --  we'll already have an entry for that one, and we
                        --  thus skip this name. Note that we need to be in
                        --  the private part for all this to be true.
                        if Is_Private and then
                           Declaration_Kind (Element) = A_Constant_Declaration
                           and then
                           not Is_Nil
                                 (Corresponding_Constant_Declaration (Name))
                        then
                           --  Skip it!
                           null;
                        else
                           if Defining_Name_Kind (Name) =
                              A_Defining_Expanded_Name
                           then
                              Name := Defining_Selector (Name);
                           end if;
                           XRef :=
                             AD.Crossrefs.Crossref_Name
                               (Name, State.Unit, State.Reporter'Access);
                           if XRef.Is_Top_Unit then
                              XRef.Image := XRef.Full_Unit_Name;
                           end if;
                           AD.Indices.Add (Name, XRef, Is_Private);
                        end if;
                     end;
                  end loop;
               end;
            end if;
         when A_Pragma =>
            --  Why did I ever have the funny idea that somebody might want
            --  a pragma index?
            declare
               XRef : AD.Crossrefs.Cross_Reference :=
                 AD.Crossrefs.Crossref_Special (Element, State.Unit);
            begin
               AD.Indices.Add (Element, XRef, Is_Private);
            end;
         when A_Clause =>
            case Representation_Clause_Kind (Element) is
               when An_Attribute_Definition_Clause |
                    An_Enumeration_Representation_Clause |
                    A_Record_Representation_Clause =>
                  declare
                     XRef : AD.Crossrefs.Cross_Reference :=
                       AD.Crossrefs.Crossref_Special (Element, State.Unit);
                  begin
                     AD.Indices.Add (Element, XRef, Is_Private);
                  end;
               when others =>
                  null;
            end case;
         when others =>
            null;
      end case;
   end Add_To_Index;

   procedure Write_Item
     (Items     : in     Item_Table;
      Current   : in     Natural;
      State     : in out Scan_State;
      Top_Level : in     Boolean := False)
   is
      Null_Items : Item_Table (2 .. 1);
      Index      : Index_Table :=
        (1 => Current) &
        Collect_Subordinates (Items, Null_Items, Items (Current).Sub);
      Ctrl       : Traverse_Control;

      procedure XRef_Other_Decl
        (Other : in     Declaration;
         State : in out Scan_State;
         Text  : in     String)
      is
      begin
         if not Is_Nil (Other) then
            AD.Printers.Other_Declaration
              (State.The_Printer,
               AD.Crossrefs.Crossref_Name
                 (Get_Name (Other), State.Unit, State.Reporter'Access),
               Text);
         end if;
      end XRef_Other_Decl;

   begin
      Sort_Subordinates (Index (Index'First + 1 .. Index'Last),
                         Items, Null_Items);
      --  First the rep clauses, then the pragmas, both ordered by name.
      AD.Printers.Open_Section (State.The_Printer, Snippet_Section);
      for I in Index'Range loop
         declare
            Pos : Position :=
              Start (Get_Span (Items (Index (I)).Element));
         begin
            if Pos.Line = 1 then Pos.Column := 1; end if;
            State.Write_From   := Pos;
            State.Last_Written := (Pos.Line, Pos.Column - 1);
            State.Indent       := Pos.Column - 1;
         end;
         if I > Index'First then
            --  Ok, the main item has been written. What follows are pragmas
            --  and rep clauses, which we still need to add to the indices!
            Add_To_Index
              (State,
               Items (Index (I)).Element,
               Items (Index (Index'First)).Is_Private);
            --  Yes, we take the 'Is_Private' flag from the main item!
         end if;
         --  if Top_Level then
         --   Check_Private_Unit (State, Items (Index (I)).Element);
         --  end if;
         Ctrl := Continue;
         State.Traverse_Top := Items (Index (I)).Element;
         Traverse (Items (Index (I)).Element, Ctrl, State);
         --  Try to generate a cross-reference to the full type declaration.
         --  Note: if the element is not a declaration at all (but a pragma
         --  or a rep clause), 'Declaration_Kind' will simply return
         --  'Not_A_Declaration' and *not* raise an exception.
         case Declaration_Kind (Items (Index (I)).Element) is
            when An_Incomplete_Type_Declaration =>
               XRef_Other_Decl
                 (Corresponding_Type_Declaration (Items (Index (I)).Element),
                  State, "Full declaration");

            when A_Private_Type_Declaration |
                 A_Private_Extension_Declaration =>
               if AD.Options.Private_Too then
                  XRef_Other_Decl
                    (Corresponding_Type_Declaration
                       (Items (Index (I)).Element),
                     State, "Full declaration");
               end if;

            when An_Ordinary_Type_Declaration |
                 A_Task_Type_Declaration |
                 A_Protected_Type_Declaration =>
               declare
                  Other : constant Declaration :=
                    Corresponding_Type_Declaration (Items (Index (I)).Element);
               begin
                  if not Is_Nil (Other) then
                     if Declaration_Kind (Other) =
                        An_Incomplete_Type_Declaration
                     then
                        XRef_Other_Decl
                          (Other, State, "Incomplete declaration");
                     elsif Items (Index (I)).Is_Private then
                        --  Actually, if it's not an incomplete declaration,
                        --  we should always be processing a full decl in the
                        --  private part!
                        XRef_Other_Decl
                          (Other, State, "Public view");
                     end if;
                  end if;
               end;

            when others =>
               null;

         end case;
         if I < Index'Last then New_Line (State.The_Printer); end if;
      end loop;
      AD.Printers.Close_Section (State.The_Printer, Snippet_Section);
      --  Then write any comments of these items:
      declare
         Have_Comments : Boolean := False;
         From          : Natural;
      begin
         if Top_Level then
            From := Index'First + 1;
         else
            From := Index'First;
         end if;
         for I in From .. Index'Last loop
            if Items (Index (I)).List /= null then
               Have_Comments := True; exit;
            end if;
         end loop;
         if Have_Comments then
            AD.Printers.Open_Section (State.The_Printer, Description_Section);
            for I in From .. Index'Last loop
               Write_Comments
                 (Items (Index (I)).Element,
                  Items (Index (I)).List, State);
            end loop;
            AD.Printers.Close_Section (State.The_Printer, Description_Section);
         end if;
      end;
   end Write_Item;

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

   generic
      with function Matches (Kind : in Declaration_Kinds) return Boolean;
   function Extract_Declarations
     (From   : in Declarative_Item_List;
      Sorted : in Boolean)
     return Declarative_Item_List;

   --  generic
   --     with function Matches (Kind : in Declaration_Kinds) return Boolean;
   function Extract_Declarations
     (From   : in Declarative_Item_List;
      Sorted : in Boolean)
     return Declarative_Item_List
   is
      Result : Declarative_Item_List (From'Range);
      N      : Natural := Result'First - 1;

      procedure Sort is
         new GAL.Sorting.Sort_G
               (List_Index, Asis.Element, Declarative_Item_List, Smaller_Name);

   begin
      for I in From'Range loop
         if Matches (Declaration_Kind (From (I))) then
            N := N + 1;
            Result (N) := From (I);
         end if;
      end loop;
      if N > Result'First and then Sorted then
         Sort (Result (Result'First .. N));
      end if;
      return Result (Result'First .. N);
   end Extract_Declarations;

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

   procedure Handle_Children
     (The_Unit     : in     Compilation_Unit;
      State        : in out Scan_State;
      Table_Opened : in out Boolean)
   is
      --  Build and output an index of known child units of the top-level
      --  libarary unit.

      Children : Compilation_Unit_List :=
        Corresponding_Children (The_Unit);

      function Smaller
        (Left, Right : in Compilation_Unit)
        return Boolean
      is
      begin
         return Asis2.Text.To_Lower (Full_Unit_Name (Left)) <
                Asis2.Text.To_Lower (Full_Unit_Name (Right));
      end Smaller;

      procedure Sort is
         new GAL.Sorting.Sort_G
               (List_Index, Compilation_Unit, Compilation_Unit_List, Smaller);

      procedure Swap is
         new GAL.Support.Swap (Compilation_Unit);

      N : Natural := 0;
      I : Natural := 0;

   begin --  Handle_Children
      if Children'Last >= Children'First then
         --  Attention, we have both specs and bodies here! First throw out the
         --  bodies!
         N := Children'Last; I := Children'First;
         while I <= N loop
            case Declaration_Kind (Unit_Declaration (Children (I))) is
               when A_Package_Body_Declaration |
                    A_Procedure_Body_Declaration |
                    A_Function_Body_Declaration =>
                  if I < N then
                     Swap (Children (I), Children (N));
                  end if;
                  N := N - 1;
               when others =>
                  I := I + 1;
            end case;
         end loop;
         --  If we had *only* bodies, give up.
         if N < Children'First then return; end if;
         --  The index is to be sorted alphabetically!
         Sort (Children (Children'First .. N));
         if not Table_Opened then
            AD.Printers.Open_Section (State.The_Printer, Content_Section);
            Table_Opened := True;
         end if;
         AD.Printers.Open_Section (State.The_Printer, Children_Section);
         for I in Children'First .. N loop
            declare
               Name : constant Defining_Name :=
                 Get_Name (Unit_Declaration (Children (I)));
               --  They're children, so they all are defining expanded names!
               XRef : AD.Crossrefs.Cross_Reference :=
                 AD.Crossrefs.Crossref_Name
                   (Defining_Selector (Name),
                    State.Unit, State.Reporter'Access);
            begin
               XRef.Image :=
                 WASU.To_Unbounded_Wide_String (Name_Definition_Image (Name));
               AD.Printers.Add_Child
                 (State.The_Printer,
                  Get_Item_Kind (Unit_Declaration (Children (I))),
                  Unit_Class (Children (I)) = A_Private_Declaration,
                  XRef);
            end;
         end loop;
         AD.Printers.Close_Section (State.The_Printer, Children_Section);
      end if;
   end Handle_Children;

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

   procedure Handle_Clauses
     (The_Unit : in     Compilation_Unit;
      State    : in out Scan_State;
      Item     : in     Item_Desc)
   is
      --  Write the context clauses in their own section.

      Clauses : constant Context_Clause_List :=
        Context_Clause_Elements (The_Unit, True);

   begin
      if Clauses'Last < Clauses'First then return; end if;
      AD.Printers.Open_Section (State.The_Printer, Dependencies_Section);
      AD.Printers.Open_Section (State.The_Printer, Snippet_Section);
      for I in Clauses'Range loop
         declare
            Ctrl : Traverse_Control := Continue;
         begin
            --  Never suppress any newlines:
            State.Traverse_Top := Nil_Element;
            Traverse (Clauses (I), Ctrl, State);
         end;
      end loop;
      AD.Printers.Close_Section (State.The_Printer, Snippet_Section);
      if Item.List /= null then
         AD.Printers.Open_Section (State.The_Printer, Description_Section);
         Write_Comments (Item.Element, Item.List, State);
         AD.Printers.Close_Section (State.The_Printer, Description_Section);
      end if;
      AD.Printers.Close_Section (State.The_Printer, Dependencies_Section);
   end Handle_Clauses;

   ----------------------------------------------------------------------------
   --  Produce a cross-ref table of all objects of a given class declared in
   --  the package.

   procedure Handle_Objects
     (Items   : in out Item_Table;
      Index   : in out Index_Table;
      Current : in out Natural;
      State   : in out Scan_State;
      Class   : in     Item_Classes)
   is

      procedure Write_Object
        (Items   : in     Item_Table;
         Current : in     Natural;
         State   : in out Scan_State)
      is
         Original : Scan_State := State;
      begin
         AD.Printers.Open_Item
           (State.The_Printer,
            AD.Crossrefs.Null_Crossref,
            AD.Printers.Get_Item_Kind (Items (Current).Element));
         Write_Item (Items, Current, State);
         AD.Printers.Close_Item (State.The_Printer);
         State := Original;
      end Write_Object;

      N : Natural;

   begin
      N := Current;
      while N <= Index'Last and then
            Items (Index (N)).Class = Class and then
            not Items (Index (N)).Is_Private
      loop
         N := N + 1;
      end loop;
      N := N - 1;
      if N >= Current then
         Sort_By_Name (Items, Index (Current .. N));
         if Class = Item_Constant then
            AD.Printers.Open_Section (State.The_Printer, Constants_Section);
         else
            AD.Printers.Open_Section (State.The_Printer, Variables_Section);
         end if;
         for I in Current .. N loop
            Add_To_Index
              (State,
               Items (Index (I)).Element, Items (Index (I)).Is_Private);
            Write_Object (Items, Index (I), State);
            Items (Index (I)).Done := True;
         end loop;
         if Class = Item_Constant then
            AD.Printers.Close_Section (State.The_Printer, Constants_Section);
         else
            AD.Printers.Close_Section (State.The_Printer, Variables_Section);
         end if;
         Current := N + 1;
      end if;
   end Handle_Objects;

   ----------------------------------------------------------------------------
   --  Produce a cross-ref table of all exceptions declared in the package.

   procedure Handle_Exceptions
     (Items   : in out Item_Table;
      Index   : in out Index_Table;
      Current : in out Natural;
      State   : in out Scan_State)
   is

      procedure Write_Exception
        (Exc   : in     Item_Desc;
         State : in out Scan_State)
      is

         function Unwind_Renames
           (Decl : in Declaration)
           return Asis.Element
         is
            --  Corresponding_Base_Entity sometimes returns an expression in
            --  an implicit spec due to an instantiation, in which case things
            --  get pretty hairy (see comment below). This routine never
            --  returns implicit things, but always the expression from the
            --  template.
            D : Asis.Element := Decl;
            B : Asis.Element;
         begin
            loop
               B := Renamed_Entity (D);
               D := Asis2.Declarations.Name_Definition (B);
               if Is_Part_Of_Instance (D) then
                  --  Get the name in the template!
                  D :=
                    Asis2.Declarations.Enclosing_Declaration
                      (AD.Queries.Expand_Generic (D, State.Reporter'Access));
               end if;
               exit when
                 Declaration_Kind (D) /= An_Exception_Renaming_Declaration;
            end loop;
            return B;
         end Unwind_Renames;

         Original : Scan_State := State;

      begin
         AD.Printers.Open_Section (State.The_Printer, Exception_Section);
         declare
            Names : constant Name_List := A_D.Names (Exc.Element);
         begin
            for I in Names'Range loop
               AD.Printers.Add_Exception
                 (State.The_Printer,
                  AD.Crossrefs.Crossref_Name
                    (Names (I), State.Unit, State.Reporter'Access));
            end loop;
         end;
         if Declaration_Kind (Exc.Element) =
            An_Exception_Renaming_Declaration
         then
            declare
               Direct_Rename : constant Asis.Expression  :=
                 Renamed_Entity (Exc.Element);
               Ctrl          : Traverse_Control := Continue;
            begin
               State.Write_From :=
                 Start (Get_Span (Direct_Rename));
               if not Is_Nil (State.Write_From) then
                  State.Last_Written :=
                    (State.Write_From.Line,
                     State.Write_From.Column - 1);
                  AD.Printers.Open_Section
                    (State.The_Printer, Exception_Rename_Section);
                  --  Never generate a newline:
                  State.Traverse_Top := Direct_Rename;
                  Traverse (Direct_Rename, Ctrl, State);
                  AD.Printers.Close_Section
                    (State.The_Printer, Exception_Rename_Section);
                  declare
                     Ultimately : constant Asis.Element :=
                       Unwind_Renames (Exc.Element);
                     --  Corresponding_Base_Entity may return an expression
                     --  in an implicit generic spec due to an instantiation,
                     --  and to get the true element from the generic template,
                     --  we'd have to go out of our way an first find the
                     --  declaration containing the expression, and then do
                     --    Renamed_Entity (Enclosing_Declaration
                     --                    (Expand_Generic (Get_Name (Decl)))).
                     --  It took me a while to figure that one out, and in the
                     --  meantime, I already had 'Unwind_Renames' written, so
                     --  I prefer to stick with my own routine.
                  begin
                     if not Is_Equal (Ultimately, Direct_Rename) then
                        State.Write_From :=
                          Start (Get_Span (Ultimately));
                        if not Is_Nil (State.Write_From) then
                           State.Last_Written :=
                             (State.Write_From.Line,
                              State.Write_From.Column - 1);
                           --  The text may be in some other unit!
                           State.Unit :=
                             Unit_Declaration
                               (Enclosing_Compilation_Unit (Ultimately));
                           AD.Printers.Open_Section
                             (State.The_Printer, Ultimate_Exception_Section);
                           Ctrl := Continue;
                           --  Never generate a newline:
                           State.Traverse_Top := Ultimately;
                           Traverse (Ultimately, Ctrl, State);
                           AD.Printers.Close_Section
                             (State.The_Printer, Ultimate_Exception_Section);
                        end if;
                     end if;
                  end;
               end if;
            end;
         end if;
         State := Original;
         if Exc.List /= null then
            AD.Printers.Open_Section (State.The_Printer, Description_Section);
            Write_Comments (Exc.Element, Exc.List, State);
            AD.Printers.Close_Section (State.The_Printer, Description_Section);
         end if;
         AD.Printers.Close_Section (State.The_Printer, Exception_Section);
         State := Original;
      end Write_Exception;

      N : Natural;

   begin
      N := Current;
      while N <= Index'Last and then
            Items (Index (N)).Class = Item_Exception and then
            not Items (Index (N)).Is_Private
      loop
         N := N + 1;
      end loop;
      --  Only visible ones!
      N := N - 1;
      if N >= Current then
         Sort_By_Name (Items, Index (Current .. N));
         AD.Printers.Open_Section (State.The_Printer, Exceptions_Section);
         for I in Current .. N loop
            Add_To_Index
              (State,
               Items (Index (I)).Element, Items (Index (I)).Is_Private);
            Write_Exception (Items (Index (I)), State);
            Items (Index (I)).Done := True;
         end loop;
         AD.Printers.Close_Section (State.The_Printer, Exceptions_Section);
         Current := N + 1;
      end if;
   end Handle_Exceptions;

   ----------------------------------------------------------------------------
   --  Produce a cross-ref table of all types declared in the package.

   Translation : constant array (AD.Queries.Operation_Kind) of
                            AD.Printers.Operation_Kind :=
     (AD.Queries.Overridden_Operation         =>
        AD.Printers.Overridden_Operation,
      AD.Queries.New_Operation                =>
        AD.Printers.Own_Operation,
      AD.Queries.Inherited_Operation          =>
        AD.Printers.Inherited_Operation,
      AD.Queries.Inherited_Original_Operation =>
        AD.Printers.Inherited_Original_Operation
     );

   procedure Handle_Types
     (Element : in     Asis.Element;
      State   : in out Scan_State)
   is
      --  Generate a cross-referenced table of all types and their primitive
      --  operations. 'Element' is a top-level package declaration. Note: we
      --  only include the visible types, and we also do not include subtype
      --  declarations in the per-unit type index.

      procedure Write_Type
        (Decl  : in     Declaration;
         State : in out Scan_State)
      is

         use type AD.Queries.Operation_Kind;

         procedure Write
           (Ops    : in     AD.Queries.Operation_List;
            I      : in out Natural;
            Kind   : in     AD.Queries.Operation_Kind;
            State  : in out Scan_State)
         is
            Header_Written : Boolean := False;
         begin
            while I <= Ops'Last and then Ops (I).Kind = Kind loop
               if not Header_Written then
                  AD.Printers.Open_Operation_List
                     (State.The_Printer, Translation (Kind));
                  Header_Written := True;
               end if;
               AD.Printers.Add_Type_Operation
                 (State.The_Printer,
                  AD.Crossrefs.Crossref_Name
                    (Get_Name (Ops (I).Decl), State.Unit,
                     State.Reporter'Access));
               I := I + 1;
            end loop;
            if Header_Written then
               AD.Printers.Close_Operation_List (State.The_Printer);
            end if;
         end Write;

         function Smaller
           (Left, Right : in AD.Queries.Operation_Description)
           return Boolean
         is
         begin
            if Left.Kind /= Right.Kind then
               return Left.Kind < Right.Kind;
            else
               return Smaller_Name (Left.Decl, Right.Decl);
            end if;
         end Smaller;

         procedure Sort is
            new GAL.Sorting.Sort_G
              (Positive,
               AD.Queries.Operation_Description,
               AD.Queries.Operation_List,
               Smaller);

         procedure Purge
           (Ops  : in out AD.Queries.Operation_List;
            Last :    out Natural)
         is
            --  Remove all 'Inherited_Original_Operation's that are not in an
            --  application defined unit. Change all others to simple
            --  'Inherited_Operations'. Set 'Last' to reflect the last index
            --  still containing a valid operation.
            I : Natural;

            procedure Swap is
              new GAL.Support.Swap (AD.Queries.Operation_Description);

         begin
            Last := Ops'Last;
            I    := Ops'First;
            while I <= Last loop
               if Ops (I).Kind = AD.Queries.Inherited_Original_Operation then
                  --  if Unit_Origin
                  --       (Enclosing_Compilation_Unit (Ops (I).Decl)) /=
                  --     An_Application_Unit
                  if not AD.Crossrefs.Crossref_To_Unit
                           (Enclosing_Compilation_Unit (Ops (I).Decl))
                  then
                     if I < Last then
                        Swap (Ops (I), Ops (Last));
                     end if;
                     Last := Last - 1;
                  else
                     Ops (I).Kind := AD.Queries.Inherited_Operation;
                     I := I + 1;
                  end if;
               else
                  I := I + 1;
               end if;
            end loop;
         end Purge;

      begin --  Write_Type
         declare
            XRef : AD.Crossrefs.Cross_Reference :=
              AD.Crossrefs.Crossref_Name
                (Get_Name (Decl), State.Unit, State.Reporter'Access);
         begin
            AD.Printers.Open_Section (State.The_Printer, Type_Section);
            AD.Printers.Type_Name (State.The_Printer, XRef);
         end;
         case Declaration_Kind (Decl) is
            when A_Task_Type_Declaration =>
               AD.Printers.Type_Kind (State.The_Printer, "task type");
            when A_Protected_Type_Declaration =>
               AD.Printers.Type_Kind (State.The_Printer, "protected type");
            when An_Incomplete_Type_Declaration =>
               --  Actually this shouldn't ever happen. We can have an
               --  incomplete type here only if we're in the private part of
               --  a package spec, but we don't traverse those anyway.
               AD.Printers.Type_Kind (State.The_Printer, "incomplete type");
               AD.Printers.Close_Section (State.The_Printer, Type_Section);
               return;
            when others =>
               case Trait_Kind (Decl) is
                  when A_Limited_Trait |
                       A_Limited_Private_Trait =>
                     AD.Printers.Type_Kind (State.The_Printer, "limited type");
                  when An_Abstract_Trait |
                       An_Abstract_Private_Trait =>
                     AD.Printers.Type_Kind
                       (State.The_Printer, "abstract type");
                  when An_Abstract_Limited_Trait |
                       An_Abstract_Limited_Private_Trait =>
                     AD.Printers.Type_Kind
                       (State.The_Printer, "abstract limited type");
                  when others =>
                     null;
               end case;
         end case;
         declare
            Parent     : constant Declaration      :=
              AD.Queries.Ancestor_Type (Decl);
            Primitives : AD.Queries.Operation_List :=
              AD.Queries.Primitive_Operations (Decl);
            I          : Natural;
            Last       : Natural;
         begin
            if not Is_Nil (Parent) then
               AD.Printers.Parent_Type
                 (State.The_Printer,
                  AD.Crossrefs.Crossref_Name
                    (Get_Name (Parent), State.Unit, State.Reporter'Access));
            end if;
            if Primitives'Last >= Primitives'First then
               Purge (Primitives, Last);
               if Last >= Primitives'First then
                  Sort (Primitives (Primitives'First .. Last));
                  I := Primitives'First;
                  AD.Printers.Open_Section
                    (State.The_Printer, Operations_Section);
                  for Kind in AD.Queries.Operation_Kind loop
                     Write
                       (Primitives (Primitives'First .. Last), I, Kind, State);
                  end loop;
                  AD.Printers.Close_Section
                    (State.The_Printer, Operations_Section);
               end if;
            end if;
         end;
         AD.Printers.Close_Section (State.The_Printer, Type_Section);
      end Write_Type;

      function Is_A_Type_Declaration
        (Kind : in Declaration_Kinds)
        return Boolean
      is
      begin
         return Kind in A_Type_Declaration;
         --  This does *not* include subtypes!
      end Is_A_Type_Declaration;

      function Extract_Types is
         new Extract_Declarations (Is_A_Type_Declaration);

      Types   : constant Declarative_Item_List :=
        Extract_Types (Visible_Part_Declarative_Items (Element, False), True);
      --  Collects all the types from the visible declarations.

   begin
      if Types'Last >= Types'First then
         AD.Printers.Open_Section (State.The_Printer, Type_Summary_Section);
         for I in Types'Range loop
            if
               Declaration_Kind (Types (I)) = An_Incomplete_Type_Declaration
            then
               --  The next one *must* be the full type declaration. Hence
               --  just skip the incomplete type decl.
               if I = Types'Last or else
                  not Is_Equal (Types (I + 1),
                                Corresponding_Type_Declaration (Types (I)))
               then
                  --  Actually, we shouldn't ever get here, because incomplete
                  --  types without completion are allowed in the private part
                  --  of a package spec only, and we don't traverse that in
                  --  the first place.
                  Write_Type (Types (I), State);
               end if;
            else
               Write_Type (Types (I), State);
            end if;
         end loop;
         AD.Printers.Close_Section (State.The_Printer, Type_Summary_Section);
      end if;
   end Handle_Types;

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

   procedure Handle_Declaration
     (Items     : in     Item_Table;
      Current   : in     Natural;
      State     : in out Scan_State;
      Is_Last   : in     Boolean;
      Top_Level : in     Boolean := False)
   is

      procedure Write_Generic_Formals
        (Decl  : in     Declaration;
         State : in out Scan_State)
      is
         --  Write the generic formals, if any.
      begin
         case Declaration_Kind (Decl) is
            when A_Generic_Package_Declaration |
                 A_Generic_Function_Declaration |
                 A_Generic_Procedure_Declaration =>
               declare
                  Ctrl            : Traverse_Control;
                  Generic_Formals : constant Element_List :=
                    Generic_Formal_Part (Decl, True);
               begin
                  for I in Generic_Formals'Range loop
                     Ctrl := Continue;
                     --  Never suppress any newlines:
                     State.Traverse_Top := Nil_Element;
                     Traverse (Generic_Formals (I), Ctrl, State);
                  end loop;
               end;

            when others =>
               null;

         end case;
      end Write_Generic_Formals;

      procedure Write_Container
        (Items     : in     Item_Table;
         Current   : in     Natural;
         State     : in out Scan_State;
         Is_Last   : in     Boolean;
         Top_Level : in     Boolean)
      is
         Old_Indent      : constant Character_Position := State.Indent;
         Kind            : constant Declaration_Kinds  :=
           Declaration_Kind (Items (Current).Element);
         Table_Opened    : Boolean             := False;
         Contained_Items : Item_Table       :=
           Find_Items (Items (Current).Element);
         For_Container   : Natural;
      begin
         Group_Items (Contained_Items, For_Container);
         Add_To_Index
           (State, Items (Current).Element, Items (Current).Is_Private);
         declare
            Name : Defining_Name := Get_Name (Items (Current).Element);
         begin
            if Defining_Name_Kind (Name) = A_Defining_Expanded_Name then
               Name := Defining_Selector (Name);
            end if;
            AD.Printers.Open_Container
              (State.The_Printer,
               AD.Crossrefs.Crossref_Name
                 (Name, State.Unit, State.Reporter'Access),
               Get_Item_Kind (Items (Current).Element),
               Get_Single_Name (Items (Current).Element));
         end;
         AD.Printers.Open_Section (State.The_Printer, Header_Section);
         declare
            Pos : Position :=
              Start (Get_Span (Items (Current).Element));
         begin
            if Pos.Line = 1 then Pos.Column := 1; end if;
            State.Write_From   := Pos;
            State.Last_Written := (Pos.Line, Pos.Column - 1);
            State.Indent       := Pos.Column - 1;
         end;
         Write_Generic_Formals (Items (Current).Element, State);
         --  Complete the header: write everything up to and including the
         --  defining name, then write everything up to and including the
         --  "is", and then write all following items belonging to this one.
         --  Finally, write the comments for all items (excluding the current
         --  item (and the context clauses) if we're on top level.
         declare
            Name : constant Defining_Name :=
              Get_Name (Items (Current).Element);
            Ctrl : Traverse_Control := Continue;
         begin
            State.Traverse_Top := Nil_Element;
            Handle_Defining_Name (Name, Ctrl, State);
            Terminate_Line (State);
            --  If it's a task or protected type, it may have discriminants
            --  here...
            if Kind = A_Task_Type_Declaration or else
               Kind = A_Protected_Type_Declaration
            then
               declare
                  Discriminants : constant Asis.Element :=
                    Discriminant_Part (Items (Current).Element);
                  Ctrl : Traverse_Control := Continue;
               begin
                  if not Is_Nil (Discriminants) then
                     --  Never suppress any newlines:
                     State.Traverse_Top := Nil_Element;
                     Traverse (Discriminants, Ctrl, State);
                  end if;
               end;
            end if;
            --  Find the 'is' and write it.
            declare
               To_Write : A_T.Span :=
                 Through (State.Unit,
                          "is", From => State.Last_Written);
            begin
               Set_Start (To_Write, State.Write_From);
               Write_Span (To_Write, State);
               New_Line (State.The_Printer);
            end;
         end;
         AD.Printers.Close_Section (State.The_Printer, Header_Section);
         --  Now write any object belonging to this one (rep clauses, pragmas),
         --  and then write the comments, if any.
         declare
            Index : Index_Table :=
              (1 => Current) &
              Collect_Subordinates (Items, Contained_Items,
                                    Items (Current).Sub, For_Container);
            Ctrl : Traverse_Control;
         begin
            if Index'Last > Index'First then
               AD.Printers.Open_Section (State.The_Printer, Content_Section);
               AD.Printers.Open_Section (State.The_Printer, Top_Item_Section);
               AD.Printers.Open_Section (State.The_Printer, Snippet_Section);
               Table_Opened := True;
               Sort_Subordinates (Index (Index'First + 1 .. Index'Last),
                                  Items, Contained_Items);
               for I in Index'First + 1 .. Index'Last loop
                  declare
                     This : Asis.Element;
                  begin
                     if Index (I) < 0 then
                        This := Contained_Items (-Index (I)).Element;
                     else
                        This := Items (Index (I)).Element;
                     end if;
                     --  TBD: Produce anchor; add to index
                     declare
                        Pos : Position := Start (Get_Span (This));
                     begin
                        if Pos.Line = 1 then Pos.Column := 1; end if;
                        State.Write_From   := Pos;
                        State.Last_Written :=
                          (Pos.Line, Pos.Column - 1);
                        State.Indent       := Pos.Column - 1;
                     end;
                     Ctrl := Continue;
                     State.Traverse_Top := This;
                     Traverse (This, Ctrl, State);
                  end;
                  if I < Index'Last then New_Line (State.The_Printer); end if;
               end loop;
               AD.Printers.Close_Section (State.The_Printer, Snippet_Section);
            end if;
            --  First check that we do have comments:
            declare
               Have_Comments : Boolean := False;
               From          : Natural;
            begin
               if Top_Level then
                  From := Index'First + 1;
               else
                  From := Index'First;
               end if;
               for I in From .. Index'Last loop
                  if (Index (I) > 0 and then
                      Items (Index (I)).List /= null)
                     or else
                     (Index (I) < 0 and then
                      Contained_Items (-Index (I)).List /= null)
                  then
                     Have_Comments := True; exit;
                  end if;
               end loop;
               if Have_Comments then
                  if not Table_Opened then
                     AD.Printers.Open_Section
                       (State.The_Printer, Content_Section);
                     AD.Printers.Open_Section
                       (State.The_Printer, Top_Item_Section);
                     Table_Opened := True;
                  end if;
                  AD.Printers.Open_Section
                    (State.The_Printer, Description_Section);
                  for I in From .. Index'Last loop
                     if Index (I) > 0 then
                        Write_Comments
                          (Items (Index (I)).Element,
                           Items (Index (I)).List, State);
                     else
                        Write_Comments
                          (Contained_Items (-Index (I)).Element,
                           Contained_Items (-Index (I)).List, State);
                     end if;
                  end loop;
                  AD.Printers.Close_Section
                    (State.The_Printer, Description_Section);
               end if;
            end;
         end;
         if Table_Opened then
            AD.Printers.Close_Section (State.The_Printer, Top_Item_Section);
         end if;
         --  And now go into it:

         declare
            Curr            : Natural;
            In_Private      : Boolean := False;
            Is_Package      : constant Boolean :=
              Kind = A_Generic_Package_Declaration or else
              Kind = A_Package_Declaration;
            Contained_Index : Index_Table :=
              Build_Index (Contained_Items);
         begin
            if Is_Package and then Top_Level then
               Handle_Children
                 (Enclosing_Compilation_Unit (Items (Current).Element),
                  State, Table_Opened);
            end if;
            if Contained_Index'Last >= Contained_Index'First then
               if not Table_Opened then
                  AD.Printers.Open_Section
                    (State.The_Printer, Content_Section);
                  Table_Opened := True;
               end if;
               Sort_Index (Contained_Items, Contained_Index);
               Curr := Contained_Index'First;
               if Is_Package then
                  Handle_Exceptions (Contained_Items, Contained_Index, Curr,
                                     State);
                  Handle_Types (Items (Current).Element, State);
                  Handle_Objects (Contained_Items, Contained_Index, Curr,
                                  State,
                                  Item_Constant);
                  Handle_Objects (Contained_Items, Contained_Index, Curr,
                                  State,
                                  Item_Object);
               end if;
               if Curr <= Contained_Index'Last then
                  AD.Printers.Open_Section (State.The_Printer, Others_Section);
                  while Curr <= Contained_Index'Last loop
                     if
                        Contained_Items (Contained_Index (Curr)).Is_Private
                     then
                        if not In_Private then
                           AD.Printers.Add_Private (State.The_Printer, False);
                        end if;
                        In_Private := True;
                     end if;
                     Handle_Declaration
                       (Contained_Items, Contained_Index (Curr),
                        State, Curr = Contained_Index'Last);
                     Curr := Curr + 1;
                  end loop;
                  AD.Printers.Close_Section
                    (State.The_Printer, Others_Section);
               end if;
               Clear_Table (Contained_Items);
            end if;
            if not AD.Options.Private_Too and then
               Asis2.Container_Elements.Has_Private (Items (Current).Element)
            then
               if not Table_Opened then
                  AD.Printers.Open_Section
                    (State.The_Printer, Content_Section);
                  Table_Opened := True;
               end if;
               AD.Printers.Add_Private (State.The_Printer, True);
            end if;
            if Table_Opened then
               AD.Printers.Close_Section (State.The_Printer, Content_Section);
            end if;
         end;

         --  Find the closing 'end':
         AD.Printers.Open_Section (State.The_Printer, Footer_Section);
         AD.Printers.Dump (State.The_Printer, "end ");
         --  Now write the name again (even if it didn't appear in the
         --  source!)
         declare
            Names : constant Name_List :=
              A_D.Names (Items (Current).Element);
            Span  : constant A_T.Span  := Get_Span (Names (Names'First));
            Ctrl  : Traverse_Control   := Continue;
         begin
            --  Now be careful to pretend that we're at the beginning,
            --  and that we have written everything on that same line
            --  before the name itself.
            State.Write_From   := Start (Span);
            State.Last_Written :=
              (State.Write_From.Line,
               State.Write_From.Column - 1);
            Handle_Defining_Name (Names (Names'First), Ctrl, State, False);
            AD.Printers.Dump (State.The_Printer, ";");
         end;
         AD.Printers.Close_Section (State.The_Printer, Footer_Section);
         AD.Printers.Close_Container
           (State.The_Printer, Is_Last and then not Top_Level);
         State.Indent := Old_Indent;
      end Write_Container;

      procedure Write_Item
        (Items     : in     Item_Table;
         Current   : in     Natural;
         State     : in out Scan_State;
         Is_Last   : in     Boolean;
         Top_Level : in     Boolean)
      is
         Old_Indent : constant Character_Position    := State.Indent;
         Kind       : constant AD.Printers.Item_Kind :=
           AD.Printers.Get_Item_Kind (Items (Current).Element);
         use type AD.Printers.Item_Kind;

      begin
         if Kind not in AD.Printers.Declaration_Item_Kind then
            AD.Printers.Open_Item
              (State.The_Printer, AD.Crossrefs.Null_Crossref, Kind);
            --  TBD: Produce anchor, add to indices.
         else
            Add_To_Index
              (State, Items (Current).Element, Items (Current).Is_Private);
            declare
               Name : Defining_Name := Get_Name (Items (Current).Element);
            begin
               if Defining_Name_Kind (Name) = A_Defining_Expanded_Name then
                  Name := Defining_Selector (Name);
               end if;
               AD.Printers.Open_Item
                 (State.The_Printer,
                  AD.Crossrefs.Crossref_Name
                    (Name, State.Unit, State.Reporter'Access),
                  Kind,
                  Get_Single_Name (Items (Current).Element));
            end;
         end if;
         Write_Item (Items, Current, State, Top_Level);
         AD.Printers.Close_Item (State.The_Printer, Is_Last);
         State.Indent := Old_Indent;
      end Write_Item;

   begin
      if Top_Level then
         if Items (Current).List /= null then
            AD.Printers.Open_Section (State.The_Printer, Description_Section);
            Write_Comments (State.Unit, Items (Current).List, State);
            AD.Printers.Close_Section (State.The_Printer, Description_Section);
         end if;
      end if;
      if Is_Container (Items (Current).Class) then
         Write_Container (Items, Current, State, Is_Last, Top_Level);
      else
         Write_Item (Items, Current, State, Is_Last, Top_Level);
      end if;
   end Handle_Declaration;

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

   procedure Handle_Defining_Name
     (Element   : in     Defining_Name;
      Control   : in out Traverse_Control;
      State     : in out Scan_State;
      Do_Anchor : in     Boolean := True)
   is
      --  Generate an anchor for a defining name, so that it can be cross-
      --  referenced.

      Name : Defining_Name := Element;
   begin
      if Defining_Name_Kind (Name) = A_Defining_Expanded_Name then
         --  Try to generate cross-references for the prefix! (Fails some-
         --  times on Asis 2.0.R for GNAT 3.13p; the failure is handled in
         --  'AD.Writers.Write_Reference').
         Traverse (Defining_Prefix (Name), Control, State);
         Name := Defining_Selector (Name);
      end if;
      if Do_Anchor then
         Write_Name (Name, State);
      else
         Write (Name, State);
      end if;
      Control := Abandon_Children;
   end Handle_Defining_Name;

   ----------------------------------------------------------------------------
   --  The only exported routine.

   procedure Scan
     (The_Unit    : in Compilation_Unit;
      The_Printer : in AD.Printers.Printer_Ref)
   is
      --  Produce an HTML rendering of the given compilation unit.

      State : Scan_State;

   begin
      State.The_Printer          := The_Printer;
      State.Reporter.The_Printer := The_Printer;
      State.Unit                 := Unit_Declaration (The_Unit);
      State.Write_From           := Start (Compilation_Unit_Span (State.Unit));
      --  Asis 2.0.R for GNAT 3.13p has a problem if the unit starts at the
      --  very beginning with a clause: the column is set to an arbitrary
      --  value. The above therefore sometimes causes some stuff at the very
      --  beginning not to be written. Correct that!
      --
      --  This error seems to be corrected in the 3.14p version.
      if State.Write_From.Line = 1 then
         State.Write_From.Column := 1;
      end if;
      State.Indent := 0;

      declare
         Name : Defining_Name := Asis2.Naming.Get_Name (State.Unit);
      begin
         if Defining_Name_Kind (Name) = A_Defining_Expanded_Name then
            Name := Defining_Selector (Name);
         end if;
         AD.Printers.Open_Unit
           (State.The_Printer,
            AD.Printers.Get_Item_Kind (State.Unit),
            Full_Unit_Name (The_Unit),
            Unit_Class (The_Unit) = A_Private_Declaration,
            AD.Crossrefs.Crossref_Name
             (Name, State.Unit, State.Reporter'Access));
      end;
      declare
         Items : Item_Table := Find_Items (The_Unit);
         Curr  : Natural;
      begin
         if Items (Items'First).Is_Clause then
            Handle_Clauses (The_Unit, State, Items (Items'First));
            Curr := Items'First + 1;
         else
            Curr := Items'First;
         end if;
         declare
            Index : constant Index_Table :=
              Build_Index (Items (Curr .. Items'Last));
         begin
            for I in Index'Range loop
               Handle_Declaration
                 (Items, Index (I), State,
                  Is_Last => I = Index'Last, Top_Level => True);
            end loop;
         end;
         Clear_Table (Items);
         Clear_Comments;
      end;
      AD.Printers.Close_Unit (State.The_Printer);
   end Scan;

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

end AD.Scanner;
