dwriter.pp 55 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976
  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, contnrs, dGlobals, PasTree, SysUtils, fpdocclasstree;
  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. TFileAllocator = class
  55. public
  56. procedure AllocFilename(AElement: TPasElement; ASubindex: Integer); virtual;
  57. function GetFilename(AElement: TPasElement;
  58. ASubindex: Integer): String; virtual; abstract;
  59. function GetRelativePathToTop(AElement: TPasElement): String; virtual;
  60. function GetCSSFilename(ARelativeTo: TPasElement): DOMString; virtual;
  61. end;
  62. TLongNameFileAllocator = class(TFileAllocator)
  63. private
  64. FExtension: String;
  65. public
  66. constructor Create(const AExtension: String);
  67. function GetFilename(AElement: TPasElement; ASubindex: Integer): String; override;
  68. function GetRelativePathToTop(AElement: TPasElement): String; override;
  69. property Extension: String read FExtension;
  70. end;
  71. TWriterLogEvent = Procedure(Sender : TObject; Const Msg : String) of object;
  72. TWriterNoteEvent = Procedure(Sender : TObject; Note : TDomElement; Var EmitNote : Boolean) of object;
  73. { TFPDocWriter }
  74. TFPDocWriter = class
  75. private
  76. FEmitNotes: Boolean;
  77. FEngine : TFPDocEngine;
  78. FPackage : TPasPackage;
  79. FContext : TPasElement;
  80. FTopics : TList;
  81. FImgExt : String;
  82. FBeforeEmitNote : TWriterNoteEvent;
  83. procedure ConvertURL(AContext: TPasElement; El: TDOMElement);
  84. procedure CreateClassTree;
  85. protected
  86. TreeClass: TClassTreeBuilder; // Global class tree
  87. TreeInterface: TClassTreeBuilder; // Global interface tree
  88. procedure AddElementsFromList(L: TStrings; List: TFPList; UsePathName : Boolean = False);
  89. Procedure DoLog(Const Msg : String);
  90. Procedure DoLog(Const Fmt : String; Args : Array of const);
  91. procedure Warning(AContext: TPasElement; const AMsg: String);
  92. procedure Warning(AContext: TPasElement; const AMsg: String;
  93. const Args: array of const);
  94. // function FindShortDescr(const Name: String): TDOMElement;
  95. // Description conversion
  96. function IsDescrNodeEmpty(Node: TDOMNode): Boolean;
  97. function IsExtShort(Node: TDOMNode): Boolean;
  98. function ConvertShort(AContext: TPasElement; El: TDOMElement): Boolean;
  99. function ConvertNotes(AContext: TPasElement; El: TDOMElement): Boolean; virtual;
  100. function ConvertBaseShort(AContext: TPasElement; Node: TDOMNode): Boolean;
  101. procedure ConvertBaseShortList(AContext: TPasElement; Node: TDOMNode;
  102. MayBeEmpty: Boolean);
  103. procedure ConvertLink(AContext: TPasElement; El: TDOMElement);
  104. function ConvertExtShort(AContext: TPasElement; Node: TDOMNode): Boolean;
  105. procedure ConvertDescr(AContext: TPasElement; El: TDOMElement;
  106. AutoInsertBlock: Boolean);
  107. function ConvertNonSectionBlock(AContext: TPasElement;
  108. Node: TDOMNode): Boolean;
  109. procedure ConvertExtShortOrNonSectionBlocks(AContext: TPasElement;
  110. Node: TDOMNode);
  111. function ConvertSimpleBlock(AContext: TPasElement; Node: TDOMNode): Boolean;
  112. Function FindTopicElement(Node : TDocNode): TTopicElement;
  113. Procedure ConvertImage(El : TDomElement);
  114. Procedure DescrEmitNotesHeader(AContext : TPasElement); virtual;
  115. Procedure DescrEmitNotesFooter(AContext : TPasElement); virtual;
  116. procedure DescrWriteText(const AText: DOMString); virtual; abstract;
  117. procedure DescrBeginBold; virtual; abstract;
  118. procedure DescrEndBold; virtual; abstract;
  119. procedure DescrBeginItalic; virtual; abstract;
  120. procedure DescrEndItalic; virtual; abstract;
  121. procedure DescrBeginUnderline; virtual; abstract;
  122. procedure DescrEndUnderline; virtual; abstract;
  123. procedure DescrBeginEmph; virtual; abstract;
  124. procedure DescrEndEmph; virtual; abstract;
  125. procedure DescrWriteImageEl(const AFileName, ACaption,ALinkName : DOMString); virtual;
  126. procedure DescrWriteFileEl(const AText: DOMString); virtual; abstract;
  127. procedure DescrWriteKeywordEl(const AText: DOMString); virtual; abstract;
  128. procedure DescrWriteVarEl(const AText: DOMString); virtual; abstract;
  129. procedure DescrBeginLink(const AId: DOMString); virtual; abstract;
  130. procedure DescrEndLink; virtual; abstract;
  131. procedure DescrBeginURL(const AURL: DOMString); virtual; abstract;
  132. procedure DescrEndURL; virtual; abstract;
  133. procedure DescrWriteLinebreak; virtual; abstract;
  134. procedure DescrBeginParagraph; virtual; abstract;
  135. procedure DescrEndParagraph; virtual; abstract;
  136. procedure DescrBeginCode(HasBorder: Boolean; const AHighlighterName: String); virtual; abstract;
  137. procedure DescrWriteCodeLine(const ALine: String); virtual; abstract;
  138. procedure DescrEndCode; virtual; abstract;
  139. procedure DescrBeginOrderedList; virtual; abstract;
  140. procedure DescrEndOrderedList; virtual; abstract;
  141. procedure DescrBeginUnorderedList; virtual; abstract;
  142. procedure DescrEndUnorderedList; virtual; abstract;
  143. procedure DescrBeginDefinitionList; virtual; abstract;
  144. procedure DescrEndDefinitionList; virtual; abstract;
  145. procedure DescrBeginListItem; virtual; abstract;
  146. procedure DescrEndListItem; virtual; abstract;
  147. procedure DescrBeginDefinitionTerm; virtual; abstract;
  148. procedure DescrEndDefinitionTerm; virtual; abstract;
  149. procedure DescrBeginDefinitionEntry; virtual; abstract;
  150. procedure DescrEndDefinitionEntry; virtual; abstract;
  151. procedure DescrBeginSectionTitle; virtual; abstract;
  152. procedure DescrBeginSectionBody; virtual; abstract;
  153. procedure DescrEndSection; virtual; abstract;
  154. procedure DescrBeginRemark; virtual; abstract;
  155. procedure DescrEndRemark; virtual; abstract;
  156. procedure DescrBeginTable(ColCount: Integer; HasBorder: Boolean); virtual; abstract;
  157. procedure DescrEndTable; virtual; abstract;
  158. procedure DescrBeginTableCaption; virtual; abstract;
  159. procedure DescrEndTableCaption; virtual; abstract;
  160. procedure DescrBeginTableHeadRow; virtual; abstract;
  161. procedure DescrEndTableHeadRow; virtual; abstract;
  162. procedure DescrBeginTableRow; virtual; abstract;
  163. procedure DescrEndTableRow; virtual; abstract;
  164. procedure DescrBeginTableCell; virtual; abstract;
  165. procedure DescrEndTableCell; virtual; abstract;
  166. Property CurrentContext : TPasElement Read FContext ;
  167. public
  168. Constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); virtual;
  169. destructor Destroy; override;
  170. procedure AddModuleIdentifiers(AModule: TPasModule; L: TStrings);
  171. property Engine : TFPDocEngine read FEngine;
  172. Property Package : TPasPackage read FPackage;
  173. Property Topics : TList Read FTopics;
  174. Property ImageExtension : String Read FImgExt Write FImgExt;
  175. // Should return True if option was succesfully interpreted.
  176. Function InterpretOption(Const Cmd,Arg : String) : Boolean; Virtual;
  177. Class Function FileNameExtension : String; virtual;
  178. Class Procedure Usage(List : TStrings); virtual;
  179. Class procedure SplitImport(var AFilename, ALinkPrefix: String); virtual;
  180. procedure WriteDoc; virtual; Abstract;
  181. Function WriteDescr(Element: TPasElement) : TDocNode;
  182. procedure WriteDescr(Element: TPasElement; DocNode: TDocNode);
  183. procedure WriteDescr(AContext: TPasElement; DescrNode: TDOMElement); virtual;
  184. Procedure FPDocError(Msg : String);
  185. Procedure FPDocError(Fmt : String; Args : Array of Const);
  186. Function ShowMember(M : TPasElement) : boolean;
  187. Procedure GetMethodList(ClassDecl: TPasClassType; List : TStringList);
  188. Property EmitNotes : Boolean Read FEmitNotes Write FEmitNotes;
  189. Property BeforeEmitNote : TWriterNoteEvent Read FBeforeEmitNote Write FBeforeEmitNote;
  190. end;
  191. const
  192. // The Multi-Page doc writer identifies each page by it's index.
  193. IdentifierIndex = 0;
  194. // Subpage indices for modules
  195. ResstrSubindex = 1;
  196. ConstsSubindex = 2;
  197. TypesSubindex = 3;
  198. ClassesSubindex = 4;
  199. ProcsSubindex = 5;
  200. VarsSubindex = 6;
  201. // Maybe needed later for topic overview ??
  202. TopicsSubIndex = 7;
  203. IndexSubIndex = 8;
  204. ClassHierarchySubIndex = 9;
  205. // Subpage indices for classes
  206. PropertiesByInheritanceSubindex = 11;
  207. PropertiesByNameSubindex = 12;
  208. MethodsByInheritanceSubindex = 13;
  209. MethodsByNameSubindex = 14;
  210. EventsByInheritanceSubindex = 15;
  211. EventsByNameSubindex = 16;
  212. Type
  213. { TMultiFileDocWriter }
  214. { TPageInfo }
  215. TPageInfo = class
  216. Public
  217. Element: TPasElement;
  218. SubpageIndex: Integer;
  219. Constructor Create(aElement : TPasElement; aIndex : Integer);
  220. end;
  221. { TLinkData }
  222. TLinkData = Class(TObject)
  223. FPathName,
  224. FLink,
  225. FModuleName : String;
  226. Constructor Create(Const APathName,ALink,AModuleName : string);
  227. end;
  228. TMultiFileDocWriter = Class(TFPDocWriter)
  229. Private
  230. FAllocator: TFileAllocator;
  231. FBaseDirectory: String;
  232. FCurDirectory: String;
  233. FModule: TPasModule;
  234. FPageInfos: TFPObjectList; // list of TPageInfo objects
  235. function GetPageCount: Integer;
  236. Protected
  237. function ResolveLinkID(const Name: String; Level: Integer=0): DOMString;
  238. function ResolveLinkIDInUnit(const Name,AUnitName: String): DOMString;
  239. function ResolveLinkWithinPackage(AElement: TPasElement; ASubpageIndex: Integer): String;
  240. Function CreateAllocator : TFileAllocator; virtual; abstract;
  241. // aFileName is the filename allocated by the Allocator, nothing prefixed.
  242. procedure WriteDocPage(const aFileName: String; aElement: TPasElement; aSubPageIndex: Integer); virtual; abstract;
  243. procedure AllocatePages; virtual;
  244. // Default page allocation mechanism.
  245. function AddPage(AElement: TPasElement; ASubpageIndex: Integer): TPageInfo; virtual;
  246. procedure AddPages(AElement: TPasElement; ASubpageIndex: Integer; AList: TFPList); virtual;
  247. procedure AddTopicPages(AElement: TPasElement); virtual;
  248. procedure AllocateClassMemberPages(AModule: TPasModule; LinkList: TObjectList); virtual;
  249. procedure AllocateModulePages(AModule: TPasModule; LinkList: TObjectList); virtual;
  250. procedure AllocatePackagePages; virtual;
  251. // Prefix every filename generated with the result of this.
  252. function GetFileBaseDir(aOutput: String): String; virtual;
  253. function ModuleHasClasses(AModule: TPasModule): Boolean;
  254. Property PageInfos : TFPObjectList Read FPageInfos;
  255. Public
  256. constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
  257. Destructor Destroy; override;
  258. procedure WriteDoc; override;
  259. property PageCount: Integer read GetPageCount;
  260. Property Allocator : TFileAllocator Read FAllocator Write FAllocator;
  261. Property Module: TPasModule Read FModule Write FModule;
  262. Property CurDirectory: String Read FCurDirectory Write FCurDirectory; // relative to curdir of process
  263. property BaseDirectory: String read FBaseDirectory Write FBaseDirectory; // relative path to package base directory
  264. end;
  265. TFPDocWriterClass = Class of TFPDocWriter;
  266. EFPDocWriterError = Class(Exception);
  267. // Member Filter Callback type
  268. TMemberFilter = function(AMember: TPasElement): Boolean;
  269. // Filter Callbacks
  270. function PropertyFilter(AMember: TPasElement): Boolean;
  271. function MethodFilter(AMember: TPasElement): Boolean;
  272. function EventFilter(AMember: TPasElement): Boolean;
  273. // Register backend
  274. Procedure RegisterWriter(AClass : TFPDocWriterClass; Const AName,ADescr : String);
  275. // UnRegister backend
  276. Procedure UnRegisterWriter(Const AName : String);
  277. // Return back end class. Exception if not found.
  278. Function GetWriterClass(AName : String) : TFPDocWriterClass;
  279. // Return index of back end class.
  280. Function FindWriterClass(AName : String) : Integer;
  281. // List of backend in name=descr form.
  282. Procedure EnumWriters(List : TStrings);
  283. // Sort elements on name
  284. function SortPasElements(Item1, Item2: Pointer): Integer;
  285. implementation
  286. function SortPasElements(Item1, Item2: Pointer): Integer;
  287. begin
  288. Result:=CompareText(TPasElement(Item1).Name,TPasElement(Item2).Name)
  289. end;
  290. { ---------------------------------------------------------------------
  291. Filter callbacks
  292. ---------------------------------------------------------------------}
  293. function PropertyFilter(AMember: TPasElement): Boolean;
  294. begin
  295. Result := (AMember.ClassType = TPasProperty) and
  296. (Copy(AMember.Name, 1, 2) <> 'On');
  297. end;
  298. function MethodFilter(AMember: TPasElement): Boolean;
  299. begin
  300. Result := AMember.InheritsFrom(TPasProcedureBase);
  301. // Writeln(aMember.Name,' (',aMember.ClassName,') is Method ',Result);
  302. end;
  303. function EventFilter(AMember: TPasElement): Boolean;
  304. begin
  305. Result := (AMember.ClassType = TPasProperty) and
  306. (Copy(AMember.Name, 1, 2) = 'On');
  307. end;
  308. { ---------------------------------------------------------------------
  309. Writer registration
  310. ---------------------------------------------------------------------}
  311. Type
  312. { TWriterRecord }
  313. TWriterRecord = Class(TObject)
  314. Private
  315. FClass : TFPDocWriterClass;
  316. FName : String;
  317. FDescription : String;
  318. Public
  319. Constructor Create (AClass : TFPDocWriterClass; Const AName,ADescr : String);
  320. end;
  321. { TPageInfo }
  322. constructor TPageInfo.Create(aElement: TPasElement; aIndex: Integer);
  323. begin
  324. Element:=aELement;
  325. SubpageIndex:=aIndex;
  326. end;
  327. { TLinkData }
  328. constructor TLinkData.Create(Const APathName, ALink, AModuleName: string);
  329. begin
  330. FPathName:=APathName;
  331. FLink:=ALink;
  332. FModuleName:=AModuleName;
  333. end;
  334. { TMultiFileDocWriter }
  335. constructor TMultiFileDocWriter.Create(APackage: TPasPackage;
  336. AEngine: TFPDocEngine);
  337. begin
  338. inherited Create(APackage, AEngine);
  339. FAllocator:=CreateAllocator;
  340. FPageInfos:=TFPObjectList.Create;
  341. end;
  342. destructor TMultiFileDocWriter.Destroy;
  343. begin
  344. FreeAndNil(FPageInfos);
  345. FreeAndNil(FAllocator);
  346. inherited Destroy;
  347. end;
  348. function TMultiFileDocWriter.GetPageCount: Integer;
  349. begin
  350. Result := PageInfos.Count;
  351. end;
  352. function TMultiFileDocWriter.ResolveLinkID(const Name: String; Level : Integer = 0): DOMString;
  353. var
  354. res,s: String;
  355. begin
  356. res:=Engine.ResolveLink(Module,Name, True);
  357. // engine can return backslashes on Windows
  358. if Length(res) > 0 then
  359. begin
  360. s:=Copy(Res, 1, Length(CurDirectory) + 1);
  361. if (S= CurDirectory + '/') or (s= CurDirectory + '\') then
  362. Res := Copy(Res, Length(CurDirectory) + 2, Length(Res))
  363. else if not IsLinkAbsolute(Res) then
  364. Res := BaseDirectory + Res;
  365. end;
  366. Result:=UTF8Decode(Res);
  367. end;
  368. { Used for:
  369. - <link> elements in descriptions
  370. - "see also" entries
  371. - AppendHyperlink (for unresolved parse tree element links)
  372. }
  373. function TMultiFileDocWriter.ResolveLinkIDInUnit(const Name,AUnitName: String): DOMString;
  374. begin
  375. Result:=ResolveLinkID(Name);
  376. If (Result='') and (AUnitName<>'') and (length(Name)>0) and (Name[1]<>'#') then
  377. Result:=ResolveLinkID(AUnitName+'.'+Name);
  378. end;
  379. function TMultiFileDocWriter.ResolveLinkWithinPackage(AElement: TPasElement;
  380. ASubpageIndex: Integer): String;
  381. var
  382. ParentEl: TPasElement;
  383. s : String;
  384. begin
  385. ParentEl := AElement;
  386. while Assigned(ParentEl) and not (ParentEl.ClassType = TPasPackage) do
  387. ParentEl := ParentEl.Parent;
  388. if Assigned(ParentEl) and (TPasPackage(ParentEl) = Engine.Package) then
  389. begin
  390. Result := Allocator.GetFilename(AElement, ASubpageIndex);
  391. // engine/allocator can return backslashes on Windows
  392. s:=Copy(Result, 1, Length(CurDirectory) + 1);
  393. if (S= CurDirectory + '/') or (s= CurDirectory + '\') then
  394. Result := Copy(Result, Length(CurDirectory) + 2, Length(Result))
  395. else
  396. Result := BaseDirectory + Result;
  397. end else
  398. SetLength(Result, 0);
  399. end;
  400. Function TMultiFileDocWriter.AddPage(AElement: TPasElement; ASubpageIndex: Integer) : TPageInfo;
  401. begin
  402. Result:= TPageInfo.Create(aElement,aSubPageIndex);
  403. PageInfos.Add(Result);
  404. Allocator.AllocFilename(AElement, ASubpageIndex);
  405. if ASubpageIndex = 0 then
  406. Engine.AddLink(AElement.PathName,Allocator.GetFilename(AElement, ASubpageIndex));
  407. end;
  408. procedure TMultiFileDocWriter.AddTopicPages(AElement: TPasElement);
  409. var
  410. PreviousTopic,
  411. TopicElement : TTopicElement;
  412. DocNode,
  413. TopicNode : TDocNode;
  414. begin
  415. DocNode:=Engine.FindDocNode(AElement);
  416. If not Assigned(DocNode) then
  417. exit;
  418. TopicNode:=DocNode.FirstChild;
  419. PreviousTopic:=Nil;
  420. While Assigned(TopicNode) do
  421. begin
  422. If TopicNode.TopicNode then
  423. begin
  424. TopicElement:=TTopicElement.Create(TopicNode.Name,AElement);
  425. Topics.Add(TopicElement);
  426. TopicElement.TopicNode:=TopicNode;
  427. TopicElement.Previous:=PreviousTopic;
  428. If Assigned(PreviousTopic) then
  429. PreviousTopic.Next:=TopicElement;
  430. PreviousTopic:=TopicElement;
  431. if AElement is TTopicElement then
  432. TTopicElement(AElement).SubTopics.Add(TopicElement);
  433. AddPage(TopicElement,IdentifierIndex);
  434. if AElement is TTopicElement then
  435. TTopicElement(AElement).SubTopics.Add(TopicElement)
  436. else // Only one level of recursion.
  437. AddTopicPages(TopicElement);
  438. end;
  439. TopicNode:=TopicNode.NextSibling;
  440. end;
  441. end;
  442. Function TMultiFileDocWriter.ModuleHasClasses(AModule: TPasModule) : Boolean;
  443. begin
  444. result:=assigned(AModule)
  445. and assigned(AModule.InterfaceSection)
  446. and assigned(AModule.InterfaceSection.Classes)
  447. and (AModule.InterfaceSection.Classes.Count>0);
  448. end;
  449. procedure TMultiFileDocWriter.AddPages(AElement: TPasElement; ASubpageIndex: Integer;
  450. AList: TFPList);
  451. var
  452. i,j: Integer;
  453. R : TPasRecordtype;
  454. FPEl : TPasElement;
  455. DocNode: TDocNode;
  456. begin
  457. if AList.Count > 0 then
  458. begin
  459. AddPage(AElement, ASubpageIndex);
  460. for i := 0 to AList.Count - 1 do
  461. begin
  462. AddPage(TPasElement(AList[i]), 0);
  463. if (TObject(AList[i]) is TPasRecordType) then
  464. begin
  465. R:=TObject(AList[I]) as TPasRecordType;
  466. For J:=0 to R.Members.Count-1 do
  467. begin
  468. FPEl:=TPasElement(R.Members[J]);
  469. if ((FPEL is TPasProperty) or (FPEL is TPasProcedureBase))
  470. and Engine.ShowElement(FPEl) then
  471. begin
  472. DocNode := Engine.FindDocNode(FPEl);
  473. if Assigned(DocNode) then
  474. AddPage(FPEl, 0);
  475. end;
  476. end;
  477. end;
  478. end;
  479. end;
  480. end;
  481. Procedure TMultiFileDocWriter.AllocateClassMemberPages(AModule: TPasModule; LinkList : TObjectList);
  482. var
  483. i, j, k: Integer;
  484. ClassEl: TPasClassType;
  485. FPEl, AncestorMemberEl: TPasElement;
  486. DocNode: TDocNode;
  487. ALink : DOMString;
  488. DidAutolink: Boolean;
  489. begin
  490. for i := 0 to AModule.InterfaceSection.Classes.Count - 1 do
  491. begin
  492. ClassEl := TPasClassType(AModule.InterfaceSection.Classes[i]);
  493. AddPage(ClassEl, 0);
  494. // !!!: Only add when there are items
  495. AddPage(ClassEl, PropertiesByInheritanceSubindex);
  496. AddPage(ClassEl, PropertiesByNameSubindex);
  497. AddPage(ClassEl, MethodsByInheritanceSubindex);
  498. AddPage(ClassEl, MethodsByNameSubindex);
  499. AddPage(ClassEl, EventsByInheritanceSubindex);
  500. AddPage(ClassEl, EventsByNameSubindex);
  501. for j := 0 to ClassEl.Members.Count - 1 do
  502. begin
  503. FPEl := TPasElement(ClassEl.Members[j]);
  504. if Not Engine.ShowElement(FPEl) then
  505. continue;
  506. DocNode := Engine.FindDocNode(FPEl);
  507. if Assigned(DocNode) then
  508. begin
  509. if Assigned(DocNode.Node) then
  510. ALink:=DocNode.Node['link']
  511. else
  512. ALink:='';
  513. If (ALink<>'') then
  514. LinkList.Add(TLinkData.Create(FPEl.PathName,UTF8Encode(ALink),AModule.name))
  515. else
  516. AddPage(FPEl, 0);
  517. end
  518. else
  519. begin
  520. DidAutolink := False;
  521. if Assigned(ClassEl.AncestorType) and
  522. (ClassEl.AncestorType.ClassType.inheritsfrom(TPasClassType)) then
  523. begin
  524. for k := 0 to TPasClassType(ClassEl.AncestorType).Members.Count - 1 do
  525. begin
  526. AncestorMemberEl :=
  527. TPasElement(TPasClassType(ClassEl.AncestorType).Members[k]);
  528. if AncestorMemberEl.Name = FPEl.Name then
  529. begin
  530. DocNode := Engine.FindDocNode(AncestorMemberEl);
  531. if Assigned(DocNode) then
  532. begin
  533. DidAutolink := True;
  534. Engine.AddLink(FPEl.PathName,
  535. Engine.FindAbsoluteLink(AncestorMemberEl.PathName));
  536. break;
  537. end;
  538. end;
  539. end;
  540. end;
  541. if not DidAutolink then
  542. AddPage(FPEl, 0);
  543. end;
  544. end;
  545. end;
  546. end;
  547. procedure TMultiFileDocWriter.AllocateModulePages(AModule: TPasModule; LinkList : TObjectList);
  548. var
  549. i: Integer;
  550. s: String;
  551. begin
  552. if not assigned(Amodule.Interfacesection) then
  553. exit;
  554. AddPage(AModule, 0);
  555. AddPage(AModule,IndexSubIndex);
  556. AddTopicPages(AModule);
  557. with AModule do
  558. begin
  559. if InterfaceSection.ResStrings.Count > 0 then
  560. begin
  561. AddPage(AModule, ResstrSubindex);
  562. s := Allocator.GetFilename(AModule, ResstrSubindex);
  563. for i := 0 to InterfaceSection.ResStrings.Count - 1 do
  564. with TPasResString(InterfaceSection.ResStrings[i]) do
  565. Engine.AddLink(PathName, s + '#' + LowerCase(Name));
  566. end;
  567. AddPages(AModule, ConstsSubindex, InterfaceSection.Consts);
  568. AddPages(AModule, TypesSubindex, InterfaceSection.Types);
  569. if InterfaceSection.Classes.Count > 0 then
  570. begin
  571. AddPage(AModule, ClassesSubindex);
  572. AllocateClassMemberPages(AModule,LinkList);
  573. end;
  574. AddPages(AModule, ProcsSubindex, InterfaceSection.Functions);
  575. AddPages(AModule, VarsSubindex, InterfaceSection.Variables);
  576. end;
  577. end;
  578. procedure TMultiFileDocWriter.AllocatePackagePages;
  579. Var
  580. I : Integer;
  581. H : Boolean;
  582. begin
  583. if Length(Package.Name) <= 1 then
  584. exit;
  585. AddPage(Package, 0);
  586. AddPage(Package,IndexSubIndex);
  587. I:=0;
  588. H:=False;
  589. While (I<Package.Modules.Count) and Not H do
  590. begin
  591. H:=ModuleHasClasses(TPasModule(Package.Modules[i]));
  592. Inc(I);
  593. end;
  594. if H then
  595. AddPage(Package,ClassHierarchySubIndex);
  596. AddTopicPages(Package);
  597. end;
  598. procedure TMultiFileDocWriter.AllocatePages;
  599. Var
  600. L : TObjectList;
  601. ML : TFPList;
  602. I : Integer;
  603. begin
  604. // Allocate page for the package itself, if a name is given (i.e. <> '#')
  605. AllocatePackagePages;
  606. ML:=Nil;
  607. L:=TObjectList.Create;
  608. try
  609. ML:=TFPList.Create;
  610. ML.AddList(Package.Modules);
  611. ML.Sort(@SortPasElements);
  612. for i := 0 to ML.Count - 1 do
  613. AllocateModulePages(TPasModule(ML[i]),L);
  614. // Resolve links
  615. For I:=0 to L.Count-1 do
  616. With TLinkData(L[i]) do
  617. Engine.AddLink(FPathName,UTF8Encode(ResolveLinkIDInUnit(FLink,FModuleName)));
  618. finally
  619. L.Free;
  620. ML.Free;
  621. end;
  622. end;
  623. function TMultiFileDocWriter.GetFileBaseDir(aOutput: String) : String;
  624. begin
  625. Result:=Engine.Output;
  626. if Result<>'' then
  627. Result:=IncludeTrailingPathDelimiter(Result);
  628. end;
  629. procedure TMultiFileDocWriter.WriteDoc;
  630. procedure CreatePath(const AFilename: String);
  631. var
  632. EndIndex: Integer;
  633. Path: String;
  634. begin
  635. EndIndex := Length(AFilename);
  636. if EndIndex = 0 then
  637. exit;
  638. while not (AFilename[EndIndex] in AllowDirectorySeparators) do
  639. begin
  640. Dec(EndIndex);
  641. if EndIndex = 0 then
  642. exit;
  643. end;
  644. Path := Copy(AFilename, 1, EndIndex - 1);
  645. if not DirectoryExists(Path) then
  646. begin
  647. CreatePath(Path);
  648. MkDir(Path);
  649. end;
  650. end;
  651. var
  652. i: Integer;
  653. FileName : String;
  654. FinalFilename: String;
  655. begin
  656. AllocatePages;
  657. DoLog(SWritingPages, [PageCount]);
  658. if Engine.Output <> '' then
  659. Engine.Output := IncludeTrailingBackSlash(Engine.Output);
  660. for i := 0 to PageInfos.Count - 1 do
  661. with TPageInfo(PageInfos[i]) do
  662. begin
  663. FileName:= Allocator.GetFilename(Element, SubpageIndex);
  664. FinalFilename := GetFileBaseDir(Engine.Output) + FileName;
  665. CreatePath(FinalFilename);
  666. WriteDocPage(FileName,ELement,SubPageIndex);
  667. end;
  668. end;
  669. { TWriterRecord }
  670. constructor TWriterRecord.Create(AClass: TFPDocWriterClass; const AName,
  671. ADescr: String);
  672. begin
  673. FClass:=AClass;
  674. FName:=AName;
  675. FDescription:=ADescr;
  676. end;
  677. Var
  678. Writers : TStringList;
  679. Procedure InitWriterList;
  680. begin
  681. Writers:=TStringList.Create;
  682. Writers.Sorted:=True;
  683. end;
  684. Procedure DoneWriterList;
  685. Var
  686. I : Integer;
  687. begin
  688. For I:=Writers.Count-1 downto 0 do
  689. Writers.Objects[i].Free;
  690. FreeAndNil(Writers);
  691. end;
  692. procedure RegisterWriter(AClass : TFPDocWriterClass; Const AName, ADescr : String);
  693. begin
  694. If Writers.IndexOf(AName)<>-1 then
  695. Raise EFPDocWriterError.CreateFmt(SErralreadyRegistered,[ANAme]);
  696. Writers.AddObject(AName,TWriterRecord.Create(AClass,AName,ADescr));
  697. end;
  698. function FindWriterClass(AName : String) : Integer;
  699. begin
  700. Result:=Writers.IndexOf(AName);
  701. end;
  702. function GetWriterClass(AName : String) : TFPDocWriterClass;
  703. Var
  704. Index : Integer;
  705. begin
  706. Index:=FindWriterClass(AName);
  707. If Index=-1 then
  708. Raise EFPDocWriterError.CreateFmt(SErrUnknownWriterClass,[ANAme]);
  709. Result:=(Writers.Objects[Index] as TWriterRecord).FClass;
  710. end;
  711. // UnRegister backend
  712. Procedure UnRegisterWriter(Const AName : String);
  713. Var
  714. Index : Integer;
  715. begin
  716. Index:=Writers.IndexOf(AName);
  717. If Index=-1 then
  718. Raise EFPDocWriterError.CreateFmt(SErrUnknownWriterClass,[ANAme]);
  719. Writers.Objects[Index].Free;
  720. Writers.Delete(Index);
  721. end;
  722. Procedure EnumWriters(List : TStrings);
  723. Var
  724. I : Integer;
  725. begin
  726. List.Clear;
  727. For I:=0 to Writers.Count-1 do
  728. With (Writers.Objects[I] as TWriterRecord) do
  729. List.Add(FName+'='+FDescription);
  730. end;
  731. function IsWhitespaceNode(Node: TDOMText): Boolean;
  732. var
  733. I,L: Integer;
  734. S: DOMString;
  735. P : PWideChar;
  736. begin
  737. S := Node.Data;
  738. Result := True;
  739. I:=0;
  740. L:=Length(S);
  741. P:=PWideChar(S);
  742. While Result and (I<L) do
  743. begin
  744. Result:=P^ in [#32,#10,#9,#13];
  745. Inc(P);
  746. Inc(I);
  747. end;
  748. end;
  749. { ---------------------------------------------------------------------
  750. TFileAllocator
  751. ---------------------------------------------------------------------}
  752. procedure TFileAllocator.AllocFilename(AElement: TPasElement;
  753. ASubindex: Integer);
  754. begin
  755. end;
  756. function TFileAllocator.GetRelativePathToTop(AElement: TPasElement): String;
  757. begin
  758. Result:='';
  759. end;
  760. function TFileAllocator.GetCSSFilename(ARelativeTo: TPasElement): DOMString;
  761. begin
  762. Result := Utf8Decode(GetRelativePathToTop(ARelativeTo)) + 'fpdoc.css';
  763. end;
  764. { ---------------------------------------------------------------------
  765. TLongNameFileAllocator
  766. ---------------------------------------------------------------------}
  767. constructor TLongNameFileAllocator.Create(const AExtension: String);
  768. begin
  769. inherited Create;
  770. FExtension := AExtension;
  771. end;
  772. function TLongNameFileAllocator.GetFilename(AElement: TPasElement; ASubindex: Integer): String;
  773. var
  774. n,s: String;
  775. i: Integer;
  776. begin
  777. Result:='';
  778. if AElement.ClassType = TPasPackage then
  779. Result := 'index'
  780. else if AElement.ClassType = TPasModule then
  781. Result := LowerCase(AElement.Name) + PathDelim + 'index'
  782. else
  783. begin
  784. if AElement is TPasOperator then
  785. begin
  786. if Assigned(AElement.Parent) then
  787. result:=LowerCase(AElement.Parent.PathName);
  788. With TPasOperator(aElement) do
  789. Result:= Result + 'op-'+OperatorTypeToOperatorName(OperatorType);
  790. s := '';
  791. N:=LowerCase(aElement.Name); // Should not contain any weird chars.
  792. Delete(N,1,Pos('(',N));
  793. i := 1;
  794. Repeat
  795. I:=Pos(',',N);
  796. if I=0 then
  797. I:=Pos(')',N);
  798. if I>1 then
  799. begin
  800. if (S<>'') then
  801. S:=S+'-';
  802. S:=S+Copy(N,1,I-1);
  803. end;
  804. Delete(N,1,I);
  805. until I=0;
  806. // First char is maybe :
  807. if (N<>'') and (N[1]=':') then
  808. Delete(N,1,1);
  809. Result:=Result + '-'+ s + '-' + N;
  810. end else
  811. Result := LowerCase(AElement.PathName);
  812. // searching for TPasModule - it is on the 2nd level
  813. if Assigned(AElement.Parent) then
  814. while Assigned(AElement.Parent.Parent) do
  815. AElement := AElement.Parent;
  816. // cut off Package Name
  817. Result := Copy(Result, Length(AElement.Parent.Name) + 2, MaxInt);
  818. // to skip dots in unit name
  819. i := Length(AElement.Name);
  820. while (i <= Length(Result)) and (Result[i] <> '.') do
  821. Inc(i);
  822. if (i <= Length(Result)) and (i > 0) then
  823. Result[i] := PathDelim;
  824. end;
  825. if ASubindex > 0 then
  826. Result := Result + '-' + IntToStr(ASubindex);
  827. Result := Result + Extension;
  828. end;
  829. function TLongNameFileAllocator.GetRelativePathToTop(AElement: TPasElement): String;
  830. begin
  831. if (AElement.ClassType=TPasPackage) then
  832. Result := ''
  833. else if (AElement.ClassType=TTopicElement) then
  834. begin
  835. If (AElement.Parent.ClassType=TTopicElement) then
  836. Result:='../'+GetRelativePathToTop(AElement.Parent)
  837. else if (AElement.Parent.ClassType=TPasPackage) then
  838. Result:=''
  839. else if (AElement.Parent.ClassType=TPasModule) then
  840. Result:='../';
  841. end
  842. else
  843. Result := '../';
  844. end;
  845. { ---------------------------------------------------------------------
  846. TFPDocWriter
  847. ---------------------------------------------------------------------}
  848. {
  849. fmtIPF:
  850. begin
  851. if Length(Engine.Output) = 0 then
  852. WriteLn(SCmdLineOutputOptionMissing)
  853. else
  854. CreateIPFDocForPackage(Engine.Package, Engine);
  855. end;
  856. }
  857. constructor TFPDocWriter.Create ( APackage: TPasPackage; AEngine: TFPDocEngine
  858. ) ;
  859. begin
  860. inherited Create;
  861. FEngine := AEngine;
  862. FPackage := APackage;
  863. FTopics:=Tlist.Create;
  864. FImgExt:='.png';
  865. TreeClass:= TClassTreeBuilder.Create(FEngine, FPackage, okClass);
  866. TreeInterface:= TClassTreeBuilder.Create(FEngine, FPackage, okInterface);
  867. CreateClassTree;
  868. end;
  869. destructor TFPDocWriter.Destroy;
  870. Var
  871. i : integer;
  872. begin
  873. For I:=0 to FTopics.Count-1 do
  874. TTopicElement(FTopics[i]).Free;
  875. FTopics.Free;
  876. TreeClass.free;
  877. TreeInterface.Free;
  878. Inherited;
  879. end;
  880. procedure TFPDocWriter.AddModuleIdentifiers(AModule : TPasModule; L : TStrings);
  881. begin
  882. if assigned(AModule.InterfaceSection) Then
  883. begin
  884. AddElementsFromList(L,AModule.InterfaceSection.Consts);
  885. AddElementsFromList(L,AModule.InterfaceSection.Types);
  886. AddElementsFromList(L,AModule.InterfaceSection.Functions);
  887. AddElementsFromList(L,AModule.InterfaceSection.Classes);
  888. AddElementsFromList(L,AModule.InterfaceSection.Variables);
  889. AddElementsFromList(L,AModule.InterfaceSection.ResStrings);
  890. end;
  891. end;
  892. function TFPDocWriter.InterpretOption(const Cmd, Arg: String): Boolean;
  893. begin
  894. Result:=False;
  895. end;
  896. class function TFPDocWriter.FileNameExtension: String;
  897. begin
  898. //Override in linear writers with the expected extension.
  899. Result := ''; //Output must not contain an extension.
  900. end;
  901. class procedure TFPDocWriter.Usage(List: TStrings);
  902. begin
  903. // Do nothing.
  904. end;
  905. class procedure TFPDocWriter.SplitImport(var AFilename, ALinkPrefix: String);
  906. var
  907. i: integer;
  908. begin
  909. //override in HTML and CHM writer
  910. i := Pos(',', AFilename);
  911. if i > 0 then
  912. begin //split CSV into filename and prefix
  913. ALinkPrefix := Copy(AFilename,i+1,Length(AFilename));
  914. SetLength(AFilename, i-1);
  915. end;
  916. end;
  917. function TFPDocWriter.FindTopicElement ( Node: TDocNode ) : TTopicElement;
  918. Var
  919. I : Integer;
  920. begin
  921. Result:=Nil;
  922. I:=FTopics.Count-1;
  923. While (I>=0) and (Result=Nil) do
  924. begin
  925. If (TTopicElement(FTopics[i]).TopicNode=Node) Then
  926. Result:=TTopicElement(FTopics[i]);
  927. Dec(I);
  928. end;
  929. end;
  930. procedure TFPDocWriter.DescrWriteImageEl(const AFileName, ACaption,
  931. ALinkName: DOMString);
  932. begin
  933. DoLog('%s : No support for images yet: %s (caption: "%s")',[ClassName,AFileName,ACaption]);
  934. end;
  935. { ---------------------------------------------------------------------
  936. Generic documentation node conversion
  937. ---------------------------------------------------------------------}
  938. function IsContentNodeType(Node: TDOMNode): Boolean;
  939. begin
  940. Result := (Node.NodeType = ELEMENT_NODE) or
  941. ((Node.NodeType = TEXT_NODE) and not IsWhitespaceNode(TDOMText(Node))) or
  942. (Node.NodeType = ENTITY_REFERENCE_NODE);
  943. end;
  944. procedure TFPDocWriter.Warning(AContext: TPasElement; const AMsg: String);
  945. begin
  946. if (AContext<>nil) then
  947. DoLog('[%s] %s',[AContext.PathName,AMsg])
  948. else
  949. DoLog('[<no context>] %s', [AMsg]);
  950. end;
  951. procedure TFPDocWriter.Warning(AContext: TPasElement; const AMsg: String;
  952. const Args: array of const);
  953. begin
  954. Warning(AContext, Format(AMsg, Args));
  955. end;
  956. function TFPDocWriter.IsDescrNodeEmpty(Node: TDOMNode): Boolean;
  957. var
  958. Child: TDOMNode;
  959. begin
  960. if (not Assigned(Node)) or (not Assigned(Node.FirstChild)) then
  961. Result := True
  962. else
  963. begin
  964. Child := Node.FirstChild;
  965. while Assigned(Child) do
  966. begin
  967. if (Child.NodeType = ELEMENT_NODE) or (Child.NodeType = TEXT_NODE) or
  968. (Child.NodeType = ENTITY_REFERENCE_NODE) then
  969. begin
  970. Result := False;
  971. exit;
  972. end;
  973. Child := Child.NextSibling;
  974. end;
  975. end;
  976. Result := True;
  977. end;
  978. { Check wether the nodes starting with the node given as argument make up an
  979. 'extshort' production. }
  980. function TFPDocWriter.IsExtShort(Node: TDOMNode): Boolean;
  981. begin
  982. while Assigned(Node) do
  983. begin
  984. if Node.NodeType = ELEMENT_NODE then
  985. if (Node.NodeName <> 'br') and
  986. (Node.NodeName <> 'link') and
  987. (Node.NodeName <> 'url') and
  988. (Node.NodeName <> 'b') and
  989. (Node.NodeName <> 'file') and
  990. (Node.NodeName <> 'i') and
  991. (Node.NodeName <> 'kw') and
  992. (Node.NodeName <> 'printshort') and
  993. (Node.NodeName <> 'var') then
  994. begin
  995. Result := False;
  996. exit;
  997. end;
  998. Node := Node.NextSibling;
  999. end;
  1000. Result := True;
  1001. end;
  1002. function TFPDocWriter.ConvertShort(AContext: TPasElement;
  1003. El: TDOMElement): Boolean;
  1004. var
  1005. Node: TDOMNode;
  1006. begin
  1007. Result := False;
  1008. if not Assigned(El) then
  1009. exit;
  1010. FContext:=AContext;
  1011. try
  1012. Node := El.FirstChild;
  1013. while Assigned(Node) do
  1014. begin
  1015. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'link') then
  1016. ConvertLink(AContext, TDOMElement(Node))
  1017. else if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'url') then
  1018. ConvertURL(AContext, TDOMElement(Node))
  1019. else
  1020. if not ConvertBaseShort(AContext, Node) then
  1021. exit;
  1022. Node := Node.NextSibling;
  1023. end;
  1024. Result := True;
  1025. finally
  1026. FContext:=Nil;
  1027. end;
  1028. end;
  1029. function TFPDocWriter.ConvertNotes(AContext: TPasElement; El: TDOMElement
  1030. ): Boolean;
  1031. Var
  1032. L : TFPList;
  1033. N : TDomNode;
  1034. I : Integer;
  1035. B : Boolean;
  1036. begin
  1037. Result:=Assigned(El) and EmitNotes;
  1038. If Not Result then
  1039. exit;
  1040. L:=TFPList.Create;
  1041. try
  1042. N:=El.FirstChild;
  1043. While Assigned(N) do
  1044. begin
  1045. If (N.NodeType=ELEMENT_NODE) and (N.NodeName='note') then
  1046. begin
  1047. B:=True;
  1048. if Assigned(FBeforeEmitNote) then
  1049. FBeforeEmitNote(Self,TDomElement(N),B);
  1050. If B then
  1051. L.Add(N);
  1052. end;
  1053. N:=N.NextSibling;
  1054. end;
  1055. Result:=L.Count>0;
  1056. If Not Result then
  1057. exit;
  1058. DescrEmitNotesHeader(AContext);
  1059. DescrBeginUnorderedList;
  1060. For i:=0 to L.Count-1 do
  1061. begin
  1062. DescrBeginListItem;
  1063. ConvertExtShortOrNonSectionBlocks(AContext, TDOMNode(L[i]).FirstChild);
  1064. DescrEndListItem;
  1065. end;
  1066. DescrEndUnorderedList;
  1067. DescrEmitNotesFooter(AContext);
  1068. finally
  1069. L.Free;
  1070. end;
  1071. end;
  1072. function TFPDocWriter.ConvertBaseShort(AContext: TPasElement;
  1073. Node: TDOMNode): Boolean;
  1074. function ConvertText: DOMString;
  1075. var
  1076. s: DOMString;
  1077. i: Integer;
  1078. begin
  1079. if Node.NodeType = TEXT_NODE then
  1080. begin
  1081. s := Node.NodeValue;
  1082. i := 1;
  1083. Result:='';
  1084. while i <= Length(s) do
  1085. if s[i] = #13 then
  1086. begin
  1087. Result := Result + ' ';
  1088. Inc(i);
  1089. if s[i] = #10 then
  1090. Inc(i);
  1091. end else if s[i] = #10 then
  1092. begin
  1093. Result := Result + ' ';
  1094. Inc(i);
  1095. end else
  1096. begin
  1097. Result := Result + s[i];
  1098. Inc(i);
  1099. end;
  1100. end else if Node.NodeType = ENTITY_REFERENCE_NODE then
  1101. if Node.NodeName = 'fpc' then
  1102. Result := 'Free Pascal'
  1103. else if Node.NodeName = 'delphi' then
  1104. Result := 'Delphi'
  1105. else
  1106. begin
  1107. Warning(AContext, Format(SErrUnknownEntityReference, [Node.NodeName]));
  1108. Result := Node.NodeName;
  1109. end
  1110. else if Node.NodeType = ELEMENT_NODE then
  1111. SetLength(Result, 0);
  1112. end;
  1113. function ConvertTextContent: DOMString;
  1114. begin
  1115. Result:='';
  1116. Node := Node.FirstChild;
  1117. while Assigned(Node) do
  1118. begin
  1119. Result := Result + ConvertText;
  1120. Node := Node.NextSibling;
  1121. end;
  1122. end;
  1123. var
  1124. El, DescrEl: TDOMElement;
  1125. hlp : TPasElement;
  1126. begin
  1127. Result := True;
  1128. if Node.NodeType = ELEMENT_NODE then
  1129. if Node.NodeName = 'b' then
  1130. begin
  1131. DescrBeginBold;
  1132. ConvertBaseShortList(AContext, Node, False);
  1133. DescrEndBold;
  1134. end else
  1135. if Node.NodeName = 'i' then
  1136. begin
  1137. DescrBeginItalic;
  1138. ConvertBaseShortList(AContext, Node, False);
  1139. DescrEndItalic;
  1140. end else
  1141. if Node.NodeName = 'em' then
  1142. begin
  1143. DescrBeginEmph;
  1144. ConvertBaseShortList(AContext, Node, False);
  1145. DescrEndEmph;
  1146. end else
  1147. if Node.NodeName = 'u' then
  1148. begin
  1149. DescrBeginUnderline;
  1150. ConvertBaseShortList(AContext, Node, False);
  1151. DescrEndUnderline;
  1152. end else
  1153. if Node.NodeName = 'file' then
  1154. DescrWriteFileEl(ConvertTextContent)
  1155. else if Node.NodeName = 'kw' then
  1156. DescrWriteKeywordEl(ConvertTextContent)
  1157. else if Node.NodeName = 'printshort' then
  1158. begin
  1159. El := TDOMElement(Node);
  1160. hlp:=AContext;
  1161. while assigned(hlp) and not (hlp is TPasModule) do
  1162. hlp:=hlp.parent;
  1163. if not (hlp is TPasModule) then
  1164. hlp:=nil;
  1165. DescrEl := Engine.FindShortDescr(TPasModule(hlp), UTF8Encode(El['id']));
  1166. if Assigned(DescrEl) then
  1167. ConvertShort(AContext, DescrEl)
  1168. else
  1169. begin
  1170. Warning(AContext, Format(SErrUnknownPrintShortID, [El['id']]));
  1171. DescrBeginBold;
  1172. DescrWriteText('#ShortDescr:' + El['id']);
  1173. DescrEndBold;
  1174. end;
  1175. end else if Node.NodeName = 'var' then
  1176. DescrWriteVarEl(ConvertTextContent)
  1177. else
  1178. Result := False
  1179. else
  1180. DescrWriteText(ConvertText);
  1181. end;
  1182. procedure TFPDocWriter.ConvertBaseShortList(AContext: TPasElement;
  1183. Node: TDOMNode; MayBeEmpty: Boolean);
  1184. var
  1185. Child: TDOMNode;
  1186. begin
  1187. Child := Node.FirstChild;
  1188. while Assigned(Child) do
  1189. begin
  1190. if not ConvertBaseShort(AContext, Child) then
  1191. Warning(AContext, SErrInvalidShortDescr)
  1192. else
  1193. MayBeEmpty := True;
  1194. Child := Child.NextSibling;
  1195. end;
  1196. if not MayBeEmpty then
  1197. Warning(AContext, SErrInvalidShortDescr)
  1198. end;
  1199. procedure TFPDocWriter.ConvertLink(AContext: TPasElement; El: TDOMElement);
  1200. begin
  1201. DescrBeginLink(El['id']);
  1202. if not IsDescrNodeEmpty(El) then
  1203. ConvertBaseShortList(AContext, El, True)
  1204. else
  1205. DescrWriteText(El['id']);
  1206. DescrEndLink;
  1207. end;
  1208. procedure TFPDocWriter.ConvertURL(AContext: TPasElement; El: TDOMElement);
  1209. begin
  1210. DescrBeginURL(El['href']);
  1211. if not IsDescrNodeEmpty(El) then
  1212. ConvertBaseShortList(AContext, El, True)
  1213. else
  1214. DescrWriteText(El['href']);
  1215. DescrEndURL;
  1216. end;
  1217. procedure TFPDocWriter.AddElementsFromList ( L: TStrings; List: TFPList;
  1218. UsePathName: Boolean ) ;
  1219. Var
  1220. I : Integer;
  1221. El : TPasElement;
  1222. N : TDocNode;
  1223. begin
  1224. For I:=0 to List.Count-1 do
  1225. begin
  1226. El:=TPasElement(List[I]);
  1227. N:=Engine.FindDocNode(El);
  1228. if (N=Nil) or (not N.IsSkipped) then
  1229. begin
  1230. if UsePathName then
  1231. L.AddObject(El.PathName,El)
  1232. else
  1233. L.AddObject(El.Name,El);
  1234. If el is TPasEnumType then
  1235. AddElementsFromList(L,TPasEnumType(el).Values);
  1236. end;
  1237. end;
  1238. end;
  1239. procedure TFPDocWriter.CreateClassTree;
  1240. var
  1241. L: TStringList;
  1242. M: TPasModule;
  1243. I:Integer;
  1244. begin
  1245. L:=TStringList.Create;
  1246. try
  1247. For I:=0 to Package.Modules.Count-1 do
  1248. begin
  1249. M:=TPasModule(Package.Modules[i]);
  1250. if Not (M is TPasExternalModule) and assigned(M.InterfaceSection) then
  1251. Self.AddElementsFromList(L,M.InterfaceSection.Classes,True)
  1252. end;
  1253. TreeClass.BuildTree(L);
  1254. TreeInterface.BuildTree(L);
  1255. {$IFDEF TREE_TEST}
  1256. TreeClass.SaveToXml('TreeClass.xml');
  1257. TreeInterface.SaveToXml('TreeInterface.xml');
  1258. {$ENDIF}
  1259. Finally
  1260. L.Free;
  1261. end;
  1262. end;
  1263. procedure TFPDocWriter.DoLog(const Msg: String);
  1264. begin
  1265. If Assigned(FEngine.OnLog) then
  1266. FEngine.OnLog(Self,Msg);
  1267. end;
  1268. procedure TFPDocWriter.DoLog(const Fmt: String; Args: array of const);
  1269. begin
  1270. DoLog(Format(Fmt,Args));
  1271. end;
  1272. function TFPDocWriter.ConvertExtShort(AContext: TPasElement;
  1273. Node: TDOMNode): Boolean;
  1274. begin
  1275. Result := False;
  1276. while Assigned(Node) do
  1277. begin
  1278. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'link') then
  1279. ConvertLink(AContext, TDOMElement(Node))
  1280. else if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'url') then
  1281. ConvertURL(AContext, TDOMElement(Node))
  1282. else if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'br') then
  1283. DescrWriteLinebreak
  1284. else
  1285. if not ConvertBaseShort(AContext, Node) then
  1286. exit;
  1287. Node := Node.NextSibling;
  1288. end;
  1289. Result := True;
  1290. end;
  1291. procedure TFPDocWriter.ConvertDescr(AContext: TPasElement; El: TDOMElement;
  1292. AutoInsertBlock: Boolean);
  1293. var
  1294. Node, Child: TDOMNode;
  1295. ParaCreated: Boolean;
  1296. begin
  1297. FContext:=AContext;
  1298. try
  1299. if AutoInsertBlock then
  1300. if IsExtShort(El.FirstChild) then
  1301. DescrBeginParagraph
  1302. else
  1303. AutoInsertBlock := False;
  1304. Node := El.FirstChild;
  1305. if not ConvertExtShort(AContext, Node) then
  1306. begin
  1307. while Assigned(Node) do
  1308. begin
  1309. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'section') then
  1310. begin
  1311. DescrBeginSectionTitle;
  1312. Child := Node.FirstChild;
  1313. while Assigned(Child) and (Child.NodeType <> ELEMENT_NODE) do
  1314. begin
  1315. if not IsDescrNodeEmpty(Child) then
  1316. Warning(AContext, SErrInvalidContentBeforeSectionTitle);
  1317. Child := Child.NextSibling;
  1318. end;
  1319. if not Assigned(Child) or (Child.NodeName <> 'title') then
  1320. Warning(AContext, SErrSectionTitleExpected)
  1321. else
  1322. ConvertShort(AContext, TDOMElement(Child));
  1323. DescrBeginSectionBody;
  1324. if IsExtShort(Child) then
  1325. begin
  1326. DescrBeginParagraph;
  1327. ParaCreated := True;
  1328. end else
  1329. ParaCreated := False;
  1330. ConvertExtShortOrNonSectionBlocks(AContext, Child.NextSibling);
  1331. if ParaCreated then
  1332. DescrEndParagraph;
  1333. DescrEndSection;
  1334. end else if not ConvertNonSectionBlock(AContext, Node) then
  1335. Warning(AContext, SErrInvalidDescr, [Node.NodeName]);
  1336. Node := Node.NextSibling;
  1337. end;
  1338. end else
  1339. if AutoInsertBlock then
  1340. DescrEndParagraph;
  1341. finally
  1342. FContext:=Nil;
  1343. end;
  1344. end;
  1345. procedure TFPDocWriter.ConvertExtShortOrNonSectionBlocks(AContext: TPasElement;
  1346. Node: TDOMNode);
  1347. begin
  1348. if not ConvertExtShort(AContext, Node) then
  1349. while Assigned(Node) do
  1350. begin
  1351. if not ConvertNonSectionBlock(AContext, Node) then
  1352. Warning(AContext, SErrInvalidDescr, [Node.NodeName]);
  1353. Node := Node.NextSibling;
  1354. end;
  1355. end;
  1356. function TFPDocWriter.ConvertNonSectionBlock(AContext: TPasElement;
  1357. Node: TDOMNode): Boolean;
  1358. procedure ConvertCells(Node: TDOMNode);
  1359. var
  1360. Child: TDOMNode;
  1361. IsEmpty: Boolean;
  1362. begin
  1363. Node := Node.FirstChild;
  1364. IsEmpty := True;
  1365. while Assigned(Node) do
  1366. begin
  1367. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'td') then
  1368. begin
  1369. DescrBeginTableCell;
  1370. Child := Node.FirstChild;
  1371. if not ConvertExtShort(AContext, Child) then
  1372. while Assigned(Child) do
  1373. begin
  1374. if not ConvertSimpleBlock(AContext, Child) then
  1375. Warning(AContext, SErrInvalidTableContent);
  1376. Child := Child.NextSibling;
  1377. end;
  1378. DescrEndTableCell;
  1379. IsEmpty := False;
  1380. end else
  1381. if IsContentNodeType(Node) then
  1382. Warning(AContext, SErrInvalidTableContent);
  1383. Node := Node.NextSibling;
  1384. end;
  1385. if IsEmpty then
  1386. Warning(AContext, SErrTableRowEmpty);
  1387. end;
  1388. procedure ConvertTable;
  1389. function GetColCount(Node: TDOMNode): Integer;
  1390. begin
  1391. Result := 0;
  1392. Node := Node.FirstChild;
  1393. while Assigned(Node) do
  1394. begin
  1395. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'td') then
  1396. Inc(Result);
  1397. Node := Node.NextSibling;
  1398. end;
  1399. end;
  1400. var
  1401. s: DOMString;
  1402. HasBorder, CaptionPossible, HeadRowPossible: Boolean;
  1403. ColCount, ThisRowColCount: Integer;
  1404. Subnode: TDOMNode;
  1405. begin
  1406. s := TDOMElement(Node)['border'];
  1407. if s = '1' then
  1408. HasBorder := True
  1409. else
  1410. begin
  1411. HasBorder := False;
  1412. if (Length(s) <> 0) and (s <> '0') then
  1413. Warning(AContext, SErrInvalidBorderValue, ['<table>']);
  1414. end;
  1415. // Determine the number of columns
  1416. ColCount := 0;
  1417. Subnode := Node.FirstChild;
  1418. while Assigned(Subnode) do
  1419. begin
  1420. if Subnode.NodeType = ELEMENT_NODE then
  1421. if (Subnode.NodeName = 'caption') or (Subnode.NodeName = 'th') or
  1422. (Subnode.NodeName = 'tr') then
  1423. begin
  1424. ThisRowColCount := GetColCount(Subnode);
  1425. if ThisRowColCount > ColCount then
  1426. ColCount := ThisRowColCount;
  1427. end;
  1428. Subnode := Subnode.NextSibling;
  1429. end;
  1430. DescrBeginTable(ColCount, HasBorder);
  1431. Node := Node.FirstChild;
  1432. CaptionPossible := True;
  1433. HeadRowPossible := True;
  1434. while Assigned(Node) do
  1435. begin
  1436. if Node.NodeType = ELEMENT_NODE then
  1437. if CaptionPossible and (Node.NodeName = 'caption') then
  1438. begin
  1439. DescrBeginTableCaption;
  1440. if not ConvertExtShort(AContext, Node.FirstChild) then
  1441. Warning(AContext, SErrInvalidTableContent);
  1442. DescrEndTableCaption;
  1443. CaptionPossible := False;
  1444. end else if HeadRowPossible and (Node.NodeName = 'th') then
  1445. begin
  1446. DescrBeginTableHeadRow;
  1447. ConvertCells(Node);
  1448. DescrEndTableHeadRow;
  1449. CaptionPossible := False;
  1450. HeadRowPossible := False;
  1451. end else if Node.NodeName = 'tr' then
  1452. begin
  1453. DescrBeginTableRow;
  1454. ConvertCells(Node);
  1455. DescrEndTableRow;
  1456. end else
  1457. Warning(AContext, SErrInvalidTableContent)
  1458. else if IsContentNodeType(Node) then
  1459. Warning(AContext, SErrInvalidTableContent);
  1460. Node := Node.NextSibling;
  1461. end;
  1462. DescrEndTable;
  1463. end;
  1464. begin
  1465. if Node.NodeType <> ELEMENT_NODE then
  1466. begin
  1467. if Node.NodeType = TEXT_NODE then
  1468. Result := IsWhitespaceNode(TDOMText(Node))
  1469. else
  1470. Result := Node.NodeType = COMMENT_NODE;
  1471. exit;
  1472. end;
  1473. if Node.NodeName = 'remark' then
  1474. begin
  1475. DescrBeginRemark;
  1476. Node := Node.FirstChild;
  1477. if not ConvertExtShort(AContext, Node) then
  1478. while Assigned(Node) do
  1479. begin
  1480. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'table') then
  1481. ConvertTable
  1482. else
  1483. if not ConvertSimpleBlock(AContext, Node) then
  1484. Warning(AContext, SErrInvalidRemarkContent, [Node.NodeName]);
  1485. Node := Node.NextSibling;
  1486. end;
  1487. DescrEndRemark;
  1488. Result := True;
  1489. end else if Node.NodeName = 'table' then
  1490. begin
  1491. ConvertTable;
  1492. Result := True;
  1493. end else
  1494. Result := ConvertSimpleBlock(AContext, Node);
  1495. end;
  1496. function TFPDocWriter.ConvertSimpleBlock(AContext: TPasElement;
  1497. Node: TDOMNode): Boolean;
  1498. procedure ConvertListItems;
  1499. var
  1500. Empty: Boolean;
  1501. begin
  1502. Node := Node.FirstChild;
  1503. Empty := True;
  1504. while Assigned(Node) do
  1505. begin
  1506. if ((Node.NodeType = TEXT_NODE) and not IsWhitespaceNode(TDOMText(Node))) or (Node.NodeType = ENTITY_REFERENCE_NODE)
  1507. then
  1508. Warning(AContext, SErrInvalidListContent)
  1509. else if Node.NodeType = ELEMENT_NODE then
  1510. if Node.NodeName = 'li' then
  1511. begin
  1512. DescrBeginListItem;
  1513. ConvertExtShortOrNonSectionBlocks(AContext, Node.FirstChild);
  1514. DescrEndListItem;
  1515. Empty := False;
  1516. end else
  1517. Warning(AContext, SErrInvalidElementInList);
  1518. Node := Node.NextSibling;
  1519. end;
  1520. if Empty then
  1521. Warning(AContext, SErrListIsEmpty);
  1522. end;
  1523. procedure ConvertDefinitionList;
  1524. var
  1525. Empty, ExpectDTNext: Boolean;
  1526. begin
  1527. Node := Node.FirstChild;
  1528. Empty := True;
  1529. ExpectDTNext := True;
  1530. while Assigned(Node) do
  1531. begin
  1532. if ((Node.NodeType = TEXT_NODE) and not IsWhitespaceNode(TDOMText(Node))) or (Node.NodeType = ENTITY_REFERENCE_NODE)
  1533. then
  1534. Warning(AContext, SErrInvalidListContent)
  1535. else if Node.NodeType = ELEMENT_NODE then
  1536. if ExpectDTNext and (Node.NodeName = 'dt') then
  1537. begin
  1538. DescrBeginDefinitionTerm;
  1539. if not ConvertShort(AContext, TDOMElement(Node)) then
  1540. Warning(AContext, SErrInvalidDefinitionTermContent);
  1541. DescrEndDefinitionTerm;
  1542. Empty := False;
  1543. ExpectDTNext := False;
  1544. end else if not ExpectDTNext and (Node.NodeName = 'dd') then
  1545. begin
  1546. DescrBeginDefinitionEntry;
  1547. ConvertExtShortOrNonSectionBlocks(AContext, Node.FirstChild);
  1548. DescrEndDefinitionEntry;
  1549. ExpectDTNext := True;
  1550. end else
  1551. Warning(AContext, SErrInvalidElementInList);
  1552. Node := Node.NextSibling;
  1553. end;
  1554. if Empty then
  1555. Warning(AContext, SErrListIsEmpty)
  1556. else if not ExpectDTNext then
  1557. Warning(AContext, SErrDefinitionEntryMissing);
  1558. end;
  1559. procedure ProcessCodeBody(Node: TDOMNode);
  1560. var
  1561. s: String;
  1562. i, j: Integer;
  1563. begin
  1564. Node := Node.FirstChild;
  1565. S:='';
  1566. while Assigned(Node) do
  1567. begin
  1568. if Node.NodeType = TEXT_NODE then
  1569. begin
  1570. s := s + UTF8Encode(Node.NodeValue);
  1571. j := 1;
  1572. for i := 1 to Length(s) do
  1573. // In XML, linefeeds are normalized to #10 by the parser!
  1574. if s[i] = #10 then
  1575. begin
  1576. DescrWriteCodeLine(Copy(s, j, i - j));
  1577. j := i + 1;
  1578. end;
  1579. if j > 1 then
  1580. s := Copy(s, j, Length(s));
  1581. end;
  1582. Node := Node.NextSibling;
  1583. end;
  1584. if Length(s) > 0 then
  1585. DescrWriteCodeLine(s);
  1586. end;
  1587. var
  1588. s: DOMString;
  1589. HasBorder: Boolean;
  1590. begin
  1591. if Node.NodeType <> ELEMENT_NODE then
  1592. begin
  1593. Result := (Node.NodeType = TEXT_NODE) and IsWhitespaceNode(TDOMText(Node));
  1594. exit;
  1595. end;
  1596. if Node.NodeName = 'p' then
  1597. begin
  1598. DescrBeginParagraph;
  1599. if not ConvertExtShort(AContext, Node.FirstChild) then
  1600. Warning(AContext, SErrInvalidParaContent);
  1601. DescrEndParagraph;
  1602. Result := True;
  1603. end else if Node.NodeName = 'code' then
  1604. begin
  1605. s := TDOMElement(Node)['border'];
  1606. if s = '1' then
  1607. HasBorder := True
  1608. else
  1609. begin
  1610. if (Length(s) > 0) and (s <> '0') then
  1611. Warning(AContext, SErrInvalidBorderValue, ['<code>']);
  1612. end;
  1613. DescrBeginCode(HasBorder, UTF8Encode(TDOMElement(Node)['highlighter']));
  1614. ProcessCodeBody(Node);
  1615. DescrEndCode;
  1616. Result := True;
  1617. end else if Node.NodeName = 'pre' then
  1618. begin
  1619. DescrBeginCode(False, 'none');
  1620. ProcessCodeBody(Node);
  1621. DescrEndCode;
  1622. Result := True;
  1623. end else if Node.NodeName = 'ul' then
  1624. begin
  1625. DescrBeginUnorderedList;
  1626. ConvertListItems;
  1627. DescrEndUnorderedList;
  1628. Result := True;
  1629. end else if Node.NodeName = 'ol' then
  1630. begin
  1631. DescrBeginOrderedList;
  1632. ConvertListItems;
  1633. DescrEndOrderedList;
  1634. Result := True;
  1635. end else if Node.NodeName = 'dl' then
  1636. begin
  1637. DescrBeginDefinitionList;
  1638. ConvertDefinitionList;
  1639. DescrEndDefinitionList;
  1640. Result := True;
  1641. end else if Node.NodeName = 'img' then
  1642. begin
  1643. begin
  1644. ConvertImage(Node as TDomElement);
  1645. Result:=True;
  1646. end;
  1647. end else
  1648. Result := False;
  1649. end;
  1650. procedure TFPDocWriter.ConvertImage ( El: TDomElement ) ;
  1651. Var
  1652. FN,Cap,LinkName : DOMString;
  1653. begin
  1654. FN:=El['file'];
  1655. Cap:=El['caption'];
  1656. LinkName:=El['name'];
  1657. FN:=UTF8decode(ChangeFileExt(UTF8Encode(FN),ImageExtension));
  1658. DescrWriteImageEl(FN,Cap,LinkName);
  1659. end;
  1660. procedure TFPDocWriter.DescrEmitNotesHeader(AContext: TPasElement);
  1661. begin
  1662. DescrWriteLinebreak;
  1663. DescrBeginBold;
  1664. DescrWriteText(UTF8Decode(SDocNotes));
  1665. DescrEndBold;
  1666. DescrWriteLinebreak;
  1667. end;
  1668. procedure TFPDocWriter.DescrEmitNotesFooter(AContext: TPasElement);
  1669. begin
  1670. DescrWriteLinebreak;
  1671. end;
  1672. Constructor TTopicElement.Create(const AName: String; AParent: TPasElement);
  1673. begin
  1674. Inherited Create(AName,AParent);
  1675. SubTopics:=TList.Create;
  1676. end;
  1677. Destructor TTopicElement.Destroy;
  1678. begin
  1679. // Actual subtopics are freed by TFPDocWriter Topics list.
  1680. SubTopics.Free;
  1681. Inherited;
  1682. end;
  1683. function TFPDocWriter.WriteDescr ( Element: TPasElement ) : TDocNode;
  1684. begin
  1685. Result:=Engine.FindDocNode(Element);
  1686. WriteDescr(ELement,Result);
  1687. end;
  1688. procedure TFPDocWriter.WriteDescr(Element: TPasElement; DocNode: TDocNode);
  1689. begin
  1690. if Assigned(DocNode) then
  1691. begin
  1692. if not IsDescrNodeEmpty(DocNode.Descr) then
  1693. WriteDescr(Element, DocNode.Descr)
  1694. else if not IsDescrNodeEmpty(DocNode.ShortDescr) then
  1695. WriteDescr(Element, DocNode.ShortDescr);
  1696. end;
  1697. end;
  1698. procedure TFPDocWriter.WriteDescr(AContext: TPasElement; DescrNode: TDOMElement);
  1699. begin
  1700. if Assigned(DescrNode) then
  1701. ConvertDescr(AContext, DescrNode, False);
  1702. end;
  1703. procedure TFPDocWriter.FPDocError(Msg: String);
  1704. begin
  1705. Raise EFPDocWriterError.Create(Msg);
  1706. end;
  1707. procedure TFPDocWriter.FPDocError(Fmt: String; Args: array of const);
  1708. begin
  1709. FPDocError(Format(Fmt,Args));
  1710. end;
  1711. function TFPDocWriter.ShowMember(M: TPasElement): boolean;
  1712. begin
  1713. Result:=not ((M.Visibility=visPrivate) and Engine.HidePrivate);
  1714. If Result then
  1715. Result:=Not ((M.Visibility=visProtected) and Engine.HideProtected)
  1716. end;
  1717. procedure TFPDocWriter.GetMethodList ( ClassDecl: TPasClassType;
  1718. List: TStringList ) ;
  1719. Var
  1720. I : Integer;
  1721. M : TPasElement;
  1722. begin
  1723. List.Clear;
  1724. List.Sorted:=False;
  1725. for i := 0 to ClassDecl.Members.Count - 1 do
  1726. begin
  1727. M:=TPasElement(ClassDecl.Members[i]);
  1728. if M.InheritsFrom(TPasProcedureBase) and ShowMember(M) then
  1729. List.AddObject(M.Name,M);
  1730. end;
  1731. List.Sorted:=False;
  1732. end;
  1733. initialization
  1734. InitWriterList;
  1735. finalization
  1736. DoneWriterList;
  1737. end.