dwriter.pp 34 KB

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