dw_xml.pp 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710
  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. * 'XML struct' output generator
  8. See the file COPYING, included in this distribution,
  9. for details about the copyright.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13. }
  14. {$mode objfpc}
  15. {$H+}
  16. unit dw_XML;
  17. interface
  18. uses DOM, PasTree, dGlobals, dwriter, xmlWrite, SysUtils, Classes;
  19. Type
  20. { TXMLWriter }
  21. TXMLWriter = Class(TMultiFileDocWriter)
  22. private
  23. FShowSourceInfo:Boolean;
  24. FUseFlatStructure:Boolean;
  25. protected
  26. function CreateAllocator : TFileAllocator; override;
  27. procedure AllocatePackagePages; override;
  28. procedure AllocateModulePages(AModule: TPasModule; {%H-}LinkList: TObjectList); override;
  29. procedure WriteDocPage(const aFileName: String; aElement: TPasElement; {%H-}aSubPageIndex: Integer); override;
  30. public
  31. constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
  32. function ModuleToXMLStruct(AModule: TPasModule): TXMLDocument;
  33. Procedure WriteDoc; override;
  34. class procedure Usage(List: TStrings); override;
  35. function InterPretOption(const Cmd,Arg : String): boolean; override;
  36. end;
  37. { TFlatFileAllocator }
  38. TFlatFileAllocator = class(TFileAllocator)
  39. private
  40. FExtension: String;
  41. public
  42. constructor Create(const AExtension: String);
  43. function GetFilename(AElement: TPasElement; ASubindex: Integer): String; override;
  44. function GetRelativePathToTop(AElement: TPasElement): String; override;
  45. property Extension: String read FExtension;
  46. end;
  47. implementation
  48. const
  49. DefaultVisibility = [visDefault, visPublic, visPublished, visProtected];
  50. { TXmlFileAllocator }
  51. constructor TFlatFileAllocator.Create(const AExtension: String);
  52. begin
  53. FExtension:= AExtension;
  54. inherited Create();
  55. end;
  56. function TFlatFileAllocator.GetFilename(AElement: TPasElement; ASubindex: Integer
  57. ): String;
  58. begin
  59. Result:='';
  60. if AElement.ClassType = TPasPackage then
  61. Result := 'index'
  62. else if AElement.ClassType = TPasModule then
  63. Result := LowerCase(AElement.Name);
  64. if ASubindex > 0 then
  65. Result := Result + '-' + GetFilePostfix(ASubindex);
  66. Result := Result + Extension;
  67. end;
  68. function TFlatFileAllocator.GetRelativePathToTop(AElement: TPasElement): String;
  69. begin
  70. Result:=inherited GetRelativePathToTop(AElement);
  71. end;
  72. function TXMLWriter.ModuleToXMLStruct(AModule: TPasModule): TXMLDocument;
  73. var
  74. ModuleElement: TDOMElement;
  75. Doc: TXMLDocument absolute Result;
  76. function VisibilityToString(vis: TPasMemberVisibility): String;
  77. begin
  78. case vis of
  79. visDefault : Result := '';
  80. visPrivate : Result := 'private';
  81. visProtected : Result := 'protected';
  82. visPublic : Result := 'public';
  83. visPublished : Result := 'published';
  84. visAutomated : Result := 'automated';
  85. visStrictPrivate : Result := 'strictprivate';
  86. visStrictProtected : Result := 'strictprotected';
  87. end;
  88. end;
  89. function Sanitize(AString: String): String;
  90. var
  91. i: Integer;
  92. begin
  93. Result := AString;
  94. for i := 1 to length(Result) do
  95. if Result[i] in [' '] then
  96. Result[i] := '_';
  97. end;
  98. procedure AddSourceInfo(ADecl: TPasElement; AElement: TDOMElement);
  99. var
  100. SourceNode: TDOMElement;
  101. begin
  102. if not FShowSourceInfo then
  103. Exit;
  104. SourceNode := Doc.CreateElement('source');
  105. SourceNode['line'] := UTF8Decode(IntToStr(ADecl.SourceLinenumber));
  106. SourceNode['file'] := UTF8Decode(ADecl.SourceFilename);
  107. AElement.AppendChild(SourceNode);
  108. end;
  109. procedure AddProcedureModifiers(ADecl: TPasProcedure; Node: TDOMElement);
  110. begin
  111. {pmVirtual , pmDynamic, pmAbstract, pmOverride,
  112. pmExport, pmOverload, pmMessage, pmReintroduce,
  113. pmStatic,pmInline,pmAssembler,pmVarargs, pmPublic,
  114. pmCompilerProc,pmExternal,pmForward}
  115. if (pmVirtual in ADecl.Modifiers) or (pmDynamic in ADecl.Modifiers) then
  116. Node['virtual'] := 'true';
  117. if pmAbstract in ADecl.Modifiers then
  118. Node['abstract'] := 'true';
  119. if assigned(ADecl.ProcType) and (ptmStatic in ADecl.ProcType.Modifiers) then
  120. Node['static'] := 'true';
  121. if pmReintroduce in ADecl.Modifiers then
  122. Node['reintroduce'] := 'true';
  123. if pmOverload in ADecl.Modifiers then
  124. Node['overload'] := 'true';
  125. if pmForward in ADecl.Modifiers then
  126. Node['forward'] := 'true';
  127. if pmOverride in ADecl.Modifiers then
  128. Node['override'] := 'true';
  129. end;
  130. procedure AddTypeNode(ToNode: TDOMElement; AType: String);
  131. begin
  132. ToNode.AttribStrings['type'] := UTF8Decode(AType);
  133. end;
  134. function AddTypeNode(ToNode: TDOMElement; AType: TPasType): Boolean;
  135. //var
  136. // TypeNode: TDOMElement;
  137. begin
  138. Result := False;
  139. if not Assigned(AType) then
  140. Exit;
  141. //TypeNode := Doc.CreateElement('type');
  142. //TypeNode.TextContent:=AType.Name;
  143. //ToNode.AppendChild(TypeNode);
  144. AddTypeNode(ToNode, AType.Name);
  145. Result := True;
  146. end;
  147. procedure ProcessArgs(Args: TFPList; ProcNode: TDomElement);
  148. var
  149. i: Integer;
  150. ArgNode: TDOMElement;
  151. Arg: TPasArgument;
  152. begin
  153. for i := 0 to Args.Count-1 do
  154. begin
  155. Arg := TPasArgument(Args.Items[i]);
  156. ArgNode := Doc.CreateElement('argument');
  157. ArgNode.AttribStrings['name'] := UTF8Decode(Arg.Name);
  158. AddTypeNode(ArgNode, Arg.ArgType);
  159. ProcNode.AppendChild(ArgNode);
  160. end;
  161. end;
  162. procedure DoVisibility(PasEl: TPasElement; Element: TDOMElement);
  163. begin
  164. if PasEl.Visibility <> visDefault then
  165. Element['visibility'] := UTF8Decode(VisibilityToString(PasEl.Visibility));
  166. end;
  167. function ProcessProcedure(Proc: TPasProcedure; Element: TDOMElement): TDOMElement;
  168. var
  169. ProcEl: TDOMElement;
  170. ReturnEl: TDOMElement;
  171. begin
  172. Result := nil;
  173. ProcEl := Doc.CreateElement(UTF8Decode(Sanitize(Proc.TypeName)));
  174. Element.AppendChild(ProcEl);
  175. ProcEl['name'] := UTF8Decode(Proc.Name);
  176. DoVisibility(Proc, ProcEl);
  177. AddProcedureModifiers(Proc, ProcEl);
  178. AddSourceInfo(Proc,ProcEl);
  179. if Proc.InheritsFrom(TPasFunction) then
  180. begin
  181. ReturnEl := Doc.CreateElement('return');
  182. ProcEl.AppendChild(ReturnEl);
  183. AddTypeNode(ReturnEl, TPasFunction(Proc).FuncType.ResultEl.ResultType);
  184. end;
  185. ProcessArgs(Proc.ProcType.Args, ProcEl);
  186. Result := ProcEl;
  187. end;
  188. procedure ProcessArrayType(AType: TPasArrayType; Element: TDOMElement);
  189. var
  190. TypeEl: TDOMElement;
  191. begin
  192. TypeEl := Doc.CreateElement('array');
  193. TypeEl['name'] := UTF8Decode(AType.Name);
  194. if not AddTypeNode(TypeEl, AType.ElType) then
  195. TypeEl['const'] := 'true';
  196. TypeEl['range'] := UTF8Decode(AType.IndexRange);
  197. DoVisibility(AType, Element);
  198. AddSourceInfo(AType,Element);
  199. Element.AppendChild(TypeEl);
  200. end;
  201. procedure ProcessPointerType(AType: TPasPointerType; Element: TDOMElement);
  202. var
  203. TypeEl: TDOMElement;
  204. begin
  205. TypeEl := Doc.CreateElement('pointer');
  206. TypeEl['name'] := UTF8Decode(AType.Name);
  207. AddTypeNode(TypeEl, AType.DestType);
  208. DoVisibility(AType, Element);
  209. AddSourceInfo(AType,Element);
  210. Element.AppendChild(TypeEl);
  211. end;
  212. procedure ProcessAliasType(AType: TPasAliasType; Element: TDOMElement);
  213. var
  214. TypeEl: TDOMElement;
  215. begin
  216. TypeEl := Doc.CreateElement('alias');
  217. TypeEl['name'] := UTF8Decode(AType.Name);
  218. AddTypeNode(TypeEl, AType.DestType);
  219. DoVisibility(AType, Element);
  220. AddSourceInfo(AType,Element);
  221. Element.AppendChild(TypeEl);
  222. end;
  223. procedure ProcessVariable(AVar: TPasVariable; Element: TDOMElement);
  224. var
  225. VarEl: TDOMElement;
  226. begin
  227. VarEl := Result.CreateElement('var');
  228. Element.AppendChild(VarEl);
  229. VarEl['name'] := UTF8Decode(AVar.Name);
  230. if not AVar.VarType.InheritsFrom(TPasArrayType) then
  231. AddTypeNode(VarEl, AVar.VarType)
  232. else
  233. begin
  234. VarEl['array'] := 'true';
  235. ProcessArrayType(TPasArrayType(AVar.VarType), VarEl);
  236. end;
  237. DoVisibility(Avar, VarEl);
  238. AddSourceInfo(AVar,VarEl);
  239. end;
  240. procedure ProcessProperty(AProp: TPasProperty; Element: TDOMElement);
  241. var
  242. PropEl: TDOMElement;
  243. begin
  244. PropEl := Doc.CreateElement('property');
  245. Element.AppendChild(PropEl);
  246. PropEl.AttribStrings['name'] := UTF8Decode(AProp.Name);
  247. AddTypeNode(PropEL, AProp.ResolvedType);
  248. if AProp.IndexValue <> '' then
  249. PropEl['index'] := UTF8Decode(AProp.IndexValue);
  250. if AProp.DefaultValue <> '' then
  251. PropEl['default'] := UTF8Decode(AProp.DefaultValue);
  252. if AProp.WriteAccessorName <> '' then
  253. PropEl.AttribStrings['writable'] := 'true';
  254. ProcessArgs(AProp.Args, PropEl);
  255. DoVisibility(AProp, Element);
  256. AddSourceInfo(AProp,PropEl);
  257. // this isn't quite right
  258. //if AProp.ReadAccessorName = '' then
  259. // PropEl.AttribStrings['inherited'] := 'true';
  260. end;
  261. procedure ProcessOverloadedProcedure(AOverload: TPasOverloadedProc; Element: TDOMElement);
  262. var
  263. OverEl: TDOMElement;
  264. i: Integer;
  265. begin
  266. for i := 0 to AOverload.Overloads.Count-1 do
  267. begin
  268. OverEl := ProcessProcedure(TPasProcedure(AOverload.Overloads.Items[i]), Element);
  269. OverEl['overload'] := 'true';
  270. end;
  271. end;
  272. procedure ProcessConst(AConst: TPasConst; Element: TDOMElement);
  273. var
  274. ConstEl: TDOMElement;
  275. begin
  276. ConstEl := Doc.CreateElement('const');
  277. ConstEl['name'] := UTF8Decode(AConst.name);
  278. ConstEl['value'] := UTF8Decode(AConst.Value);
  279. Element.AppendChild(ConstEl);
  280. AddSourceInfo(AConst,ConstEl);
  281. end;
  282. procedure ProcessEnumType(AType: TPasEnumType; Element: TDOMElement);
  283. var
  284. TypeEl: TDOMElement;
  285. ValEl: TDOMELement;
  286. i: Integer;
  287. begin
  288. TypeEl := Doc.CreateElement('enum');
  289. TypeEl['name'] := UTF8Decode(AType.name);
  290. AddSourceInfo(AType,TypeEl);
  291. //ConstEl['value'] := AConst.Value;
  292. for i := 0 to AType.Values.Count-1 do
  293. begin
  294. ValEl := Doc.CreateElement('enumvalue');
  295. ValEl['name'] := UTF8Decode(TPasEnumValue(AType.Values.Items[i]).Name);
  296. AddSourceInfo(TPasEnumValue(AType.Values.Items[i]),ValEl);
  297. TypeEl.AppendChild(ValEl);
  298. end;
  299. Element.AppendChild(TypeEl);
  300. end;
  301. procedure ProcessSetType(AType: TPasSetType; Element: TDOMElement);
  302. var
  303. SetEl: TDOMElement;
  304. begin
  305. SetEl := Doc.CreateElement('set');
  306. SetEl['name'] := UTF8Decode(AType.name);
  307. AddTypeNode(SetEl, AType.EnumType);
  308. AddSourceInfo(AType,SetEl);
  309. Element.AppendChild(SetEl);
  310. end;
  311. procedure ProcessProcedureType(AType: TPasProcedureType; Element: TDOMElement);
  312. var
  313. TypeEl: TDOMElement;
  314. begin
  315. TypeEl := Doc.CreateElement(UTF8Decode(AType.TypeName));
  316. TypeEl['name'] := UTF8Decode(AType.name);
  317. TypeEl['istype'] := 'true';
  318. if AType.IsOfObject then
  319. TypeEl['object'] := 'true';
  320. ProcessArgs(AType.Args, TypeEl);
  321. AddSourceInfo(AType,TypeEl);
  322. Element.AppendChild(TypeEl);
  323. end;
  324. procedure ProcessRecordType(AType: TPasRecordType; Element: TDOMElement);
  325. var
  326. TypeEl: TDOMElement;
  327. Decl: TPasElement;
  328. i: Integer;
  329. begin
  330. TypeEl := Doc.CreateElement('record');
  331. TypeEl['name'] := UTF8Decode(AType.name);
  332. Element.AppendChild(TypeEl);
  333. AddSourceInfo(AType,TypeEl);
  334. if Assigned(AType.Members) then
  335. for i := 0 to AType.Members.Count - 1 do
  336. begin
  337. Decl := TPasElement(AType.Members[i]);
  338. if Decl.InheritsFrom(TPasProcedure)then
  339. ProcessProcedure(TPasProcedure(Decl), TypeEl)
  340. else if Decl.ClassType = TPasVariable then
  341. ProcessVariable(TPasVariable(Decl), TypeEl)
  342. else if Decl.ClassType = TPasProperty then
  343. ProcessProperty(TPasProperty(Decl), TypeEl)
  344. else writeln('Unhandled record member: ', Decl.ClassName, ' ', Decl.Name);
  345. end;
  346. end;
  347. procedure ProcessGenericTypes(AGenericTypes: TFPList; ANode: TDOMElement);
  348. var
  349. i: Integer;
  350. Node: TDOMElement;
  351. begin
  352. for i := 0 to AGenericTypes.Count-1 do
  353. begin
  354. Node := Doc.CreateElement('t');
  355. Node['name'] := UTF8Decode(TPasGenericTemplateType(AGenericTypes.Items[i]).Name);
  356. ANode.AppendChild(Node);
  357. AddSourceInfo(TPasGenericTemplateType(AGenericTypes.Items[i]),Node);
  358. end;
  359. end;
  360. procedure ProcessRangeType(AType: TPasRangeType; Element: TDOMElement);
  361. var
  362. TypeEl: TDOMElement;
  363. begin
  364. TypeEl := Doc.CreateElement('range');
  365. TypeEl['name'] := UTF8Decode(AType.Name);
  366. TypeEl['start'] := UTF8Decode(AType.RangeStart);
  367. TypeEl['end'] := UTF8Decode(AType.RangeEnd);
  368. AddSourceInfo(AType,TypeEl);
  369. Element.AppendChild(TypeEl);
  370. end;
  371. procedure ProcessClassType(AClass: TPasClassType; Element: TDOMElement); forward;
  372. function ProcessType(AType: TPasElement; Element: TDOMElement): Boolean;
  373. begin
  374. Result := True;
  375. if AType.ClassType = TPasVariable then
  376. ProcessVariable(TPasVariable(AType), Element)
  377. else if AType.ClassType = TPasProperty then
  378. ProcessProperty(TPasProperty(AType), Element)
  379. else if AType.InheritsFrom(TPasOverloadedProc) then
  380. ProcessOverloadedProcedure(TPasOverloadedProc(AType), Element)
  381. else if AType.InheritsFrom(TPasConst) then
  382. ProcessConst(TPasConst(AType), Element)
  383. else if AType.InheritsFrom(TPasEnumType) then
  384. ProcessEnumType(TPasEnumType(AType), Element)
  385. else if AType.InheritsFrom(TPasClassType) then
  386. ProcessClassType(TPasClassType(AType), Element)
  387. else if AType.InheritsFrom(TPasAliasType) then
  388. ProcessAliasType(TPasAliasType(AType), Element)
  389. else if AType.InheritsFrom(TPasSetType) then
  390. ProcessSetType(TPasSetType(AType), Element)
  391. else if AType.InheritsFrom(TPasProcedureType) then
  392. ProcessProcedureType(TPasProcedureType(AType), Element)
  393. else if AType.InheritsFrom(TPasRecordType) then
  394. ProcessRecordType(TPasRecordType(AType), Element)
  395. else if AType.InheritsFrom(TPasArrayType) then
  396. ProcessArrayType(TPasArrayType(AType), Element)
  397. else if AType.InheritsFrom(TPasPointerType) then
  398. ProcessPointerType(TPasPointerType(AType), Element)
  399. else if AType.InheritsFrom(TPasRangeType) then
  400. ProcessRangeType(TPasRangeType(AType), Element)
  401. else
  402. Result := False;
  403. end;
  404. procedure ProcessClassType(AClass: TPasClassType; Element: TDOMElement);
  405. var
  406. ClassEl: TDOMElement = nil;
  407. i: Integer;
  408. Decl: TPasElement;
  409. SubNode: TDomElement;
  410. InterfaceEl: TDomElement;
  411. Vis: TPasMemberVisibilities = DefaultVisibility;
  412. begin
  413. if not Engine.HidePrivate then Include(Vis, visPrivate);
  414. if Engine.HideProtected then Exclude(Vis, visProtected);
  415. case AClass.ObjKind of
  416. okClass: ClassEl := Result.CreateElement('class');
  417. okObject: ClassEl := Result.CreateElement('object');
  418. okInterface: ClassEl := Result.CreateElement('interface');
  419. //okGeneric: Result.CreateElement('generic');
  420. //okClassHelper: Result.CreateElement('classhelper');
  421. //okRecordHelper: Result.CreateElement('recordhelper');
  422. //okTypeHelper: Result.CreateElement('typehelper');
  423. else
  424. //raise Exception.Create('ProcessClass: unknown class kind');
  425. WriteLn('Unhandled Class kind: ', AClass.ObjKind);
  426. end;
  427. if Assigned(ClassEl) then
  428. begin
  429. Element.AppendChild(ClassEl);
  430. ClassEl['name'] := UTF8Decode(AClass.Name);
  431. if Assigned(AClass.AncestorType) then
  432. ClassEl['parentclass'] := UTF8Decode(AClass.AncestorType.Name);
  433. AddSourceInfo(AClass,ClassEl);
  434. if Assigned(AClass.Interfaces) then
  435. for i := 0 to AClass.Interfaces.Count-1 do
  436. begin
  437. InterfaceEl := Doc.CreateElement('interface');
  438. ClassEl.AppendChild(InterfaceEl);
  439. InterfaceEl['name'] := UTF8Decode(TPasElement(AClass.Interfaces.Items[i]).Name);
  440. end;
  441. if Assigned(AClass.Members) then
  442. for i := 0 to AClass.Members.Count - 1 do
  443. begin
  444. Decl := TPasElement(AClass.Members[i]);
  445. if not (Decl.Visibility in Vis) then
  446. continue;
  447. if Decl.InheritsFrom(TPasProcedure)then
  448. begin
  449. SubNode := ProcessProcedure(TPasProcedure(Decl), ClassEl);
  450. if Assigned(SubNode) then
  451. begin
  452. if SubNode.InheritsFrom(TPasClassConstructor) then
  453. SubNode.SetAttribute('type', 'constructor')
  454. else if SubNode.InheritsFrom(TPasClassDestructor) then
  455. SubNode.SetAttribute('type', 'destructor');
  456. end;
  457. end
  458. else if not ProcessType(Decl, ClassEl) then
  459. writeln('Unhandled class member: ', Decl.ClassName, ' ', Decl.Name);
  460. end;
  461. end;
  462. end;
  463. function FindInList(AName: String; AList: TFPList): Boolean;
  464. var
  465. El: TPasElement;
  466. I: Integer;
  467. begin
  468. Result := False;
  469. I := 0;
  470. while not Result and (I < AList.Count) do
  471. begin
  472. El := TPasElement(AList[I]);
  473. if El.Name = AName then
  474. Result := True;
  475. Inc(I);
  476. end;
  477. end;
  478. procedure ProcessSection(ASection: TPasSection; const Name: DOMString);
  479. var
  480. Element, UsesElement, UnitElement: TDOMElement;
  481. i: Integer;
  482. Decl: TPasElement;
  483. begin
  484. Element := Result.CreateElement(Name);
  485. ModuleElement.AppendChild(Element);
  486. if ASection.UsesList.Count > 0 then
  487. begin
  488. UsesElement := Result.CreateElement('uses');
  489. Element.AppendChild(UsesElement);
  490. for i := 0 to ASection.UsesList.Count - 1 do
  491. begin
  492. UnitElement := Result.CreateElement('unit-ref');
  493. UnitElement['name'] := UTF8Decode(TPasType(ASection.UsesList[i]).Name);
  494. UsesElement.AppendChild(UnitElement);
  495. end;
  496. end;
  497. for i := 0 to ASection.Classes.Count -1 do
  498. begin
  499. Decl := TPasElement(ASection.Classes[i]);
  500. ProcessClassType(TPasClassType(Decl), Element);
  501. end;
  502. for i := 0 to ASection.Consts.Count - 1 do
  503. begin
  504. Decl := TPasElement(ASection.Consts[i]);
  505. ProcessConst(TPasConst(Decl), Element)
  506. end;
  507. for i := 0 to ASection.Types.Count - 1 do
  508. begin
  509. Decl := TPasElement(ASection.Types[i]);
  510. if not ProcessType(Decl, Element) then
  511. WriteLn('Unhandled type: ',Decl.ClassName, ' ', Decl.Name);
  512. end;
  513. for i := 0 to ASection.Declarations.Count - 1 do
  514. begin
  515. Decl := TPasElement(ASection.Declarations[i]);
  516. if Decl.InheritsFrom(TPasProcedure) then
  517. ProcessProcedure(TPasProcedure(Decl), Element)
  518. else if Decl.ClassType = TPasVariable then
  519. ProcessVariable(TPasVariable(Decl), Element);
  520. end;
  521. for i := 0 to ASection.Functions.Count - 1 do
  522. begin
  523. // many of these (all?) seem to be in ASection.Declarations
  524. Decl := TPasElement(ASection.Functions[i]);
  525. if FindInList(Decl.Name, ASection.Declarations) then
  526. WriteLn('Duplicate proc definition in declarations. Skipping: ', Decl.Name)
  527. else
  528. WriteLn('Unhandled function: ',Decl.ClassName, ' ', Decl.Name);
  529. end;
  530. for i := 0 to ASection.Properties.Count - 1 do
  531. begin
  532. Decl := TPasElement(ASection.Properties[i]);
  533. ProcessProperty(TPasProperty(Decl), Element);
  534. end;
  535. end;
  536. begin
  537. Result := TXMLDocument.Create;
  538. Result.AppendChild(Result.CreateComment(UTF8Decode(SDocGeneratedByComment)));
  539. Result.AppendChild(Result.CreateElement('fp-refdoc'));
  540. ModuleElement := Result.CreateElement('unit');
  541. ModuleElement['name'] := UTF8Decode(AModule.Name);
  542. Result.DocumentElement.AppendChild(ModuleElement);
  543. ProcessSection(AModule.InterfaceSection, 'interface');
  544. end;
  545. { TXMLWriter }
  546. procedure TXMLWriter.WriteDoc;
  547. begin
  548. inherited WriteDoc;
  549. end;
  550. function TXMLWriter.CreateAllocator: TFileAllocator;
  551. begin
  552. if FUseFlatStructure then
  553. Result:=TFlatFileAllocator.Create('.xml')
  554. else
  555. Result:=TLongNameFileAllocator.Create('.xml');
  556. end;
  557. procedure TXMLWriter.AllocatePackagePages;
  558. begin
  559. AddPage(Package, IdentifierIndex);
  560. AddPage(Package, ClassHierarchySubIndex);
  561. AddPage(Package, InterfaceHierarchySubIndex);
  562. end;
  563. procedure TXMLWriter.AllocateModulePages(AModule: TPasModule;
  564. LinkList: TObjectList);
  565. begin
  566. if not assigned(Amodule.Interfacesection) then
  567. exit;
  568. AddPage(AModule, IdentifierIndex);
  569. end;
  570. procedure TXMLWriter.WriteDocPage(const aFileName: String;
  571. aElement: TPasElement; aSubPageIndex: Integer);
  572. var
  573. doc: TXMLDocument;
  574. begin
  575. if (aElement is TPasModule) then
  576. begin
  577. doc := ModuleToXMLStruct(TPasModule(aElement));
  578. WriteXMLFile(doc, GetFileBaseDir(Engine.Output) + aFileName);
  579. doc.Free;
  580. end
  581. else if (aElement is TPasPackage) then
  582. begin
  583. if aSubPageIndex = ClassHierarchySubIndex then
  584. TreeClass.SaveToXml(GetFileBaseDir(Engine.Output) + aFileName);
  585. if aSubPageIndex = InterfaceHierarchySubIndex then
  586. TreeInterface.SaveToXml(GetFileBaseDir(Engine.Output) + aFileName);
  587. end;
  588. end;
  589. constructor TXMLWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
  590. begin
  591. FUseFlatStructure:= False;
  592. FShowSourceInfo:= False;
  593. inherited Create(APackage, AEngine);
  594. end;
  595. class procedure TXMLWriter.Usage(List: TStrings);
  596. begin
  597. inherited Usage(List);
  598. List.AddStrings(['--source-info', SXMLUsageSource]);
  599. List.AddStrings(['--flat-structure', SXMLUsageFlatStructure]);
  600. end;
  601. function TXMLWriter.InterPretOption(const Cmd, Arg: String): boolean;
  602. begin
  603. Result := True;
  604. if Cmd = '--source-info' then
  605. FShowSourceInfo:=True
  606. else if Cmd = '--flat-structure' then
  607. FUseFlatStructure:=True
  608. else
  609. Result:=inherited InterPretOption(Cmd, Arg);
  610. end;
  611. initialization
  612. // Do not localize.
  613. RegisterWriter(TXMLWriter,'xml','fpdoc XML output.');
  614. finalization
  615. UnRegisterWriter('xml');
  616. end.