dwriter.pp 34 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229
  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. hlp : TPasElement;
  536. begin
  537. Result := True;
  538. if Node.NodeType = ELEMENT_NODE then
  539. if Node.NodeName = 'b' then
  540. begin
  541. DescrBeginBold;
  542. ConvertBaseShortList(AContext, Node, False);
  543. DescrEndBold;
  544. end else
  545. if Node.NodeName = 'i' then
  546. begin
  547. DescrBeginItalic;
  548. ConvertBaseShortList(AContext, Node, False);
  549. DescrEndItalic;
  550. end else
  551. if Node.NodeName = 'em' then
  552. begin
  553. DescrBeginEmph;
  554. ConvertBaseShortList(AContext, Node, False);
  555. DescrEndEmph;
  556. end else
  557. if Node.NodeName = 'file' then
  558. DescrWriteFileEl(ConvertTextContent)
  559. else if Node.NodeName = 'kw' then
  560. DescrWriteKeywordEl(ConvertTextContent)
  561. else if Node.NodeName = 'printshort' then
  562. begin
  563. El := TDOMElement(Node);
  564. hlp:=AContext;
  565. while assigned(hlp) and not (hlp is TPasModule) do
  566. hlp:=hlp.parent;
  567. if not (hlp is TPasModule) then
  568. hlp:=nil;
  569. DescrEl := Engine.FindShortDescr(TPasModule(hlp), El['id']);
  570. if Assigned(DescrEl) then
  571. ConvertShort(AContext, DescrEl)
  572. else
  573. begin
  574. Warning(AContext, Format(SErrUnknownPrintShortID, [El['id']]));
  575. DescrBeginBold;
  576. DescrWriteText('#ShortDescr:' + El['id']);
  577. DescrEndBold;
  578. end;
  579. end else if Node.NodeName = 'var' then
  580. DescrWriteVarEl(ConvertTextContent)
  581. else
  582. Result := False
  583. else
  584. DescrWriteText(ConvertText);
  585. end;
  586. procedure TFPDocWriter.ConvertBaseShortList(AContext: TPasElement;
  587. Node: TDOMNode; MayBeEmpty: Boolean);
  588. var
  589. Child: TDOMNode;
  590. begin
  591. Child := Node.FirstChild;
  592. while Assigned(Child) do
  593. begin
  594. if not ConvertBaseShort(AContext, Child) then
  595. Warning(AContext, SErrInvalidShortDescr)
  596. else
  597. MayBeEmpty := True;
  598. Child := Child.NextSibling;
  599. end;
  600. if not MayBeEmpty then
  601. Warning(AContext, SErrInvalidShortDescr)
  602. end;
  603. procedure TFPDocWriter.ConvertLink(AContext: TPasElement; El: TDOMElement);
  604. begin
  605. DescrBeginLink(El['id']);
  606. if not IsDescrNodeEmpty(El) then
  607. ConvertBaseShortList(AContext, El, True)
  608. else
  609. DescrWriteText(El['id']);
  610. DescrEndLink;
  611. end;
  612. procedure TFPDocWriter.ConvertURL(AContext: TPasElement; El: TDOMElement);
  613. begin
  614. DescrBeginURL(El['href']);
  615. if not IsDescrNodeEmpty(El) then
  616. ConvertBaseShortList(AContext, El, True)
  617. else
  618. DescrWriteText(El['href']);
  619. DescrEndURL;
  620. end;
  621. procedure TFPDocWriter.DoLog(const Msg: String);
  622. begin
  623. If Assigned(FEngine.OnLog) then
  624. FEngine.OnLog(Self,Msg);
  625. end;
  626. procedure TFPDocWriter.DoLog(const Fmt: String; Args: array of const);
  627. begin
  628. DoLog(Format(Fmt,Args));
  629. end;
  630. function TFPDocWriter.ConvertExtShort(AContext: TPasElement;
  631. Node: TDOMNode): Boolean;
  632. begin
  633. Result := False;
  634. while Assigned(Node) do
  635. begin
  636. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'link') then
  637. ConvertLink(AContext, TDOMElement(Node))
  638. else if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'url') then
  639. ConvertURL(AContext, TDOMElement(Node))
  640. else if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'br') then
  641. DescrWriteLinebreak
  642. else
  643. if not ConvertBaseShort(AContext, Node) then
  644. exit;
  645. Node := Node.NextSibling;
  646. end;
  647. Result := True;
  648. end;
  649. procedure TFPDocWriter.ConvertDescr(AContext: TPasElement; El: TDOMElement;
  650. AutoInsertBlock: Boolean);
  651. var
  652. Node, Child: TDOMNode;
  653. ParaCreated: Boolean;
  654. begin
  655. FContext:=AContext;
  656. try
  657. if AutoInsertBlock then
  658. if IsExtShort(El.FirstChild) then
  659. DescrBeginParagraph
  660. else
  661. AutoInsertBlock := False;
  662. Node := El.FirstChild;
  663. if not ConvertExtShort(AContext, Node) then
  664. begin
  665. while Assigned(Node) do
  666. begin
  667. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'section') then
  668. begin
  669. DescrBeginSectionTitle;
  670. Child := Node.FirstChild;
  671. while Assigned(Child) and (Child.NodeType <> ELEMENT_NODE) do
  672. begin
  673. if not IsDescrNodeEmpty(Child) then
  674. Warning(AContext, SErrInvalidContentBeforeSectionTitle);
  675. Child := Child.NextSibling;
  676. end;
  677. if not Assigned(Child) or (Child.NodeName <> 'title') then
  678. Warning(AContext, SErrSectionTitleExpected)
  679. else
  680. ConvertShort(AContext, TDOMElement(Child));
  681. DescrBeginSectionBody;
  682. if IsExtShort(Child) then
  683. begin
  684. DescrBeginParagraph;
  685. ParaCreated := True;
  686. end else
  687. ParaCreated := False;
  688. ConvertExtShortOrNonSectionBlocks(AContext, Child.NextSibling);
  689. if ParaCreated then
  690. DescrEndParagraph;
  691. DescrEndSection;
  692. end else if not ConvertNonSectionBlock(AContext, Node) then
  693. Warning(AContext, SErrInvalidDescr, [Node.NodeName]);
  694. Node := Node.NextSibling;
  695. end;
  696. end else
  697. if AutoInsertBlock then
  698. DescrEndParagraph;
  699. finally
  700. FContext:=Nil;
  701. end;
  702. end;
  703. procedure TFPDocWriter.ConvertExtShortOrNonSectionBlocks(AContext: TPasElement;
  704. Node: TDOMNode);
  705. begin
  706. if not ConvertExtShort(AContext, Node) then
  707. while Assigned(Node) do
  708. begin
  709. if not ConvertNonSectionBlock(AContext, Node) then
  710. Warning(AContext, SErrInvalidDescr, [Node.NodeName]);
  711. Node := Node.NextSibling;
  712. end;
  713. end;
  714. function TFPDocWriter.ConvertNonSectionBlock(AContext: TPasElement;
  715. Node: TDOMNode): Boolean;
  716. procedure ConvertCells(Node: TDOMNode);
  717. var
  718. Child: TDOMNode;
  719. IsEmpty: Boolean;
  720. begin
  721. Node := Node.FirstChild;
  722. IsEmpty := True;
  723. while Assigned(Node) do
  724. begin
  725. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'td') then
  726. begin
  727. DescrBeginTableCell;
  728. Child := Node.FirstChild;
  729. if not ConvertExtShort(AContext, Child) then
  730. while Assigned(Child) do
  731. begin
  732. if not ConvertSimpleBlock(AContext, Child) then
  733. Warning(AContext, SErrInvalidTableContent);
  734. Child := Child.NextSibling;
  735. end;
  736. DescrEndTableCell;
  737. IsEmpty := False;
  738. end else
  739. if IsContentNodeType(Node) then
  740. Warning(AContext, SErrInvalidTableContent);
  741. Node := Node.NextSibling;
  742. end;
  743. if IsEmpty then
  744. Warning(AContext, SErrTableRowEmpty);
  745. end;
  746. procedure ConvertTable;
  747. function GetColCount(Node: TDOMNode): Integer;
  748. begin
  749. Result := 0;
  750. Node := Node.FirstChild;
  751. while Assigned(Node) do
  752. begin
  753. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'td') then
  754. Inc(Result);
  755. Node := Node.NextSibling;
  756. end;
  757. end;
  758. var
  759. s: String;
  760. HasBorder, CaptionPossible, HeadRowPossible: Boolean;
  761. ColCount, ThisRowColCount: Integer;
  762. Subnode: TDOMNode;
  763. begin
  764. s := TDOMElement(Node)['border'];
  765. if s = '1' then
  766. HasBorder := True
  767. else
  768. begin
  769. HasBorder := False;
  770. if (Length(s) <> 0) and (s <> '0') then
  771. Warning(AContext, SErrInvalidBorderValue, ['<table>']);
  772. end;
  773. // Determine the number of columns
  774. ColCount := 0;
  775. Subnode := Node.FirstChild;
  776. while Assigned(Subnode) do
  777. begin
  778. if Subnode.NodeType = ELEMENT_NODE then
  779. if (Subnode.NodeName = 'caption') or (Subnode.NodeName = 'th') or
  780. (Subnode.NodeName = 'tr') then
  781. begin
  782. ThisRowColCount := GetColCount(Subnode);
  783. if ThisRowColCount > ColCount then
  784. ColCount := ThisRowColCount;
  785. end;
  786. Subnode := Subnode.NextSibling;
  787. end;
  788. DescrBeginTable(ColCount, HasBorder);
  789. Node := Node.FirstChild;
  790. CaptionPossible := True;
  791. HeadRowPossible := True;
  792. while Assigned(Node) do
  793. begin
  794. if Node.NodeType = ELEMENT_NODE then
  795. if CaptionPossible and (Node.NodeName = 'caption') then
  796. begin
  797. DescrBeginTableCaption;
  798. if not ConvertExtShort(AContext, Node.FirstChild) then
  799. Warning(AContext, SErrInvalidTableContent);
  800. DescrEndTableCaption;
  801. CaptionPossible := False;
  802. end else if HeadRowPossible and (Node.NodeName = 'th') then
  803. begin
  804. DescrBeginTableHeadRow;
  805. ConvertCells(Node);
  806. DescrEndTableHeadRow;
  807. CaptionPossible := False;
  808. HeadRowPossible := False;
  809. end else if Node.NodeName = 'tr' then
  810. begin
  811. DescrBeginTableRow;
  812. ConvertCells(Node);
  813. DescrEndTableRow;
  814. end else
  815. Warning(AContext, SErrInvalidTableContent)
  816. else if IsContentNodeType(Node) then
  817. Warning(AContext, SErrInvalidTableContent);
  818. Node := Node.NextSibling;
  819. end;
  820. DescrEndTable;
  821. end;
  822. begin
  823. if Node.NodeType <> ELEMENT_NODE then
  824. begin
  825. if Node.NodeType = TEXT_NODE then
  826. Result := IsWhitespaceNode(TDOMText(Node))
  827. else
  828. Result := Node.NodeType = COMMENT_NODE;
  829. exit;
  830. end;
  831. if Node.NodeName = 'remark' then
  832. begin
  833. DescrBeginRemark;
  834. Node := Node.FirstChild;
  835. if not ConvertExtShort(AContext, Node) then
  836. while Assigned(Node) do
  837. begin
  838. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'table') then
  839. ConvertTable
  840. else
  841. if not ConvertSimpleBlock(AContext, Node) then
  842. Warning(AContext, SErrInvalidRemarkContent, [Node.NodeName]);
  843. Node := Node.NextSibling;
  844. end;
  845. DescrEndRemark;
  846. Result := True;
  847. end else if Node.NodeName = 'table' then
  848. begin
  849. ConvertTable;
  850. Result := True;
  851. end else
  852. Result := ConvertSimpleBlock(AContext, Node);
  853. end;
  854. function TFPDocWriter.ConvertSimpleBlock(AContext: TPasElement;
  855. Node: TDOMNode): Boolean;
  856. procedure ConvertListItems;
  857. var
  858. Empty: Boolean;
  859. begin
  860. Node := Node.FirstChild;
  861. Empty := True;
  862. while Assigned(Node) do
  863. begin
  864. if ((Node.NodeType = TEXT_NODE) and not IsWhitespaceNode(TDOMText(Node))) or (Node.NodeType = ENTITY_REFERENCE_NODE)
  865. then
  866. Warning(AContext, SErrInvalidListContent)
  867. else if Node.NodeType = ELEMENT_NODE then
  868. if Node.NodeName = 'li' then
  869. begin
  870. DescrBeginListItem;
  871. ConvertExtShortOrNonSectionBlocks(AContext, Node.FirstChild);
  872. DescrEndListItem;
  873. Empty := False;
  874. end else
  875. Warning(AContext, SErrInvalidElementInList);
  876. Node := Node.NextSibling;
  877. end;
  878. if Empty then
  879. Warning(AContext, SErrListIsEmpty);
  880. end;
  881. procedure ConvertDefinitionList;
  882. var
  883. Empty, ExpectDTNext: Boolean;
  884. begin
  885. Node := Node.FirstChild;
  886. Empty := True;
  887. ExpectDTNext := True;
  888. while Assigned(Node) do
  889. begin
  890. if ((Node.NodeType = TEXT_NODE) and not IsWhitespaceNode(TDOMText(Node))) or (Node.NodeType = ENTITY_REFERENCE_NODE)
  891. then
  892. Warning(AContext, SErrInvalidListContent)
  893. else if Node.NodeType = ELEMENT_NODE then
  894. if ExpectDTNext and (Node.NodeName = 'dt') then
  895. begin
  896. DescrBeginDefinitionTerm;
  897. if not ConvertShort(AContext, TDOMElement(Node)) then
  898. Warning(AContext, SErrInvalidDefinitionTermContent);
  899. DescrEndDefinitionTerm;
  900. Empty := False;
  901. ExpectDTNext := False;
  902. end else if not ExpectDTNext and (Node.NodeName = 'dd') then
  903. begin
  904. DescrBeginDefinitionEntry;
  905. ConvertExtShortOrNonSectionBlocks(AContext, Node.FirstChild);
  906. DescrEndDefinitionEntry;
  907. ExpectDTNext := True;
  908. end else
  909. Warning(AContext, SErrInvalidElementInList);
  910. Node := Node.NextSibling;
  911. end;
  912. if Empty then
  913. Warning(AContext, SErrListIsEmpty)
  914. else if not ExpectDTNext then
  915. Warning(AContext, SErrDefinitionEntryMissing);
  916. end;
  917. procedure ProcessCodeBody(Node: TDOMNode);
  918. var
  919. s: String;
  920. i, j: Integer;
  921. begin
  922. Node := Node.FirstChild;
  923. SetLength(s, 0);
  924. while Assigned(Node) do
  925. begin
  926. if Node.NodeType = TEXT_NODE then
  927. begin
  928. s := s + Node.NodeValue;
  929. j := 1;
  930. for i := 1 to Length(s) do
  931. // In XML, linefeeds are normalized to #10 by the parser!
  932. if s[i] = #10 then
  933. begin
  934. DescrWriteCodeLine(Copy(s, j, i - j));
  935. j := i + 1;
  936. end;
  937. if j > 1 then
  938. s := Copy(s, j, Length(s));
  939. end;
  940. Node := Node.NextSibling;
  941. end;
  942. if Length(s) > 0 then
  943. DescrWriteCodeLine(s);
  944. end;
  945. var
  946. s: String;
  947. HasBorder: Boolean;
  948. begin
  949. if Node.NodeType <> ELEMENT_NODE then
  950. begin
  951. Result := (Node.NodeType = TEXT_NODE) and IsWhitespaceNode(TDOMText(Node));
  952. exit;
  953. end;
  954. if Node.NodeName = 'p' then
  955. begin
  956. DescrBeginParagraph;
  957. if not ConvertExtShort(AContext, Node.FirstChild) then
  958. Warning(AContext, SErrInvalidParaContent);
  959. DescrEndParagraph;
  960. Result := True;
  961. end else if Node.NodeName = 'code' then
  962. begin
  963. s := TDOMElement(Node)['border'];
  964. if s = '1' then
  965. HasBorder := True
  966. else
  967. begin
  968. if (Length(s) > 0) and (s <> '0') then
  969. Warning(AContext, SErrInvalidBorderValue, ['<code>']);
  970. end;
  971. DescrBeginCode(HasBorder, TDOMElement(Node)['highlighter']);
  972. ProcessCodeBody(Node);
  973. DescrEndCode;
  974. Result := True;
  975. end else if Node.NodeName = 'pre' then
  976. begin
  977. DescrBeginCode(False, 'none');
  978. ProcessCodeBody(Node);
  979. DescrEndCode;
  980. Result := True;
  981. end else if Node.NodeName = 'ul' then
  982. begin
  983. DescrBeginUnorderedList;
  984. ConvertListItems;
  985. DescrEndUnorderedList;
  986. Result := True;
  987. end else if Node.NodeName = 'ol' then
  988. begin
  989. DescrBeginOrderedList;
  990. ConvertListItems;
  991. DescrEndOrderedList;
  992. Result := True;
  993. end else if Node.NodeName = 'dl' then
  994. begin
  995. DescrBeginDefinitionList;
  996. ConvertDefinitionList;
  997. DescrEndDefinitionList;
  998. Result := True;
  999. end else if Node.NodeName = 'img' then
  1000. begin
  1001. begin
  1002. ConvertImage(Node as TDomElement);
  1003. Result:=True;
  1004. end;
  1005. end else
  1006. Result := False;
  1007. end;
  1008. Procedure TFPDocWriter.ConvertImage(El : TDomElement);
  1009. Var
  1010. FN,Cap,LinkName : DOMString;
  1011. begin
  1012. FN:=El['file'];
  1013. Cap:=El['caption'];
  1014. LinkName:=El['name'];
  1015. FN:=ChangeFileExt(FN,ImageExtension);
  1016. DescrWriteImageEl(FN,Cap,LinkName);
  1017. end;
  1018. procedure TFPDocWriter.DescrEmitNotesHeader(AContext: TPasElement);
  1019. begin
  1020. DescrWriteLinebreak;
  1021. DescrBeginBold;
  1022. DescrWriteText(SDocNotes);
  1023. DescrEndBold;
  1024. DescrWriteLinebreak;
  1025. end;
  1026. procedure TFPDocWriter.DescrEmitNotesFooter(AContext: TPasElement);
  1027. begin
  1028. DescrWriteLinebreak;
  1029. end;
  1030. Constructor TTopicElement.Create(const AName: String; AParent: TPasElement);
  1031. begin
  1032. Inherited Create(AName,AParent);
  1033. SubTopics:=TList.Create;
  1034. end;
  1035. Destructor TTopicElement.Destroy;
  1036. begin
  1037. // Actual subtopics are freed by TFPDocWriter Topics list.
  1038. SubTopics.Free;
  1039. Inherited;
  1040. end;
  1041. Function TFPDocWriter.WriteDescr(Element: TPasElement) : TDocNode;
  1042. begin
  1043. Result:=Engine.FindDocNode(Element);
  1044. WriteDescr(ELement,Result);
  1045. end;
  1046. procedure TFPDocWriter.WriteDescr(Element: TPasElement; DocNode: TDocNode);
  1047. begin
  1048. if Assigned(DocNode) then
  1049. begin
  1050. if not IsDescrNodeEmpty(DocNode.Descr) then
  1051. WriteDescr(Element, DocNode.Descr)
  1052. else if not IsDescrNodeEmpty(DocNode.ShortDescr) then
  1053. WriteDescr(Element, DocNode.ShortDescr);
  1054. end;
  1055. end;
  1056. procedure TFPDocWriter.WriteDescr(AContext: TPasElement; DescrNode: TDOMElement);
  1057. begin
  1058. if Assigned(DescrNode) then
  1059. ConvertDescr(AContext, DescrNode, False);
  1060. end;
  1061. procedure TFPDocWriter.FPDocError(Msg: String);
  1062. begin
  1063. Raise EFPDocWriterError.Create(Msg);
  1064. end;
  1065. procedure TFPDocWriter.FPDocError(Fmt: String; Args: array of const);
  1066. begin
  1067. FPDocError(Format(Fmt,Args));
  1068. end;
  1069. function TFPDocWriter.ShowMember(M: TPasElement): boolean;
  1070. begin
  1071. Result:=not ((M.Visibility=visPrivate) and Engine.HidePrivate);
  1072. If Result then
  1073. Result:=Not ((M.Visibility=visProtected) and Engine.HideProtected)
  1074. end;
  1075. Procedure TFPDocWriter.GetMethodList(ClassDecl: TPasClassType; List : TStringList);
  1076. Var
  1077. I : Integer;
  1078. M : TPasElement;
  1079. begin
  1080. List.Clear;
  1081. List.Sorted:=False;
  1082. for i := 0 to ClassDecl.Members.Count - 1 do
  1083. begin
  1084. M:=TPasElement(ClassDecl.Members[i]);
  1085. if M.InheritsFrom(TPasProcedureBase) and ShowMember(M) then
  1086. List.AddObject(M.Name,M);
  1087. end;
  1088. List.Sorted:=False;
  1089. end;
  1090. initialization
  1091. InitWriterList;
  1092. finalization
  1093. DoneWriterList;
  1094. end.