------------------------------------------------------------------------------
--                                                                          --
--                      DISPLAY_SOURCE COMPONENTS                           --
--                                                                          --
--                           N O D E _ T R A V                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            Copyright (c) 1995-2002, Free Software Foundation, Inc.       --
--                                                                          --
-- Display_Source is free software; you can redistribute it and/or modify it--
-- under terms of the  GNU General Public License  as published by the Free --
-- Software Foundation;  either version 2,  or  (at your option)  any later --
-- version. Display_Source is distributed in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY or  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General  --
-- Public License for more details. You should have received a copy of the  --
-- GNU General Public License distributed with GNAT; see file COPYING. If   --
-- not, write to the Free Software Foundation, 59 Temple Place Suite 330,   --
-- Boston, MA 02111-1307, USA.                                              --
--                                                                          --
-- Display_Source is distributed as a part of the ASIS implementation for   --
-- GNAT (ASIS-for-GNAT).                                                    --
--                                                                          --
-- The   original   version   of  Display_Source  has  been  developed  by  --
-- Jean-Charles  Marteau and Serge Reboul,  ENSIMAG  High School Graduates  --
-- (Computer sciences)  Grenoble,  France  in  Sema Group Grenoble, France. --
--                                                                          --
-- Display_Source is now maintained by Ada Core Technologies Inc            --
-- (http://www.gnat.com).                                                   --
------------------------------------------------------------------------------

-----------------------------------------------------------------
-- This package is part of the ASIS application display_source --
-----------------------------------------------------------------

with Ada.Characters.Handling; use Ada.Characters.Handling;
with Text_IO;                 use Text_IO;

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

with Global_Info;             use Global_Info;

package body Node_Trav is

   use Asis;
   --  to make all the literals from Element classification hierarchy
   --  directly visible

   -------------------------------------------
   --                                       --
   --  Here are the 2 procedures that are   --
   --  called in pre_procedure when we are  --
   --  in test_control mode.                --
   --                                       --
   -------------------------------------------

   procedure Pre_Test_Control
     (Element : in     Asis.Element;
      Control : in out Asis.Traverse_Control;
      State   : in out Info_Node) is

   begin

      pragma Unreferenced (State);

      case Asis.Elements.Element_Kind (Element) is
         when A_Statement =>
            case Asis.Elements.Statement_Kind (Element) is
               when A_Return_Statement |
                    A_While_Loop_Statement =>
                  --  to check if children are left too ..
                  Control := Asis.Abandon_Siblings;
               when A_For_Loop_Statement =>
                  Control := Asis.Abandon_Children;
               when A_Raise_Statement =>
                  Control := Asis.Terminate_Immediately;
               when others => null;
            end case;
         when others =>
            null;
      end case;
      if Asis."/=" (Control, Asis.Continue) then
         Put_Line ("Pre Control : " &
                   Asis.Traverse_Control'Image (Control));
      end if;
   end Pre_Test_Control;

   procedure Post_Test_Control
     (Element : in     Asis.Element;
      Control : in out Asis.Traverse_Control;
      State   : in out Info_Node) is

   begin
      pragma Unreferenced (State);

      case Asis.Elements.Element_Kind (Element) is
         when A_Statement =>
            case Asis.Elements.Statement_Kind (Element) is
               when A_Return_Statement |
                 A_While_Loop_Statement =>
                  Put_Line ("We shouldn't be in post A_Return_Statement "&
                            "or A_While_Loop_Statement");
               when A_For_Loop_Statement =>
                  Put_Line ("We shouldn't be in post A_For_Loop_Statement");
               when A_Raise_Statement =>
                  Put_Line ("We shouldn't be in post A_Raise_Statement");
               when others => null;
            end case;
         when A_Path =>
            case Asis.Elements.Path_Kind (Element) is
               when An_Elsif_Path =>
                  Control := Asis.Abandon_Siblings;
               when An_Else_Path =>
                  Control := Asis.Abandon_Children;
               when A_Case_Path =>
                  Control := Asis.Terminate_Immediately;
               when others =>
                  null;
            end case;
         when others =>
            null;
      end case;
      if Asis."/=" (Control, Asis.Continue) then
         Put_Line ("Post Control : " &
                   Asis.Traverse_Control'Image (Control));
      end if;
   end Post_Test_Control;

   --------------------------------------------
   --                                        --
   --  Here is the pre procedure to provide  --
   --  to Traverse_Element to make a node    --
   --  display.                              --
   --                                        --
   --------------------------------------------

   procedure Pre_Procedure
     (Element : in     Asis.Element;
      Control : in out Asis.Traverse_Control;
      State   : in out Info_Node) is

      function Indentation return String;

      function Indentation return String is
         Res : String (1 .. 2 * State.Indentation) := (others => '-');
      begin
         if Res'Length > 0 then
            Res (Res'Last) := '>';
         end if;
         return Res;
      end Indentation;

   begin
      if The_Mode = Node_And_Lines then
         while Asis.Text.First_Line_Number (Element) >
           State.Last_Commented_Line
         loop
            State.Last_Commented_Line := State.Last_Commented_Line + 1;
            declare
               List : Asis.Text.Line_List := Asis.Text.Lines
                                               (Element,
                                                State.Last_Commented_Line,
                                                State.Last_Commented_Line);
            begin
               if List'Last - List'First + 1 > 0 then
                  declare
                     Comment : String := To_String (Asis.Text.Comment_Image
                       (List (List'First)));
                  begin
                     if Comment'Length /= 0 then
                        Put_Line (Comment);
                     end if;
                  end;
               end if;
            end;
         end loop;
      end if;

      Put_Line (Indentation &
                Element_Kinds'Image (Asis.Elements.Element_Kind (Element)));
      case Asis.Elements.Element_Kind (Element) is
         when A_Pragma =>                  -- Asis.Elements
            Put_Line (Indentation & "  " &
                      Pragma_Kinds'Image (Asis.Elements.Pragma_Kind (Element))
                      & " ... " &
                      To_String (Asis.Elements.Pragma_Name_Image (Element)));
         when A_Defining_Name =>           -- Asis.Declarations
            Put_Line (Indentation & "  " & Defining_Name_Kinds'Image
                      (Asis.Elements.Defining_Name_Kind (Element)) &
                      " ... " &
                      (To_String
                        (Asis.Declarations.Defining_Name_Image (Element))));
            case Asis.Elements.Defining_Name_Kind (Element) is
               when A_Defining_Operator_Symbol =>
                  Put_Line (Indentation & "    " & Operator_Kinds'Image
                            (Asis.Elements.Operator_Kind (Element)));
               when others => null;
            end case;
         when A_Declaration =>             -- Asis.Declarations
            Put_Line (Indentation & "  " & Declaration_Kinds'Image
                      (Asis.Elements.Declaration_Kind (Element)));

            case Asis.Elements.Declaration_Kind (Element) is
               when A_Private_Type_Declaration |
                 A_Private_Extension_Declaration |
                 A_Variable_Declaration |
                 A_Constant_Declaration |
                 A_Deferred_Constant_Declaration |
                 A_Discriminant_Specification |
                 A_Loop_Parameter_Specification |
                 A_Procedure_Declaration |
                 A_Function_Declaration |
                 A_Parameter_Specification =>
                  Put_Line (Indentation & "    " & Trait_Kinds'Image
                            (Asis.Elements.Trait_Kind (Element)));
               when A_Formal_Function_Declaration |
                    A_Formal_Procedure_Declaration =>
                  Put_Line
                    (Indentation & "    " & Subprogram_Default_Kinds'Image
                            (Asis.Elements.Default_Kind (Element)));
               when others =>
                  null;
            end case;

            case Asis.Elements.Declaration_Kind (Element) is
               when A_Parameter_Specification |
                 A_Formal_Object_Declaration =>
                  Put_Line (Indentation & "    " & Mode_Kinds'Image
                            (Asis.Elements.Mode_Kind (Element)));
               when others =>
                  null;
            end case;

         when A_Definition =>              -- Asis.Definitions
            Put_Line (Indentation & "  " & Definition_Kinds'Image
                      (Asis.Elements.Definition_Kind (Element)));
            case Asis.Elements.Definition_Kind (Element) is
               when A_Type_Definition =>
                  Put_Line (Indentation & "    " & Type_Kinds'Image
                    (Asis.Elements.Type_Kind (Element)));
                  case Asis.Elements.Type_Kind (Element) is
                     when  An_Access_Type_Definition =>
                        Put_Line
                          (Indentation & "      " & Access_Type_Kinds'Image
                                  (Asis.Elements.Access_Type_Kind (Element)));
                     when A_Derived_Type_Definition |
                       A_Derived_Record_Extension_Definition |
                       A_Record_Type_Definition |
                       A_Tagged_Record_Type_Definition =>
                        Put_Line (Indentation & "    " & Trait_Kinds'Image
                                  (Asis.Elements.Trait_Kind (Element)));
                     when others => null;
                  end case;
               when A_Constraint =>
                  Put_Line (Indentation & "    " & Constraint_Kinds'Image
                            (Asis.Elements.Constraint_Kind (Element)));
               when A_Formal_Type_Definition =>
                  Put_Line (Indentation & "    " & Formal_Type_Kinds'Image
                            (Asis.Elements.Formal_Type_Kind (Element)));
                  case Asis.Elements.Formal_Type_Kind (Element) is
                     when  A_Formal_Access_Type_Definition =>
                        Put_Line
                          (Indentation & "      " & Access_Type_Kinds'Image
                                  (Asis.Elements.Access_Type_Kind (Element)));
                     when A_Formal_Private_Type_Definition |
                       A_Formal_Tagged_Private_Type_Definition |
                       A_Formal_Derived_Type_Definition =>
                        Put_Line (Indentation & "    " & Trait_Kinds'Image
                                  (Asis.Elements.Trait_Kind (Element)));
                     when others => null;
                  end case;
               when A_Discrete_Subtype_Definition |
                 A_Discrete_Range =>
                  Put_Line (Indentation & "    " & Discrete_Range_Kinds'Image
                            (Asis.Elements.Discrete_Range_Kind (Element)));
               when A_Component_Definition |
                 A_Private_Type_Definition |
                 A_Tagged_Private_Type_Definition |
                 A_Private_Extension_Definition =>
                  Put_Line (Indentation & "    " & Trait_Kinds'Image
                            (Asis.Elements.Trait_Kind (Element)));
               when others => null;
            end case;

         when An_Expression =>             -- Asis.Expressions
            case Asis.Elements.Expression_Kind (Element) is
               when An_Attribute_Reference =>
                  Put (Indentation & "  " & Expression_Kinds'Image
                       (Asis.Elements.Expression_Kind (Element)));
                  Put_Line (" ... " & Attribute_Kinds'Image
                            (Asis.Elements.Attribute_Kind (Element)));
               when An_Identifier |
                 An_Operator_Symbol |
                 A_Character_Literal |
                 An_Enumeration_Literal =>
                  Put (Indentation & "  " & Expression_Kinds'Image
                       (Asis.Elements.Expression_Kind (Element)));
                  Put_Line (" ... " &
                     To_String (Asis.Expressions.Name_Image (Element)));
               when An_Integer_Literal |
                 A_Real_Literal |
                 A_String_Literal =>
                  Put (Indentation & "  " & Expression_Kinds'Image
                       (Asis.Elements.Expression_Kind (Element)));
                  Put_Line (" ... " &
                     To_String (Asis.Expressions.Value_Image (Element)));
               when A_Function_Call =>
                  Put (Indentation & "  " & Expression_Kinds'Image
                       (Asis.Elements.Expression_Kind (Element)));
                  if Asis.Expressions.Is_Prefix_Call (Element) then
                     Put_Line (" ... Prefixed");
                  else
                     Put_Line (" ... Infixed");
                  end if;
               when others =>
                  Put_Line (Indentation & "  " & Expression_Kinds'Image
                            (Asis.Elements.Expression_Kind (Element)));
            end case;

         when An_Association =>            -- Asis.Expressions
            Put_Line (Indentation & "  " & Association_Kinds'Image
                      (Asis.Elements.Association_Kind (Element)));

         when A_Statement =>               -- Asis.Statements
            Put_Line (Indentation & "  " & Statement_Kinds'Image
                      (Asis.Elements.Statement_Kind (Element)));

         when A_Path =>                    -- Asis.Statements
            Put_Line (Indentation & "  " & Path_Kinds'Image
                      (Asis.Elements.Path_Kind (Element)));

         when A_Clause =>                  -- Asis.Clauses
            Put_Line (Indentation & "  " & Clause_Kinds'Image
                      (Asis.Elements.Clause_Kind (Element)));
            case Asis.Elements.Clause_Kind (Element) is
               when A_Representation_Clause =>
                  Put_Line
                    (Indentation & "  " & Representation_Clause_Kinds'Image
                        (Asis.Elements.Representation_Clause_Kind (Element)));
               when others =>
                  null;
            end case;

         when others => null;
      end case;
      if The_Mode = Node_And_Lines then
         Put (Indentation & "    From line" &
               Asis.Text.Line_Number'Image
               (Asis.Text.First_Line_Number (Element)) &
               " to line" &
               Asis.Text.Line_Number'Image
               (Asis.Text.Last_Line_Number (Element)));

         declare
            The_Span : Asis.Text.Span :=
              Asis.Text.Element_Span (Element);
         begin
            Put ("  Span : (" &
                 Asis.Text.Line_Number'Image (The_Span.First_Line) &
                 "," &
                 Asis.Text.Character_Position'Image (The_Span.First_Column) &
                 "), (" &
                 Asis.Text.Line_Number'Image (The_Span.Last_Line) &
                 "," &
                 Asis.Text.Character_Position'Image (The_Span.Last_Column) &
                 ")");
         end;

         declare
            List : Asis.Text.Line_List := Asis.Text.Lines (Element);
            N : Natural := List'Last - List'First + 1;
         begin
            Put (" (" & Asis.Text.Line_Number'Image (N) & " lines of lengths");
            for I in List'First .. List'Last
            loop
               Put ("," &
                    Asis.Text.Character_Position'Image
                      (Asis.Text.Length (List (I))));
            end loop;
            Put_Line (")");
         end;

      end if;

      if The_Mode = Test_Control then
         Pre_Test_Control (Element, Control, State);
      end if;
      State.Indentation := State.Indentation + 1;

   end Pre_Procedure;

   procedure Post_Procedure
     (Element : in     Asis.Element;
      Control : in out Asis.Traverse_Control;
      State   : in out Info_Node) is
   begin
      State.Indentation := State.Indentation - 1;
      if The_Mode = Test_Control then
         Post_Test_Control (Element, Control, State);
      end if;
   end Post_Procedure;

   procedure Initiate_Node
     (Unit : in     Asis.Compilation_Unit;
      Control : in out Asis.Traverse_Control;
      State   : in out Info_Node) is
   begin
      pragma Unreferenced (Control);

      Put_Line ("Unit Kind : " &
                Asis.Unit_Kinds'Image
                (Asis.Compilation_Units.Unit_Kind (Unit)));
      State.Indentation := 0;
   end Initiate_Node;

   procedure Terminate_Node
     (Control : in out Asis.Traverse_Control;
      State   : in out Info_Node) is
   begin
      pragma Unreferenced (Control);
      pragma Unreferenced (State);
      null;
   end Terminate_Node;

end Node_Trav;
