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 | -- PragmAda Reusable Component (PragmARC)
-- Copyright (C) 2016 by PragmAda Software Engineering. All rights reserved.
-- **************************************************************************
--
-- History:
-- 2016 Jun 01 J. Carter V2.1--Added license text, corrected Skip_Line, and set EOL per file
-- 2016 Mar 01 J. Carter V2.0--Use Sequential_IO so no extra EOLs when a file is closed
-- 2016 Feb 15 J. Carter V1.0--Initial version
--
with Ada.Characters.Latin_1;
with Ada.IO_Exceptions;
package body PragmARC.Text_IO is
DOS_Windows_String : constant String := Ada.Characters.Latin_1.CR & Ada.Characters.Latin_1.LF;
Mac_String : constant String := Ada.Characters.Latin_1.CR & "";
Unix_String : constant String := Ada.Characters.Latin_1.LF & "";
procedure Create (File : in out File_Handle;
Name : in String := "";
Mode : in Character_IO.File_Mode := Out_File;
Form : in String := "";
EOL : in EOL_ID := DOS_Windows_EOL)
is
-- Empty
begin -- Create
Character_IO.Create (File => File.File, Name => Name, Mode => Mode, Form => Form);
File.Empty := True;
File.EOL := EOL;
end Create;
procedure Open (File : in out File_Handle;
Name : in String;
Mode : in Character_IO.File_Mode := In_File;
Form : in String := "";
EOL : in EOL_ID := DOS_Windows_EOL)
is
-- Empty
begin -- Open
Character_IO.Open (File => File.File, Name => Name, Mode => Mode, Form => Form);
File.Empty := True;
File.EOL := EOL;
end Open;
procedure Close (File : in out File_Handle) is
-- Empty
begin -- Close
Character_IO.Close (File => File.File);
end Close;
function Is_Open (File : File_Handle) return Boolean is
-- Empty
begin -- Is_Open
return Character_IO.Is_Open (File.File);
end Is_Open;
procedure New_Line (File : in out File_Handle; Spacing : in Positive := 1) is
function EOL_String return String;
-- Returns the EOL string for File.EOL
function EOL_String return String is
-- Empty
begin -- EOL_String
case File.EOL is
when DOS_Windows_EOL =>
return DOS_Windows_String;
when Mac_EOL =>
return Mac_String;
when Unix_EOL =>
return Unix_String;
end case;
end EOL_String;
EOL : constant String := EOL_String;
begin -- New_Line
All_Lines : for I in 1 .. Spacing loop
All_Characters : for J in EOL'Range loop
Character_IO.Write (File => File.File, Item => EOL (J) );
end loop All_Characters;
end loop All_Lines;
end New_Line;
function Get_C (File : File_Handle) return Character;
-- Gets the next Character from File, including EOL Characters
procedure Put_Back_C (File : in out File_Handle; Item : in Character);
-- Makes Item the Character that Get_C will return next
procedure Skip_Line (File : in out File_Handle; Spacing : in Positive := 1) is
Char1 : Character;
Char2 : Character;
EOF : Boolean := True; -- Indicates if End_Error should be reraised
begin -- Skip_Line
All_Lines : for I in 1 .. Spacing loop
Find_EOL : loop
Char1 := Get_C (File);
EOF := I < Spacing;
exit Find_EOL when Char1 = Ada.Characters.Latin_1.LF;
if Char1 = Ada.Characters.Latin_1.CR then
Char2 := Get_C (File);
if Char2 /= Ada.Characters.Latin_1.LF then
Put_Back_C (File => File, Item => Char2);
end if;
exit Find_EOL;
end if;
end loop Find_EOL;
end loop All_Lines;
exception -- Skip_Line
when Ada.IO_Exceptions.End_Error =>
if EOF then
raise;
end if;
-- Otherwise we have a final line without a line terminator, or with a Mac line terminator, and we've skipped that line
end Skip_Line;
function End_Of_Line (File : File_Handle) return Boolean is
Char : constant Character := Get_C (File);
begin -- End_Of_Line
Put_Back_C (File => File.Handle.Ptr.all, Item => Char);
return Char = Ada.Characters.Latin_1.CR or Char = Ada.Characters.Latin_1.LF;
end End_Of_Line;
function End_Of_File (File : File_Handle) return Boolean is
-- Empty
begin -- End_Of_File
return Character_IO.End_Of_File (File => File.File);
end End_Of_File;
procedure Get (File : in out File_Handle; Item : out Character) is
Char : Character;
begin -- Get
Find_Item : loop
Item := Get_C (File);
exit Find_Item when Item /= Ada.Characters.Latin_1.CR and Item /= Ada.Characters.Latin_1.LF;
if Item = Ada.Characters.Latin_1.CR then -- Mac or DOS/Windows EOL
Char := Get_C (File); -- Check for DOS/Windows EOL
if Char /= Ada.Characters.Latin_1.LF then
Put_Back_C (File => File, Item => Char);
end if;
end if;
end loop Find_Item;
end Get;
procedure Put (File : in out File_Handle; Item : in Character) is
-- Empty
begin -- Put
Character_IO.Write (File => File.File, Item => Item);
end Put;
procedure Get (File : in out File_Handle; Item : out String) is
-- Empty
begin -- Get
Get_All : for I in Item'Range loop
Get (File => File, Item => Item (I) ); -- Not Get_C, because that will include EOLs
end loop Get_All;
end Get;
procedure Put (File : in out File_Handle; Item : in String) is
-- Empty
begin -- Put
All_Characters : for I in Item'Range loop
Character_IO.Write (File => File.File, Item => Item (I) );
end loop All_Characters;
end Put;
function Get_Line (File : File_Handle) return String is
Line : String (1 .. 1000);
Last : Natural;
begin -- Get_Line
Get_Line (File => File.Handle.Ptr.all, Item => Line, Last => Last);
if Last < Line'Last then
return Line (Line'First .. Last);
end if;
return Line & Get_Line (File);
end Get_Line;
procedure Get_Line (File : in out File_Handle; Item : out String; Last : out Natural) is
-- Empty
begin -- Get_Line
Last := Item'First - 1;
Get_Characters : for I in Item'Range loop
if End_Of_Line (File) then
Skip_Line (File => File);
return;
end if;
Item (I) := Get_C (File);
Last := I;
end loop Get_Characters;
exception -- Get_Line
when Ada.IO_Exceptions.End_Error =>
if Last < Item'First then
raise;
end if; -- Otherwise we have a final line without a line terminator, and that line is in Item (Item'First .. Last)
end Get_Line;
procedure Put_Line (File : in out File_Handle; Item : in String) is
-- Empty
begin -- Put_Line
Put (File => File, Item => Item);
New_Line (File => File);
end Put_Line;
function Get_C (File : File_Handle) return Character is
F : File_Handle renames File.Handle.Ptr.all;
Result : Character;
begin -- Get_C
if F.Empty then
Character_IO.Read (File => F.File, Item => Result);
else
Result := F.Buffer;
F.Empty := True;
end if;
return Result;
end Get_C;
procedure Put_Back_C (File : in out File_Handle; Item : in Character) is
-- Empty
begin -- Put_Back_C
if not File.Empty then
raise Program_Error with "Put_Back_C: Buffer not empty";
end if;
File.Buffer := Item;
File.Empty := False;
end Put_Back_C;
end PragmARC.Text_IO;
--
-- This 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.
-- This software is distributed in the hope that it will be useful, but WITH
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-- for more details. Free Software Foundation, 59 Temple Place - Suite
-- 330, Boston, MA 02111-1307, USA.
--
-- As a special exception, 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 GNU General Public License. This exception does not
-- however invalidate any other reasons why the executable file might be
-- covered by the GNU Public License.
|