dwriter.pp 30 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076
  1. {
  2. FPDoc - Free Pascal Documentation Tool
  3. Copyright (C) 2000 - 2003 by
  4. Areca Systems GmbH / Sebastian Guenther, [email protected]
  5. * Output string definitions
  6. * Basic writer (output generator) class
  7. See the file COPYING, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. }
  13. unit dWriter;
  14. {$MODE objfpc}
  15. {$H+}
  16. interface
  17. uses Classes, DOM, dGlobals, PasTree, SysUtils;
  18. resourcestring
  19. SErrFileWriting = 'An error occured during writing of file "%s": %s';
  20. SErrInvalidShortDescr = 'Invalid short description';
  21. SErrInvalidDescr = 'Invalid description (illegal XML element: "%s")';
  22. SErrInvalidParaContent = 'Invalid paragraph content';
  23. SErrInvalidElementInList = 'Invalid element in list - only "li" allowed';
  24. SErrInvalidListContent = 'Invalid list content';
  25. SErrInvalidRemarkContent = 'Invalid <remark> content (illegal XML element: "%s")';
  26. SErrListIsEmpty = 'List is empty - need at least one "li" element';
  27. SErrInvalidDefinitionTermContent = 'Invalid content in definition term';
  28. SErrDefinitionEntryMissing = 'Definition entry after definition term is missing';
  29. SErrInvalidBorderValue = 'Invalid "border" value for %s';
  30. SErrInvalidTableContent = 'Invalid table content';
  31. SErrTableRowEmpty = 'Table row is empty (no "td" elements found)';
  32. SErrInvalidContentBeforeSectionTitle = 'Invalid content before section title';
  33. SErrSectionTitleExpected = 'Section title ("title" element) expected';
  34. SErrDescrTagUnknown = 'Warning: Unknown tag "%s" in description';
  35. SErrUnknownEntityReference = 'Warning: Unknown entity reference "&%s;" found';
  36. SErrUnknownLinkID = 'Warning: Target ID of <link> is unknown: "%s"';
  37. SErrUnknownPrintShortID = 'Warning: Target ID of <printshort> is unknown: "%s"';
  38. SErrUnknownLink = 'Could not resolve link to "%s"';
  39. SErralreadyRegistered = 'Class for output format "%s" already registered';
  40. SErrUnknownWriterClass = 'Unknown output format "%s"';
  41. type
  42. // Phony element for pas pages.
  43. TTopicElement = Class(TPaselement)
  44. Constructor Create(const AName: String; AParent: TPasElement); override;
  45. Destructor Destroy; override;
  46. TopicNode : TDocNode;
  47. Previous,
  48. Next : TPasElement;
  49. Subtopics : TList;
  50. end;
  51. { TFPDocWriter }
  52. TFPDocWriter = class
  53. private
  54. FEngine : TFPDocEngine;
  55. FPackage : TPasPackage;
  56. FTopics : TList;
  57. 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 : DOMString); virtual; abstract;
  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. { ---------------------------------------------------------------------
  303. Generic documentation node conversion
  304. ---------------------------------------------------------------------}
  305. function IsContentNodeType(Node: TDOMNode): Boolean;
  306. begin
  307. Result := (Node.NodeType = ELEMENT_NODE) or
  308. ((Node.NodeType = TEXT_NODE) and not IsWhitespaceNode(TDOMText(Node))) or
  309. (Node.NodeType = ENTITY_REFERENCE_NODE);
  310. end;
  311. procedure TFPDocWriter.Warning(AContext: TPasElement; const AMsg: String);
  312. begin
  313. if (AContext<>nil) then
  314. WriteLn('[', AContext.PathName, '] ', AMsg)
  315. else
  316. WriteLn('[<no context>] ', AMsg);
  317. end;
  318. procedure TFPDocWriter.Warning(AContext: TPasElement; const AMsg: String;
  319. const Args: array of const);
  320. begin
  321. Warning(AContext, Format(AMsg, Args));
  322. end;
  323. function TFPDocWriter.IsDescrNodeEmpty(Node: TDOMNode): Boolean;
  324. var
  325. Child: TDOMNode;
  326. begin
  327. if (not Assigned(Node)) or (not Assigned(Node.FirstChild)) then
  328. Result := True
  329. else
  330. begin
  331. Child := Node.FirstChild;
  332. while Assigned(Child) do
  333. begin
  334. if (Child.NodeType = ELEMENT_NODE) or (Child.NodeType = TEXT_NODE) or
  335. (Child.NodeType = ENTITY_REFERENCE_NODE) then
  336. begin
  337. Result := False;
  338. exit;
  339. end;
  340. Child := Child.NextSibling;
  341. end;
  342. end;
  343. Result := True;
  344. end;
  345. { Check wether the nodes starting with the node given as argument make up an
  346. 'extshort' production. }
  347. function TFPDocWriter.IsExtShort(Node: TDOMNode): Boolean;
  348. begin
  349. while Assigned(Node) do
  350. begin
  351. if Node.NodeType = ELEMENT_NODE then
  352. if (Node.NodeName <> 'br') and
  353. (Node.NodeName <> 'link') and
  354. (Node.NodeName <> 'b') and
  355. (Node.NodeName <> 'file') and
  356. (Node.NodeName <> 'i') and
  357. (Node.NodeName <> 'kw') and
  358. (Node.NodeName <> 'printshort') and
  359. (Node.NodeName <> 'var') then
  360. begin
  361. Result := False;
  362. exit;
  363. end;
  364. Node := Node.NextSibling;
  365. end;
  366. Result := True;
  367. end;
  368. function TFPDocWriter.ConvertShort(AContext: TPasElement;
  369. El: TDOMElement): Boolean;
  370. var
  371. Node: TDOMNode;
  372. begin
  373. Result := False;
  374. if not Assigned(El) then
  375. exit;
  376. Node := El.FirstChild;
  377. while Assigned(Node) do
  378. begin
  379. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'link') then
  380. ConvertLink(AContext, TDOMElement(Node))
  381. else
  382. if not ConvertBaseShort(AContext, Node) then
  383. exit;
  384. Node := Node.NextSibling;
  385. end;
  386. Result := True;
  387. end;
  388. function TFPDocWriter.ConvertBaseShort(AContext: TPasElement;
  389. Node: TDOMNode): Boolean;
  390. function ConvertText: DOMString;
  391. var
  392. s: String;
  393. i: Integer;
  394. begin
  395. if Node.NodeType = TEXT_NODE then
  396. begin
  397. s := Node.NodeValue;
  398. i := 1;
  399. SetLength(Result, 0);
  400. while i <= Length(s) do
  401. if s[i] = #13 then
  402. begin
  403. Result := Result + ' ';
  404. Inc(i);
  405. if s[i] = #10 then
  406. Inc(i);
  407. end else if s[i] = #10 then
  408. begin
  409. Result := Result + ' ';
  410. Inc(i);
  411. end else
  412. begin
  413. Result := Result + s[i];
  414. Inc(i);
  415. end;
  416. end else if Node.NodeType = ENTITY_REFERENCE_NODE then
  417. if Node.NodeName = 'fpc' then
  418. Result := 'Free Pascal'
  419. else if Node.NodeName = 'delphi' then
  420. Result := 'Delphi'
  421. else
  422. begin
  423. Warning(AContext, Format(SErrUnknownEntityReference, [Node.NodeName]));
  424. Result := Node.NodeName;
  425. end
  426. else if Node.NodeType = ELEMENT_NODE then
  427. SetLength(Result, 0);
  428. end;
  429. function ConvertTextContent: DOMString;
  430. begin
  431. SetLength(Result, 0);
  432. Node := Node.FirstChild;
  433. while Assigned(Node) do
  434. begin
  435. Result := Result + ConvertText;
  436. Node := Node.NextSibling;
  437. end;
  438. end;
  439. var
  440. El, DescrEl: TDOMElement;
  441. FPEl: TPasElement;
  442. begin
  443. Result := True;
  444. if Node.NodeType = ELEMENT_NODE then
  445. if Node.NodeName = 'b' then
  446. begin
  447. DescrBeginBold;
  448. ConvertBaseShortList(AContext, Node, False);
  449. DescrEndBold;
  450. end else
  451. if Node.NodeName = 'i' then
  452. begin
  453. DescrBeginItalic;
  454. ConvertBaseShortList(AContext, Node, False);
  455. DescrEndItalic;
  456. end else
  457. if Node.NodeName = 'em' then
  458. begin
  459. DescrBeginEmph;
  460. ConvertBaseShortList(AContext, Node, False);
  461. DescrEndEmph;
  462. end else
  463. if Node.NodeName = 'file' then
  464. DescrWriteFileEl(ConvertTextContent)
  465. else if Node.NodeName = 'kw' then
  466. DescrWriteKeywordEl(ConvertTextContent)
  467. else if Node.NodeName = 'printshort' then
  468. begin
  469. El := TDOMElement(Node);
  470. DescrEl := Engine.FindShortDescr(AContext.GetModule, El['id']);
  471. if Assigned(DescrEl) then
  472. ConvertShort(AContext, DescrEl)
  473. else
  474. begin
  475. Warning(AContext, Format(SErrUnknownPrintShortID, [El['id']]));
  476. DescrBeginBold;
  477. DescrWriteText('#ShortDescr:' + El['id']);
  478. DescrEndBold;
  479. end;
  480. end else if Node.NodeName = 'var' then
  481. DescrWriteVarEl(ConvertTextContent)
  482. else
  483. Result := False
  484. else
  485. DescrWriteText(ConvertText);
  486. end;
  487. procedure TFPDocWriter.ConvertBaseShortList(AContext: TPasElement;
  488. Node: TDOMNode; MayBeEmpty: Boolean);
  489. var
  490. Child: TDOMNode;
  491. begin
  492. Child := Node.FirstChild;
  493. while Assigned(Child) do
  494. begin
  495. if not ConvertBaseShort(AContext, Child) then
  496. Warning(AContext, SErrInvalidShortDescr)
  497. else
  498. MayBeEmpty := True;
  499. Child := Child.NextSibling;
  500. end;
  501. if not MayBeEmpty then
  502. Warning(AContext, SErrInvalidShortDescr)
  503. end;
  504. procedure TFPDocWriter.ConvertLink(AContext: TPasElement; El: TDOMElement);
  505. begin
  506. DescrBeginLink(El['id']);
  507. if not IsDescrNodeEmpty(El) then
  508. ConvertBaseShortList(AContext, El, True)
  509. else
  510. DescrWriteText(El['id']);
  511. DescrEndLink;
  512. end;
  513. function TFPDocWriter.ConvertExtShort(AContext: TPasElement;
  514. Node: TDOMNode): Boolean;
  515. begin
  516. Result := False;
  517. while Assigned(Node) do
  518. begin
  519. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'link') then
  520. ConvertLink(AContext, TDOMElement(Node))
  521. else if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'br') then
  522. DescrWriteLinebreak
  523. else
  524. if not ConvertBaseShort(AContext, Node) then
  525. exit;
  526. Node := Node.NextSibling;
  527. end;
  528. Result := True;
  529. end;
  530. procedure TFPDocWriter.ConvertDescr(AContext: TPasElement; El: TDOMElement;
  531. AutoInsertBlock: Boolean);
  532. var
  533. Node, Child: TDOMNode;
  534. ParaCreated: Boolean;
  535. begin
  536. if AutoInsertBlock then
  537. if IsExtShort(El.FirstChild) then
  538. DescrBeginParagraph
  539. else
  540. AutoInsertBlock := False;
  541. Node := El.FirstChild;
  542. if not ConvertExtShort(AContext, Node) then
  543. begin
  544. while Assigned(Node) do
  545. begin
  546. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'section') then
  547. begin
  548. DescrBeginSectionTitle;
  549. Child := Node.FirstChild;
  550. while Assigned(Child) and (Child.NodeType <> ELEMENT_NODE) do
  551. begin
  552. if not IsDescrNodeEmpty(Child) then
  553. Warning(AContext, SErrInvalidContentBeforeSectionTitle);
  554. Child := Child.NextSibling;
  555. end;
  556. if not Assigned(Child) or (Child.NodeName <> 'title') then
  557. Warning(AContext, SErrSectionTitleExpected)
  558. else
  559. ConvertShort(AContext, TDOMElement(Child));
  560. DescrBeginSectionBody;
  561. if IsExtShort(Child) then
  562. begin
  563. DescrBeginParagraph;
  564. ParaCreated := True;
  565. end else
  566. ParaCreated := False;
  567. ConvertExtShortOrNonSectionBlocks(AContext, Child.NextSibling);
  568. if ParaCreated then
  569. DescrEndParagraph;
  570. DescrEndSection;
  571. end else if not ConvertNonSectionBlock(AContext, Node) then
  572. Warning(AContext, SErrInvalidDescr, [Node.NodeName]);
  573. Node := Node.NextSibling;
  574. end;
  575. end else
  576. if AutoInsertBlock then
  577. DescrEndParagraph;
  578. end;
  579. procedure TFPDocWriter.ConvertExtShortOrNonSectionBlocks(AContext: TPasElement;
  580. Node: TDOMNode);
  581. begin
  582. if not ConvertExtShort(AContext, Node) then
  583. while Assigned(Node) do
  584. begin
  585. if not ConvertNonSectionBlock(AContext, Node) then
  586. Warning(AContext, SErrInvalidDescr, [Node.NodeName]);
  587. Node := Node.NextSibling;
  588. end;
  589. end;
  590. function TFPDocWriter.ConvertNonSectionBlock(AContext: TPasElement;
  591. Node: TDOMNode): Boolean;
  592. procedure ConvertCells(Node: TDOMNode);
  593. var
  594. Child: TDOMNode;
  595. IsEmpty: Boolean;
  596. begin
  597. Node := Node.FirstChild;
  598. IsEmpty := True;
  599. while Assigned(Node) do
  600. begin
  601. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'td') then
  602. begin
  603. DescrBeginTableCell;
  604. Child := Node.FirstChild;
  605. if not ConvertExtShort(AContext, Child) then
  606. while Assigned(Child) do
  607. begin
  608. if not ConvertSimpleBlock(AContext, Child) then
  609. Warning(AContext, SErrInvalidTableContent);
  610. Child := Child.NextSibling;
  611. end;
  612. DescrEndTableCell;
  613. IsEmpty := False;
  614. end else
  615. if IsContentNodeType(Node) then
  616. Warning(AContext, SErrInvalidTableContent);
  617. Node := Node.NextSibling;
  618. end;
  619. if IsEmpty then
  620. Warning(AContext, SErrTableRowEmpty);
  621. end;
  622. procedure ConvertTable;
  623. function GetColCount(Node: TDOMNode): Integer;
  624. begin
  625. Result := 0;
  626. Node := Node.FirstChild;
  627. while Assigned(Node) do
  628. begin
  629. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'td') then
  630. Inc(Result);
  631. Node := Node.NextSibling;
  632. end;
  633. end;
  634. var
  635. s: String;
  636. HasBorder, CaptionPossible, HeadRowPossible: Boolean;
  637. ColCount, ThisRowColCount: Integer;
  638. Subnode: TDOMNode;
  639. begin
  640. s := TDOMElement(Node)['border'];
  641. if s = '1' then
  642. HasBorder := True
  643. else
  644. begin
  645. HasBorder := False;
  646. if (Length(s) <> 0) and (s <> '0') then
  647. Warning(AContext, SErrInvalidBorderValue, ['<table>']);
  648. end;
  649. // Determine the number of columns
  650. ColCount := 0;
  651. Subnode := Node.FirstChild;
  652. while Assigned(Subnode) do
  653. begin
  654. if Subnode.NodeType = ELEMENT_NODE then
  655. if (Subnode.NodeName = 'caption') or (Subnode.NodeName = 'th') or
  656. (Subnode.NodeName = 'tr') then
  657. begin
  658. ThisRowColCount := GetColCount(Subnode);
  659. if ThisRowColCount > ColCount then
  660. ColCount := ThisRowColCount;
  661. end;
  662. Subnode := Subnode.NextSibling;
  663. end;
  664. DescrBeginTable(ColCount, HasBorder);
  665. Node := Node.FirstChild;
  666. CaptionPossible := True;
  667. HeadRowPossible := True;
  668. while Assigned(Node) do
  669. begin
  670. if Node.NodeType = ELEMENT_NODE then
  671. if CaptionPossible and (Node.NodeName = 'caption') then
  672. begin
  673. DescrBeginTableCaption;
  674. if not ConvertExtShort(AContext, Node.FirstChild) then
  675. Warning(AContext, SErrInvalidTableContent);
  676. DescrEndTableCaption;
  677. CaptionPossible := False;
  678. end else if HeadRowPossible and (Node.NodeName = 'th') then
  679. begin
  680. DescrBeginTableHeadRow;
  681. ConvertCells(Node);
  682. DescrEndTableHeadRow;
  683. CaptionPossible := False;
  684. HeadRowPossible := False;
  685. end else if Node.NodeName = 'tr' then
  686. begin
  687. DescrBeginTableRow;
  688. ConvertCells(Node);
  689. DescrEndTableRow;
  690. end else
  691. Warning(AContext, SErrInvalidTableContent)
  692. else if IsContentNodeType(Node) then
  693. Warning(AContext, SErrInvalidTableContent);
  694. Node := Node.NextSibling;
  695. end;
  696. DescrEndTable;
  697. end;
  698. begin
  699. if Node.NodeType <> ELEMENT_NODE then
  700. begin
  701. if Node.NodeType = TEXT_NODE then
  702. Result := IsWhitespaceNode(TDOMText(Node))
  703. else
  704. Result := Node.NodeType = COMMENT_NODE;
  705. exit;
  706. end;
  707. if Node.NodeName = 'remark' then
  708. begin
  709. DescrBeginRemark;
  710. Node := Node.FirstChild;
  711. if not ConvertExtShort(AContext, Node) then
  712. while Assigned(Node) do
  713. begin
  714. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'table') then
  715. ConvertTable
  716. else
  717. if not ConvertSimpleBlock(AContext, Node) then
  718. Warning(AContext, SErrInvalidRemarkContent, [Node.NodeName]);
  719. Node := Node.NextSibling;
  720. end;
  721. DescrEndRemark;
  722. Result := True;
  723. end else if Node.NodeName = 'table' then
  724. begin
  725. ConvertTable;
  726. Result := True;
  727. end else
  728. Result := ConvertSimpleBlock(AContext, Node);
  729. end;
  730. function TFPDocWriter.ConvertSimpleBlock(AContext: TPasElement;
  731. Node: TDOMNode): Boolean;
  732. procedure ConvertListItems;
  733. var
  734. Empty: Boolean;
  735. begin
  736. Node := Node.FirstChild;
  737. Empty := True;
  738. while Assigned(Node) do
  739. begin
  740. if ((Node.NodeType = TEXT_NODE) and not IsWhitespaceNode(TDOMText(Node))) or (Node.NodeType = ENTITY_REFERENCE_NODE)
  741. then
  742. Warning(AContext, SErrInvalidListContent)
  743. else if Node.NodeType = ELEMENT_NODE then
  744. if Node.NodeName = 'li' then
  745. begin
  746. DescrBeginListItem;
  747. ConvertExtShortOrNonSectionBlocks(AContext, Node.FirstChild);
  748. DescrEndListItem;
  749. Empty := False;
  750. end else
  751. Warning(AContext, SErrInvalidElementInList);
  752. Node := Node.NextSibling;
  753. end;
  754. if Empty then
  755. Warning(AContext, SErrListIsEmpty);
  756. end;
  757. procedure ConvertDefinitionList;
  758. var
  759. Empty, ExpectDTNext: Boolean;
  760. begin
  761. Node := Node.FirstChild;
  762. Empty := True;
  763. ExpectDTNext := True;
  764. while Assigned(Node) do
  765. begin
  766. if ((Node.NodeType = TEXT_NODE) and not IsWhitespaceNode(TDOMText(Node))) or (Node.NodeType = ENTITY_REFERENCE_NODE)
  767. then
  768. Warning(AContext, SErrInvalidListContent)
  769. else if Node.NodeType = ELEMENT_NODE then
  770. if ExpectDTNext and (Node.NodeName = 'dt') then
  771. begin
  772. DescrBeginDefinitionTerm;
  773. if not ConvertShort(AContext, TDOMElement(Node)) then
  774. Warning(AContext, SErrInvalidDefinitionTermContent);
  775. DescrEndDefinitionTerm;
  776. Empty := False;
  777. ExpectDTNext := False;
  778. end else if not ExpectDTNext and (Node.NodeName = 'dd') then
  779. begin
  780. DescrBeginDefinitionEntry;
  781. ConvertExtShortOrNonSectionBlocks(AContext, Node.FirstChild);
  782. DescrEndDefinitionEntry;
  783. ExpectDTNext := True;
  784. end else
  785. Warning(AContext, SErrInvalidElementInList);
  786. Node := Node.NextSibling;
  787. end;
  788. if Empty then
  789. Warning(AContext, SErrListIsEmpty)
  790. else if not ExpectDTNext then
  791. Warning(AContext, SErrDefinitionEntryMissing);
  792. end;
  793. procedure ProcessCodeBody(Node: TDOMNode);
  794. var
  795. s: String;
  796. i, j: Integer;
  797. begin
  798. Node := Node.FirstChild;
  799. SetLength(s, 0);
  800. while Assigned(Node) do
  801. begin
  802. if Node.NodeType = TEXT_NODE then
  803. begin
  804. s := s + Node.NodeValue;
  805. j := 1;
  806. for i := 1 to Length(s) do
  807. // In XML, linefeeds are normalized to #10 by the parser!
  808. if s[i] = #10 then
  809. begin
  810. DescrWriteCodeLine(Copy(s, j, i - j));
  811. j := i + 1;
  812. end;
  813. if j > 1 then
  814. s := Copy(s, j, Length(s));
  815. end;
  816. Node := Node.NextSibling;
  817. end;
  818. if Length(s) > 0 then
  819. DescrWriteCodeLine(s);
  820. end;
  821. var
  822. s: String;
  823. HasBorder: Boolean;
  824. begin
  825. if Node.NodeType <> ELEMENT_NODE then
  826. begin
  827. Result := (Node.NodeType = TEXT_NODE) and IsWhitespaceNode(TDOMText(Node));
  828. exit;
  829. end;
  830. if Node.NodeName = 'p' then
  831. begin
  832. DescrBeginParagraph;
  833. if not ConvertExtShort(AContext, Node.FirstChild) then
  834. Warning(AContext, SErrInvalidParaContent);
  835. DescrEndParagraph;
  836. Result := True;
  837. end else if Node.NodeName = 'code' then
  838. begin
  839. s := TDOMElement(Node)['border'];
  840. if s = '1' then
  841. HasBorder := True
  842. else
  843. begin
  844. if (Length(s) > 0) and (s <> '0') then
  845. Warning(AContext, SErrInvalidBorderValue, ['<code>']);
  846. end;
  847. DescrBeginCode(HasBorder, TDOMElement(Node)['highlighter']);
  848. ProcessCodeBody(Node);
  849. DescrEndCode;
  850. Result := True;
  851. end else if Node.NodeName = 'pre' then
  852. begin
  853. DescrBeginCode(False, 'none');
  854. ProcessCodeBody(Node);
  855. DescrEndCode;
  856. Result := True;
  857. end else if Node.NodeName = 'ul' then
  858. begin
  859. DescrBeginUnorderedList;
  860. ConvertListItems;
  861. DescrEndUnorderedList;
  862. Result := True;
  863. end else if Node.NodeName = 'ol' then
  864. begin
  865. DescrBeginOrderedList;
  866. ConvertListItems;
  867. DescrEndOrderedList;
  868. Result := True;
  869. end else if Node.NodeName = 'dl' then
  870. begin
  871. DescrBeginDefinitionList;
  872. ConvertDefinitionList;
  873. DescrEndDefinitionList;
  874. Result := True;
  875. end else if Node.NodeName = 'img' then
  876. begin
  877. ConvertImage(Node as TDomElement);
  878. end else
  879. Result := False;
  880. end;
  881. Procedure TFPDocWriter.ConvertImage(El : TDomElement);
  882. Var
  883. FN,Cap : DOMString;
  884. begin
  885. FN:=El['file'];
  886. Cap:=El['caption'];
  887. ChangeFileExt(FN,ImageExtension);
  888. DescrWriteImageEl(FN,Cap);
  889. end;
  890. Constructor TTopicElement.Create(const AName: String; AParent: TPasElement);
  891. begin
  892. Inherited Create(AName,AParent);
  893. SubTopics:=TList.Create;
  894. end;
  895. Destructor TTopicElement.Destroy;
  896. begin
  897. // Actual subtopics are freed by TFPDocWriter Topics list.
  898. SubTopics.Free;
  899. Inherited;
  900. end;
  901. procedure TFPDocWriter.WriteDescr(Element: TPasElement);
  902. begin
  903. WriteDescr(ELement,Engine.FindDocNode(Element));
  904. end;
  905. procedure TFPDocWriter.WriteDescr(Element: TPasElement; DocNode: TDocNode);
  906. begin
  907. if Assigned(DocNode) then
  908. begin
  909. if not IsDescrNodeEmpty(DocNode.Descr) then
  910. WriteDescr(Element, DocNode.Descr)
  911. else if not IsDescrNodeEmpty(DocNode.ShortDescr) then
  912. WriteDescr(Element, DocNode.ShortDescr);
  913. end;
  914. end;
  915. procedure TFPDocWriter.WriteDescr(AContext: TPasElement; DescrNode: TDOMElement);
  916. begin
  917. if Assigned(DescrNode) then
  918. ConvertDescr(AContext, DescrNode, False);
  919. end;
  920. procedure TFPDocWriter.FPDocError(Msg: String);
  921. begin
  922. Raise EFPDocWriterError.Create(Msg);
  923. end;
  924. procedure TFPDocWriter.FPDocError(Fmt: String; Args: array of const);
  925. begin
  926. FPDocError(Format(Fmt,Args));
  927. end;
  928. function TFPDocWriter.ShowMember(M: TPasElement): boolean;
  929. begin
  930. Result:=not ((M.Visibility=visPrivate) and Engine.HidePrivate);
  931. If Result then
  932. Result:=Not ((M.Visibility=visProtected) and Engine.HideProtected)
  933. end;
  934. Procedure TFPDocWriter.GetMethodList(ClassDecl: TPasClassType; List : TStringList);
  935. Var
  936. I : Integer;
  937. M : TPasElement;
  938. begin
  939. List.Clear;
  940. List.Sorted:=False;
  941. for i := 0 to ClassDecl.Members.Count - 1 do
  942. begin
  943. M:=TPasElement(ClassDecl.Members[i]);
  944. if M.InheritsFrom(TPasProcedureBase) and ShowMember(M) then
  945. List.AddObject(M.Name,M);
  946. end;
  947. List.Sorted:=False;
  948. end;
  949. initialization
  950. InitWriterList;
  951. finalization
  952. DoneWriterList;
  953. end.