paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-30 17:01:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Andrey Sobol to improve display of specialized types

Browse Source 
git-svn-id: trunk@48349 -
(cherry picked from commit e3481eecfb)
This commit is contained in:
michael 2021-01-23 14:29:56 +00:00 committed by Florian Klämpfl
parent bc345bb66f
commit b224889758
4 changed files with 67 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
utils/fpdoc/dw_basehtml.pp
View File

@ -1012,7 +1012,7 @@ begin
break; break;
ThisPackage := ThisPackage.NextSibling; ThisPackage := ThisPackage.NextSibling;
end; end;
if Length(s) = 0 then if (Length(s) = 0) and Assigned(Module) then
begin begin
{ Okay, then we have to try all imported units of the current module } { Okay, then we have to try all imported units of the current module }
UnitList := Module.InterfaceSection.UsesList; UnitList := Module.InterfaceSection.UsesList;
@ -1038,6 +1038,8 @@ begin
end end
else if Element is TPasEnumValue then else if Element is TPasEnumValue then
s := ResolveLinkID(Element.Parent.PathName) s := ResolveLinkID(Element.Parent.PathName)
else if Element is TPasAliasType then
s := ResolveLinkID(TPasAliasType(Element).DestType.PathName)
else else
s := ResolveLinkID(Element.PathName); s := ResolveLinkID(Element.PathName);
@ -1049,6 +1051,9 @@ begin
else else
begin begin
Result := nil; Result := nil;
if Element is TPasAliasType then
AppendText(Parent, TPasAliasType(Element).DestType.Name)
else
AppendText(Parent, Element.Name); // unresolved items AppendText(Parent, Element.Name); // unresolved items
end; end;
end; end;

39
utils/fpdoc/dw_html.pp
View File

@ -1744,7 +1744,6 @@ end;
procedure THTMLWriter.CreateClassMainPage(aClass : TPasClassType); procedure THTMLWriter.CreateClassMainPage(aClass : TPasClassType);
procedure AppendGenericTypes(CodeEl : TDomElement; AList : TFPList; isSpecialize : Boolean); procedure AppendGenericTypes(CodeEl : TDomElement; AList : TFPList; isSpecialize : Boolean);
Var Var
I : integer; I : integer;
begin begin
@ -1759,6 +1758,16 @@ procedure THTMLWriter.CreateClassMainPage(aClass : TPasClassType);
AppendSym(CodeEl, '>'); AppendSym(CodeEl, '>');
end; end;
procedure AppendGeneric(ACodeEl : TDomElement ; AGenericObject: TPasClassType);
begin
if AGenericObject.GenericTemplateTypes.Count>0 then
begin
AppendKw(ACodeEl, ' generic ');
AppendText(ACodeEl, ' ' + UTF8Decode(AGenericObject.Name) + ' ');
AppendGenericTypes(ACodeEl,AGenericObject.GenericTemplateTypes,false);
end;
end;
procedure AppendInterfaceInfo(ACodeEl : TDomElement ; AThisClass: TPasClassType); procedure AppendInterfaceInfo(ACodeEl : TDomElement ; AThisClass: TPasClassType);
var var
i:Integer; i:Integer;
@ -1777,7 +1786,7 @@ procedure THTMLWriter.CreateClassMainPage(aClass : TPasClassType);
var var
ParaEl,TableEl, TREl, TDEl, CodeEl: TDOMElement; ParaEl,TableEl, TREl, TDEl, CodeEl: TDOMElement;
ThisClass, PrevClass: TPasClassType; ThisClass, PrevClass: TPasType;
ThisTreeNode: TPasElementNode; ThisTreeNode: TPasElementNode;
begin begin
//WriteLn('@ClassPageBody.CreateMainPage Class=', AClass.Name); //WriteLn('@ClassPageBody.CreateMainPage Class=', AClass.Name);
@ -1799,11 +1808,14 @@ begin
TDEl := CreateTD(TREl); TDEl := CreateTD(TREl);
CodeEl := CreateCode(CreatePara(TDEl)); CodeEl := CreateCode(CreatePara(TDEl));
AppendKw(CodeEl, 'type'); AppendKw(CodeEl, 'type');
if not Assigned(AClass.GenericTemplateTypes) then
Dolog('ERROR generic init: %s', [AClass.name]);
if AClass.GenericTemplateTypes.Count>0 then if AClass.GenericTemplateTypes.Count>0 then
AppendKw(CodeEl, ' generic '); AppendGeneric(CodeEl, AClass)
else
AppendText(CodeEl, ' ' + UTF8Decode(AClass.Name) + ' '); AppendText(CodeEl, ' ' + UTF8Decode(AClass.Name) + ' ');
if AClass.GenericTemplateTypes.Count>0 then
AppendGenericTypes(CodeEl,AClass.GenericTemplateTypes,false);
AppendSym(CodeEl, '='); AppendSym(CodeEl, '=');
AppendText(CodeEl, ' '); AppendText(CodeEl, ' ');
AppendKw(CodeEl, UTF8Decode(ObjKindNames[AClass.ObjKind])); AppendKw(CodeEl, UTF8Decode(ObjKindNames[AClass.ObjKind]));
@ -1816,16 +1828,23 @@ begin
else else
ThisTreeNode := TreeClass.GetPasElNode(AClass); ThisTreeNode := TreeClass.GetPasElNode(AClass);
if not Assigned(ThisTreeNode) Then if not Assigned(ThisTreeNode) Then
DoLog('EROOR Tree Class information: '+ThisClass.PathName); DoLog('ERROR Tree Class information: '+ThisClass.PathName);
if Assigned(AClass.AncestorType) then if Assigned(AClass.AncestorType) then
begin begin
AppendSym(CodeEl, '('); AppendSym(CodeEl, '(');
// Show parent class information // Show parent class information
//TODO: Specialized generic classes is not processed now. if (AClass.AncestorType is TPasSpecializeType) then
// TLazFixedRoundBufferListMemBase as example begin
AppendText(CodeEl, 'specialize ');
AppendHyperlink(CodeEl, TPasSpecializeType(AClass.AncestorType).DestType);
AppendText(CodeEl, '<,>');
end
else
begin
AppendHyperlink(CodeEl, AClass.AncestorType); AppendHyperlink(CodeEl, AClass.AncestorType);
AppendInterfaceInfo(CodeEl, AClass); AppendInterfaceInfo(CodeEl, AClass);
end;
AppendSym(CodeEl, ')'); AppendSym(CodeEl, ')');
end; end;
// Class members // Class members
@ -1847,8 +1866,8 @@ begin
// Show class item // Show class item
AppendHyperlink(CodeEl, ThisClass); AppendHyperlink(CodeEl, ThisClass);
if Assigned(PrevClass) then // Interfaces from prevClass if Assigned(PrevClass) and (PrevClass Is TPasClassType) then // Interfaces from prevClass
AppendInterfaceInfo(CodeEl, PrevClass); AppendInterfaceInfo(CodeEl, TPasClassType(PrevClass));
AppendShortDescrCell(TREl, ThisClass); AppendShortDescrCell(TREl, ThisClass);
if Assigned(ThisTreeNode) then if Assigned(ThisTreeNode) then

10
utils/fpdoc/dw_markdown.pp
View File

@ -421,7 +421,7 @@ begin
break; break;
ThisPackage := ThisPackage.NextSibling; ThisPackage := ThisPackage.NextSibling;
end; end;
if Length(s) = 0 then if (Length(s) = 0) and Assigned(Module) then
begin begin
{ Okay, then we have to try all imported units of the current module } { Okay, then we have to try all imported units of the current module }
UnitList := Module.InterfaceSection.UsesList; UnitList := Module.InterfaceSection.UsesList;
@ -1577,7 +1577,7 @@ procedure TMarkdownWriter.CreateClassMainPage(aClass : TPasClassType);
var var
i: Integer; i: Integer;
ThisInterface, ThisInterface,
ThisClass: TPasClassType; ThisClass: TPasType;
ThisTreeNode: TPasElementNode; ThisTreeNode: TPasElementNode;
DocNode: TDocNode; DocNode: TDocNode;
@ -1627,12 +1627,12 @@ begin
// Show class item // Show class item
if Assigned(ThisClass) Then if Assigned(ThisClass) Then
AppendHyperlink(ThisClass); AppendHyperlink(ThisClass);
if Assigned(ThisClass) and (ThisClass.Interfaces.count>0) then if Assigned(ThisClass) and (AClass.Interfaces.count>0) then
begin begin
AppendText('('); AppendText('(');
for i:=0 to ThisClass.interfaces.count-1 do for i:=0 to AClass.interfaces.count-1 do
begin begin
ThisInterface:=TPasClassType(ThisClass.Interfaces[i]); ThisInterface:= TPasType(AClass.Interfaces[i]);
if I>0 then if I>0 then
AppendText(', '); AppendText(', ');
AppendHyperlink( ThisInterface); AppendHyperlink( ThisInterface);

32
utils/fpdoc/fpdocclasstree.pp
View File

@ -16,17 +16,17 @@ Type
TPasElementNode = Class TPasElementNode = Class
Private Private
FElement : TPasClassType; FElement : TPasType;
FParentNode: TPasElementNode; FParentNode: TPasElementNode;
FChildren : TFPObjectList; FChildren : TFPObjectList;
function GetChild(aIndex : Integer): TPasElementNode; function GetChild(aIndex : Integer): TPasElementNode;
function GetChildCount: Integer; function GetChildCount: Integer;
Public Public
Constructor Create (aElement : TPasClassType); Constructor Create (aElement : TPasType);
Destructor Destroy; override; Destructor Destroy; override;
Procedure AddChild(C : TPasElementNode); Procedure AddChild(C : TPasElementNode);
Procedure SortChildren; Procedure SortChildren;
Property Element : TPasClassType Read FElement; Property Element : TPasType Read FElement;
Property ParentNode : TPasElementNode read FParentNode; Property ParentNode : TPasElementNode read FParentNode;
Property Children [aIndex : Integer] : TPasElementNode Read GetChild; Property Children [aIndex : Integer] : TPasElementNode Read GetChild;
Property ChildCount : Integer Read GetChildCount; Property ChildCount : Integer Read GetChildCount;
@ -45,7 +45,7 @@ Type
FRootObjectName : string; FRootObjectName : string;
FRootObjectPathName : string; FRootObjectPathName : string;
Protected Protected
function AddToList(aElement: TPasClassType): TPasElementNode; function AddToList(aElement: TPasType): TPasElementNode;
Public Public
Constructor Create(AEngine:TFPDocEngine; APackage : TPasPackage; Constructor Create(AEngine:TFPDocEngine; APackage : TPasPackage;
AObjectKind : TPasObjKindSet = okWithFields); AObjectKind : TPasObjKindSet = okWithFields);
@ -85,7 +85,7 @@ begin
Result:=0 Result:=0
end; end;
constructor TPasElementNode.Create(aElement: TPasClassType); constructor TPasElementNode.Create(aElement: TPasType);
begin begin
FElement:=aElement; FElement:=aElement;
end; end;
@ -154,29 +154,41 @@ begin
Inherited; Inherited;
end; end;
function TClassTreeBuilder.AddToList ( aElement: TPasClassType function TClassTreeBuilder.AddToList ( aElement: TPasType
) : TPasElementNode; ) : TPasElementNode;
Var Var
aParentNode : TPasElementNode; aParentNode : TPasElementNode;
aName : String; aName : String;
aElementClass: TPasClassType;
begin begin
Result:= nil; Result:= nil; aElementClass:=nil;
if not (aElement.ObjKind in FObjectKind) then exit; if (aElement is TPasClassType) then
aElementClass:= TPasClassType(aElement);
if Assigned(aElementClass) and not (aElementClass.ObjKind in FObjectKind) then exit;
if not Assigned(aElementClass) and not (aElement is TPasAliasType) then exit;
aParentNode:= nil; aParentNode:= nil;
if aElement=Nil then if aElement=Nil then
aName:=FRootObjectName aName:=FRootObjectName
else if (aElement is TPasAliasType) then
aName:=TPasAliasType(aElement).DestType.FullName
else else
aName:=aElement.PathName; aName:=aElement.PathName;
Result:=TPasElementNode(FElementList.Items[aName]); Result:=TPasElementNode(FElementList.Items[aName]);
if (Result=Nil) then if (Result=Nil) then
begin begin
if aElement.AncestorType is TPasClassType then if Assigned(aElementClass) and (
aParentNode:=AddToList(aElement.AncestorType as TPasClassType); (aElementClass.AncestorType is TPasClassType) or
(aElementClass.AncestorType is TPasAliasType)
) then
aParentNode:=AddToList(aElementClass.AncestorType);
if not Assigned(aParentNode) then if not Assigned(aParentNode) then
aParentNode:=FRootNode; aParentNode:=FRootNode;
if (aElement is TPasAliasType) then
Result:=TPasElementNode.Create(TPasAliasType(TPasType(aElement)).DestType)
else
Result:=TPasElementNode.Create(aElement); Result:=TPasElementNode.Create(aElement);
aParentNode.AddChild(Result); aParentNode.AddChild(Result);
Result.FParentNode := aParentNode; Result.FParentNode := aParentNode;