dw_xml.pp 21 KB

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