dwriter.pp 59 KB

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