------------------------------------------------------------------------------
-- --
-- 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;
syntax highlighted by Code2HTML, v. 0.9.1