From e3481eecfb13248e34790c9b7de4214b0f0b1475 Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 23 Jan 2021 14:29:56 +0000 Subject: [PATCH] * Patch from Andrey Sobol to improve display of specialized types git-svn-id: trunk@48349 - --- utils/fpdoc/dw_basehtml.pp | 9 +++++-- utils/fpdoc/dw_html.pp | 45 +++++++++++++++++++++++++---------- utils/fpdoc/dw_markdown.pp | 10 ++++---- utils/fpdoc/fpdocclasstree.pp | 34 +++++++++++++++++--------- 4 files changed, 67 insertions(+), 31 deletions(-) diff --git a/utils/fpdoc/dw_basehtml.pp b/utils/fpdoc/dw_basehtml.pp index 8f7c8f2eb9..6dc246a4e9 100644 --- a/utils/fpdoc/dw_basehtml.pp +++ b/utils/fpdoc/dw_basehtml.pp @@ -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; diff --git a/utils/fpdoc/dw_html.pp b/utils/fpdoc/dw_html.pp index b32ed81e92..b8afe2be7d 100644 --- a/utils/fpdoc/dw_html.pp +++ b/utils/fpdoc/dw_html.pp @@ -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 diff --git a/utils/fpdoc/dw_markdown.pp b/utils/fpdoc/dw_markdown.pp index 6c75e5c566..00dce4a9fa 100644 --- a/utils/fpdoc/dw_markdown.pp +++ b/utils/fpdoc/dw_markdown.pp @@ -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); diff --git a/utils/fpdoc/fpdocclasstree.pp b/utils/fpdoc/fpdocclasstree.pp index fdb2618996..2dc99839ba 100644 --- a/utils/fpdoc/fpdocclasstree.pp +++ b/utils/fpdoc/fpdocclasstree.pp @@ -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);