dwriter.pp 33 KB

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