------------------------------------------------------------------------------ -- -- -- DISPLAY_SOURCE COMPONENTS -- -- -- -- D I S P L A Y _ S O U R C E -- -- -- -- B o d y -- -- -- -- Copyright (c) 1995-2000, 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 procedure is the main procedure of the -- -- ASIS application display_source -- -------------------------------------------------- -- -- Authors of the original version (April 1996): -- Jean-Charles Marteau (marteau@sema-grenoble.fr) -- Serge Reboul ( reboul@sema-grenoble.fr) -- -- -- More explanations are writen in the functionality packages. -- -- YHSTAH means that You Have Something To Add Here -- when you want to create a new application, see -- new_application.txt in ./Docs for more information -- with Ada; with Ada.Command_Line; with Ada.Exceptions; with Ada.Text_IO; use Ada.Text_IO; with Ada.Characters.Handling; with Asis; with Asis.Iterator; with Asis.Elements; with Asis.Exceptions; with Asis.Compilation_Units; with Asis.Ada_Environments; with Asis.Implementation; -- definitions of the working modes and -- declaration of the global variable The_Mode. with Global_Info; use Global_Info; -- functionality packages with Node_Trav; use Node_Trav; with Source_Trav; use Source_Trav; with Image_Trav; use Image_Trav; procedure Display_Source is -- Instanciations of traverse_element -- There is, for now, 3 kinds of applications, so there is 3 -- instanciations. There is more than 3 modes, but in fact -- the modes are grouped under more general modes and -- the differing modes of a same group are used only in -- the application type. procedure Traverse_Node is new Asis.Iterator.Traverse_Element (Info_Node, Pre_Procedure, Post_Procedure); procedure Traverse_Source is new Asis.Iterator.Traverse_Element (Info_Source, Pre_Source, Post_Source); procedure Traverse_Image is new Asis.Iterator.Traverse_Element (Info_Image, Pre_Image, Post_Image); function Is_Ads (File : String) return Boolean; -- ??? procedure Process (Element : in Asis.Element; Control : in out Asis.Traverse_Control; State_Source : in out Info_Source; State_Node : in out Info_Node; State_Image : in out Info_Image); -- YHSTAH -- ??? function Main_Name (File : String) return Wide_String; -- ??? -- YHSTAH -- Silly functions, just to help ... function Is_Ads (File : String) return Boolean is begin return File (File'Last - 3 .. File'Last) = ".ads" or else File (File'Last - 3 .. File'Last) = ".ADS"; end Is_Ads; function Main_Name (File : String) return Wide_String is -- ??? begin return Ada.Characters.Handling.To_Wide_String (File (File'First .. File'Last - 4)); end Main_Name; procedure Process (Element : in Asis.Element; Control : in out Asis.Traverse_Control; State_Source : in out Info_Source; State_Node : in out Info_Node; State_Image : in out Info_Image -- YHSTAH ) is begin case The_Mode is when Node_Modes => Traverse_Node (Element, Control, State_Node); when Source_Modes => Traverse_Source (Element, Control, State_Source); when Image_Modes => Traverse_Image (Element, Control, State_Image); -- YHSTAH end case; end Process; -- Some global variables. The_DS_Context : Asis.Context; The_Unit : Asis.Compilation_Unit; The_Declaration : Asis.Declaration; The_Control : Asis.Traverse_Control := Asis.Continue; Command_File : Positive := 2; -- index of the command parameter where the filename is. The_Source_Information : Info_Source; The_Node_Information : Info_Node; The_Image_Information : Info_Image; -- YHSTAH -- display_source body -- begin -- First we analysis the command line -- Is there enough parameters ? if Ada.Command_Line.Argument_Count not in 1 .. 2 then Put_Line ("USAGE: " & Ada.Command_Line.Command_Name & " [-n|-s|-i|-e] Unit[.ads|.adb]"); Put_Line (" : " & Ada.Command_Line.Command_Name & " -h"); return; end if; -- What parameters ? if Ada.Command_Line.Argument (1) = "-n" then The_Mode := Node; elsif Ada.Command_Line.Argument (1) = "-l" then The_Mode := Node_And_Lines; elsif Ada.Command_Line.Argument (1) = "-s" then The_Mode := Source; elsif Ada.Command_Line.Argument (1) = "-e" then The_Mode := Image_And_Example; elsif Ada.Command_Line.Argument (1) = "-t" then The_Mode := Test_Control; elsif Ada.Command_Line.Argument (1) = "-i" then The_Mode := Image; -- YHSTAH elsif Ada.Command_Line.Argument (1) = "-h" then Put_Line ("Functionalities available in display_source :"); Put_Line ("---------------------------------------------"); New_Line; Put_Line ("USAGE: " & Ada.Command_Line.Command_Name & " [-n|-s|-i|-e] Unit[.ads|.adb]"); Put_Line (" : " & Ada.Command_Line.Command_Name & " -h"); New_Line; Put_Line (" -n displays all the node of the source in their"); Put_Line (" order of appearance."); Put_Line (" -s re-displays the source, after having been"); Put_Line (" completely processed by Asis. This functionality"); Put_Line (" tends to be a code formatter, but for now, just"); Put_Line (" keeps your sources the way you typed them ..."); Put_Line (" This is the default option."); Put_Line (" -i re-displays the source, and processes all elements."); Put_Line (" like '-s' option, but the re-displaying is based on"); Put_Line (" Asis.Text features, so you have the same aspect than"); Put_Line (" the original source."); Put_Line (" -e is like '-i' option but it is a sample application"); Put_Line (" that works on pragmas."); Put_Line (" (see image_trav.ads|b for mode details"); -- YHSTAH Put_Line (" -h displays this help text"); New_Line; return; elsif Ada.Command_Line.Argument (1)(1) = '-' or Ada.Command_Line.Argument (1)'Length <= 4 then -- if the filename is not appropriate -- this will raise an error after ... Command_File := Positive'Last; else -- This is the default mode ... The_Mode := Source; Command_File := 1; end if; if Command_File > Ada.Command_Line.Argument_Count or else Ada.Command_Line.Argument (Command_File)'Length <= 4 then -- Indeed there is a problem, so we exit Put_Line ("USAGE: " & Ada.Command_Line.Command_Name & " [-n|-s|-i|-e] Unit[.ads|.adb]"); Put_Line (" : " & Ada.Command_Line.Command_Name & " -h"); return; end if; -- Initialization of Asis environment. Asis.Implementation.Initialize; Asis.Ada_Environments.Associate (The_Context => The_DS_Context, Name => "The_DS_Context", Parameters => "-FS"); Asis.Ada_Environments.Open (The_DS_Context); ------------------------------ declare Unite : String := Ada.Command_Line.Argument (Command_File); begin -- Converting file name in Ada Unit Name -- first let's change the '-' in '.' in the filename for Index in Unite'Range loop if Unite (Index) = '-' then Unite (Index) := '.'; end if; end loop; -- let's load and compile the unit... if Is_Ads (Unite) then The_Unit := Asis.Compilation_Units.Library_Unit_Declaration (Main_Name (Unite), The_DS_Context); else The_Unit := Asis.Compilation_Units.Compilation_Unit_Body (Main_Name (Unite), The_DS_Context); end if; -- If it's null, continuing makes no sense ... if (Asis.Compilation_Units.Is_Nil (The_Unit)) then Put_Line ("Unit " & Unite & " is Nil..."); Asis.Ada_Environments.Close (The_DS_Context); raise Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit; end if; -- Now we'll process the context clauses and pragmas The_Control := Asis.Continue; declare Clause_List : Asis.Context_Clause_List := Asis.Elements.Context_Clause_Elements (The_Unit, True); begin for Each_Clause in Clause_List'Range loop Process (Clause_List (Each_Clause), The_Control, The_Source_Information, The_Node_Information, The_Image_Information -- YHSTAH ); end loop; end; -- and now the main unit declaration The_Declaration := Asis.Elements.Unit_Declaration (The_Unit); -- Initialization, depending on the application case The_Mode is when Node_Modes => Initiate_Node (The_Unit, The_Control, The_Node_Information); when Source_Modes => Initiate_Source (The_Unit, Unite, The_Control, The_Source_Information); when Image_Modes => Initiate_Image (The_Declaration, The_Control, The_Image_Information); -- YHSTAH end case; end; -- we don't need unit anymore ... -- Now we traverse the declaration ... Process (The_Declaration, The_Control, The_Source_Information, The_Node_Information, The_Image_Information -- YHSTAH ); -- Termination, depending on the application case The_Mode is when Node_Modes => Terminate_Node (The_Control, The_Node_Information); when Source_Modes => Terminate_Source (The_Control, The_Source_Information); when Image_Modes => Terminate_Image (The_Control, The_Image_Information); -- YHSTAH end case; ------------------------------ -- Closing Asis .... Asis.Ada_Environments.Close (The_DS_Context); Asis.Ada_Environments.Dissociate (The_DS_Context); Asis.Implementation.Finalize (""); -- let's delete the *.at? and *.ali files declare To_Erase : String := Ada.Command_Line.Argument (Command_File); File : File_Type; begin if To_Erase (To_Erase'Last - 3 .. To_Erase'Last - 1) = ".ad" or else To_Erase (To_Erase'Last - 3 .. To_Erase'Last - 1) = ".AD" then -- tree file To_Erase (To_Erase'Last) := 't'; Open (File, Out_File, To_Erase); Delete (File); -- ali file To_Erase (To_Erase'Last - 2 .. To_Erase'Last) := "ali"; Open (File, Out_File, To_Erase); Delete (File); end if; end; exception when Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit => Put_Line ("The file " & Ada.Command_Line.Argument (Command_File) & " does not contain any Ada Unit."); New_Line; Put_Line ("USAGE: " & Ada.Command_Line.Command_Name & " [-n|-s] Unit[.ads|.adb]"); Put_Line (" : " & Ada.Command_Line.Command_Name & " -h"); raise; when Asis.Exceptions.ASIS_Failed | Asis.Exceptions.ASIS_Inappropriate_Element | Asis.Exceptions.ASIS_Inappropriate_Context => Put_Line (Ada.Characters.Handling.To_String (Asis.Implementation.Diagnosis)); -- ??? raise; when Node_Stack.Stack_Error => raise; when The_Error : others => Put_Line ("The exception received : " & Ada.Exceptions.Exception_Name (The_Error)); Put_Line (Ada.Characters.Handling.To_String (Asis.Implementation.Diagnosis)); raise; end Display_Source;