dwriter.pp 63 KB

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