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 | with AAA.ANSI;
with AAA.Debug;
with AAA.Filesystem;
with Ada.Directories;
with Ada.Strings.Unbounded;
package body AAA.Text_IO is
-------------------
-- Put_Paragraph --
-------------------
procedure Put_Paragraph (Text : String;
Line_Width : Line_Widths := Default_Line_Width;
Line_Prefix : String := "";
Filling : Filling_Modes := Greedy;
File : Ada.Text_IO.File_Access :=
Ada.Text_IO.Standard_Output)
is
pragma Unreferenced (Filling);
use Ada.Text_IO;
Pos : Integer := Text'First;
---------------
-- Next_Word --
---------------
function Next_Word return String is
begin
for I in Pos .. Text'Last loop
if Text (I) = ' ' then
return Text (Pos .. I - 1);
elsif Text (I) = '-' then
return Text (Pos .. I);
end if;
end loop;
-- No breaker found...
return Text (Pos .. Text'Last);
end Next_Word;
--------------
-- Put_Line --
--------------
procedure Put_Line is
use Ada.Strings.Unbounded;
Line : Unbounded_String;
-- Doing this with fixed strings and ANSI unknown extra lengths is
-- unnecessary trouble.
----------
-- Used --
----------
function Used return Natural
is (ANSI.Length (To_String (Line)));
PPos : constant Integer := Pos;
-- Initial Pos, to check we had some progress
---------
-- Put --
---------
procedure Put (Word : String) is
begin
Append (Line, Word);
end Put;
begin
-- Set prefix, if it fits
if Line_Prefix'Length < Line_Width - 2 then
Put (Line_Prefix);
end if;
-- Eat words until line is complete
while Used + ANSI.Length (Next_Word) - 1 <= Line_Width loop
Put (Next_Word);
Pos := Pos + Next_Word'Length;
exit when Used > Line_Width or else Pos > Text'Last;
-- Advance on spaces
if Text (Pos) = ' ' then
Put (" ");
Pos := Pos + 1;
end if;
end loop;
-- Forcefully break a word if line is still empty. This won't work
-- with ANSI codes... So don't have too short lines, I guess.
if Pos = PPos then
declare
Remain : constant Positive := Line_Width - Used;
-- Space for text (without counting the '-')
begin
Put (Text (Pos .. Pos + Remain - 1));
Pos := Pos + Remain;
Put ("-");
end;
end if;
-- Final dump to file
Put_Line (File.all, To_String (Line));
-- Eat spaces that would start the next line:
while Pos <= Text'Last and then Text (Pos) = ' ' loop
Pos := Pos + 1;
end loop;
end Put_Line;
begin
-- Trivial case of empty line:
if Text = "" then
New_Line (File.all);
else
-- Regular case:
while Pos <= Text'Last loop
Put_Line;
end loop;
end if;
end Put_Paragraph;
--------------------
-- Put_Paragraphs --
--------------------
procedure Put_Paragraphs (Text : Strings.Vector;
Line_Width : Line_Widths := Default_Line_Width;
Line_Prefix : String := "";
Filling : Filling_Modes := Greedy;
File : Ada.Text_IO.File_Access :=
Ada.Text_IO.Standard_Output)
is
begin
for Line of Text loop
Put_Paragraph (Line, Line_Width, Line_Prefix, Filling, File);
end loop;
end Put_Paragraphs;
------------------
-- Append_Lines --
------------------
procedure Append_Lines (File : String;
Lines : Strings.Vector;
Backup : Boolean := True;
Backup_Dir : String := "")
is
F : AAA.Text_IO.File := Load (File, Backup, Backup_Dir);
begin
F.Lines.Append (Lines);
end Append_Lines;
--------------
-- Finalize --
--------------
overriding
procedure Finalize (This : in out File) is
use Ada.Text_IO;
use type Strings.Vector;
File : File_Type;
begin
if This.Lines = This.Orig then
return;
end if;
declare
Replacer : Filesystem.Replacer :=
Filesystem.New_Replacement (This.Name,
This.Backup,
This.Backup_Dir);
begin
Open (File, Out_File, Replacer.Editable_Name);
for Line of This.Lines loop
Put_Line (File, Line);
end loop;
Close (File);
Replacer.Replace;
end;
exception
when E : others =>
Debug.Put_Exception (E);
end Finalize;
-----------
-- Lines --
-----------
function Lines (This : aliased in out File) return access Strings.Vector
is (This.Lines'Access);
----------
-- Load --
----------
function Load (From : String;
Backup : Boolean := True;
Backup_Dir : String := "")
return File
is
use Ada.Text_IO;
F : File_Type;
Backup_To : constant String :=
(if Backup_Dir /= ""
then Backup_Dir
else Ada.Directories.Containing_Directory (From));
begin
return This : File := (Ada.Finalization.Limited_Controlled with
Length => From'Length,
Backup_Len => Backup_To'Length,
Name => From,
Backup => Backup,
Backup_Dir => Backup_To,
Lines => <>,
Orig => <>)
do
Open (F, In_File, From);
while not End_Of_File (F) loop
This.Orig.Append (Get_Line (F));
end loop;
Close (F);
This.Lines := This.Orig;
end return;
end Load;
end AAA.Text_IO;
|