------------------------------------------------------------------------------
-- --
-- DISPLAY_SOURCE COMPONENTS --
-- --
-- S T U B _ T R A V --
-- --
-- B o d y --
-- --
-- Copyright (c) 1995-1999, 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_Stub and pop them in Post_Stub.
-- 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;
with Ada.Text_IO;
with Global_Info; use Global_Info;
package body Stub_Trav is
-- 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) 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) 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_Stub that outputs text.
procedure Output_Span (The_Span : Asis.Text.Span;
State : in out Info_Stub;
Element : Asis.Element) is
-- Line_Im is here to handle the With_Comments thing.
-- (see Info_Stub in Stub_trav.ads)
function Line_Im (Line : Asis.Text.Line) return String is
begin
if State.With_Comments
then
return Asis.Text.Line_Stub (Line);
else
return Asis.Text.Non_Comment_Stub (Line);
end if;
end Line_Im;
begin
-- debug info
-- Ada.Text_IO.New_Line;
-- Ada.Text_IO.Put_Line ("Span : (" &
-- Asis.Text.Line_Number'Stub (The_Span.First_Line) &
-- "," &
-- Asis.Text.Character_Position'Stub (The_Span.First_Column) &
-- "), (" &
-- Asis.Text.Line_Number'Stub (The_Span.Last_Line) &
-- "," &
-- Asis.Text.Character_Position'Stub (The_Span.Last_Column) &
-- ")");
-- Ada.Text_IO.Put ("|");
-- if the span is nil, nothing to do.
if "=" (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_Stub 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_Stub
(Element : in Asis.Element;
Control : in out Asis.Elements.Traverse_Control;
State : in out Info_Stub) 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 is
Tmp : Asis.Text.Span;
begin
-- setting the first position
if "=" (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 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 Stub of
-- the current element is displayed.
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 is
Elem_Span : Asis.Text.Span := Asis.Text.Element_Span (Element);
begin
State.Handled_In_Pre := True;
Control := Asis.Elements.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 is
Elem_Span : Asis.Text.Span := Asis.Text.Element_Span (Element);
begin
State.Handled_In_Pre := True;
Control := Asis.Elements.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.Elements.Abandon_Children, this way
-- the next called funtion is Post_Stub of the same element which
-- uses the boolean Handled_In_Pre immediately ...
case Asis.Elements.Element_Kind (Element) is
----------------------------------------------------------------
-- Do what you want here, you can take example on application --
-- display_source -e --
----------------------------------------------------------------
when others =>
null;
end case;
end Pre_Stub;
-----------------------------------------
-- Post_Stub has a simple function : --
-- it displays elements from the last --
-- span to the end of the element. --
-----------------------------------------
procedure Post_Stub
(Element : in Asis.Element;
Control : in out Asis.Elements.Traverse_Control;
State : in out Info_Stub) 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 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 is
Tmp : Asis.Text.Span;
begin
-- setting the first position
if "=" (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_Stub
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_Stub;
procedure Initiate_Stub
(Element : in Asis.Element;
Control : in out Asis.Elements.Traverse_Control;
State : in out Info_Stub) is
begin
State.An_Element := Element;
exception
when others =>
Ada.Text_IO.Put_Line ("exception raised in Initiate_Stub");
raise;
end Initiate_Stub;
procedure Terminate_Stub
(Control : in out Asis.Elements.Traverse_Control;
State : in out Info_Stub) is
begin
State.Finishing_Traversal := True;
Post_Stub (State.An_Element, Control, State);
exception
when others =>
Ada.Text_IO.Put_Line ("exception raised in Terminate_Stub");
raise;
end Terminate_Stub;
end Stub_Trav;
syntax highlighted by Code2HTML, v. 0.9.1