2
0

dw_xml.pp 21 KB

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