* Patch from Graeme geldenhuys to introduce class hierarchy in IPF

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@23172 3ad0048d-3df7-0310-abae-a5850022a9f2

3 files changed, 132 insertions, 7 deletions

diff --git a/utils/fpdoc/dglobals.pp b/utils/fpdoc/dglobals.pp
index 9855fec520..6bcadf8128 100644
--- a/utils/fpdoc/dglobals.pp
+++ b/utils/fpdoc/dglobals.pp
@@ -35,6 +35,7 @@ resourcestring
   SDocPrograms               = 'Programs';
   SDocUnits                  = 'Units';
   SDocUnitTitle              = 'Reference for unit ''%s''';
+  SDocInheritanceHierarchy   = 'Inheritance Hierarchy';
   SDocInterfaceSection       = 'Interface section';
   SDocImplementationSection  = 'Implementation section';
   SDocUsedUnits              = 'Used units';
@@ -462,7 +463,6 @@ begin
     end;
     { No child found, let's create one if we are at the end of the path }
     if DotPos > 0 then
-      // !!!: better throw an exception
       Raise Exception.CreateFmt('Link path does not exist: %s',[APathName]);
     Result := TLinkNode.Create(ChildName, ALinkTo);
     if Assigned(LastChild) then
diff --git a/utils/fpdoc/dw_ipflin.pas b/utils/fpdoc/dw_ipflin.pas
index f29a3e2d05..27ae54f637 100644
--- a/utils/fpdoc/dw_ipflin.pas
+++ b/utils/fpdoc/dw_ipflin.pas
@@ -141,6 +141,7 @@ type
   public
     constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
     class function FileNameExtension: string; override;
+    procedure WriteClassInheritanceOverview(ClassDecl: TPasClassType); override;
   end;
 
 
@@ -148,7 +149,7 @@ type
 implementation
 
 uses
-  SysUtils, dwriter;
+  SysUtils, dwriter, dbugintf;
 
 
 { TFPDocWriter overrides }
@@ -500,6 +501,119 @@ begin
   InTypesDeclaration := False;
 end;
 
+procedure TIPFNewWriter.WriteClassInheritanceOverview(ClassDecl: TPasClassType);
+var
+  DocNode: TDocNode;
+  ancestor: TPasClassType;
+  ancestor2: TPasType;
+  List: TStringList;
+  i: integer;
+  indent: integer;
+
+  procedure WriteDescription(const Idx: integer);
+  var
+    s: string;
+    o: TPasClassType;
+    t: string;
+  begin
+    if List.Objects[i] <> nil then
+    begin
+      o := List.Objects[i] as TPasClassType;
+      DocNode := Engine.FindDocNode(o);
+      if Assigned(DocNode) then
+      begin
+        s := ExtractFileName(o.SourceFilename);
+        t := ExtractFileExt(s);
+        s := StringReplace(s, t, '', []);
+        s := s + '.' + o.Name;
+        DescrBeginLink(s);
+        Write(o.Name);
+        DescrEndLink;
+        writeln('');
+      end
+      else
+      begin
+        writeln(List[i]);
+      end;
+    end
+    else
+    begin
+      { we only have text for it. }
+      Writeln(List[i]);
+    end;
+  end;
+
+begin
+  List := TStringList.Create;
+  List.Sorted := False;
+  { add the initial class }
+  List.AddObject(ClassDecl.Name, ClassDecl);
+
+  ancestor := nil;
+
+  if Assigned(ClassDecl.AncestorType) and ClassDecl.AncestorType.InheritsFrom(TPasClassType) then
+    { all is well, we have our first ancestor to get us started with the hierarchy traversal }
+    ancestor := TPasClassType(ClassDecl.AncestorType)
+  else
+  begin
+    { here we only have one history item to output - and not part of fpdoc hierarchy data }
+    if Assigned(ClassDecl.AncestorType) then
+    begin
+      ancestor2 := ClassDecl.AncestorType;
+      if Assigned(ancestor2) then
+      begin
+        List.AddObject(ancestor2.Name, nil);
+        ancestor2 := nil; { prevent any further attempts at traversal }
+      end;
+    end;
+  end;
+
+  while Assigned(ancestor) do
+  begin
+    List.AddObject(ancestor.Name, ancestor);
+    if Assigned(ancestor.AncestorType) and ancestor.AncestorType.InheritsFrom(TPasClassType) then
+      ancestor := TPasClassType(ancestor.AncestorType)
+    else
+    begin
+      { we hit the end of the road }
+      ancestor2 := ancestor.AncestorType;
+      if Assigned(ancestor2) then
+        List.AddObject(ancestor2.Name, nil);
+      ancestor := nil;  { prevent any further attempts at traversal }
+    end;
+  end;
+
+  if List.Count > 1 then
+  begin
+    { output a title }
+    Writeln(':p.');
+    writeln(':lm margin=1.');
+    DescrBeginBold;
+    WriteLn(SDocInheritanceHierarchy);
+    DescrEndBold;
+    { now output the hierarchy }
+    indent := 3;
+    { we go from least significant to most, hence the reversed loop }
+    for i := List.Count-1 downto 0 do
+    begin
+      Write(Format(':lm margin=%d.', [indent]));
+      { each level is indented 2 character positions more than the previous one }
+      if (indent > 3) then
+      begin
+        writeln('|');
+        write('+--');
+      end
+      else
+        write(':xmp.');
+      WriteDescription(i);
+      inc(indent, 2);
+    end;
+    WriteLn(':lm margin=1.:exmp.');
+  end;
+
+  List.Free;
+end;
+
 { TLinearWriter overrides}
 
 class function TIPFNewWriter.FileNameExtension: String;
@@ -611,7 +725,7 @@ begin
   fColCount := 0;
   Writeln(':userdoc.');
   WriteComment('This file has been created automatically by FPDoc');
-  WriteComment('IPF output (c) 2010 by Graeme Geldenhuys (graemeg@gmail.com)');
+  WriteComment('IPF output (c) 2010-2012 by Graeme Geldenhuys (graemeg@gmail.com)');
   writeln('');
   Writeln(':docprof toc=12345.');
   WriteLn(':title.' + PackageName);
@@ -735,9 +849,9 @@ begin
     DescrEndBold;
 //    writeln(':lm margin=3.');
     writeln('.br');
-  end;
+  end
 
-  if InPackageOverview then
+  else if InPackageOverview then
   begin
     FInHeadingText := ':h2%s. ' + SectionName;
 //    Writeln(':h2.' + SectionName);
diff --git a/utils/fpdoc/dwlinear.pp b/utils/fpdoc/dwlinear.pp
index 0a5d831656..470a2f6d24 100644
--- a/utils/fpdoc/dwlinear.pp
+++ b/utils/fpdoc/dwlinear.pp
@@ -107,7 +107,8 @@ Type
     procedure WriteClassDecl(ClassDecl: TPasClassType);
     procedure WriteClassMethodOverview(ClassDecl: TPasClassType);
     procedure WriteClassPropertyOverview(ClassDecl: TPasClassType);
-    procedure WriteClassInterfacesOverView(ClassDecl: TPasClassType);
+    procedure WriteClassInterfacesOverview(ClassDecl: TPasClassType);
+    procedure WriteClassInheritanceOverview(ClassDecl: TPasClassType); virtual;
     procedure WriteProperty(PropDecl: TPasProperty);
     procedure WriteExample(ADocNode: TDocNode);
     procedure WriteSeeAlso(ADocNode: TDocNode);
@@ -415,6 +416,10 @@ begin
     ConvertNotes(ClassDecl,DocNode.Notes);
   end;
 
+  // graemeg: this must move above SeeAlso, Version and Notes written above.
+  // Write Class Hierarchy (Inheritance) Overview;
+  WriteClassInheritanceOverView(ClassDecl);
+
   // Write Interfaces Overview;
   WriteClassInterfacesOverView(ClassDecl);
   // Write method overview
@@ -517,7 +522,7 @@ begin
 end;
 
 
-procedure TLinearWriter.WriteClassInterfacesOverView(ClassDecl: TPasClassType);
+procedure TLinearWriter.WriteClassInterfacesOverview(ClassDecl: TPasClassType);
 var
   lInterface: TPasElement;
   i: Integer;
@@ -571,6 +576,12 @@ begin
   end;
 end;
 
+procedure TLinearWriter.WriteClassInheritanceOverview(ClassDecl: TPasClassType);
+begin
+  { Do nothing by default. This will be implemented by descendant writers. See
+    the IPF Writer for an example. }
+end;
+
 
 function TLinearWriter.ConstValue(ConstDecl: TPasConst): String;
 begin