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
|
-------------------------------------------------------------------------------
--
-- <STRONG>Copyright © 2001, 2002 by Thomas Wolf.</STRONG>
-- <BLOCKQUOTE>
-- This piece of software is free software; you can redistribute it and/or
-- modify it under the terms of the GNU General Public License as published
-- by the Free Software Foundation; either version 2, or (at your option)
-- any later version. This software is distributed in the hope that it will
-- be useful, but <EM>without any warranty</EM>; without even the implied
-- warranty of <EM>merchantability or fitness for a particular purpose.</EM>
-- See the GNU General Public License for more details. You should have
-- received a copy of the GNU General Public License with this distribution,
-- see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-- USA.
-- </BLOCKQUOTE>
-- <BLOCKQUOTE>
-- As a special exception from the GPL, if other files instantiate generics
-- from this unit, or you link this unit with other files to produce an
-- executable, this unit does not by itself cause the resulting executable
-- to be covered by the GPL. This exception does not however invalidate any
-- other reasons why the executable file might be covered by the GPL.
-- </BLOCKQUOTE>
--
-- <AUTHOR>
-- Thomas Wolf (TW) <E_MAIL>
-- </AUTHOR>
--
-- <PURPOSE>
-- General utilities on text files.
-- </PURPOSE>
--
-- <NOT_TASK_SAFE>
--
-- <NO_STORAGE>
--
-- <HISTORY>
-- 02-MAR-2002 TW Initial version.
-- 24-APR-2002 TW Added an EOF test in 'Get_Line' to avoid problems if
-- the last line of a text file is not terminated by a
-- newline and has exactly i*100 characters.
-- </HISTORY>
-------------------------------------------------------------------------------
pragma License (Modified_GPL);
with Util.Strings;
package body Util.Files.Text_IO is
----------------------------------------------------------------------------
procedure Open_File
(File : in out Ada.Text_IO.File_Type;
Mode : in Ada.Text_IO.File_Mode;
Name : in String;
Form : in String := "")
is
use Ada.Text_IO;
procedure Open_It is
new Open_G (File_Type, File_Mode, Open, Create);
begin
Open_It (File, Mode, Name, Form);
end Open_File;
----------------------------------------------------------------------------
function Get_Line
(File : in Ada.Text_IO.File_Type := Ada.Text_IO.Current_Input)
return String
is
Buffer : String (1 .. 100);
Last : Natural;
begin
Ada.Text_IO.Get_Line (File, Buffer, Last);
if Last < Buffer'Last or else Ada.Text_IO.End_Of_File (File) then
return Buffer (1 .. Last);
end if;
return Buffer & Get_Line (File);
end Get_Line;
----------------------------------------------------------------------------
function Default_Skip_String
(S : in String;
Delim : in Character)
return Natural
is
begin
return Util.Strings.Skip_String (S, Delim);
end Default_Skip_String;
-- generic ...
function Next_Line
(File : in Ada.Text_IO.File_Type := Ada.Text_IO.Current_Input)
return String
is
use Util.Strings;
Comment_Start_Length : constant Natural := Comment_Start'Length;
Line_Continuation_Length : constant Natural := Line_Continuation'Length;
function Get_The_Line (File : in Ada.Text_IO.File_Type)
return String
is
Line : constant String := Get_Line (File);
I, J, Last : Natural;
begin -- Get_The_Line
if Line'Last < Line'First then return Line; end if;
-- Strip off comments.
Last := Line'Last;
if Comment_Start_Length > 0 and then
Comment_Start_Length <= Line'Length
then
I := Line'First;
while I <= Line'Last - Comment_Start_Length + 1 loop
if Is_In (Delimiters, Line (I)) then
J := Strings (Line (I .. Line'Last), Line (I));
exit when J = 0; -- Unterminated string
else
J := I;
end if;
if J = I then
-- Either not a string beginning, or not skipped.
if Is_Prefix (Line (I .. Line'Last), Comment_Start) then
Last := I - 1;
exit;
end if;
end if;
I := J + 1;
end loop;
if Last < Line'First then return ""; end if;
end if;
if Line_Continuation_Length > 0 then
-- Check line continuations:
I := Last;
while I >= Line'First and then Is_In (White_Space, Line (I)) loop
I := I - 1;
end loop;
-- Now I is on the last non-white-space character
if I >= Line'First and then
I - Line'First + 1 >= Line_Continuation_Length
then
if Line (I - Line_Continuation_Length + 1 .. I) =
Line_Continuation
then
-- Now check whether we are inside a string here:
J := I - Line_Continuation_Length + 1; I := Line'First;
while I < J loop
if Is_In (Delimiters, Line (I)) then
I := Strings (Line (I .. J - 1), Line (I));
exit when I = 0;
end if;
I := I + 1;
end loop;
if I = J then
-- We have a line continuation!
if Ada.Text_IO.End_Of_File (File) then
-- Next is EOF: stop here.
return Line (Line'First .. J - 1);
else
return Line (Line'First .. J - 1) &
Get_The_Line (File);
end if;
end if;
end if;
end if;
end if;
-- Sorry, this is not a line continuation!
return Line (Line'First .. Last);
end Get_The_Line;
begin -- Next_Line
if Suppress_Blank_Lines then
if Ada.Text_IO.End_Of_File (File) then
raise Ada.Text_IO.End_Error;
end if;
begin
loop
declare
Line : constant String := Get_The_Line (File);
begin
if Trim (Line)'Length > 0 then return Line; end if;
end;
end loop;
exception
when Ada.Text_IO.End_Error =>
-- We were *not* at EOF initially, but had only blank (or
-- comment) lines in the rest of the file.
return "";
end;
else
return Get_The_Line (File);
end if;
end Next_Line;
----------------------------------------------------------------------------
end Util.Files.Text_IO;
|
