paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 22:47:59 +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 -
This commit is contained in:
michael 2021-01-23 14:29:56 +00:00
parent b51fd7079a
commit e3481eecfb
4 changed files with 67 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
utils/fpdoc/dw_basehtml.pp
View File

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

45
utils/fpdoc/dw_html.pp
View File

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

10
utils/fpdoc/dw_markdown.pp
View File

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

34
utils/fpdoc/fpdocclasstree.pp
View File

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