dw_xml.pp 21 KB

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