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

* Refactoring for better readability

Browse Source 
git-svn-id: trunk@23476 -
This commit is contained in:
michael 2013-01-21 12:07:52 +00:00
parent a472de7805
commit a7a6301672
1 changed files with 51 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

112
utils/fpdoc/dglobals.pp
View File

@ -301,6 +301,8 @@ type
private private
FDocLogLevels: TFPDocLogLevels; FDocLogLevels: TFPDocLogLevels;
FOnParseUnit: TOnParseUnitEvent; FOnParseUnit: TOnParseUnitEvent;
function ResolveLinkInPackages(AModule: TPasModule; const ALinkDest: String; Strict: Boolean=False): String;
function ResolveLinkInUsedUnits(AModule: TPasModule; const ALinkDest: String; Strict: Boolean=False): String;
protected protected
DescrDocs: TObjectList; // List of XML documents DescrDocs: TObjectList; // List of XML documents
DescrDocNames: TStringList; // Names of the XML documents DescrDocNames: TStringList; // Names of the XML documents
@ -1251,89 +1253,77 @@ begin
SetLength(Result, 0); SetLength(Result, 0);
end; end;
function TFPDocEngine.ResolveLinkInPackages(AModule: TPasModule; const ALinkDest: String; Strict : Boolean = False): String;
Var
ThisPackage: TLinkNode;
begin
{ Try all packages }
Result:='';
ThisPackage:=RootLinkNode.FirstChild;
while Assigned(ThisPackage) and (Result='') do
begin
Result:=ResolveLink(AModule, ThisPackage.Name + '.' + ALinkDest, Strict);
ThisPackage := ThisPackage.NextSibling;
end;
end;
function TFPDocEngine.ResolveLinkInUsedUnits(AModule: TPasModule; const ALinkDest: String; Strict : Boolean = False): String;
var
i: Integer;
UL: TFPList;
begin
Result:='';
UL:=AModule.InterfaceSection.UsesList;
I:=UL.Count-1;
While (Result='') and (I>=0) do
begin
Result:=ResolveLinkInPackages(AModule,TPasType(UL[i]).Name+'.'+ALinkDest, strict);
Dec(I);
end;
end;
function TFPDocEngine.ResolveLink(AModule: TPasModule; const ALinkDest: String; Strict : Boolean = False): String; function TFPDocEngine.ResolveLink(AModule: TPasModule; const ALinkDest: String; Strict : Boolean = False): String;
var var
i: Integer; i: Integer;
ThisPackage: TLinkNode;
UnitList: TFPList;
function CanWeExit(AResult: string): boolean;
var
s: string;
begin
s := StringReplace(Lowercase(ALinkDest), '.', '_', [rfReplaceAll]);
Result := pos(s, AResult) > 0;
end;
begin begin
{ if Assigned(AModule) then {
system.WriteLn('ResolveLink(', AModule.Name, ' - ', ALinkDest, ')... ') if Assigned(AModule) then
else system.WriteLn('ResolveLink(', AModule.Name, ' - ', ALinkDest, ')... ')
system.WriteLn('ResolveLink(Nil - ', ALinkDest, ')... '); else
} if Length(ALinkDest) = 0 then system.WriteLn('ResolveLink(Nil - ', ALinkDest, ')... ');
begin }
SetLength(Result, 0); if (ALinkDest='') then
exit; Exit('');
end;
if (ALinkDest[1] = '#') then if (ALinkDest[1] = '#') then
Result := FindAbsoluteLink(ALinkDest) Result := FindAbsoluteLink(ALinkDest)
else if (AModule=Nil) then else if (AModule=Nil) then
Result:= FindAbsoluteLink(RootLinkNode.FirstChild.Name+'.'+ALinkDest) Result:= FindAbsoluteLink(RootLinkNode.FirstChild.Name+'.'+ALinkDest)
else else
begin
if Pos(AModule.Name, ALinkDest) = 1 then
begin begin
Result := ResolveLink(AModule, amodule.packagename + '.' + ALinkDest, Strict); if Pos(AModule.Name,ALinkDest) = 1 then
if CanWeExit(Result) then Result := ResolveLink(AModule, AModule.packagename + '.' + ALinkDest, Strict)
Exit;
end
else else
begin
Result := ResolveLink(AModule, AModule.PathName + '.' + ALinkDest, Strict); Result := ResolveLink(AModule, AModule.PathName + '.' + ALinkDest, Strict);
if CanWeExit(Result) then if (Result='') then
Exit;
end;
{ Try all packages }
SetLength(Result, 0);
ThisPackage := RootLinkNode.FirstChild;
while Assigned(ThisPackage) do
begin
Result := ResolveLink(AModule, ThisPackage.Name + '.' + ALinkDest, Strict);
if CanWeExit(Result) then
Exit;
ThisPackage := ThisPackage.NextSibling;
end;
if not CanWeExit(Result) then
begin
{ Okay, then we have to try all imported units of the current module }
UnitList := AModule.InterfaceSection.UsesList;
for i := UnitList.Count - 1 downto 0 do
begin begin
{ Try all packages } Result:=ResolveLinkInPackages(AModule,ALinkDest,Strict);
ThisPackage := RootLinkNode.FirstChild; if (Result='') then
while Assigned(ThisPackage) do Result:=ResolveLinkInUsedUnits(Amodule,AlinkDest,Strict);
begin
Result := ResolveLink(AModule, ThisPackage.Name + '.' +
TPasType(UnitList[i]).Name + '.' + ALinkDest, strict);
if CanWeExit(Result) then
Exit;
ThisPackage := ThisPackage.NextSibling;
end;
end; end;
end; end;
end;
// Match on parent : class/enumerated/record/module // Match on parent : class/enumerated/record/module
if (Length(Result) = 0) and not strict then if (Result='') and not strict then
for i := Length(ALinkDest) downto 1 do for i := Length(ALinkDest) downto 1 do
if ALinkDest[i] = '.' then if ALinkDest[i] = '.' then
begin begin
Result := ResolveLink(AModule, Copy(ALinkDest, 1, i - 1), Strict); Result := ResolveLink(AModule, Copy(ALinkDest, 1, i - 1), Strict);
exit; exit;
end; end;
end; end;
procedure ReadXMLFileALT(OUT ADoc:TXMLDocument;const AFileName:ansistring); procedure ReadXMLFileALT(OUT ADoc:TXMLDocument;const AFileName:ansistring);