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
|
-------------------------------------------------------------------------------
--
-- This file is part of AdaBrowse.
--
-- <STRONG>Copyright (c) 2002 by Thomas Wolf.</STRONG>
-- <BLOCKQUOTE>
-- AdaBrowse 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. AdaBrowse 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>
--
-- <DL><DT><STRONG>
-- Author:</STRONG><DD>
-- Thomas Wolf (TW)
-- <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
--
-- <DL><DT><STRONG>
-- Purpose:</STRONG><DD>
-- Formatted output of comments. Note that user-defined tags may be defined
-- in terms of other user-defined tags: we do macro expansion here. However,
-- since we neither do re-scanning (as does e.g. the C pre-processor) nor
-- have macro arguments, this macro substitution remains rather simple.</DL>
--
-- <!--
-- Revision History
--
-- 29-APR-2002 TW Initial version.
-- 17-JUN-2002 TW Complete rewrite to use the new filters.
-- 18-JUN-2002 TW Stripping initial and trailing dash-only line now.
-- 09-JUL-2003 TW Added the 'Format' function for formatting inline
-- comments (i.e. comments within code snippets).
-- -->
-------------------------------------------------------------------------------
pragma License (GPL);
with Ada.Characters.Handling;
with Ada.Unchecked_Deallocation;
with AD.Filters;
-- with AD.Messages;
with Util.Strings;
with Util.Text.Internal;
package body AD.Format is
package UT renames Util.Text;
-- use AD.Messages;
type Node;
type Link is access Node;
type Node is
record
Next : Link;
Name : UT.String_Access;
Program : AD.Filters.Filter_Ref;
end record;
procedure Free is
new Ada.Unchecked_Deallocation (Node, Link);
procedure Free is
new Ada.Unchecked_Deallocation (String, UT.String_Access);
Anchor, Last : Link;
procedure Enter
(Key : in String;
Filter : in AD.Filters.Filter_Ref)
is
P : Link := Anchor;
Q : Link := null;
use type AD.Filters.Filter_Ref;
begin
while P /= null and then P.Name'Length > Key'Length loop
Q := P; P := P.Next;
end loop;
while P /= null and then P.Name'Length = Key'Length and then
P.Name.all /= Key
loop
Q := P; P := P.Next;
end loop;
if P /= null and then P.Name'Length = Key'Length then
-- We already have that key:
AD.Filters.Free (P.Program);
if Filter = null then
if Key = "--" then
-- Removing the default formatting is not allowed!!
P.Program := new AD.Filters.Filter_Standard;
else
-- Oh, we need to remove that key!
if Q /= null then
Q.Next := P.Next;
else
Anchor := P.Next;
end if;
if P = Last then Last := Q; end if;
Free (P.Name);
Free (P);
end if;
else
P.Program := Filter;
end if;
elsif Filter /= null then
-- We don't have that key yet:
P := new Node'(P, new String'(Key), Filter);
if Q = null then
Anchor := P;
else
Q.Next := P;
end if;
if Last = Q then Last := P; end if;
end if;
end Enter;
procedure Format
(Lines : in Asis.Text.Line_List;
The_Printer : access AD.Printers.Printer'Class)
is
use Asis.Text;
use Util.Strings;
use Ada.Characters.Handling;
function Longest_Matching_Prefix
(S : in String)
return Link
is
-- We'll always find something; at the very least the "--" filter.
P : Link := Anchor;
begin
while P /= null and then not Is_Prefix (S, P.Name.all) loop
P := P.Next;
end loop;
return P;
end Longest_Matching_Prefix;
procedure Append
(Line : in String;
Prefix : in Link;
Text : in out UT.Unbounded_String;
Skip_Dashes : in Boolean)
is
First : constant Natural := Line'First + Prefix.Name'Length;
Last : Natural;
begin
if Line'Length >= Prefix.Name'Length + 3 and then
Line (Line'Last - 2 .. Line'Last) = " --"
then
Last := Line'Last - 3;
else
Last := Line'Last;
end if;
if Skip_Dashes then
declare
I : Natural := First;
begin
while I <= Last and then Line (I) = '-' loop
I := I + 1;
end loop;
if I > Last then return; end if;
end;
end if;
while Last >= First and then Is_Blank (Line (Last)) loop
Last := Last - 1;
end loop;
UT.Append (Text, Line (First .. Last) & ASCII.LF);
end Append;
Text : UT.Unbounded_String;
First_Line : Asis.Text.Line_Number;
use type Asis.Text.Line_Number;
begin
-- Split into blocks.
First_Line := Lines'First;
while First_Line <= Lines'Last loop
Text := UT.Null_Unbounded_String;
declare
Prefix : constant Link :=
Longest_Matching_Prefix
(Trim (To_String (Comment_Image (Lines (First_Line)))));
begin
while First_Line <= Lines'Last loop
declare
S : constant String :=
Trim (To_String (Comment_Image (Lines (First_Line))));
begin
-- Debug (S);
if Is_Prefix (S, Prefix.Name.all) and then
Longest_Matching_Prefix (S) = Prefix
then
-- This line belongs to the same block.
Append (S, Prefix, Text,
First_Line = Lines'First or else
First_Line = Lines'Last);
else
exit;
end if;
end;
First_Line := First_Line + 1;
end loop;
-- All right, we have our text block. Now format it:
AD.Filters.Transform (Prefix.Program, Text);
-- And then write it to the file:
declare
Src : constant UT.String_Access := UT.Internal.Get_Ptr (Text);
I : Natural := Src'First;
J : Natural;
begin
while I <= Src'Last loop
J := First_Index (Src (I .. Src'Last), ASCII.LF);
if J = 0 then
AD.Printers.Write_Plain
(The_Printer, Src (I .. Src'Last));
exit;
else
AD.Printers.Write_Plain
(The_Printer, Src (I .. J - 1));
AD.Printers.New_Line (The_Printer);
I := J + 1;
end if;
end loop;
end;
end;
end loop;
end Format;
function Format
(Inline_Comment : in String)
return String
is
Only_Legal : aliased AD.Filters.Filter_Unknown (True);
Shortcuts : aliased AD.Filters.Filter_Shortcut;
HTMLize : aliased AD.Filters.Filter_Plain;
Text : UT.Unbounded_String;
Start : Natural;
First_Char : Natural;
use Util.Strings;
begin
if Inline_Comment'Length <= 2 then return Inline_Comment; end if;
if Is_Prefix (Inline_Comment, "--") then
Start := Inline_Comment'First + 2;
else
Start := Inline_Comment'First;
end if;
First_Char :=
Next_Non_Blank
(Inline_Comment (Start .. Inline_Comment'Last));
if First_Char = 0 then return Inline_Comment; end if;
UT.Set (Text, Trim (Inline_Comment (Start .. Inline_Comment'Last)));
AD.Filters.Transform (Only_Legal'Access, Text);
AD.Filters.Transform (Shortcuts'Access, Text);
AD.Filters.Transform (HTMLize'Access, Text);
if Start > Inline_Comment'First then
return Inline_Comment (Inline_Comment'First .. First_Char - 1) &
UT.To_String (Text);
else
return UT.To_String (Text);
end if;
end Format;
begin
Enter ("--", new AD.Filters.Filter_Standard);
end AD.Format;
|
