3
3
* v. 2.0. If a copy of the MPL was not distributed with this file, You can
4
4
* obtain one at https://mozilla.org/MPL/2.0/
5
5
*
6
- * Copyright (C) 2012-2021 , Peter Johnson (gravatar.com/delphidabbler).
6
+ * Copyright (C) 2012-2022 , Peter Johnson (gravatar.com/delphidabbler).
7
7
*
8
8
* Implements class that renders active text as plain text in fixed width, word
9
9
* wrapped paragraphs.
15
15
interface
16
16
17
17
uses
18
- SysUtils,
19
- ActiveText.UMain;
18
+ SysUtils, Generics.Collections,
19
+ ActiveText.UMain,
20
+ UConsts;
20
21
21
22
type
22
23
TActiveTextTextRenderer = class (TObject)
24
+ public
25
+ const
26
+ // / <summary>Special space character used to indicate the start of a list
27
+ // / item.</summary>
28
+ // / <remarks>This special character is a necessary kludge because some
29
+ // / c odethat renders active text as formatted plain text strips away
30
+ // / leading #32 characters as part of the formatting process. Therefore
31
+ // / indentation in list items is lost if #32 characters are used for it.
32
+ // / NBSP was chosen since it should render the same as a space if calling
33
+ // / code doesn't convert it.</remarks>
34
+ LISpacer = NBSP; // Do not localise. Must be <> #32
35
+ // / <summary>Bullet character used when rendering unordered list items.
36
+ // / </summary>
37
+ Bullet = ' *' ; // Do not localise. Must be <> #32 and <> LISpacer
23
38
strict private
39
+ const
40
+ IndentDelta = 2 ;
41
+ type
42
+ TListKind = (lkNumber, lkBullet);
43
+ TListState = record
44
+ public
45
+ ListNumber: Cardinal;
46
+ ListKind: TListKind;
47
+ constructor Create(AListKind: TListKind);
48
+ end ;
49
+ TLIState = record
50
+ IsFirstPara: Boolean;
51
+ constructor Create(AIsFirstPara: Boolean);
52
+ end ;
24
53
var
25
54
fDisplayURLs: Boolean;
26
- fInBlock: Boolean;
27
55
fParaBuilder: TStringBuilder;
28
56
fDocBuilder: TStringBuilder;
57
+ fBlocksStack: TStack<TActiveTextActionElemKind>;
58
+ fListStack: TStack<TListState>;
59
+ fLIStack: TStack<TLIState>;
60
+ fIndent: UInt16;
61
+ fInPara: Boolean;
62
+ fInListItem: Boolean;
63
+ function CanEmitInline : Boolean;
64
+ procedure AppendToPara (const AText: string);
29
65
procedure InitialiseRender ;
30
66
procedure FinaliseRender ;
31
67
procedure OutputParagraph ;
32
68
procedure RenderTextElem (Elem: IActiveTextTextElem);
33
69
procedure RenderBlockActionElem (Elem: IActiveTextActionElem);
34
70
procedure RenderInlineActionElem (Elem: IActiveTextActionElem);
35
71
procedure RenderURL (Elem: IActiveTextActionElem);
72
+ function Render (ActiveText: IActiveText): string;
36
73
public
37
74
constructor Create;
38
75
destructor Destroy; override;
39
76
property DisplayURLs: Boolean read fDisplayURLs write fDisplayURLs
40
77
default False;
41
- function Render (ActiveText: IActiveText): string;
78
+ function RenderWrapped (ActiveText: IActiveText; const PageWidth, LMargin,
79
+ ParaOffset: Cardinal; const Prefix: string = ' ' ;
80
+ const Suffix: string = ' ' ): string;
42
81
end ;
43
82
44
83
45
84
implementation
46
85
47
86
uses
87
+ // Delphi
88
+ Character,
89
+ // Project
90
+ UIStringList,
48
91
UStrUtils;
49
92
50
93
{ TActiveTextTextRenderer }
51
94
95
+ procedure TActiveTextTextRenderer.AppendToPara (const AText: string);
96
+ begin
97
+ if AText = ' ' then
98
+ Exit;
99
+ fParaBuilder.Append(AText);
100
+ fInPara := True;
101
+ end ;
102
+
103
+ function TActiveTextTextRenderer.CanEmitInline : Boolean;
104
+ begin
105
+ if fBlocksStack.Count <= 0 then
106
+ Exit(False);
107
+ Result := TActiveTextElemCaps.CanContainText(fBlocksStack.Peek);
108
+ end ;
109
+
52
110
constructor TActiveTextTextRenderer.Create;
53
111
begin
112
+ Assert(LISpacer <> ' ' , ClassName + ' .Create: LISpacer can'' t be #32' );
113
+ Assert(Bullet <> ' ' , ClassName + ' .Create: Bullet can'' t be #32' );
114
+ Assert(Bullet <> LISpacer, ClassName + ' .Create: Bullet = LISpacer' );
54
115
inherited Create;
55
116
fParaBuilder := TStringBuilder.Create;
56
117
fDocBuilder := TStringBuilder.Create;
57
118
fDisplayURLs := False;
119
+ fBlocksStack := TStack<TActiveTextActionElemKind>.Create;
120
+ fListStack := TStack<TListState>.Create;
121
+ fLIStack := TStack<TLIState>.Create;
122
+ fIndent := 0 ;
123
+ fInPara := False;
124
+ fInListItem := False;
58
125
end ;
59
126
60
127
destructor TActiveTextTextRenderer.Destroy;
61
128
begin
129
+ fLIStack.Free;
130
+ fListStack.Free;
131
+ fBlocksStack.Free;
62
132
fDocBuilder.Free;
63
133
fParaBuilder.Free;
64
134
inherited ;
@@ -76,11 +146,33 @@ procedure TActiveTextTextRenderer.InitialiseRender;
76
146
end ;
77
147
78
148
procedure TActiveTextTextRenderer.OutputParagraph ;
149
+ var
150
+ LIState: TLIState;
79
151
begin
80
152
if fParaBuilder.Length = 0 then
81
153
Exit;
82
- fDocBuilder.AppendLine(StrTrim(fParaBuilder.ToString));
154
+ fDocBuilder.Append(StrOfChar(NBSP, fIndent));
155
+ if fInListItem and not fLIStack.Peek.IsFirstPara then
156
+ // Do we need fInListItem? - test for non-empty list stack?
157
+ // if we do need it, put it on list stack
158
+ fDocBuilder.Append(StrOfChar(NBSP, IndentDelta));
159
+ if fLIStack.Count > 0 then
160
+ begin
161
+ if not fLIStack.Peek.IsFirstPara then
162
+ begin
163
+ fDocBuilder.Append(StrOfChar(NBSP, IndentDelta));
164
+ end
165
+ else
166
+ begin
167
+ // Update item at top of stack
168
+ LIState := fLIStack.Pop;
169
+ LIState.IsFirstPara := False;
170
+ fLIStack.Push(LIState);
171
+ end ;
172
+ end ;
173
+ fDocBuilder.AppendLine(StrTrimRight(fParaBuilder.ToString));
83
174
fParaBuilder.Clear;
175
+ fInPara := False;
84
176
end ;
85
177
86
178
function TActiveTextTextRenderer.Render (ActiveText: IActiveText): string;
@@ -90,7 +182,6 @@ function TActiveTextTextRenderer.Render(ActiveText: IActiveText): string;
90
182
ActionElem: IActiveTextActionElem;
91
183
begin
92
184
InitialiseRender;
93
- fInBlock := False;
94
185
for Elem in ActiveText do
95
186
begin
96
187
if Supports(Elem, IActiveTextTextElem, TextElem) then
@@ -109,42 +200,212 @@ function TActiveTextTextRenderer.Render(ActiveText: IActiveText): string;
109
200
110
201
procedure TActiveTextTextRenderer.RenderBlockActionElem (
111
202
Elem: IActiveTextActionElem);
203
+ var
204
+ ListState: TListState;
112
205
begin
113
206
case Elem.State of
114
207
fsOpen:
115
208
begin
116
- fInBlock := True;
209
+ fBlocksStack.Push(Elem.Kind);
210
+ case Elem.Kind of
211
+ ekPara: { Do nothing} ;
212
+ ekHeading: { Do nothing} ;
213
+ ekUnorderedList:
214
+ begin
215
+ if (fListStack.Count > 0 ) and (fInPara) then
216
+ OutputParagraph;
217
+ fListStack.Push(TListState.Create(lkBullet));
218
+ Inc(fIndent, IndentDelta);
219
+ end ;
220
+ ekOrderedList:
221
+ begin
222
+ if (fListStack.Count > 0 ) and (fInPara) then
223
+ OutputParagraph;
224
+ fListStack.Push(TListState.Create(lkNumber));
225
+ Inc(fIndent, IndentDelta);
226
+ end ;
227
+ ekListItem:
228
+ begin
229
+ // Update list number of current list
230
+ ListState := fListStack.Pop;
231
+ Inc(ListState.ListNumber, 1 );
232
+ fListStack.Push(ListState);
233
+ // Push this list item to list item stack
234
+ fLIStack.Push(TLIState.Create(True));
235
+ // Act depending on current list kind
236
+ case fListStack.Peek.ListKind of
237
+ lkNumber:
238
+ begin
239
+ // Number list: start a new numbered item, with current number
240
+ fParaBuilder.Append(IntToStr(fListStack.Peek.ListNumber));
241
+ fParaBuilder.Append(NBSP);
242
+ end ;
243
+ lkBullet:
244
+ begin
245
+ // Bullet list: start a new bullet point
246
+ fParaBuilder.Append(Bullet + NBSP);
247
+ end ;
248
+ end ;
249
+ end ;
250
+ end ;
117
251
end ;
118
252
fsClose:
119
253
begin
120
- OutputParagraph;
121
- fInBlock := False;
254
+ case Elem.Kind of
255
+ ekPara:
256
+ OutputParagraph;
257
+ ekHeading:
258
+ OutputParagraph;
259
+ ekUnorderedList:
260
+ begin
261
+ OutputParagraph;
262
+ fListStack.Pop;
263
+ Dec(fIndent, IndentDelta);
264
+ end ;
265
+ ekOrderedList:
266
+ begin
267
+ OutputParagraph;
268
+ fListStack.Pop;
269
+ Dec(fIndent, IndentDelta);
270
+ end ;
271
+ ekListItem:
272
+ begin
273
+ OutputParagraph;
274
+ fInListItem := False;
275
+ fLIStack.Pop;
276
+ end ;
277
+ end ;
278
+ fBlocksStack.Pop;
122
279
end ;
123
280
end ;
124
281
end ;
125
282
126
283
procedure TActiveTextTextRenderer.RenderInlineActionElem (
127
284
Elem: IActiveTextActionElem);
128
285
begin
129
- if not fInBlock then
286
+ if not CanEmitInline then
130
287
Exit;
131
288
if (Elem.Kind = ekLink) and (Elem.State = fsClose) and fDisplayURLs then
132
289
RenderURL(Elem);
290
+ // else ignore element: formatting elements have no effect on plain text
133
291
end ;
134
292
135
293
procedure TActiveTextTextRenderer.RenderTextElem (Elem: IActiveTextTextElem);
294
+ var
295
+ TheText: string;
136
296
begin
137
- if not fInBlock then
297
+ if not CanEmitInline then
138
298
Exit;
139
- fParaBuilder.Append(Elem.Text);
299
+ TheText := Elem.Text;
300
+ // no white space emitted after block start until 1st non-white space
301
+ // character encountered
302
+ if not fInPara then
303
+ TheText := StrTrimLeft(Elem.Text);
304
+ if TheText = ' ' then
305
+ Exit;
306
+ AppendToPara(TheText);
140
307
end ;
141
308
142
309
procedure TActiveTextTextRenderer.RenderURL (Elem: IActiveTextActionElem);
143
310
resourcestring
144
311
sURL = ' (%s)' ; // formatting for URLs from hyperlinks
145
312
begin
146
313
Assert(Elem.Kind = ekLink, ClassName + ' .RenderURL: Not a link element' );
147
- fParaBuilder.AppendFormat(sURL, [Elem.Attrs[TActiveTextAttrNames.Link_URL]]);
314
+ AppendToPara(Format(sURL, [Elem.Attrs[TActiveTextAttrNames.Link_URL]]));
315
+ end ;
316
+
317
+ function TActiveTextTextRenderer.RenderWrapped (ActiveText: IActiveText;
318
+ const PageWidth, LMargin, ParaOffset: Cardinal; const Prefix, Suffix: string):
319
+ string;
320
+ var
321
+ Paras: IStringList;
322
+ Para: string;
323
+ ParaIndent: UInt16;
324
+ WrappedPara: string;
325
+ Offset: Int16;
326
+
327
+ // Calculate indent of paragraph by counting LISpacer characters inserted by
328
+ // Render method
329
+ function CalcParaIndent : UInt16;
330
+ var
331
+ Ch: Char;
332
+ begin
333
+ Result := 0 ;
334
+ for Ch in Para do
335
+ begin
336
+ if Ch <> LISpacer then
337
+ Break;
338
+ Inc(Result);
339
+ end ;
340
+ end ;
341
+
342
+ // Calculate if we are currently processing a list item by detecting Bullet,
343
+ // digits and LISpacer characters inserted by Render method
344
+ function IsListItem : Boolean;
345
+ var
346
+ Remainder: string;
347
+ Digits: string;
348
+ Ch: Char;
349
+ begin
350
+ Result := False;
351
+ // Strip any leading spacer chars from start of para
352
+ Remainder := StrTrimLeftChars(Para, LISpacer);
353
+ // Check for bullet list: starts with bullet character then spacer
354
+ if StrStartsStr(Bullet + LISpacer, Remainder) then
355
+ Exit(True);
356
+ // Check for number list: starts with digit(s) then spacer
357
+ Digits := ' ' ;
358
+ for Ch in Remainder do
359
+ if TCharacter.IsDigit(Ch) then
360
+ Digits := Digits + Ch
361
+ else
362
+ Break;
363
+ if (Digits <> ' ' ) and
364
+ StrStartsStr(Digits + LISpacer, Remainder) then
365
+ Exit(True);
366
+ end ;
367
+
368
+ begin
369
+ Result := ' ' ;
370
+ Paras := TIStringList.Create(Prefix + Render(ActiveText) + Suffix, EOL, True);
371
+ for Para in Paras do
372
+ begin
373
+ if IsListItem then
374
+ begin
375
+ Offset := -ParaOffset;
376
+ ParaIndent := CalcParaIndent + LMargin + ParaOffset;
377
+ end
378
+ else
379
+ begin
380
+ Offset := 0 ;
381
+ ParaIndent := CalcParaIndent + LMargin;
382
+ end ;
383
+ WrappedPara := StrWrap(
384
+ StrReplace(Para, LISpacer, ' ' ),
385
+ PageWidth - ParaIndent,
386
+ ParaIndent,
387
+ Offset
388
+ );
389
+ if Result <> ' ' then
390
+ Result := Result + EOL;
391
+ Result := Result + StrTrimRight(WrappedPara);
392
+ end ;
393
+ Result := StrTrimRight(Result);
394
+ end ;
395
+
396
+ { TActiveTextTextRenderer.TListState }
397
+
398
+ constructor TActiveTextTextRenderer.TListState.Create(AListKind: TListKind);
399
+ begin
400
+ ListNumber := 0 ;
401
+ ListKind := AListKind;
402
+ end ;
403
+
404
+ { TActiveTextTextRenderer.TLIState }
405
+
406
+ constructor TActiveTextTextRenderer.TLIState.Create(AIsFirstPara: Boolean);
407
+ begin
408
+ IsFirstPara := AIsFirstPara;
148
409
end ;
149
410
150
411
end .
0 commit comments