paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 20:36:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: codehlp: implemented finding references in fpdoc files

Browse Source 
git-svn-id: trunk@15987 -
This commit is contained in:
mattias 2008-08-07 18:13:17 +00:00
parent 9a68acdbec
commit 372a7016a7
6 changed files with 199 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

103
ide/codehelp.pas
View File

@ -93,7 +93,10 @@ type
ChangeStep: integer;// the CodeBuffer.ChangeStep value, when Doc was built
CodeBuffer: TCodeBuffer;
destructor Destroy; override;
function GetModuleNode: TDOMNode;
function GetPackageNode: TDOMNode; // the lazarus project or package
function GetPackageName: string;
function GetModuleNode: TDOMNode; // the unit
function GetModuleName: string;
function GetFirstElement: TDOMNode;
function GetElementWithName(const ElementName: string;
CreateIfNotExists: boolean = false): TDOMNode;
@ -106,6 +109,15 @@ type
procedure BeginUpdate;
procedure EndUpdate;
end;
{ TLazFPDocNode }
TLazFPDocNode = class
public
DocFile: TLazFPDocFile;
Node: TDomNode;
constructor Create(AFile: TLazFPDocFile; ANode: TDOMNode);
end;
{ TCHSourceToFPDocFile - cache item for source to FPDoc file mapping }
@ -125,7 +137,7 @@ type
public
CodeContext: TFindContext;
CodeXYPos: TCodeXYPosition;
ElementModuleName: string;
ElementOwnerName: string;// the 'fpdoc package' = the name of the lazarus package or project
ElementUnitName: string;
ElementUnitFileName: string;
ElementName: string;
@ -201,7 +213,7 @@ type
function LoadFPDocFile(const Filename: string;
UpdateFromDisk, Revert: Boolean;
out ADocFile: TLazFPDocFile;
out CacheWasUsed: boolean): Boolean;
out CacheWasUsed: boolean): TCodeHelpParseResult;
function SaveFPDocFile(ADocFile: TLazFPDocFile): TModalResult;
function GetFPDocFilenameForHelpContext(
Context: TPascalHelpContextList;
@ -216,9 +228,9 @@ type
var FPDocFilenames: TStringToStringTree // Names=Filename, Values=ModuleName
);
function FindModuleOwner(const Modulename: string): TObject;
function GetOwnerModuleName(TheOwner: TObject): string;
function GetModuleOwnerName(TheOwner: TObject): string;
function ExpandFPDocLinkID(const LinkID, DefaultUnitName,
DefaultModule: string): string;
DefaultOwnerName: string): string;
function ExpandFPDocLinkID(const LinkID, DefaultUnitName: string;
TheOwner: TObject): string;
function CodeNodeToElementName(Tool: TFindDeclarationTool;
@ -373,7 +385,7 @@ begin
inherited Destroy;
end;
function TLazFPDocFile.GetModuleNode: TDOMNode;
function TLazFPDocFile.GetPackageNode: TDOMNode;
begin
Result:=nil;
if Doc=nil then exit;
@ -381,12 +393,28 @@ begin
// get first node
Result := Doc.FindNode('fpdoc-descriptions');
if Result=nil then begin
//DebugLn(['TLazFPDocFile.GetModuleNode fpdoc-descriptions not found']);
//DebugLn(['TLazFPDocFile.GetPackageNode fpdoc-descriptions not found']);
exit;
end;
// proceed to package
Result := Result.FindNode('package');
end;
function TLazFPDocFile.GetPackageName: string;
var
Node: TDOMNode;
begin
Node:=GetPackageNode;
if Node is TDOMElement then
Result:=TDomElement(Node).GetAttribute('name')
else
Result:='';
end;
function TLazFPDocFile.GetModuleNode: TDOMNode;
begin
Result:=GetPackageNode;
if Result=nil then begin
//DebugLn(['TLazFPDocFile.GetModuleNode fpdoc-descriptions has no package']);
exit;
@ -396,6 +424,17 @@ begin
Result := Result.FindNode('module');
end;
function TLazFPDocFile.GetModuleName: string;
var
Node: TDOMNode;
begin
Node:=GetModuleNode;
if Node is TDOMElement then
Result:=TDomElement(Node).GetAttribute('name')
else
Result:='';
end;
function TLazFPDocFile.GetFirstElement: TDOMNode;
begin
//get first module node
@ -858,14 +897,14 @@ begin
if AProject.LazDocPaths='' then
AProject.LazDocPaths:=SelectNewLazDocPaths(AProject.ShortDescription,BaseDir);
LazDocPaths:=AProject.LazDocPaths;
LazDocPackageName:=GetOwnerModuleName(AProject);
LazDocPackageName:=GetModuleOwnerName(AProject);
end else if NewOwner is TLazPackage then begin
APackage:=TLazPackage(NewOwner);
BaseDir:=APackage.Directory;
if APackage.LazDocPaths='' then
APackage.LazDocPaths:=SelectNewLazDocPaths(APackage.Name,BaseDir);
LazDocPaths:=APackage.LazDocPaths;
LazDocPackageName:=GetOwnerModuleName(APackage);
LazDocPackageName:=GetModuleOwnerName(APackage);
end else begin
DebugLn(['TCodeHelpManager.DoCreateFPDocFileForSource unknown owner type ',dbgsName(NewOwner)]);
NewOwner:=nil;
@ -995,14 +1034,16 @@ begin
end;
function TCodeHelpManager.LoadFPDocFile(const Filename: string; UpdateFromDisk,
Revert: Boolean; out ADocFile: TLazFPDocFile; out CacheWasUsed: boolean): Boolean;
Revert: Boolean; out ADocFile: TLazFPDocFile; out CacheWasUsed: boolean
): TCodeHelpParseResult;
var
MemStream: TMemoryStream;
begin
Result:=false;
Result:=chprFailed;
CacheWasUsed:=true;
ADocFile:=FindFPDocFile(Filename);
if ADocFile=nil then begin
CacheWasUsed:=false;
ADocFile:=TLazFPDocFile.Create;
ADocFile.Filename:=Filename;
FDocs.Add(ADocFile);
@ -1020,7 +1061,7 @@ begin
// revert the modifications => rebuild the Doc from the CodeBuffer
end else begin
// no update needed
exit(true);
exit(chprSuccess);
end;
end;
end;
@ -1040,11 +1081,11 @@ begin
try
ADocFile.CodeBuffer.SaveToStream(MemStream);
MemStream.Position:=0;
Result:=false;
Result:=chprFailed;
ReadXMLFile(ADocFile.Doc, MemStream);
Result:=true;
Result:=chprSuccess;
finally
if not Result then
if Result<>chprSuccess then
FreeAndNil(ADocFile.Doc);
MemStream.Free;
CallDocChangeEvents(chmhDocChanging,ADocFile);
@ -1321,7 +1362,7 @@ begin
if FPDocFilename<>'' then begin
if FPDocFilenames=nil then
FPDocFilenames:=CreateFilenameToStringTree;
FPDocFilenames[FPDocFilename]:=GetOwnerModuleName(AnOwner);
FPDocFilenames[FPDocFilename]:=GetModuleOwnerName(AnOwner);
end;
Node:=SrcFilenames.Tree.FindSuccessor(Node);
end;
@ -1335,7 +1376,7 @@ begin
if Result<>nil then exit;
AProject:=LazarusIDE.ActiveProject;
if (AProject<>nil)
and (SysUtils.CompareText(GetOwnerModuleName(AProject),Modulename)=0)
and (SysUtils.CompareText(GetModuleOwnerName(AProject),Modulename)=0)
then begin
Result:=AProject;
exit;
@ -1343,7 +1384,7 @@ begin
Result:=nil;
end;
function TCodeHelpManager.GetOwnerModuleName(TheOwner: TObject): string;
function TCodeHelpManager.GetModuleOwnerName(TheOwner: TObject): string;
begin
if TheOwner is TLazPackage then
Result:=TLazPackage(TheOwner).Name
@ -1354,11 +1395,12 @@ begin
end;
function TCodeHelpManager.ExpandFPDocLinkID(const LinkID, DefaultUnitName,
DefaultModule: string): string;
DefaultOwnerName: string): string;
begin
Result:=LinkID;
if (LinkID='') or (LinkID[1]='#') then exit;
Result:=ExpandFPDocLinkID(LinkId,DefaultUnitName,FindModuleOwner(DefaultModule));
Result:=ExpandFPDocLinkID(LinkId,DefaultUnitName,
FindModuleOwner(DefaultOwnerName));
end;
function TCodeHelpManager.ExpandFPDocLinkID(const LinkID,
@ -1422,7 +1464,7 @@ begin
if AddUnit then
Result:=DefaultUnitName+'.'+Result;
end;
Result:='#'+GetOwnerModuleName(TheOwner)+'.'+Result;
Result:='#'+GetModuleOwnerName(TheOwner)+'.'+Result;
end;
function TCodeHelpManager.CodeNodeToElementName(Tool: TFindDeclarationTool;
@ -1470,8 +1512,8 @@ begin
if (not CacheWasUsed) and (not Complete) then exit(chprParsing);
// load FPDoc file
if not LoadFPDocFile(FPDocFilename,true,false,FPDocFile,CacheWasUsed) then
exit(chprFailed);
Result:=LoadFPDocFile(FPDocFilename,true,false,FPDocFile,CacheWasUsed);
if Result<>chprSuccess then exit;
if (not CacheWasUsed) and (not Complete) then exit(chprParsing);
// find FPDoc node
@ -1610,7 +1652,7 @@ begin
AnOwner:=Self;
FPDocFilename:=GetFPDocFilenameForSource(CHElement.ElementUnitFileName,
false,CacheWasUsed,AnOwner);
CHElement.ElementModuleName:=GetOwnerModuleName(AnOwner);
CHElement.ElementOwnerName:=GetModuleOwnerName(AnOwner);
//DebugLn(['TCodeHelpManager.GetElementChain FPDocFilename=',FPDocFilename]);
if (not CacheWasUsed) and (not Complete) then exit(chprParsing);
@ -1805,6 +1847,7 @@ var
CacheWasUsed: boolean;
FPDocFilename: String;
AnOwner: TObject;
CHResult: TCodeHelpParseResult;
begin
Result:=false;
Element:=nil;
@ -1842,8 +1885,8 @@ begin
DebugLn(['TCodeHelpManager.CreateElement FPDocFilename=',FPDocFilename]);
// parse fpdoc file
if not LoadFPDocFile(FPDocFilename,true,false,Element.FPDocFile,CacheWasUsed)
then begin
CHResult:=LoadFPDocFile(FPDocFilename,true,false,Element.FPDocFile,CacheWasUsed);
if CHResult<>chprSuccess then begin
DebugLn(['TCodeHelpManager.CreateElement unable to load fpdoc file ',FPDocFilename]);
exit;
end;
@ -1973,5 +2016,13 @@ begin
Result:=Items[0].FPDocFile;
end;
{ TLazFPDocNode }
constructor TLazFPDocNode.Create(AFile: TLazFPDocFile; ANode: TDOMNode);
begin
Node:=ANode;
DocFile:=AFile;
end;
end.

131
ide/findrenameidentifier.pas
View File

@ -33,7 +33,7 @@ uses
Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, ExtCtrls, AvgLvlTree,
// codetools
AVL_Tree, CodeAtom, CodeCache, CodeToolManager,
Laz_Dom, AVL_Tree, CodeAtom, CodeCache, CodeToolManager,
// IDE
LazarusIDEStrConsts, IDEProcs, IDEWindowIntf, MiscOptions, DialogProcs,
InputHistory, SearchResultView, CodeHelp;
@ -78,7 +78,9 @@ type
procedure CleanUpFileList(Files: TStringList);
function ShowFindRenameIdentifierDialog(const Filename: string;
const Position: TPoint; AllowRename, SetRenameActive: boolean;
const Position: TPoint;
AllowRename: boolean; // allow user to disable/enable rename
SetRenameActive: boolean; // enable rename
Options: TFindRenameIdentifierOptions): TModalResult;
function GatherIdentifierReferences(Files: TStringList;
DeclarationCode: TCodeBuffer; const DeclarationCaretXY: TPoint;
@ -91,12 +93,13 @@ procedure AddReferencesToResultView(DeclarationCode: TCodeBuffer;
const DeclarationCaretXY: TPoint; TargetCode: TCodeBuffer;
TreeOfPCodeXYPosition: TAVLTree; ClearItems: boolean; SearchPageIndex: integer);
function GatherFPDocReferences(PascalFiles: TStringList;
function GatherFPDocReferencesForPascalFiles(PascalFiles: TStringList;
DeclarationCode: TCodeBuffer; const DeclarationCaretXY: TPoint;
var TreeOfPCodeXYPosition: TAVLTree): TModalResult;
function GatherFPDocReferences(const ElementModuleName, ElementName,
FileModuleName, FPDocFilename: string;
var TreeOfPCodeXYPosition: TAVLTree): TModalResult;
var ListOfLazFPDocNode: TFPList): TModalResult;
function GatherReferencesInFPDocFile(
const OldPackageName, OldModuleName, OldElementName: string;
const FPDocFilename: string;
var ListOfLazFPDocNode: TFPList): TModalResult;
implementation
@ -119,7 +122,7 @@ begin
end;
function ShowFindRenameIdentifierDialog(const Filename: string;
const Position: TPoint; AllowRename, SetRenameActive: boolean;
const Position: TPoint; AllowRename: boolean; SetRenameActive: boolean;
Options: TFindRenameIdentifierOptions): TModalResult;
var
FindRenameIdentifierDialog: TFindRenameIdentifierDialog;
@ -129,8 +132,7 @@ begin
FindRenameIdentifierDialog.LoadFromConfig;
FindRenameIdentifierDialog.SetIdentifier(Filename,Position);
FindRenameIdentifierDialog.AllowRename:=AllowRename;
if SetRenameActive and AllowRename then
FindRenameIdentifierDialog.RenameCheckBox.Checked:=true;
FindRenameIdentifierDialog.RenameCheckBox.Checked:=SetRenameActive and AllowRename;
Result:=FindRenameIdentifierDialog.ShowModal;
if Result=mrOk then
if Options<>nil then
@ -271,9 +273,9 @@ begin
SearchResultsView.EndUpdate(SearchPageIndex);
end;
function GatherFPDocReferences(PascalFiles: TStringList;
function GatherFPDocReferencesForPascalFiles(PascalFiles: TStringList;
DeclarationCode: TCodeBuffer; const DeclarationCaretXY: TPoint;
var TreeOfPCodeXYPosition: TAVLTree): TModalResult;
var ListOfLazFPDocNode: TFPList): TModalResult;
var
PascalFilenames, FPDocFilenames: TStringToStringTree;
CacheWasUsed: boolean;
@ -283,7 +285,6 @@ var
AVLNode: TAvgLvlTreeNode;
Item: PStringToStringItem;
FPDocFilename: String;
ModuleName: String;
begin
Result:=mrCancel;
PascalFilenames:=nil;
@ -308,16 +309,17 @@ begin
exit;
end;
CHElement:=Chain[0];
DebugLn(['GatherFPDocReferences ModuleName=',CHElement.ElementModuleName,' Name=',CHElement.ElementName]);
DebugLn(['GatherFPDocReferences OwnerName=',CHElement.ElementOwnerName,' Name=',CHElement.ElementName]);
// search FPDoc files
AVLNode:=FPDocFilenames.Tree.FindLowest;
while AVLNode<>nil do begin
Item:=PStringToStringItem(AVLNode.Data);
FPDocFilename:=Item^.Name;
ModuleName:=Item^.Value;
Result:=GatherFPDocReferences(CHElement.ElementModuleName,CHElement.ElementName,
ModuleName,FPDocFilename,TreeOfPCodeXYPosition);
Result:=GatherReferencesInFPDocFile(
CHElement.ElementOwnerName,CHElement.ElementUnitName,
CHElement.ElementName,
FPDocFilename,ListOfLazFPDocNode);
if Result<>mrOk then exit;
AVLNode:=FPDocFilenames.Tree.FindSuccessor(AVLNode);
end;
@ -326,19 +328,100 @@ begin
finally
PascalFilenames.Free;
FPDocFilenames.Free;
if Result<>mrOk then
CodeToolBoss.FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition);
if Result<>mrOk then begin
FreeListObjects(ListOfLazFPDocNode,true);
ListOfLazFPDocNode:=nil;
end;
end;
end;
function GatherFPDocReferences(const ElementModuleName, ElementName,
FileModuleName, FPDocFilename: string; var TreeOfPCodeXYPosition: TAVLTree
function GatherReferencesInFPDocFile(
const OldPackageName, OldModuleName, OldElementName: string;
const FPDocFilename: string;
var ListOfLazFPDocNode: TFPList
): TModalResult;
var
DocFile: TLazFPDocFile;
IsSamePackage: Boolean;
IsSameModule: Boolean;// = same unit
procedure CheckLink(Node: TDOMNode; Link: string);
var
p: LongInt;
PackageName: String;
begin
if Link='' then exit;
if Link[1]='#' then begin
p:=System.Pos('.',Link);
if p<1 then exit;
PackageName:=copy(Link,2,p-2);
if SysUtils.CompareText(PackageName,OldPackageName)<>0 then exit;
Link:=copy(Link,p+1,length(Link));
end;
if (SysUtils.CompareText(Link,OldElementName)=0)
or (SysUtils.CompareText(Link,OldModuleName+'.'+OldElementName)=0) then
begin
DebugLn(['CheckLink Found: ',Link]);
if ListOfLazFPDocNode=nil then
ListOfLazFPDocNode:=TFPList.Create;
ListOfLazFPDocNode.Add(TLazFPDocNode.Create(DocFile,Node));
end;
end;
procedure SearchLinksInChildNodes(Node: TDomNode);
// search recursively for links
begin
Node:=Node.FirstChild;
while Node<>nil do begin
if (Node.NodeName='link')
and (Node is TDomElement) then begin
CheckLink(Node,TDomElement(Node).GetAttribute('id'));
end;
SearchLinksInChildNodes(Node);
Node:=Node.NextSibling;
end;
end;
var
CHResult: TCodeHelpParseResult;
CacheWasUsed: boolean;
Node: TDOMNode;
begin
Result:=mrCancel;
DebugLn(['GatherFPDocReferences ElementModuleName=',ElementModuleName,
' ElementName=',ElementName,' FPDocFilename=',FPDocFilename,
' FileModuleName=',FileModuleName]);
DebugLn(['GatherFPDocReferences ',
' OldPackageName=',OldPackageName,
' OldModuleName=',OldModuleName,' OldElementName=',OldElementName,
' FPDocFilename=',FPDocFilename]);
CHResult:=CodeHelpBoss.LoadFPDocFile(FPDocFilename,true,false,DocFile,
CacheWasUsed);
if CHResult<>chprSuccess then begin
DebugLn(['GatherReferencesInFPDocFile CodeHelpBoss.LoadFPDocFile failed File=',FPDocFilename]);
exit(mrCancel);
end;
// search in Doc nodes
IsSamePackage:=SysUtils.CompareText(DocFile.GetPackageName,OldPackageName)=0;
IsSameModule:=SysUtils.CompareText(DocFile.GetModuleName,OldModuleName)=0;
DebugLn(['GatherReferencesInFPDocFile ',DocFile.GetPackageName,'=',OldPackageName,' ',DocFile.GetModuleName,'=',OldModuleName]);
Node:=DocFile.GetFirstElement;
while Node<>nil do begin
if Node is TDomElement then begin
if (SysUtils.CompareText(TDomElement(Node).GetAttribute('name'),OldElementName)=0)
and IsSamePackage and IsSameModule
then begin
// this is the element itself
DebugLn(['GatherReferencesInFPDocFile Element itself found: ',Node.NodeName,' ',Node.NodeValue]);
if ListOfLazFPDocNode=nil then
ListOfLazFPDocNode:=TFPList.Create;
ListOfLazFPDocNode.Add(TLazFPDocNode.Create(DocFile,Node));
end;
CheckLink(Node,TDomElement(Node).GetAttribute('link'));
SearchLinksInChildNodes(Node);
end;
Node:=Node.NextSibling;
end;
Result:=mrOk;
end;

10
ide/fpdoceditwindow.pas
View File

@ -784,10 +784,10 @@ begin
Element:=fChain[0];
if (ExpandedLink='') then begin
ExpandedLink:=CodeHelpBoss.ExpandFPDocLinkID(Link,
Element.ElementUnitName,Element.ElementModuleName);
Element.ElementUnitName,Element.ElementOwnerName);
end;
ExpandedID:=CodeHelpBoss.ExpandFPDocLinkID(ID,
Element.ElementUnitName,Element.ElementModuleName);
Element.ElementUnitName,Element.ElementOwnerName);
if SysUtils.CompareText(ExpandedID,ExpandedLink)=0 then
exit;
end;
@ -883,7 +883,7 @@ end;
function TFPDocEditor.GetCurrentModuleName: string;
begin
if (fChain<>nil) and (fChain.Count>0) then
Result:=fChain[0].ElementModuleName
Result:=fChain[0].ElementOwnerName
else
Result:='';
end;
@ -1140,8 +1140,8 @@ begin
Link:=Element.ElementName;
if Element.ElementUnitName<>'' then begin
Link:=Element.ElementUnitName+'.'+Link;
if Element.ElementModuleName<>'' then
Link:='#'+Element.ElementModuleName+'.'+Link;
if Element.ElementOwnerName<>'' then
Link:='#'+Element.ElementOwnerName+'.'+Link;
end;
if Link<>LinkEdit.Text then begin
LinkEdit.Text:=Link;

1
ide/ideprocs.pp
View File

@ -1258,6 +1258,7 @@ procedure FreeListObjects(List: TFPList; FreeList: boolean);
var
i: Integer;
begin
if List=nil then exit;
for i:=0 to List.Count-1 do
TObject(List[i]).Free;
List.Clear;

13
ide/main.pp
View File

@ -12288,7 +12288,8 @@ var
ExtraFiles: TStrings;
Files: TStringList;
Identifier: string;
PascalReferences, FPDocReferences: TAVLTree;
PascalReferences: TAVLTree;
ListOfLazFPDocNode: TFPList;
begin
Result:=mrCancel;
if not BeginCodeTool(TargetSrcEdit,TargetUnitInfo,[]) then exit;
@ -12312,7 +12313,7 @@ begin
// let user choose the search scope
Result:=ShowFindRenameIdentifierDialog(DeclarationUnitInfo.Source.Filename,
DeclarationCaretXY,Rename,Rename,nil);
DeclarationCaretXY,true,Rename,nil);
if Result<>mrOk then begin
debugln('TMainIDE.DoFindRenameIdentifier failed: let user choose the search scope');
exit;
@ -12321,7 +12322,7 @@ begin
Files:=nil;
OwnerList:=nil;
PascalReferences:=nil;
FPDocReferences:=nil;
ListOfLazFPDocNode:=nil;
try
// create the file list
Files:=TStringList.Create;
@ -12380,8 +12381,8 @@ begin
{$IFDEF EnableFPDocRename}
// ToDo: search fpdoc references
Result:=GatherFPDocReferences(Files,DeclarationUnitInfo.Source,
DeclarationCaretXY,FPDocReferences);
Result:=GatherFPDocReferencesForPascalFiles(Files,DeclarationUnitInfo.Source,
DeclarationCaretXY,ListOfLazFPDocNode);
if Result<>mrOk then begin
debugln('TMainIDE.DoFindRenameIdentifier GatherFPDocReferences failed');
exit;
@ -12415,8 +12416,8 @@ begin
finally
Files.Free;
OwnerList.Free;
CodeToolBoss.FreeTreeOfPCodeXYPosition(FPDocReferences);
CodeToolBoss.FreeTreeOfPCodeXYPosition(PascalReferences);
FreeListObjects(ListOfLazFPDocNode,true);
end;
end;

4
lcl/maskedit.pp
View File

@ -634,7 +634,7 @@ begin
FMask := FMask + S[I];
Special := False;
end
else
else
begin
Inc(FMaxChars);
@ -730,7 +730,7 @@ begin
end;
end;
// Trasform a position from Text in a real position
// Transform a position from Text in a real position
procedure TCustomMaskEdit.SetCharToPos;
Var
SelectionStart, SelectionStop : Integer;