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