diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 54e2f4bd67..6574439b78 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -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); diff --git a/components/codetools/customcodetool.pas b/components/codetools/customcodetool.pas index 3cdc49a11b..72c6797fdf 100644 --- a/components/codetools/customcodetool.pas +++ b/components/codetools/customcodetool.pas @@ -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; diff --git a/components/codetools/keywordfunclists.pas b/components/codetools/keywordfunclists.pas index 68c99b98d9..31092db433 100644 --- a/components/codetools/keywordfunclists.pas +++ b/components/codetools/keywordfunclists.pas @@ -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 diff --git a/components/codetools/methodjumptool.pas b/components/codetools/methodjumptool.pas index 33b8424f99..7bc7ded424 100644 --- a/components/codetools/methodjumptool.pas +++ b/components/codetools/methodjumptool.pas @@ -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); diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index 40cafd8b49..b7fd57a564 100644 --- a/components/codetools/pascalparsertool.pas +++ b/components/codetools/pascalparsertool.pas @@ -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;