dwriter.pp 30 KB

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