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
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
|
------------------------------------------------------------------------------
-- --
-- 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;
|
