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 | with Ada.Characters.Wide_Wide_Latin_1;
with Ada.Containers;
with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
with Ada.Strings.Wide_Wide_Fixed;
with Ada.Strings.Wide_Wide_Unbounded;
with GNAT.IO;
package body AAA.Table_IO is
package Chars renames Ada.Characters.Wide_Wide_Latin_1;
package UTF renames Ada.Strings.UTF_Encoding;
use all type Ada.Containers.Count_Type;
----------------
-- ANSI_Extra --
----------------
function ANSI_Extra (Text : Wide_Wide_String) return Natural is
Counting : Boolean := False;
Extra : Natural := 0;
begin
for Char of Text loop
if Counting then
Extra := Extra + 1;
if Char = 'm' then
Counting := False;
end if;
else
if Char = Chars.ESC then
Counting := True;
Extra := Extra + 1;
end if;
end if;
end loop;
return Extra;
end ANSI_Extra;
-----------------
-- ANSI_Length --
-----------------
function ANSI_Length (Text : Wide_Wide_String) return Natural is
begin
return Text'Length - ANSI_Extra (Text);
end ANSI_Length;
------------
-- Append --
------------
procedure Append (T : in out Table; Cell : String) is
begin
declare
Cell : constant Wide_Wide_String :=
UTF.Wide_Wide_Strings.Decode (Append.Cell);
begin
if T.Rows.Is_Empty then
T.New_Row;
end if;
if Natural (T.Max_Widths.Length) < T.Next_Column then
T.Max_Widths.Append (ANSI_Length (Cell));
else
T.Max_Widths (T.Next_Column) :=
Natural'Max (ANSI_Length (Cell), T.Max_Widths (T.Next_Column));
end if;
T.Rows (Natural (T.Rows.Length)).Append (Cell);
T.Next_Column := T.Next_Column + 1;
end;
end Append;
------------
-- Append --
------------
function Append (T : aliased in out Table; Cell : String) return Reference is
begin
T.Append (Cell);
return Reference'(Table => T'Access);
end Append;
-------------
-- New_Row --
-------------
procedure New_Row (T : in out Table) is
begin
T.Next_Column := 1;
T.Rows.Append (String_Vectors.Empty_Vector);
end New_Row;
----------------
-- Put_Padded --
----------------
function Prepare_Padded (T : Table;
Col : Positive;
Text : Wide_Wide_String;
Align : Ada.Strings.Alignment)
return Wide_Wide_String
is
Field : Wide_Wide_String (1 .. T.Max_Widths (Col) + ANSI_Extra (Text));
begin
Ada.Strings.Wide_Wide_Fixed.Move (Text,
Field,
Drop => Ada.Strings.Error,
Justify => Align);
return Field;
end Prepare_Padded;
-----------
-- Print --
-----------
procedure Print (T : Table;
Separator : String := " ";
Align : Alignments := (1 .. 0 => <>);
Put_Line : access procedure (Line : String) := null)
is
use Ada.Strings.Wide_Wide_Unbounded;
Wide_Separator : constant Wide_Wide_String :=
UTF.Wide_Wide_Strings.Decode (Separator);
begin
for Row of T.Rows loop
declare
Line : Unbounded_Wide_Wide_String;
begin
for I in 1 .. Natural (Row.Length) loop
Append (Line,
Prepare_Padded
(T,
I,
Row (I),
(if Align'Length >= I
then Align (I)
else Ada.Strings.Left)));
if I < Natural (Row.Length) then
Append (Line, Wide_Separator);
else
declare
UTF8_Line : constant String :=
UTF.Wide_Wide_Strings.Encode
(To_Wide_Wide_String (Line));
begin
if Put_Line /= null then
Put_Line (UTF8_Line);
else
GNAT.IO.Put_Line (UTF8_Line);
end if;
end;
end if;
end loop;
end;
end loop;
end Print;
end AAA.Table_IO;
|