mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2026-01-06 21:40:46 +01:00
codetools: implemented searching abstract methods, added example
git-svn-id: trunk@13188 -
This commit is contained in:
mattias
parent
f26448f1f7
commit
363234509c
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -86,6 +86,8 @@ components/codetools/examples/addmethod.lpi svneol=native#text/plain
|
||||
components/codetools/examples/addmethod.lpr svneol=native#text/plain
|
||||
components/codetools/examples/codecompletion.lpi svneol=native#text/plain
|
||||
components/codetools/examples/codecompletion.lpr svneol=native#text/plain
|
||||
components/codetools/examples/completeabstractmethods.lpi svneol=native#text/plain
|
||||
components/codetools/examples/completeabstractmethods.lpr svneol=native#text/plain
|
||||
components/codetools/examples/finddeclaration.lpi svneol=native#text/plain
|
||||
components/codetools/examples/finddeclaration.lpr svneol=native#text/plain
|
||||
components/codetools/examples/fixdefinitionorder.lpi svneol=native#text/plain
|
||||
@ -107,6 +109,7 @@ components/codetools/examples/reduceifdefs.lpr svneol=native#text/plain
|
||||
components/codetools/examples/replaceresourcedirectives.lpi svneol=native#text/plain
|
||||
components/codetools/examples/replaceresourcedirectives.lpr svneol=native#text/plain
|
||||
components/codetools/examples/scanexamples/BigLettersUnit.pas svneol=native#text/plain
|
||||
components/codetools/examples/scanexamples/abstractclass1.pas svneol=native#text/plain
|
||||
components/codetools/examples/scanexamples/addeventexample.pas svneol=native#text/plain
|
||||
components/codetools/examples/scanexamples/brokenfilenames.pas svneol=native#text/plain
|
||||
components/codetools/examples/scanexamples/brokenincfiles.inc svneol=native#text/plain
|
||||
|
||||
@ -273,8 +273,15 @@ function RemoveFormComponentFromSource(Source:TSourceLog;
|
||||
ComponentName, ComponentClassName: string): boolean;
|
||||
function FindClassAncestorName(const Source, FormClassName: string): string;
|
||||
|
||||
// procedure specifiers
|
||||
function SearchProcSpecifier(const ProcText, Specifier: string;
|
||||
out SpecifierEndPosition: integer;
|
||||
NestedComments: boolean = false;
|
||||
WithSpaceBehindSemicolon: boolean = true;
|
||||
CaseSensitive: boolean = false): integer;
|
||||
|
||||
// code search
|
||||
function SearchCodeInSource(const Source, Find: string; StartPos:integer;
|
||||
function SearchCodeInSource(const Source, Find: string; StartPos: integer;
|
||||
out EndFoundPosition: integer; CaseSensitive: boolean;
|
||||
NestedComments: boolean = false): integer;
|
||||
function ReadNextPascalAtom(const Source: string;
|
||||
@ -987,6 +994,7 @@ function SearchCodeInSource(const Source, Find: string; StartPos: integer;
|
||||
NestedComments: boolean):integer;
|
||||
// search pascal atoms of Find in Source
|
||||
// returns the start pos
|
||||
// -1 on failure
|
||||
var
|
||||
FindLen: Integer;
|
||||
SrcLen: Integer;
|
||||
@ -1459,6 +1467,37 @@ begin
|
||||
while (IsIdentChar[Identifier[Result]]) do inc(Result);
|
||||
end;
|
||||
|
||||
function SearchProcSpecifier(const ProcText, Specifier: string;
|
||||
out SpecifierEndPosition: integer; NestedComments: boolean;
|
||||
WithSpaceBehindSemicolon: boolean; CaseSensitive: boolean): integer;
|
||||
// Result = -1 on failure
|
||||
// Result = start of Specifier on success
|
||||
// SpecifierEndPosition on semicolon or >length(ProcText)
|
||||
// if WithSpaceBehindSemicolon then SpecifierEndPosition is start of next specifier
|
||||
var
|
||||
AtomStart: integer;
|
||||
begin
|
||||
Result:=SearchCodeInSource(ProcText, Specifier, 1, SpecifierEndPosition,
|
||||
CaseSensitive, NestedComments);
|
||||
if Result<1 then exit;
|
||||
while (SpecifierEndPosition<=length(ProcText))
|
||||
and (ProcText[SpecifierEndPosition]<>';') do begin
|
||||
ReadRawNextPascalAtom(ProcText,SpecifierEndPosition,AtomStart,NestedComments);
|
||||
if AtomStart>length(ProcText) then exit;
|
||||
if ProcText[AtomStart] in ['[','('] then begin
|
||||
if not ReadTilPascalBracketClose(ProcText,AtomStart,NestedComments)
|
||||
then
|
||||
exit(-1);
|
||||
SpecifierEndPosition:=AtomStart;
|
||||
end;
|
||||
end;
|
||||
if WithSpaceBehindSemicolon and (SpecifierEndPosition<=length(ProcText)) then
|
||||
begin
|
||||
SpecifierEndPosition:=FindLineEndOrCodeAfterPosition(ProcText,
|
||||
SpecifierEndPosition+1,0,NestedComments);
|
||||
end;
|
||||
end;
|
||||
|
||||
function ReadNextPascalAtom(const Source:string;
|
||||
var Position, AtomStart: integer; NestedComments: boolean):string;
|
||||
var DirectiveName:string;
|
||||
|
||||
@ -186,6 +186,10 @@ type
|
||||
function CompleteCode(CursorPos: TCodeXYPosition; OldTopLine: integer;
|
||||
out NewPos: TCodeXYPosition; out NewTopLine: integer;
|
||||
SourceChangeCache: TSourceChangeCache): boolean;
|
||||
function AddMethods(CursorPos: TCodeXYPosition;// position in class declaration
|
||||
ListOfPCodeXYPosition: TFPList;
|
||||
const VirtualToOverride: boolean;
|
||||
SourceChangeCache: TSourceChangeCache): boolean;
|
||||
function AddPublishedVariable(const UpperClassName,VarName, VarType: string;
|
||||
SourceChangeCache: TSourceChangeCache): boolean; override;
|
||||
function GetRedefinitionNodeText(Node: TCodeTreeNode): string;
|
||||
@ -5624,6 +5628,148 @@ begin
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TCodeCompletionCodeTool.AddMethods(CursorPos: TCodeXYPosition;
|
||||
ListOfPCodeXYPosition: TFPList;
|
||||
const VirtualToOverride: boolean;
|
||||
SourceChangeCache: TSourceChangeCache): boolean;
|
||||
var
|
||||
CleanCursorPos: integer;
|
||||
CursorNode: TCodeTreeNode;
|
||||
i: Integer;
|
||||
CodeXYPos: TCodeXYPosition;
|
||||
ProcNode: TCodeTreeNode;
|
||||
NewMethods: TAVLTree;// Tree of TCodeTreeNodeExtension
|
||||
NewCodeTool: TFindDeclarationTool;
|
||||
CleanProcCode: String;
|
||||
FullProcCode: String;
|
||||
VirtualStartPos: LongInt;
|
||||
VirtualEndPos: integer;
|
||||
AbstractStartPos: LongInt;
|
||||
AbstractEndPos: integer;
|
||||
VisibilityDesc: TCodeTreeNodeDesc;
|
||||
NodeExt: TCodeTreeNodeExtension;
|
||||
AVLNode: TAVLTreeNode;
|
||||
ProcName: String;
|
||||
NewClassPart: TNewClassPart;
|
||||
begin
|
||||
Result:=false;
|
||||
if (ListOfPCodeXYPosition=nil) or (ListOfPCodeXYPosition.Count=0) then
|
||||
exit(true);
|
||||
|
||||
if (SourceChangeCache=nil) then
|
||||
RaiseException('need a SourceChangeCache');
|
||||
|
||||
NewMethods:=TAVLTree.Create(@CompareCodeTreeNodeExt);
|
||||
try
|
||||
|
||||
// collect all methods
|
||||
for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
|
||||
//get next code position
|
||||
CodeXYPos:=PCodeXYPosition(ListOfPCodeXYPosition[i])^;
|
||||
// get codetool for this position
|
||||
NewCodeTool:=OnGetCodeToolForBuffer(Self,CodeXYPos.Code,true);
|
||||
if NewCodeTool=nil then begin
|
||||
DebugLn(['TCodeCompletionCodeTool.AddMethods unit not found for source ',CodeXYPos.Code.Filename,'(',CodeXYPos.Y,',',CodeXYPos.X,')']);
|
||||
exit;
|
||||
end;
|
||||
// parse unit
|
||||
NewCodeTool.BuildTreeAndGetCleanPos(trAll,CodeXYPos,CleanCursorPos,[]);
|
||||
// find node at position
|
||||
ProcNode:=FindDeepestExpandedNodeAtPos(CleanCursorPos,true);
|
||||
if (ProcNode.Desc<>ctnProcedure)
|
||||
or (ProcNode.Parent=nil) then begin
|
||||
MoveCursorToNodeStart(ProcNode);
|
||||
RaiseException('TCodeCompletionCodeTool.AddMethods source position not a procedure');
|
||||
end;
|
||||
// find visibility
|
||||
VisibilityDesc:=ctnClassPublic;
|
||||
if ProcNode.Parent.Desc in AllClassBaseSections then
|
||||
VisibilityDesc:=ProcNode.Parent.Desc;
|
||||
// extract proc
|
||||
ProcName:=NewCodeTool.ExtractProcName(ProcNode,[phpWithoutClassName,phpInUpperCase]);
|
||||
CleanProcCode:=NewCodeTool.ExtractProcHead(ProcNode,[phpWithoutClassName]);
|
||||
FullProcCode:=NewCodeTool.ExtractProcHead(ProcNode,
|
||||
[phpWithStart,phpWithoutClassName,phpWithVarModifiers,
|
||||
phpWithParameterNames,phpWithDefaultValues,phpWithResultType,
|
||||
phpWithCallingSpecs,phpWithProcModifiers]);
|
||||
if VirtualToOverride then begin
|
||||
VirtualStartPos:=SearchProcSpecifier(FullProcCode,'virtual',
|
||||
VirtualEndPos,NewCodeTool.Scanner.NestedComments,false);
|
||||
if VirtualStartPos>=1 then begin
|
||||
// replace virtual with override
|
||||
FullProcCode:=copy(FullProcCode,1,VirtualStartPos-1)
|
||||
+'override'
|
||||
+copy(FullProcCode,VirtualEndPos,length(FullProcCode));
|
||||
end;
|
||||
// remove abstract
|
||||
AbstractStartPos:=SearchProcSpecifier(FullProcCode,'abstract',
|
||||
AbstractEndPos,NewCodeTool.Scanner.NestedComments,true);
|
||||
if AbstractStartPos>=1 then begin
|
||||
// replace virtual with override
|
||||
FullProcCode:=copy(FullProcCode,1,AbstractStartPos-1)
|
||||
+copy(FullProcCode,AbstractEndPos,length(FullProcCode));
|
||||
end;
|
||||
end;
|
||||
|
||||
// add method data
|
||||
NodeExt:=NodeExtMemManager.NewNode;
|
||||
NodeExt.Txt:=CleanProcCode;
|
||||
NodeExt.ExtTxt1:=FullProcCode;
|
||||
NodeExt.ExtTxt2:=ProcName;
|
||||
NodeExt.Flags:=VisibilityDesc;
|
||||
NewMethods.Add(NodeExt);
|
||||
DebugLn(['TCodeCompletionCodeTool.AddMethods ',i,' CleanProcTxt=',CleanProcCode,' FullProcTxt=',FullProcCode]);
|
||||
end;
|
||||
|
||||
BuildTreeAndGetCleanPos(trAll,CursorPos, CleanCursorPos,[]);
|
||||
|
||||
// find node at position
|
||||
CursorNode:=FindDeepestExpandedNodeAtPos(CleanCursorPos,true);
|
||||
|
||||
// if cursor is on type node, find class node
|
||||
if CursorNode.Desc=ctnTypeDefinition then
|
||||
CursorNode:=CursorNode.FirstChild
|
||||
else if CursorNode.Desc=ctnGenericType then
|
||||
CursorNode:=CursorNode.LastChild;
|
||||
if (CursorNode=nil) or (CursorNode.Desc<>ctnClass) then begin
|
||||
DebugLn(['TIdentCompletionTool.AddMethods cursor not in a class']);
|
||||
exit;
|
||||
end;
|
||||
|
||||
CodeCompleteSrcChgCache:=SourceChangeCache;
|
||||
CodeCompleteClassNode:=CursorNode;
|
||||
|
||||
// add methods
|
||||
AVLNode:=NewMethods.FindLowest;
|
||||
while AVLNode<>nil do begin
|
||||
NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
|
||||
CleanProcCode:=NodeExt.Txt;
|
||||
FullProcCode:=NodeExt.ExtTxt1;
|
||||
ProcName:=NodeExt.ExtTxt2;
|
||||
VisibilityDesc:=TCodeTreeNodeDesc(NodeExt.Flags);
|
||||
case VisibilityDesc of
|
||||
ctnClassPrivate: NewClassPart:=ncpPrivateProcs;
|
||||
ctnClassProtected: NewClassPart:=ncpProtectedProcs;
|
||||
ctnClassPublic: NewClassPart:=ncpPublicProcs;
|
||||
ctnClassPublished: NewClassPart:=ncpPublishedProcs;
|
||||
else NewClassPart:=ncpPublicProcs;
|
||||
end;
|
||||
AddClassInsertion(CleanProcCode,FullProcCode,ProcName,NewClassPart);
|
||||
|
||||
AVLNode:=NewMethods.FindSuccessor(AVLNode);
|
||||
end;
|
||||
|
||||
// apply changes
|
||||
if not InsertAllNewClassParts then exit;
|
||||
if not SourceChangeCache.Apply then
|
||||
RaiseException(ctsUnableToApplyChanges);
|
||||
|
||||
Result:=true;
|
||||
finally
|
||||
NodeExtMemManager.DisposeAVLTree(NewMethods);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TCodeCompletionCodeTool.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
@ -165,7 +165,8 @@ type
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Init(Config: TCodeToolsOptions);
|
||||
|
||||
procedure SimpleInit(const ConfigFilename: string);
|
||||
|
||||
procedure ActivateWriteLock;
|
||||
procedure DeactivateWriteLock;
|
||||
property ChangeStep: integer read FChangeStep;
|
||||
@ -388,7 +389,9 @@ type
|
||||
function GetIdentifierAt(Code: TCodeBuffer; X,Y: integer;
|
||||
var Identifier: string): boolean;
|
||||
function IdentItemCheckHasChilds(IdentItem: TIdentifierListItem): boolean;
|
||||
|
||||
function FindAbstractMethods(Code: TCodeBuffer; X,Y: integer;
|
||||
out ListOfPCodeXYPosition: TFPList): boolean;
|
||||
|
||||
// rename identifier
|
||||
function FindReferences(IdentifierCode: TCodeBuffer;
|
||||
X, Y: integer; TargetCode: TCodeBuffer; SkipComments: boolean;
|
||||
@ -438,6 +441,9 @@ type
|
||||
function CompleteCode(Code: TCodeBuffer; X,Y,TopLine: integer;
|
||||
out NewCode: TCodeBuffer;
|
||||
out NewX, NewY, NewTopLine: integer): boolean;
|
||||
function AddMethods(Code: TCodeBuffer; X,Y: integer;
|
||||
ListOfPCodeXYPosition: TFPList;
|
||||
const VirtualToOverride: boolean): boolean;
|
||||
function FindRedefinitions(Code: TCodeBuffer;
|
||||
out TreeOfCodeTreeNodeExt: TAVLTree; WithEnums: boolean): boolean;
|
||||
function RemoveRedefinitions(Code: TCodeBuffer;
|
||||
@ -867,6 +873,40 @@ begin
|
||||
'$(#LazarusSrcDir)','$(#LCLWidgetType)','$(#ProjectDir)',nil));
|
||||
end;
|
||||
|
||||
procedure TCodeToolManager.SimpleInit(const ConfigFilename: string);
|
||||
var
|
||||
Options: TCodeToolsOptions;
|
||||
begin
|
||||
// setup the Options
|
||||
Options:=TCodeToolsOptions.Create;
|
||||
try
|
||||
// To not parse the FPC sources every time, the options are saved to a file.
|
||||
if FileExists(ConfigFilename) then
|
||||
Options.LoadFromFile(ConfigFilename);
|
||||
|
||||
// setup your paths
|
||||
DebugLn(['TCodeToolManager.SimpleInit Config=',ConfigFilename]);
|
||||
if FileExists(ConfigFilename) then
|
||||
Options.LoadFromFile(ConfigFilename);
|
||||
Options.InitWithEnvironmentVariables;
|
||||
if Options.FPCSrcDir='' then
|
||||
Options.FPCSrcDir:=ExpandFileName('~/freepascal/fpc');
|
||||
if Options.LazarusSrcDir='' then
|
||||
Options.LazarusSrcDir:=ExpandFileName('~/pascal/lazarus');
|
||||
DebugLn(['TCodeToolManager.SimpleInit PP=',Options.FPCPath,' FPCDIR=',Options.FPCSrcDir,' LAZARUSDIR=',Options.LazarusSrcDir]);
|
||||
|
||||
// init the codetools
|
||||
if not Options.UnitLinkListValid then
|
||||
debugln('Scanning FPC sources may take a while ...');
|
||||
CodeToolBoss.Init(Options);
|
||||
|
||||
// save the options and the FPC unit links results.
|
||||
Options.SaveToFile(ConfigFilename);
|
||||
finally
|
||||
Options.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCodeToolManager.BeginUpdate;
|
||||
begin
|
||||
SourceChangeCache.BeginUpdate;
|
||||
@ -1905,7 +1945,7 @@ begin
|
||||
{$ENDIF}
|
||||
try
|
||||
Result:=FCurCodeTool.GatherIdentifiers(CursorPos,IdentifierList,
|
||||
SourceChangeCache.BeautifyCodeOptions);
|
||||
SourceChangeCache.BeautifyCodeOptions);
|
||||
except
|
||||
on e: Exception do HandleException(e);
|
||||
end;
|
||||
@ -1948,6 +1988,27 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeToolManager.FindAbstractMethods(Code: TCodeBuffer; X, Y: integer;
|
||||
out ListOfPCodeXYPosition: TFPList): boolean;
|
||||
var
|
||||
CursorPos: TCodeXYPosition;
|
||||
begin
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TCodeToolManager.FindRedefinitions A ',Code.Filename);
|
||||
{$ENDIF}
|
||||
Result:=false;
|
||||
ListOfPCodeXYPosition:=nil;
|
||||
if not InitCurCodeTool(Code) then exit;
|
||||
CursorPos.X:=X;
|
||||
CursorPos.Y:=Y;
|
||||
CursorPos.Code:=Code;
|
||||
try
|
||||
Result:=FCurCodeTool.FindAbstractMethods(CursorPos,ListOfPCodeXYPosition);
|
||||
except
|
||||
on e: Exception do Result:=HandleException(e);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeToolManager.FindReferences(IdentifierCode: TCodeBuffer;
|
||||
X, Y: integer; TargetCode: TCodeBuffer; SkipComments: boolean;
|
||||
var ListOfPCodeXYPosition: TFPList): boolean;
|
||||
@ -2939,6 +3000,28 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeToolManager.AddMethods(Code: TCodeBuffer; X, Y: integer;
|
||||
ListOfPCodeXYPosition: TFPList; const VirtualToOverride: boolean
|
||||
): boolean;
|
||||
var
|
||||
CursorPos: TCodeXYPosition;
|
||||
begin
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TCodeToolManager.AddMethods A ',Code.Filename);
|
||||
{$ENDIF}
|
||||
Result:=false;
|
||||
if not InitCurCodeTool(Code) then exit;
|
||||
CursorPos.X:=X;
|
||||
CursorPos.Y:=Y;
|
||||
CursorPos.Code:=Code;
|
||||
try
|
||||
Result:=FCurCodeTool.AddMethods(CursorPos,ListOfPCodeXYPosition,
|
||||
VirtualToOverride,SourceChangeCache);
|
||||
except
|
||||
on e: Exception do Result:=HandleException(e);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeToolManager.FindRedefinitions(Code: TCodeBuffer; out
|
||||
TreeOfCodeTreeNodeExt: TAVLTree; WithEnums: boolean): boolean;
|
||||
begin
|
||||
|
||||
@ -253,9 +253,14 @@ end;
|
||||
|
||||
procedure TCodeToolsOptions.InitWithEnvironmentVariables;
|
||||
begin
|
||||
FPCPath:=FindDefaultCompilerFilename;
|
||||
FPCSrcDir:=GetEnvironmentVariable('FPCDIR');
|
||||
LazarusSrcDir:=GetEnvironmentVariable('LAZARUSDIR');
|
||||
if FPCPath='' then
|
||||
FPCPath:=FindDefaultCompilerFilename;
|
||||
if FPCPath='' then
|
||||
FPCPath:=GetEnvironmentVariable('PP');
|
||||
if FPCSrcDir='' then
|
||||
FPCSrcDir:=GetEnvironmentVariable('FPCDIR');
|
||||
if LazarusSrcDir='' then
|
||||
LazarusSrcDir:=GetEnvironmentVariable('LAZARUSDIR');
|
||||
end;
|
||||
|
||||
function TCodeToolsOptions.FindDefaultCompilerFilename: string;
|
||||
|
||||
@ -201,7 +201,7 @@ type
|
||||
function CleanPosToCodePos(CleanPos: integer;
|
||||
out CodePos:TCodePosition): boolean; // true=ok, false=invalid CleanPos
|
||||
function CleanPosToCaret(CleanPos: integer;
|
||||
var Caret:TCodeXYPosition): boolean; // true=ok, false=invalid CleanPos
|
||||
out Caret:TCodeXYPosition): boolean; // true=ok, false=invalid CleanPos
|
||||
function CleanPosToCaretAndTopLine(CleanPos: integer;
|
||||
var Caret:TCodeXYPosition; var NewTopLine: integer): boolean; // true=ok, false=invalid CleanPos
|
||||
function CleanPosToStr(CleanPos: integer): string;
|
||||
@ -2142,10 +2142,11 @@ begin
|
||||
end;
|
||||
|
||||
function TCustomCodeTool.CleanPosToCaret(CleanPos: integer;
|
||||
var Caret:TCodeXYPosition): boolean; // true=ok, false=invalid CleanPos
|
||||
out Caret:TCodeXYPosition): boolean; // true=ok, false=invalid CleanPos
|
||||
var p: integer;
|
||||
Code: Pointer;
|
||||
begin
|
||||
Caret:=CleanCodeXYPosition;
|
||||
Result:=Scanner.CleanedPosToCursor(CleanPos,p,Code);
|
||||
if Result then begin
|
||||
Caret.Code:=TCodeBuffer(Code);
|
||||
|
||||
53
components/codetools/examples/completeabstractmethods.lpi
Normal file
53
components/codetools/examples/completeabstractmethods.lpi
Normal file
@ -0,0 +1,53 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<PathDelim Value="/"/>
|
||||
<Version Value="6"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<IconPath Value="./"/>
|
||||
<TargetFileExt Value=""/>
|
||||
</General>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="CodeTools"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="completeabstractmethods.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="CompleteAbstractMethods"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="scanexamples/abstractclass1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="AbstractClass1"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="5"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="scanexamples/"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<Generate Value="Faster"/>
|
||||
</CodeGeneration>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</CONFIG>
|
||||
103
components/codetools/examples/completeabstractmethods.lpr
Normal file
103
components/codetools/examples/completeabstractmethods.lpr
Normal file
@ -0,0 +1,103 @@
|
||||
{
|
||||
***************************************************************************
|
||||
* *
|
||||
* This source is free software; you can redistribute it and/or modify *
|
||||
* it under the terms of the GNU General Public License as published by *
|
||||
* the Free Software Foundation; either version 2 of the License, or *
|
||||
* (at your option) any later version. *
|
||||
* *
|
||||
* This code is distributed in the hope that it will be useful, but *
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
||||
* General Public License for more details. *
|
||||
* *
|
||||
* A copy of the GNU General Public License is available on the World *
|
||||
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
||||
* obtain it by writing to the Free Software Foundation, *
|
||||
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
||||
* *
|
||||
***************************************************************************
|
||||
|
||||
Author: Mattias Gaertner
|
||||
|
||||
Abstract:
|
||||
Demonstration, how to setup the codetools, FPC and Lazarus Source
|
||||
directory to find abstract methods not yet implemented in a class.
|
||||
}
|
||||
program CompleteAbstractMethods;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Classes, SysUtils, CodeCache, CodeToolManager, CodeTree, CodeAtom,
|
||||
AbstractClass1;
|
||||
|
||||
const
|
||||
ConfigFilename = 'codetools.config';
|
||||
var
|
||||
Code: TCodeBuffer;
|
||||
X: Integer;
|
||||
Y: Integer;
|
||||
Filename: String;
|
||||
ListOfPCodeXYPosition: TFPList;
|
||||
i: Integer;
|
||||
CodeXYPos: TCodeXYPosition;
|
||||
begin
|
||||
if (ParamCount>=1) and (Paramcount<>3) then begin
|
||||
writeln('Usage:');
|
||||
writeln(' ',ParamStr(0));
|
||||
writeln(' ',ParamStr(0),' <filename> <X> <Y>');
|
||||
end;
|
||||
|
||||
// setup the Options
|
||||
ListOfPCodeXYPosition:=nil;
|
||||
try
|
||||
CodeToolBoss.SimpleInit(ConfigFilename);
|
||||
|
||||
// Example: complete identifier s,
|
||||
// by adding a local variable declaration (var s: string)
|
||||
Filename:=GetCurrentDir+'/scanexamples/abstractclass1.pas';
|
||||
X:=3;
|
||||
Y:=18;
|
||||
|
||||
if (ParamCount>=3) then begin
|
||||
Filename:=ExpandFileName(ParamStr(1));
|
||||
X:=StrToInt(ParamStr(2));
|
||||
Y:=StrToInt(ParamStr(3));
|
||||
end;
|
||||
|
||||
// Step 1: load the file
|
||||
Code:=CodeToolBoss.LoadFile(Filename,false,false);
|
||||
if Code=nil then
|
||||
raise Exception.Create('loading failed '+Filename);
|
||||
|
||||
// find abstract methods
|
||||
if CodeToolBoss.FindAbstractMethods(Code,X,Y,ListOfPCodeXYPosition)
|
||||
then begin
|
||||
writeln('FindAbstractMethods succeeded: ');
|
||||
if ListOfPCodeXYPosition<>nil then begin
|
||||
for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
|
||||
CodeXYPos:=PCodeXYPosition(ListOfPCodeXYPosition[i])^;
|
||||
writeln(i,' ',CodeXYPos.Code.Filename,'(',CodeXYPos.Y,',',CodeXYPos.X,')');
|
||||
end;
|
||||
end;
|
||||
end else begin
|
||||
writeln('FindAbstractMethods failed: ',CodeToolBoss.ErrorMessage);
|
||||
end;
|
||||
|
||||
if CodeToolBoss.AddMethods(Code,X,Y,ListOfPCodeXYPosition,true)
|
||||
then begin
|
||||
writeln('AddMethods succeeded: ');
|
||||
writeln(Code.Source);
|
||||
end else begin
|
||||
writeln('AddMethods failed: ',CodeToolBoss.ErrorMessage);
|
||||
end;
|
||||
|
||||
except
|
||||
on E: Exception do begin
|
||||
writeln(E.Message);
|
||||
end;
|
||||
end;
|
||||
CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
|
||||
end.
|
||||
|
||||
@ -0,0 +1,23 @@
|
||||
unit AbstractClass1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
TAbstractClass = class
|
||||
public
|
||||
procedure Increase; virtual; abstract;
|
||||
procedure Decrease; virtual; abstract;
|
||||
end;
|
||||
|
||||
TMyClass = class(TAbstractClass)
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
|
||||
@ -270,6 +270,7 @@ type
|
||||
ClassAndAncestors: TFPList;// list of PCodeXYPosition
|
||||
FoundPublicProperties: TAVLTree;// tree of PChar (pointing to the
|
||||
// property names in source)
|
||||
FoundMethods: TAVLTree;// tree of TCodeTreeNodeExtension Txt=clean text
|
||||
protected
|
||||
CurrentIdentifierList: TIdentifierList;
|
||||
CurrentContexts: TCodeContextInfo;
|
||||
@ -294,13 +295,19 @@ type
|
||||
function CollectAllContexts(Params: TFindDeclarationParams;
|
||||
const FoundContext: TFindContext): TIdentifierFoundResult;
|
||||
procedure AddCollectionContext(Tool: TFindDeclarationTool;
|
||||
Node: TCodeTreeNode);
|
||||
Node: TCodeTreeNode);
|
||||
procedure InitFoundMethods;
|
||||
procedure ClearFoundMethods;
|
||||
function CollectMethods(Params: TFindDeclarationParams;
|
||||
const FoundContext: TFindContext): TIdentifierFoundResult;
|
||||
public
|
||||
function GatherIdentifiers(const CursorPos: TCodeXYPosition;
|
||||
var IdentifierList: TIdentifierList;
|
||||
BeautifyCodeOptions: TBeautifyCodeOptions): boolean;
|
||||
function FindCodeContext(const CursorPos: TCodeXYPosition;
|
||||
out CodeContexts: TCodeContextInfo): boolean;
|
||||
function FindAbstractMethods(const CursorPos: TCodeXYPosition;
|
||||
out ListOfPCodeXYPosition: TFPList): boolean;
|
||||
end;
|
||||
|
||||
const
|
||||
@ -1297,6 +1304,53 @@ begin
|
||||
//DebugLn('TIdentCompletionTool.AddCollectionContext ',Node.DescAsString,' ',ExtractNode(Node,[]));
|
||||
end;
|
||||
|
||||
procedure TIdentCompletionTool.InitFoundMethods;
|
||||
begin
|
||||
if FoundMethods<>nil then ClearFoundMethods;
|
||||
FoundMethods:=TAVLTree.Create(@CompareCodeTreeNodeExt);
|
||||
end;
|
||||
|
||||
procedure TIdentCompletionTool.ClearFoundMethods;
|
||||
begin
|
||||
if FoundMethods=nil then exit;
|
||||
NodeExtMemManager.DisposeAVLTree(FoundMethods);
|
||||
FoundMethods:=nil;
|
||||
end;
|
||||
|
||||
function TIdentCompletionTool.CollectMethods(
|
||||
Params: TFindDeclarationParams; const FoundContext: TFindContext
|
||||
): TIdentifierFoundResult;
|
||||
var
|
||||
ProcText: String;
|
||||
AVLNode: TAVLTreeNode;
|
||||
NodeExt: TCodeTreeNodeExtension;
|
||||
begin
|
||||
// proceed searching ...
|
||||
Result:=ifrProceedSearch;
|
||||
|
||||
{$IFDEF ShowFoundIdents}
|
||||
//if FoundContext.Tool=Self then
|
||||
DebugLn('::: COLLECT IDENT ',FoundContext.Node.DescAsString,
|
||||
' "',StringToPascalConst(copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50)),'"');
|
||||
{$ENDIF}
|
||||
|
||||
if FoundContext.Node.Desc=ctnProcedure then begin
|
||||
ProcText:=FoundContext.Tool.ExtractProcHead(FoundContext.Node,
|
||||
[phpWithoutClassKeyword]);
|
||||
AVLNode:=FindCodeTreeNodeExtAVLNode(FoundMethods,ProcText);
|
||||
if AVLNode<>nil then begin
|
||||
// method is overriden => ignore
|
||||
end else begin
|
||||
// new method
|
||||
NodeExt:=NodeExtMemManager.NewNode;
|
||||
NodeExt.Node:=FoundContext.Node;
|
||||
NodeExt.Data:=FoundContext.Tool;
|
||||
NodeExt.Txt:=ProcText;
|
||||
FoundMethods.Add(NodeExt);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TIdentCompletionTool.GatherIdentifiers(
|
||||
const CursorPos: TCodeXYPosition; var IdentifierList: TIdentifierList;
|
||||
BeautifyCodeOptions: TBeautifyCodeOptions): boolean;
|
||||
@ -1602,19 +1656,85 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TIdentCompletionTool.FindAbstractMethods(
|
||||
const CursorPos: TCodeXYPosition; out ListOfPCodeXYPosition: TFPList
|
||||
): boolean;
|
||||
var
|
||||
CleanCursorPos: integer;
|
||||
CursorNode: TCodeTreeNode;
|
||||
Params: TFindDeclarationParams;
|
||||
AVLNode: TAVLTreeNode;
|
||||
NodeExt: TCodeTreeNodeExtension;
|
||||
ATool: TFindDeclarationTool;
|
||||
ANode: TCodeTreeNode;
|
||||
ProcXYPos: TCodeXYPosition;
|
||||
begin
|
||||
Result:=false;
|
||||
ListOfPCodeXYPosition:=nil;
|
||||
ActivateGlobalWriteLock;
|
||||
Params:=nil;
|
||||
try
|
||||
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
|
||||
[{$IFNDEF DisableIgnoreErrorAfter}btSetIgnoreErrorPos{$ENDIF}]);
|
||||
|
||||
// find node at position
|
||||
CursorNode:=FindDeepestExpandedNodeAtPos(CleanCursorPos,true);
|
||||
|
||||
// if cursor is on type node, find class node
|
||||
if CursorNode.Desc=ctnTypeDefinition then
|
||||
CursorNode:=CursorNode.FirstChild
|
||||
else if CursorNode.Desc=ctnGenericType then
|
||||
CursorNode:=CursorNode.LastChild;
|
||||
if (CursorNode=nil) or (CursorNode.Desc<>ctnClass)
|
||||
or ((CursorNode.SubDesc and ctnsForwardDeclaration)>0) then begin
|
||||
DebugLn(['TIdentCompletionTool.FindAbstractMethods cursor not in a class']);
|
||||
exit;
|
||||
end;
|
||||
|
||||
Params:=TFindDeclarationParams.Create;
|
||||
// gather all identifiers in context
|
||||
Params.ContextNode:=CursorNode;
|
||||
Params.SetIdentifier(Self,nil,@CollectMethods);
|
||||
Params.Flags:=[fdfSearchInAncestors,fdfCollect,fdfFindVariable];
|
||||
InitFoundMethods;
|
||||
FindIdentifierInContext(Params);
|
||||
|
||||
if FoundMethods<>nil then begin
|
||||
AVLNode:=FoundMethods.FindLowest;
|
||||
while AVLNode<>nil do begin
|
||||
NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
|
||||
ANode:=NodeExt.Node;
|
||||
ATool:=TFindDeclarationTool(NodeExt.Data);
|
||||
//DebugLn(['TIdentCompletionTool.FindAbstractMethods ',NodeExt.Txt,' ',ATool.ProcNodeHasSpecifier(ANode,psABSTRACT)]);
|
||||
if ATool.ProcNodeHasSpecifier(ANode,psABSTRACT) then begin
|
||||
if not ATool.CleanPosToCaret(ANode.StartPos,ProcXYPos) then
|
||||
raise Exception.Create('TIdentCompletionTool.FindAbstractMethods inconsistency');
|
||||
AddCodePosition(ListOfPCodeXYPosition,ProcXYPos);
|
||||
end;
|
||||
AVLNode:=FoundMethods.FindSuccessor(AVLNode);
|
||||
end;
|
||||
end;
|
||||
|
||||
Result:=true;
|
||||
finally
|
||||
Params.Free;
|
||||
ClearFoundMethods;
|
||||
DeactivateGlobalWriteLock;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TIdentifierListItem }
|
||||
|
||||
function TIdentifierListItem.GetParamList: string;
|
||||
var
|
||||
CurNode: TCodeTreeNode;
|
||||
ANode: TCodeTreeNode;
|
||||
begin
|
||||
if not (iliParamListValid in Flags) then begin
|
||||
// Note: if you implement param lists for other than ctnProcedure, check
|
||||
// CompareParamList
|
||||
CurNode:=Node;
|
||||
if (CurNode<>nil) and (CurNode.Desc=ctnProcedure) then begin
|
||||
FParamList:=Tool.ExtractProcHead(CurNode,
|
||||
ANode:=Node;
|
||||
if (ANode<>nil) and (ANode.Desc=ctnProcedure) then begin
|
||||
FParamList:=Tool.ExtractProcHead(ANode,
|
||||
[phpWithoutClassKeyword,phpWithoutClassName,
|
||||
phpWithoutName,phpInUpperCase]);
|
||||
//debugln('TIdentifierListItem.GetParamList A ',GetIdentifier(Identifier),' ',Tool.MainFilename,' ',dbgs(CurNode.StartPos));
|
||||
@ -1664,7 +1784,7 @@ end;
|
||||
|
||||
function TIdentifierListItem.AsString: string;
|
||||
var
|
||||
CurNode: TCodeTreeNode;
|
||||
ANode: TCodeTreeNode;
|
||||
begin
|
||||
Result:=IdentifierCompatibilityNames[Compatibility];
|
||||
if HasChilds then
|
||||
@ -1676,19 +1796,19 @@ begin
|
||||
Result:=Result+' Lvl='+IntToStr(Level);
|
||||
if Tool<>nil then
|
||||
Result:=Result+' File='+Tool.MainFilename;
|
||||
CurNode:=Node;
|
||||
if CurNode<>nil then
|
||||
Result:=Result+' Node='+CurNode.DescAsString
|
||||
+' "'+StringToPascalConst(copy(Tool.Src,CurNode.StartPos,50))+'"';
|
||||
ANode:=Node;
|
||||
if ANode<>nil then
|
||||
Result:=Result+' Node='+ANode.DescAsString
|
||||
+' "'+StringToPascalConst(copy(Tool.Src,ANode.StartPos,50))+'"';
|
||||
end;
|
||||
|
||||
function TIdentifierListItem.GetDesc: TCodeTreeNodeDesc;
|
||||
var
|
||||
CurNode: TCodeTreeNode;
|
||||
ANode: TCodeTreeNode;
|
||||
begin
|
||||
CurNode:=Node;
|
||||
if CurNode<>nil then
|
||||
Result:=CurNode.Desc
|
||||
ANode:=Node;
|
||||
if ANode<>nil then
|
||||
Result:=ANode.Desc
|
||||
else
|
||||
Result:=DefaultDesc;
|
||||
end;
|
||||
@ -1712,32 +1832,32 @@ end;
|
||||
|
||||
function TIdentifierListItem.IsProcNodeWithParams: boolean;
|
||||
var
|
||||
CurNode: TCodeTreeNode;
|
||||
ANode: TCodeTreeNode;
|
||||
begin
|
||||
CurNode:=Node;
|
||||
Result:=(CurNode<>nil) and Tool.ProcNodeHasParamList(CurNode);
|
||||
ANode:=Node;
|
||||
Result:=(ANode<>nil) and Tool.ProcNodeHasParamList(ANode);
|
||||
end;
|
||||
|
||||
function TIdentifierListItem.IsPropertyWithParams: boolean;
|
||||
var
|
||||
CurNode: TCodeTreeNode;
|
||||
ANode: TCodeTreeNode;
|
||||
begin
|
||||
CurNode:=Node;
|
||||
Result:=(CurNode<>nil) and Tool.PropertyNodeHasParamList(CurNode);
|
||||
ANode:=Node;
|
||||
Result:=(ANode<>nil) and Tool.PropertyNodeHasParamList(ANode);
|
||||
end;
|
||||
|
||||
function TIdentifierListItem.CheckHasChilds: boolean;
|
||||
// returns true if test was successful
|
||||
var
|
||||
CurNode: TCodeTreeNode;
|
||||
ANode: TCodeTreeNode;
|
||||
begin
|
||||
Result:=false;
|
||||
if GetDesc in [ctnClass,ctnRecordType,ctnClassInterface] then begin
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
CurNode:=Node;
|
||||
if CurNode=nil then exit;
|
||||
ANode:=Node;
|
||||
if ANode=nil then exit;
|
||||
UpdateBaseContext;
|
||||
if (BaseExprType.Desc=xtContext)
|
||||
and (BaseExprType.Context.Node<>nil)
|
||||
@ -1749,16 +1869,16 @@ end;
|
||||
|
||||
function TIdentifierListItem.CanBeAssigned: boolean;
|
||||
var
|
||||
CurNode: TCodeTreeNode;
|
||||
ANode: TCodeTreeNode;
|
||||
begin
|
||||
Result:=false;
|
||||
CurNode:=Node;
|
||||
if (CurNode=nil) then exit;
|
||||
ANode:=Node;
|
||||
if (ANode=nil) then exit;
|
||||
if (GetDesc=ctnVarDefinition) then
|
||||
Result:=true;
|
||||
if (CurNode.Desc in [ctnProperty,ctnGlobalProperty]) then begin
|
||||
if Tool.PropertyHasSpecifier(CurNode,'write') then exit(true);
|
||||
if Tool.PropNodeIsTypeLess(CurNode) then begin
|
||||
if (ANode.Desc in [ctnProperty,ctnGlobalProperty]) then begin
|
||||
if Tool.PropertyHasSpecifier(ANode,'write') then exit(true);
|
||||
if Tool.PropNodeIsTypeLess(ANode) then begin
|
||||
exit(true);// ToDo: search the real property definition
|
||||
end;
|
||||
end;
|
||||
@ -1767,17 +1887,17 @@ end;
|
||||
procedure TIdentifierListItem.UpdateBaseContext;
|
||||
var
|
||||
Params: TFindDeclarationParams;
|
||||
CurNode: TCodeTreeNode;
|
||||
ANode: TCodeTreeNode;
|
||||
begin
|
||||
if (iliBaseExprTypeValid in Flags) then exit;
|
||||
BaseExprType:=CleanExpressionType;
|
||||
BaseExprType.Desc:=xtNone;
|
||||
CurNode:=Node;
|
||||
if (CurNode<>nil) and (Tool<>nil) then begin
|
||||
ANode:=Node;
|
||||
if (ANode<>nil) and (Tool<>nil) then begin
|
||||
Tool.ActivateGlobalWriteLock;
|
||||
Params:=TFindDeclarationParams.Create;
|
||||
try
|
||||
BaseExprType.Context:=Tool.FindBaseTypeOfNode(Params,CurNode);
|
||||
BaseExprType.Context:=Tool.FindBaseTypeOfNode(Params,ANode);
|
||||
if (BaseExprType.Context.Node<>nil) then
|
||||
BaseExprType.Desc:=xtContext;
|
||||
finally
|
||||
@ -1795,11 +1915,11 @@ end;
|
||||
|
||||
function TIdentifierListItem.IsFunction: boolean;
|
||||
var
|
||||
CurNode: TCodeTreeNode;
|
||||
ANode: TCodeTreeNode;
|
||||
begin
|
||||
if not (iliIsFunctionValid in Flags) then begin
|
||||
CurNode:=Node;
|
||||
if (CurNode<>nil) and Tool.NodeIsFunction(CurNode) then
|
||||
ANode:=Node;
|
||||
if (ANode<>nil) and Tool.NodeIsFunction(ANode) then
|
||||
Include(Flags,iliIsFunction);
|
||||
Include(Flags,iliIsFunctionValid);
|
||||
end;
|
||||
@ -1808,12 +1928,12 @@ end;
|
||||
|
||||
function TIdentifierListItem.IsAbstractMethod: boolean;
|
||||
var
|
||||
CurNode: TCodeTreeNode;
|
||||
ANode: TCodeTreeNode;
|
||||
begin
|
||||
if not (iliIsAbstractMethodValid in Flags) then begin
|
||||
CurNode:=Node;
|
||||
if (CurNode<>nil)
|
||||
and Tool.MoveCursorToProcSpecifier(CurNode,psABSTRACT) then
|
||||
ANode:=Node;
|
||||
if (ANode<>nil)
|
||||
and Tool.ProcNodeHasSpecifier(ANode,psABSTRACT) then
|
||||
Include(Flags,iliIsAbstractMethod);
|
||||
Include(Flags,iliIsAbstractMethodValid);
|
||||
end;
|
||||
@ -1837,16 +1957,16 @@ end;
|
||||
function TIdentifierListItem.CompareParamList(CompareItem: TIdentifierListItem
|
||||
): integer;
|
||||
var
|
||||
CurNode: TCodeTreeNode;
|
||||
ANode: TCodeTreeNode;
|
||||
CmpNode: TCodeTreeNode;
|
||||
begin
|
||||
Result:=0;
|
||||
if Self=CompareItem then exit;
|
||||
CurNode:=Node;
|
||||
ANode:=Node;
|
||||
CmpNode:=CompareItem.Node;
|
||||
if (CurNode=CmpNode) then exit;
|
||||
if (CurNode=nil) or (CmpNode=nil) then exit;
|
||||
if (CurNode.Desc<>ctnProcedure) or (CmpNode.Desc<>ctnProcedure) then
|
||||
if (ANode=CmpNode) then exit;
|
||||
if (ANode=nil) or (CmpNode=nil) then exit;
|
||||
if (ANode.Desc<>ctnProcedure) or (CmpNode.Desc<>ctnProcedure) then
|
||||
exit;
|
||||
{DbgOut('TIdentifierListItem.CompareParamList ',GetIdentifier(Identifier),'=',GetIdentifier(CompareItem.Identifier));
|
||||
if Node<>nil then
|
||||
|
||||
@ -651,6 +651,7 @@ procedure TPascalReaderTool.MoveCursorToFirstProcSpecifier(
|
||||
// After the call,
|
||||
// CurPos will stand on the first proc specifier or on a semicolon
|
||||
begin
|
||||
//DebugLn(['TPascalReaderTool.MoveCursorToFirstProcSpecifier ',ProcNode.DescAsString,' ',ProcNode.StartPos]);
|
||||
if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then begin
|
||||
SaveRaiseException('Internal Error in'
|
||||
+' TPascalParserTool.MoveCursorFirstProcSpecifier: '
|
||||
|
||||
Loading…
Reference in New Issue
Block a user