← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/utils/fpdoc/dwriter.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/utils/fpdoc/dwriter.pp
 
1
{
 
2
 
 
3
    FPDoc  -  Free Pascal Documentation Tool
 
4
    Copyright (C) 2000 - 2003 by
 
5
      Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org
 
6
 
 
7
    * Output string definitions
 
8
    * Basic writer (output generator) class
 
9
 
 
10
    See the file COPYING, included in this distribution,
 
11
    for details about the copyright.
 
12
 
 
13
    This program is distributed in the hope that it will be useful,
 
14
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
15
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
16
}
 
17
 
 
18
 
 
19
unit dWriter;
 
20
 
 
21
{$MODE objfpc}
 
22
{$H+}
 
23
 
 
24
interface
 
25
 
 
26
uses Classes, DOM, dGlobals, PasTree, SysUtils;
 
27
 
 
28
resourcestring
 
29
  SErrFileWriting = 'An error occured during writing of file "%s": %s';
 
30
 
 
31
  SErrInvalidShortDescr = 'Invalid short description';
 
32
  SErrInvalidDescr = 'Invalid description (illegal XML element: "%s")';
 
33
  SErrInvalidParaContent = 'Invalid paragraph content';
 
34
  SErrInvalidElementInList = 'Invalid element in list - only "li" allowed';
 
35
  SErrInvalidListContent = 'Invalid list content';
 
36
  SErrInvalidRemarkContent = 'Invalid <remark> content (illegal XML element: "%s")';
 
37
  SErrListIsEmpty = 'List is empty - need at least one "li" element';
 
38
  SErrInvalidDefinitionTermContent = 'Invalid content in definition term';
 
39
  SErrDefinitionEntryMissing = 'Definition entry after definition term is missing';
 
40
  SErrInvalidBorderValue = 'Invalid "border" value for %s';
 
41
  SErrInvalidTableContent = 'Invalid table content';
 
42
  SErrTableRowEmpty = 'Table row is empty (no "td" elements found)';
 
43
  SErrInvalidContentBeforeSectionTitle = 'Invalid content before section title';
 
44
  SErrSectionTitleExpected = 'Section title ("title" element) expected';
 
45
 
 
46
  SErrDescrTagUnknown = 'Warning: Unknown tag "%s" in description';
 
47
  SErrUnknownEntityReference = 'Warning: Unknown entity reference "&%s;" found';
 
48
  SErrUnknownLinkID = 'Warning: Target ID of <link> is unknown: "%s"';
 
49
  SErrUnknownPrintShortID = 'Warning: Target ID of <printshort> is unknown: "%s"';
 
50
  SErrUnknownLink = 'Could not resolve link to "%s"';
 
51
  SErralreadyRegistered = 'Class for output format "%s" already registered';
 
52
  SErrUnknownWriterClass = 'Unknown output format "%s"';
 
53
 
 
54
type
 
55
  // Phony element for pas pages.
 
56
 
 
57
  TTopicElement = Class(TPaselement)
 
58
    Constructor Create(const AName: String; AParent: TPasElement); override;
 
59
    Destructor Destroy; override;
 
60
    TopicNode : TDocNode;
 
61
    Previous,
 
62
    Next : TPasElement;
 
63
    Subtopics : TList;
 
64
  end;
 
65
 
 
66
  { TFPDocWriter }
 
67
 
 
68
  TFPDocWriter = class
 
69
  private
 
70
    FEngine  : TFPDocEngine;
 
71
    FPackage : TPasPackage;
 
72
 
 
73
    FTopics  : TList;
 
74
  protected
 
75
 
 
76
    procedure Warning(AContext: TPasElement; const AMsg: String);
 
77
    procedure Warning(AContext: TPasElement; const AMsg: String;
 
78
      const Args: array of const);
 
79
 
 
80
    // function FindShortDescr(const Name: String): TDOMElement;
 
81
 
 
82
    // Description conversion
 
83
    function IsDescrNodeEmpty(Node: TDOMNode): Boolean;
 
84
    function IsExtShort(Node: TDOMNode): Boolean;
 
85
    function ConvertShort(AContext: TPasElement; El: TDOMElement): Boolean;
 
86
    function ConvertBaseShort(AContext: TPasElement; Node: TDOMNode): Boolean;
 
87
    procedure ConvertBaseShortList(AContext: TPasElement; Node: TDOMNode;
 
88
      MayBeEmpty: Boolean);
 
89
    procedure ConvertLink(AContext: TPasElement; El: TDOMElement);
 
90
    function ConvertExtShort(AContext: TPasElement; Node: TDOMNode): Boolean;
 
91
    procedure ConvertDescr(AContext: TPasElement; El: TDOMElement;
 
92
      AutoInsertBlock: Boolean);
 
93
    function ConvertNonSectionBlock(AContext: TPasElement;
 
94
      Node: TDOMNode): Boolean;
 
95
    procedure ConvertExtShortOrNonSectionBlocks(AContext: TPasElement;
 
96
      Node: TDOMNode);
 
97
    function ConvertSimpleBlock(AContext: TPasElement; Node: TDOMNode): Boolean;
 
98
    Function FindTopicElement(Node : TDocNode): TTopicElement;
 
99
 
 
100
    procedure DescrWriteText(const AText: DOMString); virtual; abstract;
 
101
    procedure DescrBeginBold; virtual; abstract;
 
102
    procedure DescrEndBold; virtual; abstract;
 
103
    procedure DescrBeginItalic; virtual; abstract;
 
104
    procedure DescrEndItalic; virtual; abstract;
 
105
    procedure DescrBeginEmph; virtual; abstract;
 
106
    procedure DescrEndEmph; virtual; abstract;
 
107
    procedure DescrWriteFileEl(const AText: DOMString); virtual; abstract;
 
108
    procedure DescrWriteKeywordEl(const AText: DOMString); virtual; abstract;
 
109
    procedure DescrWriteVarEl(const AText: DOMString); virtual; abstract;
 
110
    procedure DescrBeginLink(const AId: DOMString); virtual; abstract;
 
111
    procedure DescrEndLink; virtual; abstract;
 
112
    procedure DescrWriteLinebreak; virtual; abstract;
 
113
    procedure DescrBeginParagraph; virtual; abstract;
 
114
    procedure DescrEndParagraph; virtual; abstract;
 
115
    procedure DescrBeginCode(HasBorder: Boolean; const AHighlighterName: String); virtual; abstract;
 
116
    procedure DescrWriteCodeLine(const ALine: String); virtual; abstract;
 
117
    procedure DescrEndCode; virtual; abstract;
 
118
    procedure DescrBeginOrderedList; virtual; abstract;
 
119
    procedure DescrEndOrderedList; virtual; abstract;
 
120
    procedure DescrBeginUnorderedList; virtual; abstract;
 
121
    procedure DescrEndUnorderedList; virtual; abstract;
 
122
    procedure DescrBeginDefinitionList; virtual; abstract;
 
123
    procedure DescrEndDefinitionList; virtual; abstract;
 
124
    procedure DescrBeginListItem; virtual; abstract;
 
125
    procedure DescrEndListItem; virtual; abstract;
 
126
    procedure DescrBeginDefinitionTerm; virtual; abstract;
 
127
    procedure DescrEndDefinitionTerm; virtual; abstract;
 
128
    procedure DescrBeginDefinitionEntry; virtual; abstract;
 
129
    procedure DescrEndDefinitionEntry; virtual; abstract;
 
130
    procedure DescrBeginSectionTitle; virtual; abstract;
 
131
    procedure DescrBeginSectionBody; virtual; abstract;
 
132
    procedure DescrEndSection; virtual; abstract;
 
133
    procedure DescrBeginRemark; virtual; abstract;
 
134
    procedure DescrEndRemark; virtual; abstract;
 
135
    procedure DescrBeginTable(ColCount: Integer; HasBorder: Boolean); virtual; abstract;
 
136
    procedure DescrEndTable; virtual; abstract;
 
137
    procedure DescrBeginTableCaption; virtual; abstract;
 
138
    procedure DescrEndTableCaption; virtual; abstract;
 
139
    procedure DescrBeginTableHeadRow; virtual; abstract;
 
140
    procedure DescrEndTableHeadRow; virtual; abstract;
 
141
    procedure DescrBeginTableRow; virtual; abstract;
 
142
    procedure DescrEndTableRow; virtual; abstract;
 
143
    procedure DescrBeginTableCell; virtual; abstract;
 
144
    procedure DescrEndTableCell; virtual; abstract;
 
145
  public
 
146
    Constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); virtual;
 
147
    destructor Destroy;  override;
 
148
    property Engine : TFPDocEngine read FEngine;
 
149
    Property Package : TPasPackage read FPackage;
 
150
    Property Topics : TList Read FTopics;
 
151
    // Should return True if option was succesfully interpreted.
 
152
    Function InterpretOption(Const Cmd,Arg : String) : Boolean; Virtual;
 
153
    Class Procedure Usage(List : TStrings); virtual;
 
154
    procedure WriteDoc; virtual; Abstract;
 
155
    procedure WriteDescr(Element: TPasElement);
 
156
    procedure WriteDescr(Element: TPasElement; DocNode: TDocNode);
 
157
    procedure WriteDescr(AContext: TPasElement; DescrNode: TDOMElement); virtual;
 
158
    Procedure FPDocError(Msg : String);
 
159
    Procedure FPDocError(Fmt : String; Args : Array of Const);
 
160
    Function  ShowMember(M : TPasElement) : boolean;
 
161
    Procedure GetMethodList(ClassDecl: TPasClassType; List : TStringList);
 
162
  end;
 
163
 
 
164
  TFPDocWriterClass = Class of TFPDocWriter;
 
165
  EFPDocWriterError = Class(Exception);
 
166
 
 
167
// Register backend
 
168
Procedure RegisterWriter(AClass : TFPDocWriterClass; Const AName,ADescr : String);
 
169
// UnRegister backend
 
170
Procedure UnRegisterWriter(Const AName : String);
 
171
// Return back end class. Exception if not found.
 
172
Function  GetWriterClass(AName : String) : TFPDocWriterClass;
 
173
// Return index of back end class.
 
174
Function  FindWriterClass(AName : String) : Integer;
 
175
// List of backend in name=descr form.
 
176
Procedure EnumWriters(List : TStrings);
 
177
 
 
178
implementation
 
179
 
 
180
 
 
181
{ ---------------------------------------------------------------------
 
182
  Writer registration
 
183
  ---------------------------------------------------------------------}
 
184
 
 
185
Type
 
186
 
 
187
{ TWriterRecord }
 
188
 
 
189
  TWriterRecord = Class(TObject)
 
190
  Private
 
191
    FClass : TFPDocWriterClass;
 
192
    FName : String;
 
193
    FDescription : String;
 
194
  Public
 
195
    Constructor Create (AClass : TFPDocWriterClass; Const AName,ADescr : String);
 
196
  end;
 
197
 
 
198
{ TWriterRecord }
 
199
 
 
200
constructor TWriterRecord.Create(AClass: TFPDocWriterClass; const AName,
 
201
  ADescr: String);
 
202
begin
 
203
  FClass:=AClass;
 
204
  FName:=AName;
 
205
  FDescription:=ADescr;
 
206
end;
 
207
 
 
208
Var
 
209
  Writers : TStringList;
 
210
 
 
211
Procedure InitWriterList;
 
212
 
 
213
begin
 
214
  Writers:=TStringList.Create;
 
215
  Writers.Sorted:=True;
 
216
end;
 
217
 
 
218
Procedure DoneWriterList;
 
219
 
 
220
Var
 
221
  I : Integer;
 
222
 
 
223
begin
 
224
  For I:=Writers.Count-1 downto 0 do
 
225
    Writers.Objects[i].Free;
 
226
  FreeAndNil(Writers);
 
227
end;
 
228
 
 
229
procedure RegisterWriter(AClass : TFPDocWriterClass; Const AName, ADescr : String);
 
230
begin
 
231
  If Writers.IndexOf(AName)<>-1 then
 
232
    Raise EFPDocWriterError.CreateFmt(SErralreadyRegistered,[ANAme]);
 
233
  Writers.AddObject(AName,TWriterRecord.Create(AClass,AName,ADescr));
 
234
end;
 
235
 
 
236
function  FindWriterClass(AName : String) : Integer;
 
237
 
 
238
begin
 
239
  Result:=Writers.IndexOf(AName);
 
240
end;
 
241
 
 
242
function GetWriterClass(AName : String) : TFPDocWriterClass;
 
243
 
 
244
Var
 
245
  Index : Integer;
 
246
 
 
247
begin
 
248
  Index:=FindWriterClass(AName);
 
249
  If Index=-1 then
 
250
    Raise EFPDocWriterError.CreateFmt(SErrUnknownWriterClass,[ANAme]);
 
251
  Result:=(Writers.Objects[Index] as TWriterRecord).FClass;
 
252
end;
 
253
 
 
254
// UnRegister backend
 
255
 
 
256
Procedure UnRegisterWriter(Const AName : String);
 
257
Var
 
258
  Index : Integer;
 
259
 
 
260
begin
 
261
  Index:=Writers.IndexOf(AName);
 
262
  If Index=-1 then
 
263
    Raise EFPDocWriterError.CreateFmt(SErrUnknownWriterClass,[ANAme]);
 
264
  Writers.Objects[Index].Free;
 
265
  Writers.Delete(Index);
 
266
end;
 
267
 
 
268
 
 
269
Procedure EnumWriters(List : TStrings);
 
270
 
 
271
Var
 
272
  I : Integer;
 
273
 
 
274
begin
 
275
  List.Clear;
 
276
  For I:=0 to Writers.Count-1 do
 
277
    With (Writers.Objects[I] as TWriterRecord) do
 
278
      List.Add(FName+'='+FDescription);
 
279
end;
 
280
 
 
281
function IsWhitespaceNode(Node: TDOMText): Boolean;
 
282
var
 
283
  I,L: Integer;
 
284
  S: DOMString;
 
285
  P : PWideChar;
 
286
  
 
287
begin
 
288
  S := Node.Data;
 
289
  Result := True;
 
290
  I:=0;
 
291
  L:=Length(S);
 
292
  P:=PWideChar(S);
 
293
  While Result and (I<L) do
 
294
    begin
 
295
    Result:=P^ in [#32,#10,#9,#13];
 
296
    Inc(P);
 
297
    Inc(I);
 
298
    end;
 
299
end;
 
300
 
 
301
 
 
302
{ ---------------------------------------------------------------------
 
303
  TFPDocWriter
 
304
  ---------------------------------------------------------------------}
 
305
{
 
306
      fmtIPF:
 
307
        begin
 
308
          if Length(Engine.Output) = 0 then
 
309
            WriteLn(SCmdLineOutputOptionMissing)
 
310
          else
 
311
            CreateIPFDocForPackage(Engine.Package, Engine);
 
312
        end;
 
313
 
 
314
 
 
315
}
 
316
Constructor TFPDocWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
 
317
 
 
318
begin
 
319
  inherited Create;
 
320
  FEngine  := AEngine;
 
321
  FPackage := APackage;
 
322
  FTopics:=Tlist.Create;
 
323
end;
 
324
 
 
325
destructor TFPDocWriter.Destroy;
 
326
 
 
327
Var
 
328
  i : integer;
 
329
 
 
330
begin
 
331
  For I:=0 to FTopics.Count-1 do
 
332
    TTopicElement(FTopics[i]).Free;
 
333
  FTopics.Free;
 
334
  Inherited;
 
335
end;
 
336
 
 
337
function TFPDocWriter.InterpretOption(Const Cmd,Arg : String): Boolean;
 
338
begin
 
339
  Result:=False;
 
340
end;
 
341
 
 
342
Class procedure TFPDocWriter.Usage(List: TStrings);
 
343
begin
 
344
  // Do nothing.
 
345
end;
 
346
 
 
347
Function TFPDocWriter.FindTopicElement(Node : TDocNode): TTopicElement;
 
348
 
 
349
Var
 
350
  I : Integer;
 
351
 
 
352
begin
 
353
  Result:=Nil;
 
354
  I:=FTopics.Count-1;
 
355
  While (I>=0) and (Result=Nil) do
 
356
    begin
 
357
    If (TTopicElement(FTopics[i]).TopicNode=Node) Then
 
358
      Result:=TTopicElement(FTopics[i]);
 
359
    Dec(I);
 
360
    end;
 
361
end;
 
362
 
 
363
{ ---------------------------------------------------------------------
 
364
  Generic documentation node conversion
 
365
  ---------------------------------------------------------------------}
 
366
 
 
367
function IsContentNodeType(Node: TDOMNode): Boolean;
 
368
begin
 
369
  Result := (Node.NodeType = ELEMENT_NODE) or 
 
370
    ((Node.NodeType = TEXT_NODE) and not IsWhitespaceNode(TDOMText(Node))) or
 
371
    (Node.NodeType = ENTITY_REFERENCE_NODE);
 
372
end;
 
373
 
 
374
 
 
375
procedure TFPDocWriter.Warning(AContext: TPasElement; const AMsg: String);
 
376
begin
 
377
  if (AContext<>nil) then
 
378
    WriteLn('[', AContext.PathName, '] ', AMsg)
 
379
  else
 
380
    WriteLn('[<no context>] ', AMsg);
 
381
end;
 
382
 
 
383
procedure TFPDocWriter.Warning(AContext: TPasElement; const AMsg: String;
 
384
  const Args: array of const);
 
385
begin
 
386
  Warning(AContext, Format(AMsg, Args));
 
387
end;
 
388
 
 
389
function TFPDocWriter.IsDescrNodeEmpty(Node: TDOMNode): Boolean;
 
390
var
 
391
  Child: TDOMNode;
 
392
begin
 
393
  if (not Assigned(Node)) or (not Assigned(Node.FirstChild)) then
 
394
    Result := True
 
395
  else
 
396
  begin
 
397
    Child := Node.FirstChild;
 
398
    while Assigned(Child) do
 
399
    begin
 
400
      if (Child.NodeType = ELEMENT_NODE) or (Child.NodeType = TEXT_NODE) or
 
401
        (Child.NodeType = ENTITY_REFERENCE_NODE) then
 
402
      begin
 
403
        Result := False;
 
404
        exit;
 
405
      end;
 
406
      Child := Child.NextSibling;
 
407
    end;
 
408
  end;
 
409
  Result := True;
 
410
end;
 
411
 
 
412
{ Check wether the nodes starting with the node given as argument make up an
 
413
  'extshort' production. }
 
414
function TFPDocWriter.IsExtShort(Node: TDOMNode): Boolean;
 
415
begin
 
416
  while Assigned(Node) do
 
417
  begin
 
418
    if Node.NodeType = ELEMENT_NODE then
 
419
      if (Node.NodeName <> 'br') and
 
420
         (Node.NodeName <> 'link') and
 
421
         (Node.NodeName <> 'b') and
 
422
         (Node.NodeName <> 'file') and
 
423
         (Node.NodeName <> 'i') and
 
424
         (Node.NodeName <> 'kw') and
 
425
         (Node.NodeName <> 'printshort') and
 
426
         (Node.NodeName <> 'var') then
 
427
      begin
 
428
        Result := False;
 
429
        exit;
 
430
      end;
 
431
    Node := Node.NextSibling;
 
432
  end;
 
433
  Result := True;
 
434
end;
 
435
 
 
436
function TFPDocWriter.ConvertShort(AContext: TPasElement;
 
437
 El: TDOMElement): Boolean;
 
438
var
 
439
  Node: TDOMNode;
 
440
begin
 
441
  Result := False;
 
442
  if not Assigned(El) then
 
443
    exit;
 
444
 
 
445
  Node := El.FirstChild;
 
446
  while Assigned(Node) do
 
447
  begin
 
448
    if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'link') then
 
449
      ConvertLink(AContext, TDOMElement(Node))
 
450
    else
 
451
      if not ConvertBaseShort(AContext, Node) then
 
452
        exit;
 
453
    Node := Node.NextSibling;
 
454
  end;
 
455
  Result := True;
 
456
end;
 
457
 
 
458
function TFPDocWriter.ConvertBaseShort(AContext: TPasElement;
 
459
  Node: TDOMNode): Boolean;
 
460
 
 
461
  function ConvertText: DOMString;
 
462
  var
 
463
    s: String;
 
464
    i: Integer;
 
465
  begin
 
466
    if Node.NodeType = TEXT_NODE then
 
467
    begin
 
468
      s := Node.NodeValue;
 
469
      i := 1;
 
470
      SetLength(Result, 0);
 
471
      while i <= Length(s) do
 
472
        if s[i] = #13 then
 
473
        begin
 
474
          Result := Result + ' ';
 
475
          Inc(i);
 
476
          if s[i] = #10 then
 
477
            Inc(i);
 
478
        end else if s[i] = #10 then
 
479
        begin
 
480
          Result := Result + ' ';
 
481
          Inc(i);
 
482
        end else
 
483
        begin
 
484
          Result := Result + s[i];
 
485
          Inc(i);
 
486
        end;
 
487
    end else if Node.NodeType = ENTITY_REFERENCE_NODE then
 
488
      if Node.NodeName = 'fpc' then
 
489
        Result := 'Free Pascal'
 
490
      else if Node.NodeName = 'delphi' then
 
491
        Result := 'Delphi'
 
492
      else
 
493
      begin
 
494
        Warning(AContext, Format(SErrUnknownEntityReference, [Node.NodeName]));
 
495
        Result := Node.NodeName;
 
496
      end
 
497
    else if Node.NodeType = ELEMENT_NODE then
 
498
      SetLength(Result, 0);
 
499
  end;
 
500
 
 
501
  function ConvertTextContent: DOMString;
 
502
  begin
 
503
    SetLength(Result, 0);
 
504
    Node := Node.FirstChild;
 
505
    while Assigned(Node) do
 
506
    begin
 
507
      Result := Result + ConvertText;
 
508
      Node := Node.NextSibling;
 
509
    end;
 
510
  end;
 
511
 
 
512
var
 
513
  El, DescrEl: TDOMElement;
 
514
  FPEl: TPasElement;
 
515
begin
 
516
  Result := True;
 
517
  if Node.NodeType = ELEMENT_NODE then
 
518
    if Node.NodeName = 'b' then
 
519
    begin
 
520
      DescrBeginBold;
 
521
      ConvertBaseShortList(AContext, Node, False);
 
522
      DescrEndBold;
 
523
    end else
 
524
    if Node.NodeName = 'i' then
 
525
    begin
 
526
      DescrBeginItalic;
 
527
      ConvertBaseShortList(AContext, Node, False);
 
528
      DescrEndItalic;
 
529
    end else
 
530
    if Node.NodeName = 'em' then
 
531
    begin
 
532
      DescrBeginEmph;
 
533
      ConvertBaseShortList(AContext, Node, False);
 
534
      DescrEndEmph;
 
535
    end else
 
536
    if Node.NodeName = 'file' then
 
537
      DescrWriteFileEl(ConvertTextContent)
 
538
    else if Node.NodeName = 'kw' then
 
539
      DescrWriteKeywordEl(ConvertTextContent)
 
540
    else if Node.NodeName = 'printshort' then
 
541
    begin
 
542
      El := TDOMElement(Node);
 
543
      DescrEl := Engine.FindShortDescr(AContext.GetModule, El['id']);
 
544
      if Assigned(DescrEl) then
 
545
        ConvertShort(AContext, DescrEl)
 
546
      else
 
547
      begin
 
548
        Warning(AContext, Format(SErrUnknownPrintShortID, [El['id']]));
 
549
        DescrBeginBold;
 
550
        DescrWriteText('#ShortDescr:' + El['id']);
 
551
        DescrEndBold;
 
552
      end;
 
553
    end else if Node.NodeName = 'var' then
 
554
      DescrWriteVarEl(ConvertTextContent)
 
555
    else
 
556
      Result := False
 
557
  else
 
558
    DescrWriteText(ConvertText);
 
559
end;
 
560
 
 
561
procedure TFPDocWriter.ConvertBaseShortList(AContext: TPasElement;
 
562
  Node: TDOMNode; MayBeEmpty: Boolean);
 
563
var
 
564
  Child: TDOMNode;
 
565
begin
 
566
  Child := Node.FirstChild;
 
567
  while Assigned(Child) do
 
568
  begin
 
569
    if not ConvertBaseShort(AContext, Child) then
 
570
      Warning(AContext, SErrInvalidShortDescr)
 
571
    else
 
572
      MayBeEmpty := True;
 
573
    Child := Child.NextSibling;
 
574
  end;
 
575
  if not MayBeEmpty then
 
576
    Warning(AContext, SErrInvalidShortDescr)
 
577
end;
 
578
 
 
579
procedure TFPDocWriter.ConvertLink(AContext: TPasElement; El: TDOMElement);
 
580
begin
 
581
  DescrBeginLink(El['id']);
 
582
  if not IsDescrNodeEmpty(El) then
 
583
    ConvertBaseShortList(AContext, El, True)
 
584
  else
 
585
    DescrWriteText(El['id']);
 
586
  DescrEndLink;
 
587
end;
 
588
 
 
589
function TFPDocWriter.ConvertExtShort(AContext: TPasElement;
 
590
  Node: TDOMNode): Boolean;
 
591
begin
 
592
  Result := False;
 
593
 
 
594
  while Assigned(Node) do
 
595
  begin
 
596
    if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'link') then
 
597
      ConvertLink(AContext, TDOMElement(Node))
 
598
    else if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'br') then
 
599
      DescrWriteLinebreak
 
600
    else
 
601
      if not ConvertBaseShort(AContext, Node) then
 
602
        exit;
 
603
    Node := Node.NextSibling;
 
604
  end;
 
605
  Result := True;
 
606
end;
 
607
 
 
608
procedure TFPDocWriter.ConvertDescr(AContext: TPasElement; El: TDOMElement;
 
609
  AutoInsertBlock: Boolean);
 
610
var
 
611
  Node, Child: TDOMNode;
 
612
  ParaCreated: Boolean;
 
613
begin
 
614
  if AutoInsertBlock then
 
615
    if IsExtShort(El.FirstChild) then
 
616
      DescrBeginParagraph
 
617
    else
 
618
      AutoInsertBlock := False;
 
619
 
 
620
  Node := El.FirstChild;
 
621
  if not ConvertExtShort(AContext, Node) then
 
622
  begin
 
623
    while Assigned(Node) do
 
624
    begin
 
625
      if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'section') then
 
626
      begin
 
627
        DescrBeginSectionTitle;
 
628
        Child := Node.FirstChild;
 
629
        while Assigned(Child) and (Child.NodeType <> ELEMENT_NODE) do
 
630
        begin
 
631
          if not IsDescrNodeEmpty(Child) then
 
632
            Warning(AContext, SErrInvalidContentBeforeSectionTitle);
 
633
          Child := Child.NextSibling;
 
634
        end;
 
635
        if not Assigned(Child) or (Child.NodeName <> 'title') then
 
636
          Warning(AContext, SErrSectionTitleExpected)
 
637
        else
 
638
          ConvertShort(AContext, TDOMElement(Child));
 
639
 
 
640
        DescrBeginSectionBody;
 
641
 
 
642
        if IsExtShort(Child) then
 
643
        begin
 
644
          DescrBeginParagraph;
 
645
          ParaCreated := True;
 
646
        end else
 
647
          ParaCreated := False;
 
648
 
 
649
        ConvertExtShortOrNonSectionBlocks(AContext, Child.NextSibling);
 
650
 
 
651
        if ParaCreated then
 
652
          DescrEndParagraph;
 
653
        DescrEndSection;
 
654
      end else if not ConvertNonSectionBlock(AContext, Node) then
 
655
        Warning(AContext, SErrInvalidDescr, [Node.NodeName]);
 
656
      Node := Node.NextSibling;
 
657
    end;
 
658
  end else
 
659
    if AutoInsertBlock then
 
660
      DescrEndParagraph;
 
661
end;
 
662
 
 
663
procedure TFPDocWriter.ConvertExtShortOrNonSectionBlocks(AContext: TPasElement;
 
664
  Node: TDOMNode);
 
665
begin
 
666
  if not ConvertExtShort(AContext, Node) then
 
667
    while Assigned(Node) do
 
668
    begin
 
669
      if not ConvertNonSectionBlock(AContext, Node) then
 
670
        Warning(AContext, SErrInvalidDescr, [Node.NodeName]);
 
671
      Node := Node.NextSibling;
 
672
    end;
 
673
end;
 
674
 
 
675
function TFPDocWriter.ConvertNonSectionBlock(AContext: TPasElement;
 
676
  Node: TDOMNode): Boolean;
 
677
 
 
678
  procedure ConvertCells(Node: TDOMNode);
 
679
  var
 
680
    Child: TDOMNode;
 
681
    IsEmpty: Boolean;
 
682
  begin
 
683
    Node := Node.FirstChild;
 
684
    IsEmpty := True;
 
685
    while Assigned(Node) do
 
686
    begin
 
687
      if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'td') then
 
688
      begin
 
689
        DescrBeginTableCell;
 
690
        Child := Node.FirstChild;
 
691
        if not ConvertExtShort(AContext, Child) then
 
692
          while Assigned(Child) do
 
693
          begin
 
694
            if not ConvertSimpleBlock(AContext, Child) then
 
695
              Warning(AContext, SErrInvalidTableContent);
 
696
            Child := Child.NextSibling;
 
697
          end;
 
698
        DescrEndTableCell;
 
699
        IsEmpty := False;
 
700
      end else
 
701
        if IsContentNodeType(Node) then
 
702
          Warning(AContext, SErrInvalidTableContent);
 
703
      Node := Node.NextSibling;
 
704
    end;
 
705
    if IsEmpty then
 
706
      Warning(AContext, SErrTableRowEmpty);
 
707
  end;
 
708
 
 
709
  procedure ConvertTable;
 
710
 
 
711
    function GetColCount(Node: TDOMNode): Integer;
 
712
    begin
 
713
      Result := 0;
 
714
      Node := Node.FirstChild;
 
715
      while Assigned(Node) do
 
716
      begin
 
717
        if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'td') then
 
718
          Inc(Result);
 
719
        Node := Node.NextSibling;
 
720
      end;
 
721
    end;
 
722
 
 
723
  var
 
724
    s: String;
 
725
    HasBorder, CaptionPossible, HeadRowPossible: Boolean;
 
726
    ColCount, ThisRowColCount: Integer;
 
727
    Subnode: TDOMNode;
 
728
  begin
 
729
    s := TDOMElement(Node)['border'];
 
730
    if s = '1' then
 
731
      HasBorder := True
 
732
    else
 
733
    begin
 
734
      HasBorder := False;
 
735
      if (Length(s) <> 0) and (s <> '0') then
 
736
        Warning(AContext, SErrInvalidBorderValue, ['<table>']);
 
737
    end;
 
738
 
 
739
    // Determine the number of columns
 
740
    ColCount := 0;
 
741
    Subnode := Node.FirstChild;
 
742
    while Assigned(Subnode) do
 
743
    begin
 
744
      if Subnode.NodeType = ELEMENT_NODE then
 
745
        if (Subnode.NodeName = 'caption') or (Subnode.NodeName = 'th') or
 
746
          (Subnode.NodeName = 'tr') then
 
747
        begin
 
748
          ThisRowColCount := GetColCount(Subnode);
 
749
          if ThisRowColCount > ColCount then
 
750
            ColCount := ThisRowColCount;
 
751
        end;
 
752
      Subnode := Subnode.NextSibling;
 
753
    end;
 
754
 
 
755
    DescrBeginTable(ColCount, HasBorder);
 
756
 
 
757
    Node := Node.FirstChild;
 
758
    CaptionPossible := True;
 
759
    HeadRowPossible := True;
 
760
    while Assigned(Node) do
 
761
    begin
 
762
      if Node.NodeType = ELEMENT_NODE then
 
763
        if CaptionPossible and (Node.NodeName = 'caption') then
 
764
        begin
 
765
          DescrBeginTableCaption;
 
766
          if not ConvertExtShort(AContext, Node.FirstChild) then
 
767
            Warning(AContext, SErrInvalidTableContent);
 
768
          DescrEndTableCaption;
 
769
          CaptionPossible := False;
 
770
        end else if HeadRowPossible and (Node.NodeName = 'th') then
 
771
        begin
 
772
          DescrBeginTableHeadRow;
 
773
          ConvertCells(Node);
 
774
          DescrEndTableHeadRow;
 
775
          CaptionPossible := False;
 
776
          HeadRowPossible := False;
 
777
        end else if Node.NodeName = 'tr' then
 
778
        begin
 
779
          DescrBeginTableRow;
 
780
          ConvertCells(Node);
 
781
          DescrEndTableRow;
 
782
        end else
 
783
          Warning(AContext, SErrInvalidTableContent)
 
784
      else if IsContentNodeType(Node) then
 
785
        Warning(AContext, SErrInvalidTableContent);
 
786
      Node := Node.NextSibling;
 
787
    end;
 
788
    DescrEndTable;
 
789
  end;
 
790
 
 
791
begin
 
792
  if Node.NodeType <> ELEMENT_NODE then
 
793
  begin
 
794
    if Node.NodeType = TEXT_NODE then
 
795
          Result := IsWhitespaceNode(TDOMText(Node))
 
796
        else  
 
797
      Result := Node.NodeType = COMMENT_NODE;
 
798
    exit;
 
799
  end;
 
800
  if Node.NodeName = 'remark' then
 
801
  begin
 
802
    DescrBeginRemark;
 
803
    Node := Node.FirstChild;
 
804
    if not ConvertExtShort(AContext, Node) then
 
805
      while Assigned(Node) do
 
806
      begin
 
807
        if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'table') then
 
808
          ConvertTable
 
809
        else
 
810
          if not ConvertSimpleBlock(AContext, Node) then
 
811
            Warning(AContext, SErrInvalidRemarkContent, [Node.NodeName]);
 
812
        Node := Node.NextSibling;
 
813
      end;
 
814
    DescrEndRemark;
 
815
    Result := True;
 
816
  end else if Node.NodeName = 'table' then
 
817
  begin
 
818
    ConvertTable;
 
819
    Result := True;
 
820
  end else
 
821
    Result := ConvertSimpleBlock(AContext, Node);
 
822
end;
 
823
 
 
824
function TFPDocWriter.ConvertSimpleBlock(AContext: TPasElement;
 
825
  Node: TDOMNode): Boolean;
 
826
 
 
827
  procedure ConvertListItems;
 
828
  var
 
829
    Empty: Boolean;
 
830
  begin
 
831
    Node := Node.FirstChild;
 
832
    Empty := True;
 
833
    while Assigned(Node) do
 
834
    begin
 
835
      if ((Node.NodeType = TEXT_NODE) and not IsWhitespaceNode(TDOMText(Node))) or (Node.NodeType = ENTITY_REFERENCE_NODE)
 
836
        then
 
837
        Warning(AContext, SErrInvalidListContent)
 
838
      else if Node.NodeType = ELEMENT_NODE then
 
839
        if Node.NodeName = 'li' then
 
840
        begin
 
841
          DescrBeginListItem;
 
842
          ConvertExtShortOrNonSectionBlocks(AContext, Node.FirstChild);
 
843
          DescrEndListItem;
 
844
          Empty := False;
 
845
        end else
 
846
          Warning(AContext, SErrInvalidElementInList);
 
847
      Node := Node.NextSibling;
 
848
    end;
 
849
    if Empty then
 
850
      Warning(AContext, SErrListIsEmpty);
 
851
  end;
 
852
 
 
853
  procedure ConvertDefinitionList;
 
854
  var
 
855
    Empty, ExpectDTNext: Boolean;
 
856
  begin
 
857
    Node := Node.FirstChild;
 
858
    Empty := True;
 
859
    ExpectDTNext := True;
 
860
    while Assigned(Node) do
 
861
    begin
 
862
      if ((Node.NodeType = TEXT_NODE) and not IsWhitespaceNode(TDOMText(Node))) or (Node.NodeType = ENTITY_REFERENCE_NODE)
 
863
        then
 
864
        Warning(AContext, SErrInvalidListContent)
 
865
      else if Node.NodeType = ELEMENT_NODE then
 
866
        if ExpectDTNext and (Node.NodeName = 'dt') then
 
867
        begin
 
868
          DescrBeginDefinitionTerm;
 
869
          if not ConvertShort(AContext, TDOMElement(Node)) then
 
870
            Warning(AContext, SErrInvalidDefinitionTermContent);
 
871
          DescrEndDefinitionTerm;
 
872
          Empty := False;
 
873
          ExpectDTNext := False;
 
874
        end else if not ExpectDTNext and (Node.NodeName = 'dd') then
 
875
        begin
 
876
          DescrBeginDefinitionEntry;
 
877
          ConvertExtShortOrNonSectionBlocks(AContext, Node.FirstChild);
 
878
          DescrEndDefinitionEntry;
 
879
          ExpectDTNext := True;
 
880
        end else
 
881
          Warning(AContext, SErrInvalidElementInList);
 
882
      Node := Node.NextSibling;
 
883
    end;
 
884
    if Empty then
 
885
      Warning(AContext, SErrListIsEmpty)
 
886
    else if not ExpectDTNext then
 
887
      Warning(AContext, SErrDefinitionEntryMissing);
 
888
  end;
 
889
 
 
890
  procedure ProcessCodeBody(Node: TDOMNode);
 
891
  var
 
892
    s: String;
 
893
    i, j: Integer;
 
894
  begin
 
895
    Node := Node.FirstChild;
 
896
    SetLength(s, 0);
 
897
    while Assigned(Node) do
 
898
    begin
 
899
      if Node.NodeType = TEXT_NODE then
 
900
      begin
 
901
        s := s + Node.NodeValue;
 
902
        j := 1;
 
903
        for i := 1 to Length(s) do
 
904
          // In XML, linefeeds are normalized to #10 by the parser!
 
905
          if s[i] = #10 then
 
906
          begin
 
907
            DescrWriteCodeLine(Copy(s, j, i - j));
 
908
            j := i + 1;
 
909
          end;
 
910
        if j > 1 then
 
911
          s := Copy(s, j, Length(s));
 
912
      end;
 
913
      Node := Node.NextSibling;
 
914
    end;
 
915
    if Length(s) > 0 then
 
916
      DescrWriteCodeLine(s);
 
917
  end;
 
918
 
 
919
var
 
920
  s: String;
 
921
  HasBorder: Boolean;
 
922
begin
 
923
  if Node.NodeType <> ELEMENT_NODE then
 
924
  begin
 
925
    Result := (Node.NodeType = TEXT_NODE) and IsWhitespaceNode(TDOMText(Node));
 
926
    exit;
 
927
  end;
 
928
  if Node.NodeName = 'p' then
 
929
  begin
 
930
    DescrBeginParagraph;
 
931
    if not ConvertExtShort(AContext, Node.FirstChild) then
 
932
      Warning(AContext, SErrInvalidParaContent);
 
933
    DescrEndParagraph;
 
934
    Result := True;
 
935
  end else if Node.NodeName = 'code' then
 
936
  begin
 
937
    s := TDOMElement(Node)['border'];
 
938
    if s = '1' then
 
939
      HasBorder := True
 
940
    else
 
941
    begin
 
942
      if (Length(s) > 0) and (s <> '0') then
 
943
        Warning(AContext, SErrInvalidBorderValue, ['<code>']);
 
944
    end;
 
945
 
 
946
    DescrBeginCode(HasBorder, TDOMElement(Node)['highlighter']);
 
947
    ProcessCodeBody(Node);
 
948
    DescrEndCode;
 
949
    Result := True;
 
950
  end else if Node.NodeName = 'pre' then
 
951
  begin
 
952
    DescrBeginCode(False, 'none');
 
953
    ProcessCodeBody(Node);
 
954
    DescrEndCode;
 
955
    Result := True;
 
956
  end else if Node.NodeName = 'ul' then
 
957
  begin
 
958
    DescrBeginUnorderedList;
 
959
    ConvertListItems;
 
960
    DescrEndUnorderedList;
 
961
    Result := True;
 
962
  end else if Node.NodeName = 'ol' then
 
963
  begin
 
964
    DescrBeginOrderedList;
 
965
    ConvertListItems;
 
966
    DescrEndOrderedList;
 
967
    Result := True;
 
968
  end else if Node.NodeName = 'dl' then
 
969
  begin
 
970
    DescrBeginDefinitionList;
 
971
    ConvertDefinitionList;
 
972
    DescrEndDefinitionList;
 
973
    Result := True;
 
974
  end else
 
975
    Result := False;
 
976
end;
 
977
 
 
978
Constructor TTopicElement.Create(const AName: String; AParent: TPasElement);
 
979
 
 
980
begin
 
981
  Inherited Create(AName,AParent);
 
982
  SubTopics:=TList.Create;
 
983
end;
 
984
 
 
985
Destructor TTopicElement.Destroy;
 
986
 
 
987
begin
 
988
  // Actual subtopics are freed by TFPDocWriter Topics list.
 
989
  SubTopics.Free;
 
990
  Inherited;
 
991
end;
 
992
 
 
993
procedure TFPDocWriter.WriteDescr(Element: TPasElement);
 
994
 
 
995
begin
 
996
  WriteDescr(ELement,Engine.FindDocNode(Element));
 
997
end;
 
998
 
 
999
procedure TFPDocWriter.WriteDescr(Element: TPasElement; DocNode: TDocNode);
 
1000
 
 
1001
begin
 
1002
  if Assigned(DocNode) then
 
1003
    begin
 
1004
    if not IsDescrNodeEmpty(DocNode.Descr) then
 
1005
      WriteDescr(Element, DocNode.Descr)
 
1006
    else if not IsDescrNodeEmpty(DocNode.ShortDescr) then
 
1007
      WriteDescr(Element, DocNode.ShortDescr);
 
1008
    end;
 
1009
end;
 
1010
 
 
1011
procedure TFPDocWriter.WriteDescr(AContext: TPasElement; DescrNode: TDOMElement);
 
1012
begin
 
1013
  if Assigned(DescrNode) then
 
1014
    ConvertDescr(AContext, DescrNode, False);
 
1015
end;
 
1016
 
 
1017
procedure TFPDocWriter.FPDocError(Msg: String);
 
1018
begin
 
1019
  Raise EFPDocWriterError.Create(Msg);
 
1020
end;
 
1021
 
 
1022
procedure TFPDocWriter.FPDocError(Fmt: String; Args: array of const);
 
1023
begin
 
1024
  FPDocError(Format(Fmt,Args));
 
1025
end;
 
1026
 
 
1027
function TFPDocWriter.ShowMember(M: TPasElement): boolean;
 
1028
begin
 
1029
  Result:=not ((M.Visibility=visPrivate) and Engine.HidePrivate);
 
1030
  If Result then
 
1031
    Result:=Not ((M.Visibility=visProtected) and Engine.HideProtected)
 
1032
end;
 
1033
 
 
1034
Procedure TFPDocWriter.GetMethodList(ClassDecl: TPasClassType; List : TStringList);
 
1035
 
 
1036
Var
 
1037
  I : Integer;
 
1038
  M : TPasElement;
 
1039
 
 
1040
begin
 
1041
  List.Clear;
 
1042
  List.Sorted:=False;
 
1043
  for i := 0 to ClassDecl.Members.Count - 1 do
 
1044
    begin
 
1045
    M:=TPasElement(ClassDecl.Members[i]);
 
1046
    if M.InheritsFrom(TPasProcedureBase) and ShowMember(M) then
 
1047
       List.AddObject(M.Name,M);
 
1048
    end;
 
1049
  List.Sorted:=False;
 
1050
end;
 
1051
 
 
1052
initialization
 
1053
  InitWriterList;
 
1054
finalization
 
1055
  DoneWriterList;
 
1056
end.