dwriter.pp 31 KB

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