* Partially resolved ID 38141 : better handling of class hierarchy and cross-package links

git-svn-id: trunk@47710 -

utils/fpdoc/dglobals.pp

@@ -36,9 +36,12 @@ Var
 resourcestring
   // Output strings
   SDocPackageTitle           = 'Reference for package ''%s''';
+  SDocPackageMenuTitle       = 'Package ''%s''';
+  SDocPackageLinkTitle       = 'Package';
   SDocPrograms               = 'Programs';
   SDocUnits                  = 'Units';
   SDocUnitTitle              = 'Reference for unit ''%s''';
+  SDocUnitMenuTitle          = 'Unit ''%s''';
   SDocInheritanceHierarchy   = 'Inheritance Hierarchy';
   SDocInterfaceSection       = 'Interface section';
   SDocImplementationSection  = 'Implementation section';
@@ -205,7 +208,9 @@ resourcestring
 Const
   SVisibility: array[TPasMemberVisibility] of string =
        ('Default', 'Private', 'Protected', 'Public',
-       'Published', 'Automated','Strict Private','Strict Protected','Required','Optional');
+       'Published', 'Automated','Strict Private','Strict Protected',
+       'Required', 'Optional' // ObjCClass
+       );
 
 type
   TBufType = Array[1..ContentBufSize-1] of byte;
@@ -319,9 +324,9 @@ type
     FAlwaysVisible : TStringList;
     DescrDocs: TObjectList;             // List of XML documents
     DescrDocNames: TStringList;         // Names of the XML documents
-    FRootLinkNode: TLinkNode;
-    FRootDocNode: TDocNode;
-    FPackages: TFPList;                   // List of TFPPackage objects
+    FRootLinkNode: TLinkNode;           // Global tree of TlinkNode from the imported .xct files
+    FRootDocNode: TDocNode;             // Global tree of TDocNode from the .xml documentation files
+    FPackages: TFPList;                 // Global list of TPasPackage objects and full tree of sources
     CurModule: TPasModule;
     CurPackageDocNode: TDocNode;
     function ParseUsedUnit(AName, AInputLine,AOSTarget,ACPUTarget: String): TPasModule; virtual;
@@ -338,13 +343,16 @@ type
     constructor Create;
     destructor Destroy; override;
     procedure SetPackageName(const APackageName: String);
+    // process the import objects from external .xct file
     procedure ReadContentFile(const AFilename, ALinkPrefix: String);
+    // creation of an own .xct output file
     procedure WriteContentFile(const AFilename: String);
 
     function CreateElement(AClass: TPTreeElement; const AName: String;
       AParent: TPasElement; AVisibility: TPasMemberVisibility;
       const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
       override;
+    function FindInModule(const AName: String ; AModule: TPasModule): TPasElement;
     function FindElement(const AName: String): TPasElement; override;
     function FindModule(const AName: String): TPasModule; override;
     Function HintsToStr(Hints : TPasMemberHints) : String;
@@ -660,7 +668,9 @@ end;
 procedure TFPDocEngine.ReadContentFile(const AFilename, ALinkPrefix: String);
 var
   f: Text;
-  inheritanceinfo : TStringlist;
+  inheritanceinfo : TStringlist; // contents list of TPasClass with inheritance info
+                                 // like this #PackageName.ModuleName.ClassName
+  tmpLinkPrefix : string;
 
   procedure ReadLinkTree;
   var
@@ -708,8 +718,10 @@ var
       i := ThisSpaces + 1;
       while s[i] <> ' ' do
         Inc(i);
+      if ALinkPrefix <> '' then
+        tmpLinkPrefix := ExcludeTrailingPathDelimiter(ALinkPrefix)+'/';
       NewNode := TLinkNode.Create(Copy(s, ThisSpaces + 1, i - ThisSpaces - 1),
-        ALinkPrefix + Copy(s, i + 1, Length(s)));
+        tmpLinkPrefix + Copy(s, i + 1, Length(s)));
       if pos(' ',newnode.link)>0 then
         writeln(stderr,'Bad format imported node: name="',newnode.name,'" link="',newnode.link,'"');
       if Assigned(PrevSibling) then
@@ -721,56 +733,57 @@ var
   end;
 
   function ResolvePackageModule(AName:String;out pkg:TPasPackage;out module:TPasModule;createnew:boolean):String;
-    var
-      DotPos, DotPos2, i: Integer;
-      s: String;
-      HPackage: TPasPackage;
+  var
+    DotPos, DotPos2, i: Integer;
+    s: String;
+    HPackage: TPasPackage;
 
-    begin
-      pkg:=nil; module:=nil; result:='';
-
-      // Find or create package
-      DotPos := Pos('.', AName);
-      s := Copy(AName, 1, DotPos - 1);
-      HPackage := nil;
-      for i := 0 to FPackages.Count - 1 do
-        if CompareText(TPasPackage(FPackages[i]).Name, s) = 0 then
-        begin
-          HPackage := TPasPackage(FPackages[i]);
-          break;
-        end;
-      if not Assigned(HPackage) then
+  begin
+    pkg:=nil; module:=nil; result:='';
+
+    // Find or create package
+    DotPos := Pos('.', AName);
+    s := Copy(AName, 1, DotPos - 1);
+    HPackage := nil;
+    for i := 0 to FPackages.Count - 1 do
+      if CompareText(TPasPackage(FPackages[i]).Name, s) = 0 then
       begin
-        if not CreateNew then
-          exit;
-        HPackage := TPasPackage(inherited CreateElement(TPasPackage, s, nil,
-          '', 0));
-        FPackages.Add(HPackage);
+        HPackage := TPasPackage(FPackages[i]);
+        break;
       end;
+    if not Assigned(HPackage) then
+    begin
+      if not CreateNew then
+        exit;
+      HPackage := TPasPackage(inherited CreateElement(TPasPackage, s, nil,
+        '', 0));
+      FPackages.Add(HPackage);
+    end;
 
-      // Find or create module
-      DotPos2 := DotPos;
-      repeat
-        Inc(DotPos2);
-      until AName[DotPos2] = '.';
-      s := Copy(AName, DotPos + 1, DotPos2 - DotPos - 1);
-      Module := nil;
-      for i := 0 to HPackage.Modules.Count - 1 do
-        if CompareText(TPasModule(HPackage.Modules[i]).Name, s) = 0 then
-        begin
-          Module := TPasModule(HPackage.Modules[i]);
-          break;
-        end;
-      if not Assigned(Module) then
+    // Find or create module
+    DotPos2 := DotPos;
+    repeat
+      Inc(DotPos2);
+    until AName[DotPos2] = '.';
+    s := Copy(AName, DotPos + 1, DotPos2 - DotPos - 1);
+    Module := nil;
+    for i := 0 to HPackage.Modules.Count - 1 do
+      if CompareText(TPasModule(HPackage.Modules[i]).Name, s) = 0 then
       begin
-        if not CreateNew then
-          exit;
-        Module := TPasExternalModule.Create(s, HPackage);
-        Module.InterfaceSection := TInterfaceSection.Create('', Module);
-        HPackage.Modules.Add(Module);
+        Module := TPasModule(HPackage.Modules[i]);
+        break;
       end;
-     pkg:=hpackage;
-     result:=Copy(AName, DotPos2 + 1, length(AName)-dotpos2);
+    if not Assigned(Module) then
+    begin
+      if not CreateNew then
+        exit;
+      Module := TPasExternalModule.Create(s, HPackage);
+      Module.InterfaceSection := TInterfaceSection.Create('', Module);
+      Module.PackageName:= HPackage.Name;
+      HPackage.Modules.Add(Module);
+    end;
+    pkg:=hpackage;
+    result:=Copy(AName, DotPos2 + 1, length(AName)-dotpos2);
   end;
 
   function SearchInList(clslist:TFPList;s:string):TPasElement;
@@ -834,9 +847,9 @@ var
         InheritanceInfo.AddObject(Inheritancestr,result);
     end;
 
-   procedure splitalias(var instr:string;out outstr:string);
-   var i,j:integer;
-   begin 
+    procedure splitalias(var instr:string;out outstr:string);
+    var i,j:integer;
+    begin
      if length(instr)=0 then exit;
      instr:=trim(instr);
      i:=pos('(',instr);
@@ -848,10 +861,10 @@ var
         outstr:=copy(instr,i+1,j);
         delete(instr,i,j+2);
       end
-   end;
+    end;
 
-   Function ResolveAndLinkClass(clname:String;IsClass:boolean;cls:TPasClassType):TPasClassType;
-   begin
+    Function ResolveAndLinkClass(clname:String;IsClass:boolean;cls:TPasClassType):TPasClassType;
+    begin
      result:=TPasClassType(ResolveClassType(clname)); 
      if assigned(result) and not (cls=result) then  // save from tobject=implicit tobject
        begin
@@ -870,47 +883,47 @@ var
      else
        if cls<>result then
          DoLog('Warning : ancestor class %s of class %s could not be resolved',[clname,cls.name]);
-end;
+    end;
 
-function CreateAliasType (alname,clname : string;parentclass:TPasClassType; out cl2 :TPasClassType):TPasAliasType;
-// create alias clname =  alname
-var 
-  pkg     : TPasPackage;
-  module  : TPasModule; 
-  s       : string;  
-begin
-    Result:=nil;
-    s:=ResolvePackageModule(Alname,pkg,module,True);
-    if not assigned(module) then
-      exit;
-    cl2:=TPasClassType(ResolveClassType(alname));
-    if assigned( cl2) and not (parentclass=cl2) then  
-      begin
-        result:=ResolveAliasType(clname);
-        if assigned(result) then
-          begin
-//            writeln('found alias ',clname,' (',s,') ',result.classname);  
-          end
-        else
+    function CreateAliasType (alname,clname : string;parentclass:TPasClassType; out cl2 :TPasClassType):TPasAliasType;
+    // create alias clname =  alname
+    var
+      pkg     : TPasPackage;
+      module  : TPasModule;
+      s       : string;
+    begin
+        Result:=nil;
+        s:=ResolvePackageModule(Alname,pkg,module,True);
+        if not assigned(module) then
+          exit;
+        cl2:=TPasClassType(ResolveClassType(alname));
+        if assigned( cl2) and not (parentclass=cl2) then  
           begin
-//            writeln('new alias ',clname,' (',s,') ');
-            cl2.addref;
-            Result := TPasAliasType(CreateElement(TPasAliasType,s,module.interfacesection,vispublic,'',0));
-            module.interfacesection.Declarations.Add(Result);
-            TPasAliasType(Result).DestType := cl2;
+            result:=ResolveAliasType(clname);
+            if assigned(result) then
+              begin
+    //            writeln('found alias ',clname,' (',s,') ',result.classname);
+              end
+            else
+              begin
+    //            writeln('new alias ',clname,' (',s,') ');
+                cl2.addref;
+                Result := TPasAliasType(CreateElement(TPasAliasType,s,module.interfacesection,vispublic,'',0));
+                module.interfacesection.Declarations.Add(Result);
+                TPasAliasType(Result).DestType := cl2;
+              end
           end
-      end
-end;
+    end;
 
-   procedure ProcessInheritanceStrings(inhInfo:TStringList);
+    procedure ProcessInheritanceStrings(inhInfo:TStringList);
 
-   var i,j : integer;
-       cls : TPasClassType;  
+    var i,j : integer;
+       cls : TPasClassType;
        cls2: TPasClassType;
        clname,
        alname : string;
        inhclass   : TStringList;
-   begin
+    begin
      inhclass:=TStringList.Create;
      inhclass.delimiter:=',';
      if InhInfo.Count>0 then
@@ -922,12 +935,12 @@ end;
 
            for j:= 0 to inhclass.count-1 do
              begin
-               //writeln('processing',inhclass[j]);
+               // writeln('processing',inhclass[j]);
                clname:=inhclass[j];
-               splitalias(clname,alname);               
+               splitalias(clname,alname);
                if alname<>'' then // the class//interface we refered to is an alias
                  begin
-                   // writeln('Found alias pair ',clname,' = ',alname);   
+                   // writeln('Found alias pair ',clname,' = ',alname);
                    if not assigned(CreateAliasType(alname,clname,cls,cls2)) then
                       DoLog('Warning: creating alias %s for %s failed!',[alname,clname]);
                  end 
@@ -936,7 +949,7 @@ end;
              end;
          end;
     inhclass.free;
-   end;
+    end;
 
   var
     s, Name: String;
@@ -993,10 +1006,10 @@ end;
           CurClass.Members.Add(Member);
         end;
       end;
-     ProcessInheritanceStrings(Inheritanceinfo);
+      ProcessInheritanceStrings(Inheritanceinfo);
     finally
-     inheritanceinfo.Free;
-     end;
+      inheritanceinfo.Free;
+    end;
   end;
 
 var
@@ -1044,11 +1057,13 @@ var
     end;
   end;
 
-  function CheckImplicitInterfaceLink(const s : String):String;
+  function CheckImplicitLink(const s : String):String;
   begin
-   if uppercase(s)='IUNKNOWN' then
+    if uppercase(s)='IUNKNOWN' then
      Result:='#rtl.System.IUnknown'
-   else 
+    else if uppercase(s)='TOBJECT' then
+     Result:='#rtl.System.TObject'
+   else
      Result:=s;
   end;
 var
@@ -1096,13 +1111,13 @@ begin
           ClassLikeDecl:=MemberDecl as TPasClassType
         else
           ClassLikeDecl:=nil;
-        Write(ContentFile, CheckImplicitInterfaceLink(MemberDecl.PathName), ' ');
+        Write(ContentFile, CheckImplicitLink(MemberDecl.PathName), ' ');
         if Assigned(ClassLikeDecl) then
           begin
           if Assigned(ClassLikeDecl.AncestorType) then
             begin
             // simple aliases to class types are coded as "alias(classtype)"
-            Write(ContentFile, CheckImplicitInterfaceLink(ClassLikeDecl.AncestorType.PathName));
+            Write(ContentFile, CheckImplicitLink(ClassLikeDecl.AncestorType.PathName));
             if ClassLikeDecl.AncestorType is TPasAliasType then
                begin
                alias:= TPasAliasType(ClassLikeDecl.AncestorType);
@@ -1118,12 +1133,12 @@ begin
             begin
             for k:=0 to ClassLikeDecl.Interfaces.count-1 do
               begin
-                write(contentfile,',',CheckImplicitInterfaceLink(TPasClassType(ClassLikeDecl.Interfaces[k]).PathName));
+                write(contentfile,',',CheckImplicitLink(TPasClassType(ClassLikeDecl.Interfaces[k]).PathName));
                 if TPasElement(ClassLikeDecl.Interfaces[k]) is TPasAliasType then
                   begin
                     alias:= TPasAliasType(ClassLikeDecl.Interfaces[k]);
                     if assigned(alias.desttype) and (alias.desttype is TPasClassType) then
-                      write(ContentFile,'(',CheckImplicitInterfaceLink(alias.desttype.PathName),')');   
+                      write(ContentFile,'(',CheckImplicitLink(alias.desttype.PathName),')');
                   end;
               end;
             end;
@@ -1173,41 +1188,41 @@ begin
   Result.SourceLinenumber := ASourceLinenumber;
 end;
 
-function TFPDocEngine.FindElement(const AName: String): TPasElement;
+function TFPDocEngine.FindInModule ( const AName: String; AModule: TPasModule
+  ) : TPasElement;
+var
+  l: TFPList;
+  i: Integer;
 
-  function FindInModule(AModule: TPasModule; const LocalName: String): TPasElement;
-  
-  var
-    l: TFPList;
-    i: Integer;
-    
-  begin
-    If assigned(AModule.InterfaceSection) and 
-       Assigned(AModule.InterfaceSection.Declarations) then
+begin
+  If Assigned(AModule) and Assigned(AModule.InterfaceSection) and
+     Assigned(AModule.InterfaceSection.Declarations) then
+    begin
+    l:=AModule.InterfaceSection.Declarations;
+    for i := 0 to l.Count - 1 do
       begin
-      l:=AModule.InterfaceSection.Declarations;
-      for i := 0 to l.Count - 1 do
-        begin
-        Result := TPasElement(l[i]);
-        if  CompareText(Result.Name, LocalName) = 0 then
-          exit;
-        end;
-      end;  
-    Result := nil;
- end;
+      Result := TPasElement(l[i]);
+      if CompareText(Result.Name, AName) = 0 then
+        exit;
+      end;
+    end;
+  Result := nil;
+end;
+
+function TFPDocEngine.FindElement(const AName: String): TPasElement;
 
 var
   i: Integer;
   Module: TPasElement;
 begin
-  Result := FindInModule(CurModule, AName);
+  Result := FindInModule( AName, CurModule );
   if not Assigned(Result) and assigned (CurModule.InterfaceSection) then
     for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do
     begin
       Module := TPasElement(CurModule.InterfaceSection.UsesList[i]);
       if Module.ClassType.InheritsFrom(TPasModule) then
       begin
-        Result := FindInModule(TPasModule(Module), AName);
+        Result := FindInModule(AName, TPasModule(Module));
         if Assigned(Result) then
           exit;
       end;

utils/fpdoc/dw_html.pp

@@ -15,7 +15,7 @@
 {$mode objfpc}
 {$H+}
 
-unit dw_HTML;
+unit dw_html;
 {$WARN 5024 off : Parameter "$1" not used}
 interface
 
@@ -75,9 +75,7 @@ type
   THTMLWriter = class(TFPDocWriter)
   private
     FImageFileList: TStrings;
-
     FOnTest: TNotifyEvent;
-    FPackage: TPasPackage;
     FCharSet : String;
     procedure CreateMinusImage;
     procedure CreatePlusImage;
@@ -233,7 +231,7 @@ type
     procedure CreatePackagePageBody;
     procedure CreatePackageIndex;
     procedure CreatePackageClassHierarchy;
-    procedure CreateClassHierarchyPage(AList: TStringList; AddUnit : Boolean);
+    procedure CreateClassHierarchyPage(AddUnit : Boolean);
     procedure AddModuleIdentifiers(AModule : TPasModule; L : TStrings);
     Procedure CreateTopicPageBody(AElement : TTopicElement);
     procedure CreateModulePageBody(AModule: TPasModule; ASubpageIndex: Integer);
@@ -244,9 +242,9 @@ type
     procedure CreateVarPageBody(AVar: TPasVariable);
     procedure CreateProcPageBody(AProc: TPasProcedureBase);
     Procedure CreateTopicLinks(Node : TDocNode; PasElement : TPasElement);
-    procedure AddElementsFromList(L: TStrings; List: TFPList; UsePathName : Boolean = False);
     procedure AppendTypeDecl(AType: TPasType; TableEl, CodeEl: TDomElement);
   public
+    // Creating all module hierarchy classes is here !!!!
     constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
     destructor Destroy; override;
 
@@ -254,7 +252,7 @@ type
     function CreateHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument;
     function CreateXHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument;
 
-    // For producing complete package documentation
+    // Start producing html complete package documentation
     procedure WriteHTMLPages; virtual;
     procedure WriteXHTMLPages;
     function  ModuleForElement(AnElement:TPasElement):TPasModule;
@@ -266,7 +264,7 @@ type
     Class procedure SplitImport(var AFilename, ALinkPrefix: String); override;
     Property SearchPage: String Read FSearchPage Write FSearchPage;
     property Allocator: TFileAllocator read FAllocator;
-    property Package: TPasPackage read FPackage;
+
     property PageCount: Integer read GetPageCount;
     Property IncludeDateInFooter : Boolean Read FIDF Write FIDF;
     Property DateFormat : String Read FDateFormat Write FDateFormat;
@@ -326,13 +324,20 @@ function TLongNameFileAllocator.GetFilename(AElement: TPasElement; ASubindex: In
 var
   n,s: String;
   i: Integer;
-
+  excl: Boolean; //search
 begin
   Result:='';
+  excl := False;
   if AElement.ClassType = TPasPackage then
-    Result := 'index'
+  begin
+    Result := 'index';
+    excl := True;
+  end
   else if AElement.ClassType = TPasModule then
-    Result := LowerCase(AElement.Name) + PathDelim + 'index'
+  begin
+    Result := LowerCase(AElement.Name) + PathDelim + 'index';
+    excl := True;
+  end
   else
   begin
     if AElement is TPasOperator then
@@ -361,8 +366,12 @@ begin
       if (N<>'') and  (N[1]=':') then
         Delete(N,1,1);
       Result:=Result + '-'+ s + '-' + N;
-    end else
+    end
+      else
+    begin
       Result := LowerCase(AElement.PathName);
+      excl := (ASubindex > 0);
+    end;
     // searching for TPasModule - it is on the 2nd level
     if Assigned(AElement.Parent) then
       while Assigned(AElement.Parent.Parent) do
@@ -375,6 +384,14 @@ begin
       Inc(i);
     if (i <= Length(Result)) and (i > 0) then
       Result[i] := PathDelim;
+    if excl or (Length(Result)=0) then
+      begin
+        // exclude the from full text search index
+        s:= '.'+ExtractFileName(Result + '.');
+        n:= ExtractFileDir(Result);
+        Result := n + DirectorySeparator + s;
+        Result := Copy(Result, 1, Length(Result)-1);
+      end;
   end;
 
   if ASubindex > 0 then
@@ -632,7 +649,7 @@ var
   H : Boolean;
 
 begin
-  inherited ;
+  inherited Create(APackage, AEngine);
 
   // should default to true since this is the old behavior
   UseMenuBrackets:=True;
@@ -640,7 +657,6 @@ begin
   IndexColCount:=3;
   Charset:='iso-8859-1';
   CreateAllocator;
-  FPackage := APackage;
   OutputNodeStack := TList.Create;
 
   PageInfos := TObjectList.Create;
@@ -716,6 +732,7 @@ begin
   HTMLEl.AppendChild(BodyElement);
 
   CreatePageBody(AElement, ASubpageIndex);
+
   AppendFooter;
 
   HeadEl.AppendChild(El);
@@ -771,6 +788,7 @@ begin
         Filename := Engine.Output + Allocator.GetFilename(Element, SubpageIndex);
         try
           CreatePath(Filename);
+          //writeln('Element: ',Element.PathName, ' FileName: ', Filename);
           WriteHTMLFile(PageDoc, Filename);
         except
           on E: Exception do
@@ -1534,7 +1552,8 @@ begin
   end;
 end;
 
-Procedure THTMLWriter.AppendShortDescr(AContext: TPasElement; Parent: TDOMNode; DocNode : TDocNode);
+procedure THTMLWriter.AppendShortDescr ( AContext: TPasElement;
+  Parent: TDOMNode; DocNode: TDocNode ) ;
 
 Var
   N : TDocNode;
@@ -2093,7 +2112,7 @@ end;
 procedure THTMLWriter.AppendMenuBar(ASubpageIndex: Integer);
 
 var
-  TableEl, TREl, ParaEl, TitleEl: TDOMElement;
+  TableEl, TREl, TRE2, ParaEl, TitleEl: TDOMElement;
 
   procedure AddLink(ALinkSubpageIndex: Integer; const AName: String);
   begin
@@ -2132,8 +2151,34 @@ begin
   TableEl['border'] := '0';
   TableEl['width'] := '100%';
   TableEl['class'] := 'bar';
+  // Title Row
   TREl := CreateTR(TableEl);
-  ParaEl := CreateEl(CreateTD(TREl), 'b');
+  // Menu title
+  ParaEl := CreateTD(TREl);
+  ParaEl['align'] := 'left';
+  TitleEl := CreateEl(ParaEl, 'span');
+  TitleEl['class'] := 'bartitle';
+  if Assigned(Module) then
+    AppendText(TitleEl, Format(SDocUnitMenuTitle, [Module.Name]))
+  else
+    AppendText(TitleEl, Format(SDocPackageMenuTitle, [Package.Name]));
+
+  // Package link title
+  ParaEl := CreateTD(TREl);
+  ParaEl['align'] := 'right';
+  TitleEl := CreateEl(ParaEl, 'span');
+  TitleEl['class'] := 'bartitle';
+  if Assigned(Module) and Assigned(Package) then // Displays a Package page
+  begin
+    AppendText(TitleEl, SDocPackageLinkTitle);
+  end;
+
+  // Links Row
+  TRE2 := CreateTR(TableEl);
+  ParaEl := CreateTD(TRE2);
+  ParaEl['align'] := 'left';
+  ParaEl := CreateEl(ParaEl, 'span');
+  ParaEl['class']:= 'bartitle';
 
   if Assigned(Module) then
     begin
@@ -2150,12 +2195,18 @@ begin
       AddLink(ProcsSubindex, SDocProceduresAndFunctions);
     if Module.InterfaceSection.Variables.Count > 0 then
       AddLink(VarsSubindex, SDocVariables);
-    AddLink(IndexSubIndex,SDocIdentifierIndex);  
+    AddLink(IndexSubIndex,SDocIdentifierIndex);
     AppendFragment(ParaEl, NavigatorHTML);
     end
   else
     begin
+    // Overview
+    AppendText(ParaEl, '[');
+    AppendHyperlink(ParaEl, Package).TextContent:= UTF8Decode(SDocOverview);
+    AppendText(ParaEl, ']');
+    //Index
     AddPackageLink(IndexSubIndex, SDocIdentifierIndex);
+    // Class TObject tree
     AddPackageLink(ClassHierarchySubIndex, SDocPackageClassHierarchy);
     AppendFragment(ParaEl, NavigatorHTML)
     end;
@@ -2168,17 +2219,16 @@ begin
     if FUseMenuBrackets then
       AppendText(ParaEl, ']');
   end;
-  ParaEl := CreateTD(TREl);
+
+  ParaEl := CreateTD(TRE2);
   ParaEl['align'] := 'right';
-  TitleEl := CreateEl(ParaEl, 'span');
-  TitleEl['class'] := 'bartitle';
-  if Assigned(Module) then
-    AppendText(TitleEl, Format(SDocUnitTitle, [Module.Name]));
-  if Assigned(Package) then
+  ParaEl := CreateEl(ParaEl, 'span');
+  ParaEl['class']:= 'bartitle';
+  if Assigned(Module) and Assigned(Package) then // Displays a Package page
   begin
-    AppendText(TitleEl, ' (');
-    AppendHyperlink(TitleEl, Package);
-    AppendText(TitleEl, ')');
+    AppendText(ParaEl, '[');
+    AppendHyperlink(ParaEl, Package);
+    AppendText(ParaEl, ']');
   end;
   AppendFragment(BodyElement,HeaderHTML);
 end;
@@ -2189,7 +2239,8 @@ begin
     [ExtractFileName(AElement.SourceFilename), AElement.SourceLinenumber]));
 end;
 
-Procedure THTMLWriter.AppendSeeAlsoSection(AElement : TPasElement;DocNode : TDocNode);
+procedure THTMLWriter.AppendSeeAlsoSection ( AElement: TPasElement;
+  DocNode: TDocNode ) ;
 
 var
   Node: TDOMNode;
@@ -2263,7 +2314,8 @@ begin
      end; // While
 end;
 
-Procedure THTMLWriter.AppendExampleSection(AElement : TPasElement;DocNode : TDocNode);
+procedure THTMLWriter.AppendExampleSection ( AElement: TPasElement;
+  DocNode: TDocNode ) ;
 
 var
   Node: TDOMNode;
@@ -2384,10 +2436,11 @@ begin
     end;
 end;
 
-procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Boolean);
+procedure THTMLWriter.CreateClassHierarchyPage(AddUnit : Boolean);
+type
+  TypeEN = (NPackage, NModule, NName);
 
   Procedure PushClassElement;
-
   Var
     H : THTMLElement;
   begin
@@ -2403,7 +2456,6 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo
   end;
 
   Procedure PushClassList;
-
   Var
     H : THTMLElement;
   begin
@@ -2412,32 +2464,39 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo
     PushOutputNode(h);
   end;
 
-  Procedure AppendClass(E : TPasElementNode);
+  function ExtractName(APathName: String; Tp: TypeEN):String;
+  var
+  l:TStringList;
+  begin
+    Result:= Trim(APathName);
+    if Result = '' then exit;
+    l:=TStringList.Create;
+    try
+      l.AddDelimitedText(Result, '.', True);
+      if l.Count=3 then
+        Result:= l.Strings[Integer(Tp)]
+      else
+        Result:='';
+    finally
+      l.free;
+    end;
+  end;
+
+  Procedure AppendClass(EN : TPasElementNode);
 
   Var
-    N : TDomNode;
-    P,PM,M : TPasElement;
-    EN : String;
-    LL : TstringList;
-    I,J : Integer;
+    PE,PM : TPasElement;
+    I : Integer;
 
   begin
-    M:=E.Element.GetModule;
-    if (M<>Nil) then
-      EN:=Package.Name+'.'+UTF8Encode(M.Name)+'.'+UTF8Encode(E.Element.Name)
-    else
-      EN:=UTF8Encode(E.Element.Name);
-    J:=AList.IndexOf(EN);
-    If J<>-1 then
-      P:=AList.Objects[J] as TPasElement
-    else
-      P:=Engine.FindElement(EN);
+    if not Assigned(EN) then exit;
+    PE:=EN.Element;
     PushClassElement;
     try
-      if (P<>Nil) then
+      if (PE<>Nil) then
         begin
-        AppendHyperLink(CurOutputNode,P);
-        PM:=ModuleForElement(P);
+        AppendHyperLink(CurOutputNode,PE);
+        PM:=ModuleForElement(PE);
         if (PM<>Nil) then
           begin
           AppendText(CurOutputNode,' (');
@@ -2446,13 +2505,13 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo
           end
         end
       else
-        AppendText(CurOutputNode,E.Element.Name);
-      if E.ChildCount>0 then
+        AppendText(CurOutputNode,EN.Element.Name);
+      if EN.ChildCount>0 then
         begin
         PushClassList;
         try
-          For I:=0 to E.ChildCount-1 do
-            AppendClass(E.Children[i] as TPasElementNode);
+          For I:=0 to EN.ChildCount-1 do
+            AppendClass(EN.Children[i] as TPasElementNode);
         finally
           PopOutputNode;
         end;
@@ -2462,29 +2521,12 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo
     end;
   end;
 
-Var
-  B : TClassTreeBuilder;
-  E : TPasElementNode;
-
 begin
   PushOutputNode(BodyElement);
   try
-    B:=TClassTreeBuilder.Create(Package,okClass);
-    try
-      B.BuildTree(AList);
-      // Classes
-      // WriteXMLFile(B.ClassTree,'tree.xml');
-      // Dummy TObject
-      E:=B.RootNode;
-      PushClassList;
-      try
-        AppendClass(E);
-      finally
-        PopOutputNode;
-      end;
-    finally
-      B.Free;
-    end;
+    PushClassList;
+    AppendClass(TreeClass.RootNode);
+    //PopOutputNode;
   finally
     PopOutputNode;
   end;
@@ -2500,9 +2542,6 @@ Const
           '}';
 
 Var
-  L : TStringList;
-  I : Integer;
-  M : TPasModule;
   S : String;
   SE : THTMLElement;
 
@@ -2510,24 +2549,12 @@ begin
   SE := Doc.CreateElement('script');
   AppendText(SE,SFunc);
   HeadElement.AppendChild(SE);
-  L:=TStringList.Create;
-  try
-    L.Capacity:=PageInfos.Count; // Too much, but that doesn't hurt.
-    For I:=0 to Package.Modules.Count-1 do
-      begin
-      M:=TPasModule(Package.Modules[i]);
-      if Not (M is TPasExternalModule) and assigned(M.InterfaceSection) then
-        Self.AddElementsFromList(L,M.InterfaceSection.Classes,True)
-      end;
-    AppendMenuBar(ClassHierarchySubIndex);
-    S:=Package.Name;
-    If Length(S)>0 then
-      Delete(S,1,1);
-    AppendTitle(UTF8Decode(Format(SDocPackageClassHierarchy, [S])));
-    CreateClassHierarchyPage(L,True);
-  Finally
-    L.Free;
-  end;
+  AppendMenuBar(ClassHierarchySubIndex);
+  S:=Package.Name;
+  If Length(S)>0 then
+    Delete(S,1,1);
+  AppendTitle(UTF8Decode(Format(SDocPackageClassHierarchy, [S])));
+  CreateClassHierarchyPage(True);
 end;
 
 procedure THTMLWriter.CreatePageBody(AElement: TPasElement;
@@ -2673,29 +2700,6 @@ begin
   end;  
 end;
 
-Procedure THTMLWriter.AddElementsFromList(L : TStrings; List : TFPList; UsePathName : Boolean = False);
-
-Var
-  I : Integer;
-  El : TPasElement;
-  N : TDocNode;
-
-begin
-  For I:=0 to List.Count-1 do
-    begin
-    El:=TPasElement(List[I]);
-    N:=Engine.FindDocNode(El);
-    if (N=Nil) or (not N.IsSkipped) then
-      begin
-      if UsePathName then
-        L.AddObject(El.PathName,El)
-      else
-        L.AddObject(El.Name,El);
-      If el is TPasEnumType then
-        AddElementsFromList(L,TPasEnumType(el).Values);
-      end;
-    end;
-end;
 
 procedure THTMLWriter.AddModuleIdentifiers(AModule : TPasModule; L : TStrings);
 
@@ -2783,7 +2787,8 @@ begin
     end;
 end;
 
-Procedure THTMLWriter.CreateTopicLinks(Node : TDocNode; PasElement : TPasElement);
+procedure THTMLWriter.CreateTopicLinks ( Node: TDocNode;
+  PasElement: TPasElement ) ;
 
 var
   DocNode: TDocNode;
@@ -3351,10 +3356,9 @@ var
     i: Integer;
     ThisInterface,
     ThisClass: TPasClassType;
-    HaveSeenTObject: Boolean;
-    LName     : String;
-    ThisNode  : TPasUnresolvedTypeRef;
+    ThisTreeNode: TPasElementNode;
   begin
+    //WriteLn('@ClassPageBody.CreateMainPage Class=', AClass.Name);
     AppendMenuBar(-1);
     AppendTitle(UTF8Decode(AClass.Name),AClass.Hints);
 
@@ -3398,28 +3402,29 @@ var
     end;
     CreateMemberDeclarations(AClass, AClass.Members,TableEl, not AClass.IsShortDefinition);
 
-
-
     AppendText(CreateH2(BodyElement), UTF8Decode(SDocInheritance));
     TableEl := CreateTable(BodyElement);
-    HaveSeenTObject := AClass.ObjKind <> okClass;
-    // we try to track classes. But imported classes
-    // are TLinkNode's not the TPasClassType generated by the parser.
-    ThisClass := AClass; ThisNode := Nil;
+
+    // Now we are using only TreeClass for show inheritance
+
+    ThisClass := AClass; ThisTreeNode := Nil;
+    if AClass.ObjKind = okInterface then
+      ThisTreeNode := TreeInterface.GetPasElNode(AClass)
+    else
+      ThisTreeNode := TreeClass.GetPasElNode(AClass);
     while True do
     begin
       TREl := CreateTR(TableEl);
       TDEl := CreateTD_vtop(TREl);
       TDEl['align'] := 'center';
       CodeEl := CreateCode(CreatePara(TDEl));
-      if Assigned(ThisClass) then
-        LName:=ThisClass.Name
-      Else
-        LName:=ThisNode.Name;
+
+      // Show class item
       if Assigned(ThisClass) Then
-        AppendHyperlink(CodeEl, ThisClass)
-      else
-        AppendHyperlink(CodeEl, ThisNode);
+        AppendHyperlink(CodeEl, ThisClass);
+      //else
+      //  AppendHyperlink(CodeEl, ThisTreeNode);
+      // Show links to class interfaces
       if Assigned(ThisClass) and (ThisClass.Interfaces.count>0) then
         begin
           for i:=0 to ThisClass.interfaces.count-1 do
@@ -3429,48 +3434,28 @@ var
               AppendHyperlink(CodeEl, ThisInterface);
             end;
         end;
-      AppendShortDescrCell(TREl, ThisClass);
-      if HaveSeenTObject or (CompareText(LName, 'TObject') = 0) then
-        HaveSeenTObject := True
-      else
-      begin
-        TDEl := CreateTD(CreateTR(TableEl));
-        TDEl['align'] := 'center';
-        AppendText(TDEl, '|');
-      end;
+      // short class description
+      if Assigned(ThisClass) then
+            AppendShortDescrCell(TREl, ThisClass);
 
-      if Assigned(ThisClass.AncestorType) then
-      begin
-        if ThisClass.AncestorType.InheritsFrom(TPasClassType) then
-          ThisClass := TPasClassType(ThisClass.AncestorType)
-        else
+      if Assigned(ThisTreeNode) then
+        if Assigned(ThisTreeNode.ParentNode) then
         begin
-          if thisclass.ancestortype is TPasUnresolvedTypeRef then
-            thisnode:=TPasUnresolvedTypeRef(ThisClass.ancestortype);
           TDEl := CreateTD(CreateTR(TableEl));
           TDEl['align'] := 'center';
-          AppendText(CreateCode(CreatePara(TDEl)), UTF8Decode(ThisClass.AncestorType.Name));
-          if CompareText(ThisClass.AncestorType.Name, 'TObject') = 0 then
-            HaveSeenTObject := True
+          AppendText(TDEl, '|');
+          ThisClass := ThisTreeNode.ParentNode.Element;
+          ThisTreeNode := ThisTreeNode.ParentNode;
+        end
           else
-          begin
-            TDEl := CreateTD(CreateTR(TableEl));
-            TDEl['align'] := 'center';
-            AppendText(TDEl, '?');
-          end;
+        begin
+          ThisClass := nil;
+          ThisTreeNode:= nil;
           break;
         end
-      end else
+      else
         break;
     end;
-
-    if not HaveSeenTObject then
-    begin
-      TDEl := CreateTD(CreateTR(TableEl));
-      TDEl['align'] := 'center';
-      AppendText(CreateCode(CreatePara(TDEl)), 'TObject');
-    end;
-
     FinishElementPage(AClass);
   end;
 
@@ -3847,11 +3832,12 @@ begin
   FinishElementPage(AProc);
 end;
 
-Function THTMLWriter.InterPretOption(Const Cmd,Arg : String) : boolean;
+function THTMLWriter.InterPretOption ( const Cmd, Arg: String ) : boolean;
 
   Function ReadFile(aFileName : string) : TstringStream;
 
   begin
+    aFileName:= SetDirSeparators(aFileName);
     try
       if copy(aFileName,1,1)<>'@' then
         Result:=TStringStream.Create(aFileName)
@@ -3942,7 +3928,7 @@ begin
     end;
 end;
 
-Class Function THTMLWriter.FileNameExtension : String; 
+class function THTMLWriter.FileNameExtension: String;
 begin
   result:='';
 end;

utils/fpdoc/dw_txt.pp

@@ -158,18 +158,19 @@ Function FindSpace(Const S : String; P : Integer) : Integer;
 
 Var
   I,L : Integer;
-
+  SP: set of char;
 begin
   Result:=0;
+  SP := [#10,#13,' ',#9];
   I:=P;
   L:=Length(S);
-  While (I>0) and (I<=L) and not (S[i] in [#10,#13,' ',#9]) do
-    Dec(i);
+  While (I>0) and (I<=L) and not (S[i] in SP) do
+    Dec(I);
   If (I=0) then
     begin
-    I:=P;
-    While (I<=L) and not (S[i] in [#10,#13,' ',#9]) do
-      Inc(i);
+    Inc(I);
+    While (I<=L) and not (S[I] in SP) do
+      Inc(I);
     end;
   Result:=I;
 end;
@@ -186,7 +187,7 @@ begin
     exit;
   N:=S;
   Repeat
-    If ((FCurrentPos+Length(N))>LineWidth) then
+    If ((FCurrentPos+Length(N)+1)>LineWidth) then
       begin
       L:=FindSpace(N,LineWidth-FCurrentPos+1);
       inherited Write(Copy(N,1,L-1));
@@ -195,8 +196,8 @@ begin
       end
     else
       begin
-      L:=Length(N)+1;
-      inherited Write(Copy(N,1,L-1));
+      L:=Length(N);
+      inherited Write(Copy(N,1,L));
       Inc(FCurrentPos,L);
       If FCheckEOL then
         If (L>=LEOL) then

utils/fpdoc/dwriter.pp

@@ -25,7 +25,7 @@ unit dWriter;
 {$WARN 5024 off : Parameter "$1" not used}
 interface
 
-uses Classes, DOM, dGlobals, PasTree, SysUtils;
+uses Classes, DOM, dGlobals, PasTree, SysUtils, fpdocclasstree;
 
 resourcestring
   SErrFileWriting = 'An error occurred during writing of file "%s": %s';
@@ -80,8 +80,12 @@ type
     FImgExt : String;
     FBeforeEmitNote : TWriterNoteEvent;
     procedure ConvertURL(AContext: TPasElement; El: TDOMElement);
-    
+    procedure CreateClassTree;
   protected
+    TreeClass: TClassTreeBuilder;      // Global class tree
+    TreeInterface: TClassTreeBuilder;  // Global interface tree
+
+    procedure AddElementsFromList(L: TStrings; List: TFPList; UsePathName : Boolean = False);
     Procedure DoLog(Const Msg : String);
     Procedure DoLog(Const Fmt : String; Args : Array of const);
     procedure Warning(AContext: TPasElement; const AMsg: String);
@@ -339,7 +343,8 @@ end;
 
 
 }
-Constructor TFPDocWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
+constructor TFPDocWriter.Create ( APackage: TPasPackage; AEngine: TFPDocEngine
+  ) ;
 
 begin
   inherited Create;
@@ -347,6 +352,9 @@ begin
   FPackage := APackage;
   FTopics:=Tlist.Create;
   FImgExt:='.png';
+  TreeClass:= TClassTreeBuilder.Create(FEngine, FPackage, okClass);
+  TreeInterface:= TClassTreeBuilder.Create(FEngine, FPackage, okInterface);
+  CreateClassTree;
 end;
 
 destructor TFPDocWriter.Destroy;
@@ -358,6 +366,8 @@ begin
   For I:=0 to FTopics.Count-1 do
     TTopicElement(FTopics[i]).Free;
   FTopics.Free;
+  TreeClass.free;
+  TreeInterface.Free;
   Inherited;
 end;
 
@@ -390,7 +400,7 @@ begin
     end;
 end;
 
-Function TFPDocWriter.FindTopicElement(Node : TDocNode): TTopicElement;
+function TFPDocWriter.FindTopicElement ( Node: TDocNode ) : TTopicElement;
 
 Var
   I : Integer;
@@ -713,6 +723,55 @@ begin
   DescrEndURL;
 end;
 
+procedure TFPDocWriter.AddElementsFromList ( L: TStrings; List: TFPList;
+  UsePathName: Boolean ) ;
+Var
+  I : Integer;
+  El : TPasElement;
+  N : TDocNode;
+
+begin
+  For I:=0 to List.Count-1 do
+    begin
+    El:=TPasElement(List[I]);
+    N:=Engine.FindDocNode(El);
+    if (N=Nil) or (not N.IsSkipped) then
+      begin
+      if UsePathName then
+        L.AddObject(El.PathName,El)
+      else
+        L.AddObject(El.Name,El);
+      If el is TPasEnumType then
+        AddElementsFromList(L,TPasEnumType(el).Values);
+      end;
+    end;
+end;
+
+procedure TFPDocWriter.CreateClassTree;
+var
+   L: TStringList;
+   M: TPasModule;
+   I:Integer;
+begin
+  L:=TStringList.Create;
+  try
+    For I:=0 to Package.Modules.Count-1 do
+      begin
+      M:=TPasModule(Package.Modules[i]);
+      if Not (M is TPasExternalModule) and assigned(M.InterfaceSection) then
+        Self.AddElementsFromList(L,M.InterfaceSection.Classes,True)
+      end;
+      TreeClass.BuildTree(L);
+      TreeInterface.BuildTree(L);
+      {$IFDEF TREE_TEST}
+      TreeClass.SaveToXml('TreeClass.xml');
+      TreeInterface.SaveToXml('TreeInterface.xml');
+      {$ENDIF}
+  Finally
+    L.Free;
+  end;
+end;
+
 procedure TFPDocWriter.DoLog(const Msg: String);
 begin
   If Assigned(FEngine.OnLog) then
@@ -1126,7 +1185,7 @@ begin
     Result := False;
 end;
 
-Procedure TFPDocWriter.ConvertImage(El : TDomElement);
+procedure TFPDocWriter.ConvertImage ( El: TDomElement ) ;
 
 Var
   FN,Cap,LinkName : DOMString;
@@ -1169,7 +1228,7 @@ begin
   Inherited;
 end;
 
-Function TFPDocWriter.WriteDescr(Element: TPasElement) : TDocNode;
+function TFPDocWriter.WriteDescr ( Element: TPasElement ) : TDocNode;
 
 begin
   Result:=Engine.FindDocNode(Element);
@@ -1211,7 +1270,8 @@ begin
     Result:=Not ((M.Visibility=visProtected) and Engine.HideProtected)
 end;
 
-Procedure TFPDocWriter.GetMethodList(ClassDecl: TPasClassType; List : TStringList);
+procedure TFPDocWriter.GetMethodList ( ClassDecl: TPasClassType;
+  List: TStringList ) ;
 
 Var
   I : Integer;

utils/fpdoc/fpclasschart.pp

@@ -447,7 +447,7 @@ Constructor TClassTreeEngine.Create(AClassTree : TXMLDocument; AObjectKind : TPa
 
 begin
   FPackage:=TPasPackage.Create('dummy',Nil);
-  FTree:=TClassTreeBuilder.Create(FPackage,AObjectKind);
+  FTree:=TClassTreeBuilder.Create(Self,FPackage,AObjectKind);
   FObjects:=TStringList.Create;
   Inherited Create;
 end;

utils/fpdoc/fpdoc.lpi

@@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="11"/>
+    <Version Value="12"/>
     <General>
       <Flags>
         <SaveClosedFiles Value="False"/>
@@ -10,9 +10,9 @@
         <MainUnitHasTitleStatement Value="False"/>
         <SaveJumpHistory Value="False"/>
         <SaveFoldState Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <Title Value="FPDoc Documentation generator"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
@@ -65,7 +65,6 @@
       <Unit3>
         <Filename Value="dw_html.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="dw_HTML"/>
       </Unit3>
       <Unit4>
         <Filename Value="dw_ipflin.pas"/>

utils/fpdoc/fpdoc.pp

@@ -428,6 +428,8 @@ begin
 end;
 
 begin
+  //AssignFile(Output, 'fpdoc.log');
+  //rewrite(Output);
   With TFPDocApplication.Create(Nil) do
     try
       Run;

utils/fpdoc/fpdocclasstree.pp

@@ -5,7 +5,7 @@ unit fpdocclasstree;
 interface
 
 uses
-  Classes, SysUtils, DOM, pastree, contnrs;
+  Classes, SysUtils, dGlobals, pastree, contnrs, DOM ,XMLWrite;
 
 Type
 
@@ -13,16 +13,18 @@ Type
 
   TPasElementNode = Class
   Private
-    FElement : TPasElement;
+    FElement : TPasClassType;
+    FParentNode: TPasElementNode;
     FChildren : TFPObjectList;
     function GetChild(aIndex : Integer): TPasElementNode;
     function GetChildCount: Integer;
   Public
-    Constructor Create (aElement : TPaselement);
+    Constructor Create (aElement : TPasClassType);
     Destructor Destroy; override;
     Procedure AddChild(C : TPasElementNode);
     Procedure SortChildren;
-    Property Element : TPasElement Read FElement;
+    Property Element : TPasClassType Read FElement;
+    Property ParentNode : TPasElementNode read  FParentNode;
     Property Children [aIndex : Integer] : TPasElementNode Read GetChild;
     Property ChildCount : Integer Read GetChildCount;
   end;
@@ -31,20 +33,27 @@ Type
 
   TClassTreeBuilder = Class
   Private
-    // Full name -> TDomElement;
+    FEngine:TFPDocEngine;
     FElementList : TFPObjectHashTable;
     FObjectKind : TPasObjKind;
     FPackage: TPasPackage;
     FParentObject : TPasClassType;
     FRootNode : TPasElementNode;
     FRootObjectName : string;
+    FRootObjectPathName : string;
   Protected
     function AddToList(aElement: TPasClassType): TPasElementNode;
   Public
-    Constructor Create(APackage : TPasPackage; AObjectKind : TPasObjKind = okClass);
+    Constructor Create(AEngine:TFPDocEngine; APackage : TPasPackage;
+                          AObjectKind : TPasObjKind = okClass);
     Destructor Destroy; override;
     Function BuildTree(AObjects : TStringList) : Integer;
+{$IFDEF TREE_TEST}
+    Procedure SaveToXml(AFileName: String);
+{$ENDIF}
     Property RootNode : TPasElementNode Read FRootNode;
+    Property PasElToNodes: TFPObjectHashTable read FElementList;
+    function GetPasElNode (APasEl: TPasElement) : TPasElementNode;
   end;
 
 implementation
@@ -72,7 +81,7 @@ begin
     Result:=0
 end;
 
-constructor TPasElementNode.Create(aElement: TPaselement);
+constructor TPasElementNode.Create(aElement: TPasClassType);
 begin
   FElement:=aElement;
 end;
@@ -96,24 +105,38 @@ begin
     FChildren.Sort(@SortOnElementName);
 end;
 
-constructor TClassTreeBuilder.Create(APackage : TPasPackage;
+constructor TClassTreeBuilder.Create(AEngine:TFPDocEngine; APackage : TPasPackage;
   AObjectKind: TPasObjKind);
 
 begin
-  FPackage:=APAckage;
+  FEngine:= AEngine;
+  FPackage:= APAckage;
   FObjectKind:=AObjectKind;
   Case FObjectkind of
-    okInterface : FRootObjectName:='#rtl.System.IInterface';
-    okObject,
-    okClass    : FRootObjectName:='#rtl.System.TObject';
+    okInterface :
+      begin
+        FRootObjectPathName:='#rtl.System.IInterface';
+        FRootObjectName:= 'IInterface';
+      end;
+    okObject, okClass :
+      begin
+        FRootObjectPathName:='#rtl.System.TObject';
+        FRootObjectName:= 'TObject';
+      end
   else
-    FRootObjectName:='#rtl.System.TObject';
+    begin
+      FRootObjectPathName:='#rtl.System.TObject';
+      FRootObjectName:= 'TObject';
+    end;
   end;
-  FParentObject:=TPasClassType.Create(FRootObjectName,FPackage);
+  FParentObject:=TPasClassType.Create(FRootObjectName,FEngine.FindModule('System'));
+  if not Assigned(FParentObject) then
+    FParentObject:=TPasClassType.Create(FRootObjectName,FPackage);
   FParentObject.ObjKind:=FObjectKind;
   FRootNode:=TPasElementNode.Create(FParentObject);
+  FRootNode.FParentNode := nil;
   FElementList:=TFPObjectHashTable.Create(False);
-  FElementList.Add(FRootObjectName,FRootNode);
+  FElementList.Add(FRootObjectPathName,FRootNode);
 end;
 
 destructor TClassTreeBuilder.Destroy;
@@ -124,34 +147,37 @@ begin
   Inherited;
 end;
 
-Function TClassTreeBuilder.AddToList(aElement : TPasClassType) : TPasElementNode;
+function TClassTreeBuilder.AddToList ( aElement: TPasClassType
+  ) : TPasElementNode;
 
 Var
   aParentNode : TPasElementNode;
   aName : String;
 
 begin
+  Result:= nil;
+  if (aElement.ObjKind <> FObjectKind) then exit;
+  aParentNode:= nil;
   if aElement=Nil then
     aName:=FRootObjectName
   else
-    begin
     aName:=aElement.PathName;
-    end;
   Result:=TPasElementNode(FElementList.Items[aName]);
   if (Result=Nil) then
-    begin
+  begin
     if aElement.AncestorType is TPasClassType then
-      aParentNode:=AddToList(aElement.AncestorType as TPasClassType)
-    else
+      aParentNode:=AddToList(aElement.AncestorType as TPasClassType);
+    if not Assigned(aParentNode) then
       aParentNode:=FRootNode;
     Result:=TPasElementNode.Create(aElement);
     aParentNode.AddChild(Result);
+    Result.FParentNode := aParentNode;
     FElementList.Add(aName,Result);
-    end;
+  end;
 end;
 
 
-Function TClassTreeBuilder.BuildTree(AObjects : TStringList) : Integer;
+function TClassTreeBuilder.BuildTree ( AObjects: TStringList ) : Integer;
 
 (*
 Procedure DumpNode(Prefix : String; N : TPasElementNode);
@@ -182,7 +208,64 @@ begin
       end;
 end;
 
+function TClassTreeBuilder.GetPasElNode ( APasEl: TPasElement
+  ) : TPasElementNode;
+begin
+  Result:= TPasElementNode(FElementList.Items[APasEl.PathName]);
+end;
 
+{$IFDEF TREE_TEST}
+procedure TClassTreeBuilder.SaveToXml ( AFileName: String ) ;
+
+  procedure AddPasElChildsToXml (ParentxmlEl : TDOMElement ; ParentPasEl: TPasElementNode ) ;
+  var
+    CounterVar: Integer;
+    PasElNode: TPasElementNode;
+    AXmlDoc: TDOMDocument;
+    xmlEl: TDOMElement;
+    M: TPasModule;
+  begin
+    if not Assigned(ParentPasEl) or (ParentPasEl.ChildCount = 0) then exit;
+    AXmlDoc:= ParentxmlEl.OwnerDocument;
+    for CounterVar := 0 to ParentPasEl.ChildCount-1 do
+    begin
+      PasElNode:= ParentPasEl.Children[CounterVar];
+      xmlEl:= AXmlDoc.CreateElement(UnicodeString(PasElNode.Element.Name));
+      M:= PasElNode.Element.GetModule;
+      xmlEl['unit'] := UnicodeString(M.Name);
+      xmlEl['package'] := UnicodeString(M.PackageName);
+      ParentxmlEl.AppendChild(xmlEl);
+      AddPasElChildsToXml(xmlEl, PasElNode);
+    end;
+  end;
+
+var
+  XmlDoc: TXMLDocument;
+  XmlRootEl: TDOMElement;
+  M: TPasModule;
+begin
+  XmlDoc:= TXMLDocument.Create;
+  try
+    XmlRootEl:= XmlDoc.CreateElement(UnicodeString(FRootNode.Element.Name));
+    M:= FRootNode.Element.GetModule;
+    if Assigned(M) then
+    begin
+      XmlRootEl['unit'] := UnicodeString(M.Name);
+      XmlRootEl['package'] := UnicodeString(M.PackageName);
+    end
+      else
+    begin
+      XmlRootEl['unit'] := 'system';
+      XmlRootEl['package'] := 'rtl';
+    end;
+    XmlDoc.AppendChild(XmlRootEl);
+    AddPasElChildsToXml(XmlRootEl, FRootNode);
+    WriteXMLFile(XmlDoc, AFileName);
+  finally
+    XmlDoc.Free;
+  end;
+end;
+{$ENDIF}
 
 end.
 

utils/fpdoc/mkfpdoc.pp

@@ -42,6 +42,8 @@ Type
     procedure SetVerbose(AValue: Boolean); virtual;
     Procedure DoLog(Const Msg : String);
     procedure DoLog(Const Fmt : String; Args : Array of Const);
+    Procedure DoLogSender(Sender : TObject; Const Msg : String);
+    // Create documetation by specified Writer class
     procedure CreateOutput(APackage: TFPDocPackage; Engine: TFPDocEngine); virtual;
   Public
     Constructor Create(AOwner : TComponent); override;
@@ -96,6 +98,14 @@ begin
   DoLog(Format(Fmt,Args));
 end;
 
+procedure TFPDocCreator.DoLogSender ( Sender: TObject; const Msg: String ) ;
+begin
+  if Assigned(Sender) then
+    DoLog(Format('%s - Sender: %s', [Msg, Sender.ClassName]))
+  else
+    DoLog(Msg);
+end;
+
 procedure TFPDocCreator.HandleOnParseUnit(Sender: TObject;
   const AUnitName: String; out AInputFile, OSTarget, CPUTarget: String);
 
@@ -208,7 +218,9 @@ Var
   Cmd,Arg : String;
 
 begin
+  // Now is used the specified writer
   WriterClass:=GetWriterClass(Options.Backend);
+  // ALL CONTENT CREATED HERE
   Writer:=WriterClass.Create(Engine.Package,Engine);
   With Writer do
     Try
@@ -225,10 +237,12 @@ begin
           If not InterPretOption(Cmd,Arg) then
             DoLog(SCmdLineInvalidOption,[Cmd+'='+Arg]);
           end;
+      // Output created Documentation
       WriteDoc;
     Finally
       Free;
     end;
+  // Output content files
   Writeln('Content file : ',APackage.ContentFile);
   if Length(APackage.ContentFile) > 0 then
     Engine.WriteContentFile(APackage.ContentFile);
@@ -247,16 +261,21 @@ begin
   Cmd:='';
   FCurPackage:=APackage;
   Engine:=TFPDocEngine.Create;
+  Engine.OnLog:= @DoLogSender;
   try
+    // get documentation Writer html, latex, and other
     WriterClass:=GetWriterClass(Options.Backend);
     For J:=0 to Apackage.Imports.Count-1 do
       begin
       Arg:=Apackage.Imports[j];
+      // conversion import FilePathes
       WriterClass.SplitImport(Arg,Cmd);
+      // create tree of imported objects
       Engine.ReadContentFile(Arg, Cmd);
       end;
     for i := 0 to APackage.Descriptions.Count - 1 do
       Engine.AddDocFile(FixDescrFile(APackage.Descriptions[i]),Options.donttrim);
+    // set engine options
     Engine.SetPackageName(APackage.Name);
     Engine.Output:=APackage.Output;
     Engine.OnLog:=Self.OnLog;
@@ -268,13 +287,18 @@ begin
     Engine.WarnNoNode:=Options.WarnNoNode;
     if Length(Options.Language) > 0 then
       TranslateDocStrings(Options.Language);
+    // scan the input source files
     for i := 0 to APackage.Inputs.Count - 1 do
       try
+        // get options from input packages
         SplitInputFileOption(APackage.Inputs[i],Cmd,Arg);
+        // make absolute filepath
         Cmd:=FixInputFile(Cmd);
         if FProcessedUnits.IndexOf(Cmd)=-1 then
           begin
           FProcessedUnits.Add(Cmd);
+          // Parce sources for OS Target
+          //WriteLn(Format('Parcing unit: %s', [ExtractFilenameOnly(Cmd)]));
           ParseSource(Engine,Cmd+' '+Arg, Options.OSTarget, Options.CPUTarget,[poUseStreams]);
           end;
       except
@@ -290,6 +314,7 @@ begin
     if Not ParseOnly then
       begin
       Engine.StartDocumenting;
+      // Create documentation
       CreateOutput(APackage,Engine);
       end;
   finally