------------------------------------------------------------------------------
--                                                                          --
--                      DISPLAY_SOURCE COMPONENTS                           --
--                                                                          --
--                         I M A G E _ T R A V                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 258 $
--                                                                          --
--            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 --
-----------------------------------------------------------------
--
--  In that application, each element is displayed, so we have
--  always a detailed display of each element (which can have a
--  cost in performance, because we call Asis queries on every
--  element). In fact it would be possible to have a global
--  display of the elements whose sub-elements didn't undergo
--  any special treatment (in Pre-Source).
--
--  Changing that would imply to have a more complex structure
--  (in State parameter), probably with a stack. We would push
--  the elements in Pre_Image and pop them in Post_Image.
--  Moreover we would need to keep in memory for each pushed
--  element the list of the children already passed without any
--  special treatment (In order to be able to display them
--  separately if one of their siblings had a special treatment)
--
--  But in fact i prefered to keep something simple because the
--  gain in performance is not obvious.
--

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

with Ada.Text_IO;

with Asis.Text;
with Asis.Elements;
with Asis.Expressions;

with Global_Info; use Global_Info;

package body Image_Trav is

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

   --  Increment_Source_Position and Decrement_Source_Position are used by
   --  span operations "-" and "/". As you can imagine, those functions add
   --  of substract one char to a position in the source (line, column).
   --  It takes into account the length of the lines, so if you are at the
   --  end of a line, the next position is the first character of the next
   --  line, and if you are at the beginning of a line, the previous character
   --  is the last character of the previous line.

   --  Pre-condition : the incrementation is possible ..
   --  (i.e we are not at the last character of the last line ...)

   procedure Increment_Source_Position
     (Line : in out Asis.Text.Line_Number;
      Char : in out Asis.Text.Character_Position;
      Element : Asis.Element);

   procedure Increment_Source_Position
     (Line : in out Asis.Text.Line_Number;
      Char : in out Asis.Text.Character_Position;
      Element : Asis.Element)
   is
      List : Asis.Text.Line_List :=
         Asis.Text.Lines (Element, Line, Line);
   begin
      if List'Length /= 0  then

         if Asis.Text.Length (List (List'First)) >= Char then
            Char := Char + 1;
         else
            --  normaly that is ok, in that case ....
            Line := Line + 1;
            Char := 1;
         end if;
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line
            ("exception raised in Increment_Source_Position");
         raise;
   end Increment_Source_Position;

   --  There is no condition here, if the position is the begining of the file,
   --  then the position returned is the same.
   procedure Decrement_Source_Position
     (Line : in out Asis.Text.Line_Number;
      Char : in out Asis.Text.Character_Position;
      Element : Asis.Element);

   procedure Decrement_Source_Position
     (Line : in out Asis.Text.Line_Number;
      Char : in out Asis.Text.Character_Position;
      Element : Asis.Element)
   is
   begin

      if Char /= 1 then
         Char := Char - 1;
      else
         if Line /= 1 then
            Line := Line - 1;
            declare
               List : Asis.Text.Line_List :=
                  Asis.Text.Lines (Element, Line, Line);
            begin
               if List'Length /= 0 then
                  Char := Asis.Text.Length (List (List'First));
               end if;
            end;
         end if;
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line
            ("exception raised in Decrement_Source_Position");
         raise;
   end Decrement_Source_Position;

   --  Outputs the text corresponding to the given span and elements.
   --  Modify State.Last_Printed_Span, when the given span is has been output
   --  (ie when it's not a Nil_Span).
   --  Output_span is the only function with Pre_Image that outputs text.
   procedure Output_Span
     (The_Span : Asis.Text.Span;
      State   : in out Info_Image;
      Element : Asis.Element);

   procedure Output_Span
     (The_Span : Asis.Text.Span;
      State   : in out Info_Image;
      Element : Asis.Element) is

      --  Line_Im is here to handle the With_Comments thing.
      --  (see Info_Image in image_trav.ads)
      function Line_Im (Line : Asis.Text.Line) return String;

      function Line_Im (Line : Asis.Text.Line) return String is --  ???
      begin
         if State.With_Comments then
            return To_String (Asis.Text.Line_Image (Line)); --  ???
         else
            return To_String (Asis.Text.Non_Comment_Image (Line));
         end if;
      end Line_Im;

   begin

      --  if the span is nil, nothing to do.
      if Asis.Text."=" (The_Span, Asis.Text.Nil_Span) then
         return;
      end if;

      declare
         --  we get the lines :
         List : Asis.Text.Line_List := Asis.Text.Lines (Element, The_Span);
      begin
         --  and we print them one by one
         for I in List'Range
         loop
            declare
               Text : String := Line_Im (List (I));
            begin
               if I = List'First then
                  if List'Length = 1 then
                     Ada.Text_IO.Put (Text);
                  else
                     Ada.Text_IO.Put_Line (Text);
                  end if;
               elsif I = List'Last then
                  Ada.Text_IO.Put (Text);
               else
                  Ada.Text_IO.Put_Line (Text);
               end if;
               State.Horizontal_Position := Text'Length;
            end;
         end loop;
         State.Last_Printed_Span := The_Span;
      end;
   exception
      when others =>
         Ada.Text_IO.Put_Line ("exception raised in Output_Span");
         raise;
   end Output_Span;

   --  In Pre_Image you can do what you want in order to do your
   --  particular application.
   --  When you decide that an element will take care of its display on its
   --  own, you just have to print the span :
   --    Element_Span (Element) - Last_Printed_Span
   --  which is the span between the last span the application has displayed
   --  and the span corresponding to the element ...
   --  and put   State.Last_Printed_Span := Element_Span (Span);
   procedure Pre_Image
     (Element : in    Asis.Element;
      Control : in out Asis.Traverse_Control;
      State   : in out Info_Image) is

      --  Definition of an operation between Spans ...
      --  Like the standard minus, you put the higher argument as the
      --  left parameter (higher for a span means that it denotes
      --  a text window that is after ...)
      --  The result is :
      --     - The Span that is between the 2 spans given if they
      --       are in the correct order.
      --     - The Nil_Span if Right is higher than Left.
      --
      --   example :
      --
      --           -----
      --           |   |
      --           -----
      --                          -----
      --                          |   |
      --                     =>   |   |
      --                          |   |
      --                          -----
      --           -----
      --           |   |
      --           -----

      function "-" (Left, Right : Asis.Text.Span) return Asis.Text.Span;

      function "-" (Left, Right : Asis.Text.Span) return Asis.Text.Span is
         Tmp : Asis.Text.Span;
      begin
         --  setting the first position
         if Asis.Text."=" (Right, Asis.Text.Nil_Span) then
            Tmp.First_Line := 1;
            Tmp.First_Column := 1;
         else
            Tmp.First_Line := Right.Last_Line;
            Tmp.First_Column := Right.Last_Column;
            Increment_Source_Position
              (Tmp.First_Line, Tmp.First_Column, Element);
         end if;
         --  setting the last position
         Tmp.Last_Line := Left.First_Line;
         Tmp.Last_Column := Left.First_Column;

         Decrement_Source_Position
           (Tmp.Last_Line, Tmp.Last_Column, Element);

         --  before returning we check that the span is correct
         if (Tmp.First_Line < Tmp.Last_Line) or
           (Tmp.First_Line = Tmp.Last_Line and
            Tmp.First_Column <= Tmp.Last_Column)
         then
            return Tmp;
         else
            return Asis.Text.Nil_Span;
         end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line ("exception raised in ""-""");
         raise;
      end "-";

      --  returns a string that helps to indent when you replace
      --  something with something else that has several lines ...
      function Indentation return String;

      function Indentation return String is
         Result : String (1 .. State.Horizontal_Position) := (others => ' ');
      begin
         return Result;
      end Indentation;

      --  the procedure Display_Before, updates the output so that
      --  all the text before the first character of the image of
      --  the current element is displayed.
      procedure Display_Before;

      procedure Display_Before is
      begin
         Output_Span
           ((Asis.Text.Element_Span (Element) - State.Last_Printed_Span),
             State,
             Element);
      exception
      when others =>
         Ada.Text_IO.Put_Line ("exception raised in Display_Before");
         raise;
      end Display_Before;

      --  the procedure Dont_Display make it so everything is like if
      --  the current element had been displayed except the displaying
      --  in itself ...
      --  It's important to notice that it sets the control to
      --  Abandon_Children
      procedure Dont_Display;

      procedure Dont_Display is
         Elem_Span : Asis.Text.Span := Asis.Text.Element_Span (Element);
      begin
         State.Handled_In_Pre := True;
         Control := Asis.Abandon_Children;
         State.Last_Printed_Span := Elem_Span;
      exception
      when others =>
         Ada.Text_IO.Put_Line ("exception raised in Dont_Display");
         raise;
      end Dont_Display;

      --  the procedure Display_Now is like Dont_Display, but it displays the
      --  element.
      --  It's important to notice that it sets the control to
      --  Abandon_Children
      procedure Display_Now;

      pragma Unreferenced (Display_Now);

      procedure Display_Now is
         Elem_Span : Asis.Text.Span := Asis.Text.Element_Span (Element);
      begin
         State.Handled_In_Pre := True;
         Control := Asis.Abandon_Children;
         Output_Span (Elem_Span, State, Element);
      end Display_Now;

   begin
      --  In this function, the program tests if you've got the expected
      --  element kind, and if so you can choose for instance :
      --    - to display the element on your own (modify)
      --    - not to display the element (skip it)
      --    - comment it .. or whatever ...
      --
      --  Before that, you say that you want the text before the element
      --  to be displayed by calling the Display_before procedure.
      --  Then you can call the Dont_Display procedure that indicates
      --  you don't want the element to be displayed in Post-Source.
      --  This procedure sets State.Handled_In_Pre to True, and
      --   Control to Asis.Abandon_Children, this way
      --  the next called funtion is Post_Image of the same element which
      --  uses the boolean Handled_In_Pre immediately ...

      --  The example here is an application where we want to suppress
      --  inline pragmas (that can be because we want to reduce exec size.
      --  (I didn't check it does, it's just an example ... :))
      --  there is also some operations on Unknown pragmas :
      --  for example :
      --    pragma Bonjour;
      --    pragma Hello;
      --    pragma Hello ("master");
      --    pragma Hello (1);
      --  pragma Hello (2.3E32);
      --    pragma Hello ('U');
      --    pragma Hello (A);
      --    pragma Hello ('U', "Me");
      --    pragma Hello ((1 => 2, others => 3));
      --    pragma HeLlO;
      --
      --  becomes :
      --     -- pragma Bonjour;
      --    Ada.Text_IO.Put_Line ("Hello default !");
      --    Ada.Text_IO.Put_Line   -- I wanted to show that we can pass a line
      --      ("Hello "master" !");
      --    Ada.Text_IO.Put_Line   -- I wanted to show that we can pass a line
      --      ("Hello 1 !");
      --  Ada.Text_IO.Put_Line   -- I wanted to show that we can pass a line
      --    ("Hello 2.3E32 !");
      --    Ada.Text_IO.Put_Line ("Hello 'U' !");
      --    Ada.Text_IO.Put_Line ("Hello A !");
      --    Ada.Text_IO.Put_Line
      --      ("I can't say hello to more than one parameter at once.");
      --    Ada.Text_IO.Put_Line ("I don't say hello to such parameter");
      --    -- pragma HeLlO;

      --  the pragma 'Pre-Compilation' works only if we are in mode
      --  Image_And_Example, if not, the source is displayed as is.

      if The_Mode /= Image_And_Example then
         return;
      end if;

      case Asis.Elements.Element_Kind (Element) is
         when A_Pragma =>
            case Asis.Elements.Pragma_Kind (Element) is
               when An_Inline_Pragma =>
                  Display_Before;
                  Dont_Display;
                  --  we display nothing because we want to suppress them ...
               when An_Unknown_Pragma =>
                  Display_Before;
                  --  We check that we have the correct pragma
                  --  if we want to be case unsensitive, we need
                  --    to make an unsensitive case test.
                  if To_String (Asis.Elements.Pragma_Name_Image (Element)) =
                     String'("Hello")
                  then
                     Dont_Display; -- to say that we'll do by ourselves
                     declare
                        --  we get the parameter list
                        Param : Asis.Association_List :=
                          Asis.Elements.Pragma_Argument_Associations (Element);
                        Expr : Asis.Element;
                     begin
                        if Param'Length = 0 then
                           --  if no parameter, then we do the default
                           Ada.Text_IO.Put
                             ("Ada.Text_IO.Put_Line (""Hello default !"");");
                        elsif Param'Length = 1 then
                           --  if there is one parameter, we get its value
                           --  (named parameter form could be handled getting
                           --  the Formal_Parameter of the association)
                           Expr := Asis.Expressions.Actual_Parameter
                             (Param (Param'First));
                           --  depending on the kind of expression we do
                           --  different things
                           case Asis.Elements.Expression_Kind (Expr) is
                              when An_Identifier       |
                                   An_Operator_Symbol  |
                                   A_Character_Literal |
                                   An_Enumeration_Literal =>
                                 Ada.Text_IO.Put
                                   ("Ada.Text_IO.Put_Line (""Hello " &
                                     To_String
                                        (Asis.Expressions.Name_Image (Expr)) &
                                     " !"");");
                              when An_Integer_Literal |
                                   A_Real_Literal |
                                   A_String_Literal =>
                                 Ada.Text_IO.Put_Line
                                   ("Ada.Text_IO.Put_Line   "&
                                    "-- I wanted to show that "&
                                    "we can pass a line");
                                 Ada.Text_IO.Put
                                   (Indentation &
                                    "  (""Hello " & To_String
                                     (Asis.Expressions.Value_Image (Expr)) &
                                     " !"");");
                              when others =>
                                 --  Some expression kinds are very
                                 --  complicated we handle here only simple
                                 --  expressions
                                 Ada.Text_IO.Put
                                   ("Ada.Text_IO.Put_Line "&
                                   "(""I don't say hello "&
                                   "to such parameter"");");
                           end case;
                        else
                           --  if there is more than one parameter,
                           --  it is an error
                           Ada.Text_IO.Put
                              ("Ada.Text_IO.Put_Line "&
                               "(""I can't say hello to more than one "&
                               "parameter at once."");");
                        end if;
                     end;
                  else
                     --  When it is an unknown unknown pragma
                     --  (when it is different from "Hello")
                     --  we comment it ...
                     --  notice that there is no Dont_Display here
                     Ada.Text_IO.Put ("-- ");
                  end if;
               when others =>
                  null;
            end case;
         when others =>
            null;
      end case;
   end Pre_Image;

   -----------------------------------------
   -- Post_Image has a simple function :  --
   --  it displays elements from the last --
   --  span to the end of the element.    --
   -----------------------------------------
   procedure Post_Image
     (Element : in     Asis.Element;
      Control : in out Asis.Traverse_Control;
      State   : in out Info_Image) is

      pragma Unreferenced (Control);

      --  Definition of an operation between Spans ...
      --  Like the standard minus, you put the higher argument as the
      --  left parameter (higher for a span means that it denotes
      --  a text window that is after ...)
      --  The result is :
      --    - The union of the Left span and of the span corresponding
      --      to the space between the 2 spans if they
      --      are in the correct order.
      --    - The Nil_Span if Right is higher than Left.
      --
      --   example :
      --
      --           -----
      --           |   |
      --           -----
      --                          -----
      --                          |   |
      --                     =>   |   |
      --                          |   |
      --           -----          |   |
      --           |   |          |   |
      --           -----          -----
      function "/" (Left, Right : Asis.Text.Span) return Asis.Text.Span;

      function "/" (Left, Right : Asis.Text.Span) return Asis.Text.Span is
         Tmp : Asis.Text.Span;
      begin
         --  setting the first position
         if Asis.Text."=" (Right, Asis.Text.Nil_Span) then
            Tmp.First_Line := 1;
            Tmp.First_Column := 1;
         else
            Tmp.First_Line := Right.Last_Line;
            Tmp.First_Column := Right.Last_Column;
            Increment_Source_Position
              (Tmp.First_Line, Tmp.First_Column, Element);
         end if;

         --  setting the last position
         Tmp.Last_Line := Left.Last_Line;
         Tmp.Last_Column := Left.Last_Column;

         --  before returning we check that the span is correct
         if (Tmp.First_Line < Tmp.Last_Line) or
            (Tmp.First_Line = Tmp.Last_Line and
             Tmp.First_Column <= Tmp.Last_Column)
         then
            return Tmp;
         else
            return Asis.Text.Nil_Span;
         end if;

      end "/";

      Tmp_Span : Asis.Text.Span := Asis.Text.Nil_Span;

   begin
      --  if the element has already been displayed in Pre_Image
      if State.Handled_In_Pre then
         State.Handled_In_Pre := False;
         return;
      end if;

      if State.Finishing_Traversal then
         --  we use this value for terminate to say that we must display
         --  everything now ....
         Tmp_Span := Asis.Text.Compilation_Span (Element) /
                     State.Last_Printed_Span;
      else
         Tmp_Span := Asis.Text.Element_Span (Element) /
                     State.Last_Printed_Span;
      end if;
      Output_Span (Tmp_Span, State, Element);
   end Post_Image;

   procedure Initiate_Image
     (Element : in     Asis.Element;
      Control : in out Asis.Traverse_Control;
      State   : in out Info_Image) is
   begin
      pragma Unreferenced (Control);
      State.An_Element := Element;
   exception
      when others =>
         Ada.Text_IO.Put_Line ("exception raised in Initiate_Image");
         raise;
   end Initiate_Image;

   procedure Terminate_Image
     (Control : in out Asis.Traverse_Control;
      State : in out Info_Image) is
   begin
      State.Finishing_Traversal := True;
      Post_Image (State.An_Element, Control, State);
   exception
      when others =>
         Ada.Text_IO.Put_Line ("exception raised in Terminate_Image");
         raise;
   end Terminate_Image;

end Image_Trav;
