dwriter.pp 55 KB

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