dwriter.pp 31 KB

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