dwriter.pp 35 KB

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