mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-05 12:38:16 +02:00
MG: fixed method jump
git-svn-id: trunk@433 -
This commit is contained in:
lazarus
parent
c6937651f4
commit
b18dbc2ed7
@ -61,7 +61,6 @@ type
|
||||
FCursorBeyondEOL: boolean;
|
||||
FOnBeforeApplyChanges: TOnBeforeApplyChanges;
|
||||
FOnAfterApplyChanges: TOnAfterApplyChanges;
|
||||
FLastException: Exception;
|
||||
FCatchExceptions: boolean;
|
||||
FWriteExceptions: boolean;
|
||||
function OnScannerGetInitValues(Code: Pointer): TExpressionEvaluator;
|
||||
@ -100,7 +99,6 @@ type
|
||||
function FilenameHasSourceExt(const ExpandedFilename: string): boolean;
|
||||
|
||||
// exception handling
|
||||
property LastException: Exception read FLastException write FLastException;
|
||||
property CatchExceptions: boolean
|
||||
read FCatchExceptions write FCatchExceptions;
|
||||
property WriteExceptions: boolean
|
||||
@ -122,6 +120,10 @@ type
|
||||
property OnAfterApplyChanges: TOnAfterApplyChanges
|
||||
read FOnAfterApplyChanges write FOnAfterApplyChanges;
|
||||
|
||||
// syntax checking (true on syntax is ok)
|
||||
function CheckSyntax(Code: TCodeBuffer; var NewCode: TCodeBuffer;
|
||||
var NewX, NewY, NewTopLine: integer; var ErrorMsg: string): boolean;
|
||||
|
||||
// method jumping
|
||||
function JumpToMethod(Code: TCodeBuffer; X,Y: integer;
|
||||
var NewCode: TCodeBuffer;
|
||||
@ -229,7 +231,6 @@ begin
|
||||
SourceChangeCache.OnAfterApplyChanges:=@AfterApplyingChanges;
|
||||
GlobalValues:=TExpressionEvaluator.Create;
|
||||
FSourceExtensions:='.pp;.pas;.lpr;.dpr;.dpk';
|
||||
FLastException:=nil;
|
||||
FCatchExceptions:=true;
|
||||
FWriteExceptions:=true;
|
||||
FIndentSize:=2;
|
||||
@ -400,20 +401,19 @@ var
|
||||
ACode: TCodeBuffer;
|
||||
Line, Column: integer;
|
||||
begin
|
||||
FLastException:=AnException;
|
||||
if FWriteExceptions then begin
|
||||
if (AnException is ELinkScannerError)
|
||||
and (FCodeTool<>nil) and (FCodeTool.Scanner<>nil)
|
||||
and (FCodeTool.Scanner.Code<>nil)
|
||||
and (FCodeTool.Scanner.LinkCount>0) then begin
|
||||
ACode:=TCodeBuffer(FCodeTool.Scanner.Code);
|
||||
ACode.AbsoluteToLineCol(FCodeTool.Scanner.SrcPos,Line,Column);
|
||||
if Line>=0 then begin
|
||||
AnException.Message:='"'+ACode.Filename+'"'
|
||||
+' at Y:'+IntToStr(Line)+',X:'+IntToStr(Column)
|
||||
+' '+AnException.Message;
|
||||
end;
|
||||
if (AnException is ELinkScannerError)
|
||||
and (FCodeTool<>nil) and (FCodeTool.Scanner<>nil)
|
||||
and (FCodeTool.Scanner.Code<>nil)
|
||||
and (FCodeTool.Scanner.LinkCount>0) then begin
|
||||
ACode:=TCodeBuffer(FCodeTool.Scanner.Code);
|
||||
ACode.AbsoluteToLineCol(FCodeTool.Scanner.SrcPos,Line,Column);
|
||||
if Line>=0 then begin
|
||||
AnException.Message:='"'+ACode.Filename+'"'
|
||||
+' at Line '+IntToStr(Line)+', Column'+IntToStr(Column)
|
||||
+' '+AnException.Message;
|
||||
end;
|
||||
end;
|
||||
if FWriteExceptions then begin
|
||||
{$IFDEF CTDEBUG}
|
||||
WriteDebugReport(true,false,false,false,false);
|
||||
{$ENDIF}
|
||||
@ -423,6 +423,42 @@ WriteDebugReport(true,false,false,false,false);
|
||||
Result:=false;
|
||||
end;
|
||||
|
||||
function TCodeToolManager.CheckSyntax(Code: TCodeBuffer;
|
||||
var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer;
|
||||
var ErrorMsg: string): boolean;
|
||||
var OldCatchExceptions: boolean;
|
||||
begin
|
||||
Result:=false;
|
||||
NewCode:=nil;
|
||||
OldCatchExceptions:=FCatchExceptions;
|
||||
FCatchExceptions:=false;
|
||||
try
|
||||
try
|
||||
ErrorMsg:='init code tool failed';
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FCodeTool.ErrorPosition.Code:=nil;
|
||||
ErrorMsg:='internal build code tree error';
|
||||
FCodeTool.BuildTree(false);
|
||||
except
|
||||
on e: Exception do begin
|
||||
ErrorMsg:=e.Message;
|
||||
if FCodeTool<>nil then begin
|
||||
NewCode:=FCodeTool.ErrorPosition.Code;
|
||||
NewX:=FCodeTool.ErrorPosition.X;
|
||||
NewY:=FCodeTool.ErrorPosition.Y;
|
||||
NewTopLine:=NewY;
|
||||
if JumpCentered then begin
|
||||
dec(NewTopLine,VisibleEditorLines div 2);
|
||||
if NewTopLine<1 then NewTopLine:=1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
FCatchExceptions:=OldCatchExceptions;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeToolManager.JumpToMethod(Code: TCodeBuffer; X,Y: integer;
|
||||
var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer): boolean;
|
||||
var
|
||||
@ -441,7 +477,6 @@ writeln('TCodeToolManager.JumpToMethod A ',Code.Filename,' x=',x,' y=',y);
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TCodeToolManager.JumpToMethod B ',FCodeTool.Scanner<>nil);
|
||||
{$ENDIF}
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.FindJumpPoint(CursorPos,NewPos,NewTopLine);
|
||||
if Result then begin
|
||||
@ -464,7 +499,6 @@ begin
|
||||
writeln('TCodeToolManager.GetCompatibleMethods A ',Code.Filename,' Classname=',AClassname);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
FCodeTool.GetCompatiblePublishedMethods(UpperCaseStr(AClassName),
|
||||
TypeData,Proc);
|
||||
@ -481,7 +515,6 @@ writeln('TCodeToolManager.MethodExists A ',Code.Filename,' ',AClassName,':',AMet
|
||||
{$ENDIF}
|
||||
Result:=InitCodeTool(Code);
|
||||
if not Result then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.PublishedMethodExists(UpperCaseStr(AClassName),
|
||||
UpperCaseStr(AMethodName),TypeData);
|
||||
@ -500,7 +533,6 @@ writeln('TCodeToolManager.JumpToMethodBody A ',Code.Filename,' ',AClassName,':',
|
||||
{$ENDIF}
|
||||
Result:=InitCodeTool(Code);
|
||||
if not Result then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.JumpToPublishedMethodBody(UpperCaseStr(AClassName),
|
||||
UpperCaseStr(AMethodName),TypeData,NewPos,NewTopLine);
|
||||
@ -522,7 +554,6 @@ writeln('TCodeToolManager.RenameMethod A');
|
||||
{$ENDIF}
|
||||
Result:=InitCodeTool(Code);
|
||||
if not Result then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
SourceChangeCache.Clear;
|
||||
Result:=FCodeTool.RenamePublishedMethod(UpperCaseStr(AClassName),
|
||||
@ -541,7 +572,6 @@ writeln('TCodeToolManager.CreateMethod A');
|
||||
{$ENDIF}
|
||||
Result:=InitCodeTool(Code);
|
||||
if not Result then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
SourceChangeCache.Clear;
|
||||
Result:=FCodeTool.CreatePublishedMethod(UpperCaseStr(AClassName),
|
||||
@ -565,7 +595,6 @@ writeln('TCodeToolManager.CompleteCode A ',Code.Filename,' x=',x,' y=',y);
|
||||
CursorPos.X:=X;
|
||||
CursorPos.Y:=Y;
|
||||
CursorPos.Code:=Code;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.CompleteCode(CursorPos,NewPos,NewTopLine,SourceChangeCache);
|
||||
if Result then begin
|
||||
@ -588,7 +617,6 @@ writeln('TCodeToolManager.GetSourceName A ',Code.Filename,' ',Code.SourceLength)
|
||||
CheckHeap(IntToStr(GetMem_Cnt));
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.GetSourceName;
|
||||
except
|
||||
@ -610,7 +638,6 @@ begin
|
||||
writeln('TCodeToolManager.GetSourceType A ',Code.Filename,' ',Code.SourceLength);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
// GetSourceType does not parse the code -> parse it with GetSourceName
|
||||
FCodeTool.GetSourceName;
|
||||
@ -642,7 +669,6 @@ begin
|
||||
writeln('TCodeToolManager.RenameSource A ',Code.Filename,' NewName=',NewName);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.RenameSource(NewName,SourceChangeCache);
|
||||
except
|
||||
@ -663,7 +689,6 @@ writeln('TCodeToolManager.FindUnitInAllUsesSections A ',Code.Filename,' UnitName
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TCodeToolManager.FindUnitInAllUsesSections B ',Code.Filename,' UnitName=',AnUnitName);
|
||||
{$ENDIF}
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.FindUnitInAllUsesSections(UpperCaseStr(AnUnitName),
|
||||
NameAtomPos, InAtomPos);
|
||||
@ -684,7 +709,6 @@ begin
|
||||
writeln('TCodeToolManager.RenameUsedUnit A, ',Code.Filename,' Old=',OldUnitName,' New=',NewUnitName);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.RenameUsedUnit(UpperCaseStr(OldUnitName),NewUnitName,
|
||||
NewUnitInFile,SourceChangeCache);
|
||||
@ -701,7 +725,6 @@ begin
|
||||
writeln('TCodeToolManager.AddUnitToMainUsesSection A ',Code.Filename,' NewUnitName=',NewUnitName);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.AddUnitToMainUsesSection(NewUnitName, NewUnitInFile,
|
||||
SourceChangeCache);
|
||||
@ -718,7 +741,6 @@ begin
|
||||
writeln('TCodeToolManager.RemoveUnitFromAllUsesSections A ',Code.Filename,' UnitName=',AnUnitName);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.RemoveUnitFromAllUsesSections(UpperCaseStr(AnUnitName),
|
||||
SourceChangeCache);
|
||||
@ -737,7 +759,6 @@ begin
|
||||
writeln('TCodeToolManager.FindLFMFileName A ',Code.Filename);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
LinkIndex:=-1;
|
||||
CurCode:=FCodeTool.FindNextIncludeInInitialization(LinkIndex);
|
||||
@ -763,7 +784,6 @@ begin
|
||||
writeln('TCodeToolManager.FindNextResourceFile A ',Code.Filename);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.FindNextIncludeInInitialization(LinkIndex);
|
||||
except
|
||||
@ -779,7 +799,6 @@ begin
|
||||
writeln('TCodeToolManager.FindLazarusResource A ',Code.Filename,' ResourceName=',ResourceName);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.FindLazarusResource(ResourceName);
|
||||
except
|
||||
@ -800,7 +819,6 @@ writeln('TCodeToolManager.AddLazarusResource A ',Code.Filename,' ResourceName=',
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TCodeToolManager.AddLazarusResource B ');
|
||||
{$ENDIF}
|
||||
FLastException:=nil;
|
||||
try
|
||||
LinkIndex:=-1;
|
||||
ResCode:=FCodeTool.FindNextIncludeInInitialization(LinkIndex);
|
||||
@ -822,7 +840,6 @@ begin
|
||||
writeln('TCodeToolManager.RemoveLazarusResource A ',Code.Filename,' ResourceName=',ResourceName);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
LinkIndex:=-1;
|
||||
ResCode:=FCodeTool.FindNextIncludeInInitialization(LinkIndex);
|
||||
@ -843,7 +860,6 @@ begin
|
||||
writeln('TCodeToolManager.RenameMainInclude A ',Code.Filename,' NewFilename=',NewFilename,' KeepPath=',KeepPath);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
LinkIndex:=-1;
|
||||
if FCodeTool.FindNextIncludeInInitialization(LinkIndex)=nil then exit;
|
||||
@ -866,7 +882,6 @@ begin
|
||||
writeln('TCodeToolManager.FindCreateFormStatement A ',Code.Filename,' StartPos=',StartPos,' ',AClassName,':',AVarName);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.FindCreateFormStatement(StartPos,UpperCaseStr(AClassName),
|
||||
UpperCaseStr(AVarName),PosAtom);
|
||||
@ -885,7 +900,6 @@ begin
|
||||
writeln('TCodeToolManager.AddCreateFormStatement A ',Code.Filename,' ',AClassName,':',AVarName);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.AddCreateFormStatement(AClassName,AVarName,
|
||||
SourceChangeCache);
|
||||
@ -902,7 +916,6 @@ begin
|
||||
writeln('TCodeToolManager.RemoveCreateFormStatement A ',Code.Filename,' ',AVarName);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.RemoveCreateFormStatement(UpperCaseStr(AVarName),
|
||||
SourceChangeCache);
|
||||
@ -919,7 +932,6 @@ begin
|
||||
writeln('TCodeToolManager.ListAllCreateFormStatements A ',Code.Filename);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.ListAllCreateFormStatements;
|
||||
except
|
||||
@ -935,7 +947,6 @@ begin
|
||||
writeln('TCodeToolManager.SetAllCreateFromStatements A ',Code.Filename);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.SetAllCreateFromStatements(List,SourceChangeCache);
|
||||
except
|
||||
@ -951,7 +962,6 @@ begin
|
||||
writeln('TCodeToolManager.PublishedVariableExists A ',Code.Filename,' ',AClassName,':',AVarName);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.FindPublishedVariable(UpperCaseStr(AClassName),
|
||||
UpperCaseStr(AVarName))<>nil;
|
||||
@ -968,7 +978,6 @@ begin
|
||||
writeln('TCodeToolManager.AddPublishedVariable A ',Code.Filename,' ',AClassName,':',VarName);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.AddPublishedVariable(UpperCaseStr(AClassName),
|
||||
VarName,VarType,SourceChangeCache);
|
||||
@ -985,7 +994,6 @@ begin
|
||||
writeln('TCodeToolManager.RemovePublishedVariable A ',Code.Filename,' ',AClassName,':',AVarName);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
FLastException:=nil;
|
||||
try
|
||||
Result:=FCodeTool.RemovePublishedVariable(UpperCaseStr(AClassName),
|
||||
UpperCaseStr(AVarName),SourceChangeCache);
|
||||
|
||||
@ -72,6 +72,8 @@ type
|
||||
JumpCentered: boolean;
|
||||
CursorBeyondEOL: boolean;
|
||||
|
||||
ErrorPosition: TCodeXYPosition;
|
||||
|
||||
property Scanner: TLinkScanner read FScanner write SetScanner;
|
||||
|
||||
function FindDeepestNodeAtPos(P: integer): TCodeTreeNode;
|
||||
@ -170,14 +172,19 @@ end;
|
||||
procedure TCustomCodeTool.RaiseException(const AMessage: string);
|
||||
var CaretXY: TCodeXYPosition;
|
||||
begin
|
||||
ErrorPosition.Code:=nil;
|
||||
if (CleanPosToCaret(CurPos.StartPos,CaretXY))
|
||||
and (CaretXY.Code<>nil) then begin
|
||||
ErrorPosition:=CaretXY;
|
||||
raise ECodeToolError.Create('"'+CaretXY.Code.Filename+'"'
|
||||
+' at Y:'+IntToStr(CaretXY.Y)+',X:'+IntToStr(CaretXY.X)+' '+AMessage);
|
||||
end else if (Scanner<>nil) and (Scanner.MainCode<>nil) then
|
||||
+' at Line '+IntToStr(CaretXY.Y)+', Column'+IntToStr(CaretXY.X)
|
||||
+' '+AMessage);
|
||||
end else if (Scanner<>nil) and (Scanner.MainCode<>nil) then begin
|
||||
ErrorPosition.Code:=TCodeBuffer(Scanner.MainCode);
|
||||
ErrorPosition.Y:=-1;
|
||||
raise ECodeToolError.Create('"'+TCodeBuffer(Scanner.MainCode).Filename+'" '
|
||||
+AMessage)
|
||||
else
|
||||
end else
|
||||
raise ECodeToolError.Create(AMessage);
|
||||
end;
|
||||
|
||||
@ -629,6 +636,7 @@ begin
|
||||
or ((c1='>') and (c2='<'))
|
||||
or ((c1='.') and (c2='.'))
|
||||
or ((c1='*') and (c2='*'))
|
||||
or ((c1='@') and (c2='@'))
|
||||
then inc(CurPos.EndPos);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -444,6 +444,9 @@ begin
|
||||
Add('DIV',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('MOD',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('NIL',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('LOW',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('HIGH',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('ORD',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
end;
|
||||
WordIsKeyWord:=TKeyWordFunctionList.Create;
|
||||
with WordIsKeyWord do begin
|
||||
|
||||
@ -34,6 +34,8 @@ interface
|
||||
|
||||
{$I codetools.inc}
|
||||
|
||||
{$DEFINE CTDEBUG}
|
||||
|
||||
uses
|
||||
{$IFDEF MEM_CHECK}
|
||||
MemCheck,
|
||||
@ -66,10 +68,96 @@ implementation
|
||||
|
||||
function TMethodJumpingCodeTool.FindJumpPoint(CursorPos: TCodeXYPosition;
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
||||
|
||||
function FindBestProcNode(
|
||||
SearchForProcNode: TCodeTreeNode; SearchForProcAttr: TProcHeadAttributes;
|
||||
StartNode: TCodeTreeNode; SearchInProcAttr: TProcHeadAttributes): boolean;
|
||||
// search first for proc node with same name and param list and jump,
|
||||
// if this fails
|
||||
// search for a proc node with same name and jump to difference in param list
|
||||
// returns true on jumped, false if no target proc found
|
||||
var SearchedProcHead: string;
|
||||
FromProcHead, ToProcHead: string;
|
||||
Attr: TProcHeadAttributes;
|
||||
DiffPos: integer;
|
||||
NewProcCaret: TCodeXYPosition;
|
||||
ProcNode: TCodeTreeNode;
|
||||
begin
|
||||
Result:=false;
|
||||
SearchedProcHead:=ExtractProcHead(SearchForProcNode,SearchForProcAttr);
|
||||
if SearchedProcHead='' then exit;
|
||||
ProcNode:=FindProcNode(StartNode,SearchedProcHead,SearchInProcAttr);
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode A ',ProcNode<>nil,' "',SearchedProcHead,'"');
|
||||
{$ENDIF}
|
||||
if ProcNode<>nil then begin
|
||||
Result:=FindJumpPointInProcNode(ProcNode,NewPos,NewTopLine);
|
||||
exit;
|
||||
end;
|
||||
// there is no exact corresponding proc
|
||||
// -> search for a proc with the same name but different param list
|
||||
SearchForProcAttr:=SearchForProcAttr-[phpWithVarModifiers,
|
||||
phpWithParameterNames, phpWithDefaultValues, phpWithResultType,
|
||||
phpWithComments];
|
||||
SearchForProcAttr:=SearchForProcAttr+[phpWithoutBrackets,
|
||||
phpWithoutParamList];
|
||||
SearchInProcAttr:=SearchInProcAttr-[phpWithVarModifiers,
|
||||
phpWithParameterNames, phpWithDefaultValues, phpWithResultType,
|
||||
phpWithComments];
|
||||
SearchInProcAttr:=SearchInProcAttr+[phpWithoutBrackets,
|
||||
phpWithoutParamList];
|
||||
SearchedProcHead:=ExtractProcHead(SearchForProcNode,SearchForProcAttr);
|
||||
if SearchedProcHead='' then exit;
|
||||
ProcNode:=FindProcNode(StartNode,SearchedProcHead,SearchInProcAttr);
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode B ',ProcNode<>nil,' "',SearchedProcHead,'"');
|
||||
{$ENDIF}
|
||||
if ProcNode<>nil then begin
|
||||
// there is a proc with the same name, but with different parameters
|
||||
// -> search first difference
|
||||
|
||||
// extract the two procedures
|
||||
Attr:=[phpInUpperCase,phpWithoutClassName];
|
||||
FromProcHead:=ExtractProcHead(SearchForProcNode,Attr);
|
||||
ToProcHead:=ExtractProcHead(ProcNode,Attr);
|
||||
// search for difference in filtered proc headers
|
||||
DiffPos:=1;
|
||||
while (DiffPos<=length(FromProcHead)) and (DiffPos<=length(ToProcHead))
|
||||
and (FromProcHead[DiffPos]=ToProcHead[DiffPos]) do
|
||||
inc(DiffPos);
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode C "',FromProcHead,'" <> "',ToProcHead,'" DiffPos=',DiffPos,' ',copy(ToProcHead,DiffPos,5));
|
||||
{$ENDIF}
|
||||
// search difference in code
|
||||
ExtractSearchPos:=DiffPos;
|
||||
try
|
||||
ExtractProcHead(ProcNode,Attr);
|
||||
DiffPos:=ExtractFoundPos;
|
||||
finally
|
||||
ExtractSearchPos:=-1;
|
||||
end;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode C ',DiffPos);
|
||||
{$ENDIF}
|
||||
// move cursor to first difference in procedure head
|
||||
if not CleanPosToCaret(DiffPos,NewPos) then exit;
|
||||
// calculate NewTopLine
|
||||
if not CleanPosToCaret(ProcNode.StartPos,NewProcCaret) then exit;
|
||||
if NewPos.Code=NewProcCaret.Code then
|
||||
NewTopLine:=NewProcCaret.Y
|
||||
else
|
||||
NewTopLine:=1;
|
||||
if NewTopLine<=NewPos.Y-VisibleEditorLines then
|
||||
NewTopLine:=NewPos.Y-VisibleEditorLines+1;
|
||||
Result:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
var CursorNode, ClassNode, ProcNode, StartNode, TypeSectionNode: TCodeTreeNode;
|
||||
CleanCursorPos, r, LineStart, LineEnd, FirstAtomStart, LastAtomEnd,
|
||||
DiffTxtPos: integer;
|
||||
SearchedProc, SearchedClassname: string;
|
||||
SearchedClassname: string;
|
||||
SearchForNodes, SearchInNodes: TAVLTree;
|
||||
DiffNode: TAVLTreeNode;
|
||||
NewProcCaret: TCodeXYPosition;
|
||||
@ -106,46 +194,43 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint C ',NodeDescriptionAsString(Cursor
|
||||
while (ClassNode<>nil) and (ClassNode.Desc<>ctnClass) do
|
||||
ClassNode:=ClassNode.Parent;
|
||||
if ClassNode<>nil then begin
|
||||
// cursor is in class/object definition
|
||||
// search in all implemented class procedures for the body
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint C2 ',NodeDescriptionAsString(ClassNode.Desc));
|
||||
{$ENDIF}
|
||||
// cursor is in class/object definition
|
||||
if CursorNode.SubDesc=ctnsForwardDeclaration then exit;
|
||||
// parse class and build CodeTreeNodes for all properties/methods
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint D ',CleanCursorPos,', |',copy(Src,CleanCursorPos,8));
|
||||
{$ENDIF}
|
||||
BuildSubTreeForClass(ClassNode);
|
||||
TypeSectionNode:=ClassNode.Parent;
|
||||
if (TypeSectionNode<>nil) and (TypeSectionNode.Parent<>nil)
|
||||
and (TypeSectionNode.Parent.Desc=ctnTypeSection) then
|
||||
TypeSectionNode:=TypeSectionNode.Parent;
|
||||
// search the method node under the cursor
|
||||
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos);
|
||||
if (CursorNode=nil)
|
||||
or (not (CursorNode.Desc in [ctnProcedureHead,ctnProcedure])) then
|
||||
exit;
|
||||
// build the method name + parameter list (without default values)
|
||||
SearchedProc:=ExtractProcHead(CursorNode,
|
||||
[phpWithParameterNames,phpAddClassname]);
|
||||
//SearchedProc:=ExtractProcHead(CursorNode,
|
||||
// [phpWithParameterNames,phpAddClassname]);
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint E SearchedProc="',SearchedProc,'"');
|
||||
//writeln('TMethodJumpingCodeTool.FindJumpPoint E SearchedProc="',SearchedProc,'"');
|
||||
{$ENDIF}
|
||||
if SearchedProc='' then exit;
|
||||
//if SearchedProc='' then exit;
|
||||
// search the method
|
||||
TypeSectionNode:=ClassNode.Parent;
|
||||
if (TypeSectionNode<>nil) and (TypeSectionNode.Parent<>nil)
|
||||
and (TypeSectionNode.Parent.Desc=ctnTypeSection) then
|
||||
TypeSectionNode:=TypeSectionNode.Parent;
|
||||
ProcNode:=FindProcNode(TypeSectionNode,SearchedProc,
|
||||
[phpWithParameterNames,phpIgnoreForwards]);
|
||||
//ProcNode:=FindProcNode(TypeSectionNode,SearchedProc,
|
||||
// [phpWithParameterNames,phpIgnoreForwards]);
|
||||
Result:=FindBestProcNode(CursorNode,[phpAddClassName,phpInUpperCase],
|
||||
TypeSectionNode,[phpIgnoreForwards,phpInUpperCase]);
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint F FindProcNode=',ProcNode<>nil);
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint F FindBestProcNode=',Result);
|
||||
{$ENDIF}
|
||||
if ProcNode<>nil then begin
|
||||
// find good position in procedure body
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint G');
|
||||
{$ENDIF}
|
||||
Result:=FindJumpPointInProcNode(ProcNode,NewPos,NewTopLine);
|
||||
end else begin
|
||||
// find the first not defined method
|
||||
if not Result then begin
|
||||
// find the first implemented class method that it is not defined in class
|
||||
StartNode:=ClassNode.FirstChild;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint H');
|
||||
@ -226,20 +311,22 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint 2B ');
|
||||
{$ENDIF}
|
||||
|
||||
// build the method name + parameter list (without default values)
|
||||
SearchedProc:=ExtractProcHead(ProcNode,[phpWithParameterNames]);
|
||||
//SearchedProc:=ExtractProcHead(ProcNode,[phpInUpperCase]);
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint 2C SearchedProc="',SearchedProc,'"');
|
||||
//writeln('TMethodJumpingCodeTool.FindJumpPoint 2C SearchedProc="',SearchedProc,'"');
|
||||
{$ENDIF}
|
||||
if SearchedProc='' then exit;
|
||||
//if SearchedProc='' then exit;
|
||||
// search the method
|
||||
ProcNode:=FindProcNode(ProcNode,SearchedProc,
|
||||
[phpWithParameterNames,phpIgnoreForwards]);
|
||||
if ProcNode=nil then exit;
|
||||
//ProcNode:=FindProcNode(ProcNode,SearchedProc,
|
||||
// [phpInUpperCase,phpIgnoreForwards]);
|
||||
Result:=FindBestProcNode(ProcNode,[phpInUpperCase],
|
||||
ProcNode,[phpInUpperCase,phpIgnoreForwards]);
|
||||
//if ProcNode=nil then exit;
|
||||
// find good position in procedure body
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint 2D');
|
||||
{$ENDIF}
|
||||
Result:=FindJumpPointInProcNode(ProcNode,NewPos,NewTopLine);
|
||||
//Result:=FindJumpPointInProcNode(ProcNode,NewPos,NewTopLine);
|
||||
end else begin
|
||||
// procedure without forward, search on same level
|
||||
{$IFDEF CTDEBUG}
|
||||
@ -257,7 +344,6 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint 4B ',StartNode<>nil,' ',SearchedCl
|
||||
true,false);
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint 4C ',ClassNode<>nil);
|
||||
writeln(' ',NodeDescToStr(ClassNode.Desc));
|
||||
{$ENDIF}
|
||||
if ClassNode=nil then exit;
|
||||
BuildSubTreeForClass(ClassNode);
|
||||
@ -272,17 +358,31 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint 4D ',StartNode<>nil);
|
||||
{$ENDIF}
|
||||
if StartNode=nil then exit;
|
||||
StartNode:=StartNode.FirstChild;
|
||||
SearchedProc:=ExtractProcHead(ProcNode,
|
||||
[phpWithoutClassName,phpWithParameterNames]);
|
||||
ProcNode:=FindProcNode(StartNode,SearchedProc,[phpWithParameterNames]);
|
||||
//SearchedProc:=ExtractProcHead(ProcNode,
|
||||
// [phpWithoutClassName,phpInUpperCase]);
|
||||
//if SearchedProc='' then exit;
|
||||
//ProcNode:=FindProcNode(StartNode,SearchedProc,[phpInUpperCase]);
|
||||
Result:=FindBestProcNode(ProcNode,[phpWithoutClassName,phpInUpperCase],
|
||||
StartNode,[phpInUpperCase]);
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint 4E ',ProcNode<>nil,' ',SearchedProc);
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint 4E ',Result);
|
||||
{$ENDIF}
|
||||
if ProcNode=nil then begin
|
||||
//if ProcNode=nil then begin
|
||||
// there is no exact corresponding proc
|
||||
// -> search for a proc with the same name but different param list
|
||||
// SearchedProc:=ExtractProcHead(ProcNode,
|
||||
// [phpWithoutClassName,phpInUpperCase,phpWithoutBrackets,
|
||||
// phpWithoutParamList]);
|
||||
// ProcNode:=FindProcNode(StartNode,SearchedProc,[phpInUpperCase,
|
||||
// phpWithoutBrackets,phpWithoutParamList]);
|
||||
{$IFDEF CTDEBUG}
|
||||
//writeln('TMethodJumpingCodeTool.FindJumpPoint 4E2 ',ProcNode<>nil,' ',SearchedProc);
|
||||
{$ENDIF}
|
||||
//end;
|
||||
if not Result then begin
|
||||
// search first undefined proc node with body
|
||||
SearchForNodes:=GatherProcNodes(StartNode,
|
||||
[phpInUpperCase,phpAddClassname,phpIgnoreProcsWithBody],
|
||||
'');
|
||||
[phpInUpperCase,phpAddClassname,phpIgnoreProcsWithBody],'');
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint 4F ');
|
||||
{$ENDIF}
|
||||
@ -327,19 +427,20 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint 4G ',DiffNode<>nil);
|
||||
NodeExtMemManager.DisposeAVLTree(SearchInNodes);
|
||||
end;
|
||||
end;
|
||||
Result:=JumpToNode(ProcNode,NewPos,NewTopLine);
|
||||
end else begin
|
||||
// search forward procedure
|
||||
SearchedProc:=ExtractProcHead(ProcNode,[phpWithParameterNames]);
|
||||
ProcNode:=FindProcNode(StartNode,SearchedProc,
|
||||
[phpWithParameterNames,phpIgnoreProcsWithBody]);
|
||||
if ProcNode=nil then exit;
|
||||
//SearchedProc:=ExtractProcHead(ProcNode,[phpWithParameterNames]);
|
||||
//ProcNode:=FindProcNode(StartNode,SearchedProc,
|
||||
// [phpWithParameterNames,phpIgnoreProcsWithBody]);
|
||||
//if ProcNode=nil then exit;
|
||||
Result:=FindBestProcNode(ProcNode,[phpInUpperCase],
|
||||
StartNode,[phpInUpperCase,phpIgnoreProcsWithBody]);
|
||||
// find good position in forward procedure
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint 4B');
|
||||
//writeln('TMethodJumpingCodeTool.FindJumpPoint 4B');
|
||||
{$ENDIF}
|
||||
ProcNode:=ProcNode.FirstChild;
|
||||
Result:=JumpToNode(ProcNode,NewPos,NewTopLine);
|
||||
//ProcNode:=ProcNode.FirstChild;
|
||||
//Result:=JumpToNode(ProcNode,NewPos,NewTopLine);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -354,7 +455,11 @@ begin
|
||||
Result:=false;
|
||||
// search method body
|
||||
DestNode:=FindProcBody(ProcNode);
|
||||
if DestNode=nil then exit;
|
||||
if DestNode=nil then begin
|
||||
// proc without body -> jump to proc node header
|
||||
Result:=JumpToNode(ProcNode.FirstChild,NewPos,NewTopLine);
|
||||
exit;
|
||||
end;
|
||||
// search good position
|
||||
{ examples
|
||||
begin |end
|
||||
@ -480,6 +585,7 @@ function TMethodJumpingCodeTool.FindFirstDifferenceNode(
|
||||
var SearchInNode: TAVLTreeNode;
|
||||
cmp: integer;
|
||||
NodeTxt1, NodeTxt2: string;
|
||||
Attr: TProcHeadAttributes;
|
||||
begin
|
||||
Result:=SearchForNodes.FindLowest;
|
||||
if Result=nil then exit;
|
||||
@ -496,21 +602,39 @@ begin
|
||||
//writeln('[TMethodJumpingCodeTool.FindFirstDifferenceNode] ',NodeTxt1,' ?',cmp,'= ',NodeTxt2);
|
||||
|
||||
if cmp<0 then begin
|
||||
// node not found in SearchInNodes
|
||||
NodeTxt1:=TCodeTreeNodeExtension(Result.Data).Txt;
|
||||
NodeTxt2:=TCodeTreeNodeExtension(SearchInNode.Data).Txt;
|
||||
// result node not found in SearchInNodes
|
||||
// -> search for first difference
|
||||
//NodeTxt1:=TCodeTreeNodeExtension(Result.Data).Txt;
|
||||
//NodeTxt2:=TCodeTreeNodeExtension(SearchInNode.Data).Txt;
|
||||
Attr:=[phpWithStart, phpWithoutClassName, phpWithVarModifiers,
|
||||
phpWithResultType, phpInUpperCase];
|
||||
NodeTxt1:=ExtractProcHead(TCodeTreeNodeExtension(Result.Data).Node,Attr);
|
||||
NodeTxt2:=ExtractProcHead(TCodeTreeNodeExtension(SearchInNode.Data).Node,
|
||||
Attr);
|
||||
//writeln('[TMethodJumpingCodeTool.FindFirstDifferenceNode] C Result=',NodeTxt1);
|
||||
//writeln('[TMethodJumpingCodeTool.FindFirstDifferenceNode] C SearchInNode=',NodeTxt2);
|
||||
DiffTxtPos:=1;
|
||||
while (DiffTxtPos<=length(NodeTxt1)) and (DiffTxtPos<=length(NodeTxt2)) do
|
||||
begin
|
||||
if UpChars[NodeTxt1[DiffTxtPos]]<>UpChars[NodeTxt2[DiffTxtPos]] then
|
||||
if NodeTxt1[DiffTxtPos]<>NodeTxt2[DiffTxtPos] then
|
||||
break;
|
||||
inc(DiffTxtPos);
|
||||
end;
|
||||
//writeln('[TMethodJumpingCodeTool.FindFirstDifferenceNode] D DiffTxtPos=',DiffTxtPos);
|
||||
ExtractSearchPos:=DiffTxtPos;
|
||||
try
|
||||
ExtractProcHead(TCodeTreeNodeExtension(Result.Data).Node,Attr);
|
||||
DiffTxtPos:=ExtractFoundPos;
|
||||
finally
|
||||
ExtractSearchPos:=-1;
|
||||
end;
|
||||
//writeln('[TMethodJumpingCodeTool.FindFirstDifferenceNode] E DiffTxtPos=',DiffTxtPos);
|
||||
exit;
|
||||
end else if cmp=0 then begin
|
||||
// node found in SearchInNodes -> search next
|
||||
Result:=SearchForNodes.FindSuccessor(Result);
|
||||
if Result=nil then exit;
|
||||
SearchInNode:=SearchInNodes.FindSuccessor(SearchInNode);
|
||||
if (Result=nil) or (SearchInNode=nil) then exit;
|
||||
end else begin
|
||||
// search in successor
|
||||
SearchInNode:=SearchInNodes.FindSuccessor(SearchInNode);
|
||||
|
||||
@ -75,8 +75,10 @@ type
|
||||
phpWithoutName, phpWithVarModifiers, phpWithParameterNames,
|
||||
phpWithDefaultValues, phpWithResultType, phpWithComments, phpInUpperCase,
|
||||
phpWithoutBrackets, phpIgnoreForwards, phpIgnoreProcsWithBody,
|
||||
phpOnlyWithClassname, phpFindCleanPosition);
|
||||
phpOnlyWithClassname, phpFindCleanPosition, phpWithoutParamList);
|
||||
TProcHeadAttributes = set of TProcHeadAttribute;
|
||||
|
||||
TProcHeadExtractPos = (phepNone, phepStart, phepName, phepParamList);
|
||||
|
||||
TPascalParserTool = class(TMultiKeyWordListCodeTool)
|
||||
private
|
||||
@ -89,6 +91,7 @@ type
|
||||
ExtractMemStream: TMemoryStream;
|
||||
ExtractSearchPos: integer;
|
||||
ExtractFoundPos: integer;
|
||||
ExtractProcHeadPos: TProcHeadExtractPos;
|
||||
procedure InitExtraction;
|
||||
function GetExtraction: string;
|
||||
procedure ExtractNextAtom(AddAtom: boolean; Attr: TProcHeadAttributes);
|
||||
@ -167,7 +170,7 @@ type
|
||||
function ExtractClassName(ClassNode: TCodeTreeNode;
|
||||
InUpperCase: boolean): string;
|
||||
function ExtractClassNameOfProcNode(ProcNode: TCodeTreeNode): string;
|
||||
function FindProcNode(StartNode: TCodeTreeNode; const ProcName: string;
|
||||
function FindProcNode(StartNode: TCodeTreeNode; const AProcHead: string;
|
||||
Attr: TProcHeadAttributes): TCodeTreeNode;
|
||||
function FindProcBody(ProcNode: TCodeTreeNode): TCodeTreeNode;
|
||||
function FindVarNode(StartNode: TCodeTreeNode;
|
||||
@ -873,11 +876,17 @@ begin
|
||||
if not AtomIsChar(',') then
|
||||
break
|
||||
else
|
||||
if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr);
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
ExtractNextAtom(not (phpWithoutParamList in Attr),Attr);
|
||||
until false;
|
||||
// read type
|
||||
if (AtomIsChar(':')) then begin
|
||||
if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr);
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
ExtractNextAtom(not (phpWithoutParamList in Attr),Attr);
|
||||
if not ReadParamType(ExceptionOnError,Extract,Attr) then exit;
|
||||
if AtomIsChar('=') then begin
|
||||
// read default value
|
||||
@ -901,7 +910,10 @@ begin
|
||||
RaiseException(
|
||||
'syntax error: '+CloseBracket+' expected, but '+GetAtom+' found')
|
||||
else exit;
|
||||
if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr);
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
ExtractNextAtom(not (phpWithoutParamList in Attr),Attr);
|
||||
until false;
|
||||
if (CloseBracket<>#0) then begin
|
||||
if Src[CurPos.StartPos]<>CloseBracket then
|
||||
@ -930,13 +942,19 @@ begin
|
||||
else exit;
|
||||
ReadNextAtom;
|
||||
if UpAtomIs('CONST') then begin
|
||||
if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr);
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
ExtractNextAtom(not (phpWithoutParamList in Attr),Attr);
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
if not AtomIsIdentifier(ExceptionOnError) then exit;
|
||||
if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr);
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
ExtractNextAtom(not (phpWithoutParamList in Attr),Attr);
|
||||
end else begin
|
||||
if ExceptionOnError then
|
||||
RaiseException(
|
||||
@ -1337,8 +1355,15 @@ begin
|
||||
end;
|
||||
|
||||
function TPascalParserTool.KeyWordFuncEnd: boolean;
|
||||
// end (parse end of block, e.g. begin..end)
|
||||
// keyword 'end' (parse end of block, e.g. begin..end)
|
||||
begin
|
||||
if LastAtomIs(0,'@') then
|
||||
RaiseException('syntax error: identifer expected but keyword end found');
|
||||
if LastAtomIs(0,'@@') then begin
|
||||
// for Delphi compatibility @@end is allowed
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
if CurNode.Desc in [ctnImplementation,ctnInterface] then
|
||||
CurNode.EndPos:=CurPos.StartPos
|
||||
else
|
||||
@ -1416,9 +1441,70 @@ end;
|
||||
|
||||
function TPascalParserTool.KeyWordFuncBeginEnd: boolean;
|
||||
// Keyword: begin, asm
|
||||
|
||||
procedure ReadTilBlockEnd;
|
||||
type
|
||||
TEndBlockType = (ebtBegin, ebtAsm, ebtTry, ebtCase, ebtRepeat);
|
||||
TTryType = (ttNone, ttFinally, ttExcept);
|
||||
var BlockType: TEndBlockType;
|
||||
TryType: TTryType;
|
||||
begin
|
||||
TryType:=ttNone;
|
||||
if UpAtomIs('BEGIN') then
|
||||
BlockType:=ebtBegin
|
||||
else if UpAtomIs('REPEAT') then
|
||||
BlockType:=ebtRepeat
|
||||
else if UpAtomIs('TRY') then
|
||||
BlockType:=ebtTry
|
||||
else if UpAtomIs('CASE') then
|
||||
BlockType:=ebtCase
|
||||
else if UpAtomIs('ASM') then
|
||||
BlockType:=ebtAsm
|
||||
else
|
||||
RaiseException('internal codetool error in '
|
||||
+'TPascalParserTool.KeyWordFuncBeginEnd: unkown block type');
|
||||
repeat
|
||||
ReadNextAtom;
|
||||
if (CurPos.StartPos>SrcLen) then begin
|
||||
RaiseException('syntax error: "end" not found.')
|
||||
end else if (UpAtomIs('END')) then begin
|
||||
if BlockType=ebtRepeat then
|
||||
RaiseException(
|
||||
'syntax error: ''until'' expected, but "'+GetAtom+'" found');
|
||||
if (BlockType=ebtTry) and (TryType=ttNone) then
|
||||
RaiseException(
|
||||
'syntax error: ''finally'' expected, but "'+GetAtom+'" found');
|
||||
break;
|
||||
end else if EndKeyWordFuncList.DoItUppercase(UpperSrc,CurPos.StartPos,
|
||||
CurPos.EndPos-CurPos.StartPos)
|
||||
or UpAtomIs('REPEAT') then
|
||||
begin
|
||||
if BlockType=ebtAsm then
|
||||
RaiseException('syntax error: unexpected keyword "'+GetAtom+'" found');
|
||||
ReadTilBlockEnd;
|
||||
end else if UpAtomIs('UNTIL') then begin
|
||||
if BlockType=ebtRepeat then
|
||||
break;
|
||||
RaiseException(
|
||||
'syntax error: ''end'' expected, but "'+GetAtom+'" found');
|
||||
end else if UpAtomIs('FINALLY') then begin
|
||||
if (BlockType=ebtTry) and (TryType=ttNone) then
|
||||
TryType:=ttFinally
|
||||
else
|
||||
RaiseException(
|
||||
'syntax error: "end" expected, but "'+GetAtom+'" found');
|
||||
end else if UpAtomIs('EXCEPT') then begin
|
||||
if (BlockType=ebtTry) and (TryType=ttNone) then
|
||||
TryType:=ttExcept
|
||||
else
|
||||
RaiseException(
|
||||
'syntax error: "end" expected, but "'+GetAtom+'" found');
|
||||
end;
|
||||
until false;
|
||||
end;
|
||||
|
||||
var BeginKeyWord: shortstring;
|
||||
ChildNodeCreated: boolean;
|
||||
Level: integer;
|
||||
begin
|
||||
BeginKeyWord:=GetUpAtom;
|
||||
ChildNodeCreated:=(BeginKeyWord='BEGIN') or (BeginKeyWord='ASM');
|
||||
@ -1430,18 +1516,7 @@ begin
|
||||
CurNode.Desc:=ctnAsmBlock;
|
||||
end;
|
||||
// search "end"
|
||||
Level:=1;
|
||||
repeat
|
||||
ReadNextAtom;
|
||||
if (CurPos.StartPos>SrcLen) then begin
|
||||
RaiseException('syntax error: "end" not found.')
|
||||
end else if EndKeyWordFuncList.DoItUppercase(UpperSrc,CurPos.StartPos,
|
||||
CurPos.EndPos-CurPos.StartPos) then begin
|
||||
inc(Level);
|
||||
end else if (UpAtomIs('END')) then begin
|
||||
dec(Level);
|
||||
end;
|
||||
until Level<=0;
|
||||
ReadTilBlockEnd;
|
||||
// close node
|
||||
if ChildNodeCreated then begin
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
@ -2222,6 +2297,7 @@ begin
|
||||
end else if (CurPos.StartPos>LastAtomEndPos)
|
||||
and (ExtractMemStream.Position>0) then begin
|
||||
ExtractMemStream.Write(' ',1);
|
||||
LastStreamPos:=ExtractMemStream.Position;
|
||||
end;
|
||||
end;
|
||||
if AddAtom then begin
|
||||
@ -2251,6 +2327,7 @@ var
|
||||
// Attr: TProcHeadAttributes): string;
|
||||
begin
|
||||
Result:='';
|
||||
ExtractProcHeadPos:=phepNone;
|
||||
if (ProcNode=nil) or (ProcNode.StartPos<1) then exit;
|
||||
if ProcNode.Desc=ctnProcedureHead then
|
||||
ProcNode:=ProcNode.Parent;
|
||||
@ -2283,6 +2360,7 @@ begin
|
||||
ExtractNextAtom(phpWithStart in Attr,Attr)
|
||||
else
|
||||
exit;
|
||||
ExtractProcHeadPos:=phepStart;
|
||||
// read name
|
||||
if (not AtomIsWord) or AtomIsKeyWord then exit;
|
||||
ReadNextAtom;
|
||||
@ -2310,9 +2388,11 @@ begin
|
||||
ExtractMemStream.Write(s[1],length(s));
|
||||
end;
|
||||
end;
|
||||
ExtractProcHeadPos:=phepName;
|
||||
// read parameter list
|
||||
if AtomIsChar('(') then
|
||||
ReadParamList(false,true,Attr);
|
||||
ExtractProcHeadPos:=phepParamList;
|
||||
// read result type
|
||||
while not AtomIsChar(';') do
|
||||
ExtractNextAtom(phpWithResultType in Attr,Attr);
|
||||
@ -2348,26 +2428,26 @@ begin
|
||||
end;
|
||||
|
||||
function TPascalParserTool.FindProcNode(StartNode: TCodeTreeNode;
|
||||
const ProcName: string; Attr: TProcHeadAttributes): TCodeTreeNode;
|
||||
const AProcHead: string; Attr: TProcHeadAttributes): TCodeTreeNode;
|
||||
// search in all next brothers for a Procedure Node with the Name ProcName
|
||||
// if there are no further brothers and the parent is a section node
|
||||
// ( e.g. 'interface', 'implementation', ...) or a class visibility node
|
||||
// (e.g. 'public', 'private', ...) then the search will continue in the next
|
||||
// section
|
||||
var CurProcName: string;
|
||||
var CurProcHead: string;
|
||||
begin
|
||||
Result:=StartNode;
|
||||
while (Result<>nil) do begin
|
||||
//writeln('TPascalParserTool.FindProcNode A "',NodeDescriptionAsString(Result.Desc),'"');
|
||||
writeln('TPascalParserTool.FindProcNode A "',NodeDescriptionAsString(Result.Desc),'"');
|
||||
if Result.Desc=ctnProcedure then begin
|
||||
if (not ((phpIgnoreForwards in Attr)
|
||||
and (Result.SubDesc=ctnsForwardDeclaration)))
|
||||
and (not ((phpIgnoreProcsWithBody in Attr)
|
||||
and (FindProcBody(Result)<>nil))) then begin
|
||||
CurProcName:=ExtractProcHead(Result,Attr);
|
||||
//writeln('TPascalParserTool.FindProcNode B "',CurProcName,'" =? "',ProcName,'"');
|
||||
if (CurProcName<>'')
|
||||
and (CompareTextIgnoringSpace(CurProcName,ProcName,false)=0) then
|
||||
CurProcHead:=ExtractProcHead(Result,Attr);
|
||||
writeln('TPascalParserTool.FindProcNode B "',CurProcHead,'" =? "',AProcHead,'"');
|
||||
if (CurProcHead<>'')
|
||||
and (CompareTextIgnoringSpace(CurProcHead,AProcHead,false)=0) then
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user