dwriter.pp 29 KB

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