dwriter.pp 55 KB

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