------------------------------------------------------------------------------ -- -- -- 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;