From 5600a9bf24728b209216d93ce6d5a41afdf729f3 Mon Sep 17 00:00:00 2001
From: michael <michael@freepascal.org>
Date: Wed, 6 Jan 2021 12:24:09 +0000
Subject: [PATCH] * Patch from Andrey Sobol to control XML file layout

git-svn-id: trunk@48093 -
(cherry picked from commit 498805c1ca93d4c0784d2d3b7a0a1dbcfa7e5e54)
---
 utils/fpdoc/dw_html.pp |  2 +-
 utils/fpdoc/dw_xml.pp  | 97 ++++++++++++++++++++++++++++++++++++++----
 utils/fpdoc/dwriter.pp |  3 +-
 3 files changed, 90 insertions(+), 12 deletions(-)

diff --git a/utils/fpdoc/dw_html.pp b/utils/fpdoc/dw_html.pp
index 5b43b06c1f..66dd82a79a 100644
--- a/utils/fpdoc/dw_html.pp
+++ b/utils/fpdoc/dw_html.pp
@@ -129,7 +129,7 @@ type
 
 implementation
 
-uses SysUtils, XMLRead, HTMWrite, sh_pas, fpdocclasstree;
+uses SysUtils, HTMWrite, fpdocclasstree;
 
 {$i css.inc}
 {$i plusimage.inc}
diff --git a/utils/fpdoc/dw_xml.pp b/utils/fpdoc/dw_xml.pp
index 2d31e2a68b..4a204f599f 100644
--- a/utils/fpdoc/dw_xml.pp
+++ b/utils/fpdoc/dw_xml.pp
@@ -29,17 +29,34 @@ Type
 
   { TXMLWriter }
 
-  TXMLWriter = Class(TFPDocWriter)
+  TXMLWriter = Class(TMultiFileDocWriter)
   private
-    FShowSourceInfo: Boolean;
+    FShowSourceInfo:Boolean;
+    FUseFlatStructure:Boolean;
+  protected
+    function CreateAllocator : TFileAllocator; override;
+    procedure AllocatePackagePages; override;
+    procedure AllocateModulePages(AModule: TPasModule; {%H-}LinkList: TObjectList); override;
+    procedure WriteDocPage(const aFileName: String; aElement: TPasElement; {%H-}aSubPageIndex: Integer); override;
   public
+    constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
     function ModuleToXMLStruct(AModule: TPasModule): TXMLDocument;
     Procedure WriteDoc; override;
     class procedure Usage(List: TStrings); override;
     function  InterPretOption(const Cmd,Arg : String): boolean; override;
   end;
 
+  { TFlatFileAllocator }
 
+  TFlatFileAllocator = class(TFileAllocator)
+  private
+    FExtension: String;
+  public
+    constructor Create(const AExtension: String);
+    function GetFilename(AElement: TPasElement; ASubindex: Integer): String; override;
+    function GetRelativePathToTop(AElement: TPasElement): String; override;
+    property Extension: String read FExtension;
+  end;
 
 
 implementation
@@ -47,6 +64,31 @@ implementation
 const
   DefaultVisibility = [visDefault, visPublic, visPublished, visProtected];
 
+{ TXmlFileAllocator }
+
+constructor TFlatFileAllocator.Create(const AExtension: String);
+begin
+  FExtension:= AExtension;
+  inherited Create();
+end;
+
+function TFlatFileAllocator.GetFilename(AElement: TPasElement; ASubindex: Integer
+  ): String;
+begin
+  Result:='';
+  if AElement.ClassType = TPasPackage then
+    Result := 'index'
+  else if AElement.ClassType = TPasModule then
+    Result := LowerCase(AElement.Name);
+
+  Result := Result + Extension;
+end;
+
+function TFlatFileAllocator.GetRelativePathToTop(AElement: TPasElement): String;
+begin
+  Result:=inherited GetRelativePathToTop(AElement);
+end;
+
 function TXMLWriter.ModuleToXMLStruct(AModule: TPasModule): TXMLDocument;
 
 var
@@ -586,24 +628,59 @@ end;
 { TXMLWriter }
 
 procedure TXMLWriter.WriteDoc;
+begin
+  inherited WriteDoc;
+end;
+
+function TXMLWriter.CreateAllocator: TFileAllocator;
+begin
+  if FUseFlatStructure then
+    Result:=TFlatFileAllocator.Create('.xml')
+  else
+    Result:=TLongNameFileAllocator.Create('.xml');
+end;
+
+procedure TXMLWriter.AllocatePackagePages;
+var
+  H: Boolean;
+begin
+  H:= false; // TODO: I want to public TreeClass for package
+  if H then
+    AddPage(Package,ClassHierarchySubIndex);
+end;
+
+procedure TXMLWriter.AllocateModulePages(AModule: TPasModule;
+  LinkList: TObjectList);
+begin
+  if not assigned(Amodule.Interfacesection) then
+    exit;
+  AddPage(AModule, 0);
+end;
+
+procedure TXMLWriter.WriteDocPage(const aFileName: String;
+  aElement: TPasElement; aSubPageIndex: Integer);
 var
   doc: TXMLDocument;
-  i: Integer;
 begin
-  if Engine.Output <> '' then
-    Engine.Output := IncludeTrailingBackSlash(Engine.Output);
-
-  for i := 0 to Package.Modules.Count - 1 do
+  if (aElement is TPasModule) then
   begin
-    doc := ModuleToXMLStruct(TPasModule(Package.Modules[i]));
-    WriteXMLFile(doc, Engine.Output + TPasModule(Package.Modules[i]).Name + '.xml' );
+    doc := ModuleToXMLStruct(TPasModule(aElement));
+    WriteXMLFile(doc, GetFileBaseDir(Engine.Output) + aFileName);
     doc.Free;
   end;
 end;
 
+constructor TXMLWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
+begin
+  FUseFlatStructure:= False;
+  FShowSourceInfo:= False;
+  inherited Create(APackage, AEngine);
+end;
+
 class procedure TXMLWriter.Usage(List: TStrings);
 begin
   List.AddStrings(['--source-info', SXMLUsageSource]);
+  List.AddStrings(['--flat-structure', SXMLUsageFlatStructure]);
 end;
 
 function TXMLWriter.InterPretOption(const Cmd, Arg: String): boolean;
@@ -611,6 +688,8 @@ begin
   Result := True;
   if Cmd = '--source-info' then
     FShowSourceInfo:=True
+  else if Cmd = '--flat-structure' then
+      FUseFlatStructure:=True
   else
     Result:=inherited InterPretOption(Cmd, Arg);
 end;
diff --git a/utils/fpdoc/dwriter.pp b/utils/fpdoc/dwriter.pp
index 500fe02c09..249fddf5fd 100644
--- a/utils/fpdoc/dwriter.pp
+++ b/utils/fpdoc/dwriter.pp
@@ -310,7 +310,6 @@ function MethodFilter(AMember: TPasElement): Boolean;
 function EventFilter(AMember: TPasElement): Boolean;
 
 
-
 // Register backend
 Procedure RegisterWriter(AClass : TFPDocWriterClass; Const AName,ADescr : String);
 // UnRegister backend
@@ -398,7 +397,6 @@ constructor TMultiFileDocWriter.Create(APackage: TPasPackage;
   AEngine: TFPDocEngine);
 begin
   inherited Create(APackage, AEngine);
-  FAllocator:=CreateAllocator;
   FPageInfos:=TFPObjectList.Create;
 end;
 
@@ -759,6 +757,7 @@ var
   FinalFilename: String;
 
 begin
+  FAllocator:=CreateAllocator;
   AllocatePages;
   DoLog(SWritingPages, [PageCount]);
   if Engine.Output <> '' then