1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381
|
------------------------------------------------------------------------------
-- --
-- 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;
|