diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 6bb09478c6..c057280ad1 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -53,6 +53,7 @@ type TCodeToolManager = class private + FAdjustTopLineDueToComment: boolean; FCatchExceptions: boolean; FCheckFilesOnDisk: boolean; FCurCodeTool: TCodeCompletionCodeTool; // current codetool @@ -123,6 +124,8 @@ type property ErrorTopLine: integer read fErrorTopLine; // tool settings + property AdjustTopLineDueToComment: boolean + read FAdjustTopLineDueToComment write FAdjustTopLineDueToComment; property CheckFilesOnDisk: boolean read FCheckFilesOnDisk write SetCheckFilesOnDisk; property IndentSize: integer read FIndentSize write SetIndentSize; @@ -280,13 +283,14 @@ begin SourceChangeCache.OnBeforeApplyChanges:=@BeforeApplyingChanges; SourceChangeCache.OnAfterApplyChanges:=@AfterApplyingChanges; GlobalValues:=TExpressionEvaluator.Create; - FSourceExtensions:='.pp;.pas;.lpr;.dpr;.dpk'; + FAdjustTopLineDueToComment:=true; FCatchExceptions:=true; - FWriteExceptions:=true; - FIndentSize:=2; - FVisibleEditorLines:=20; - FJumpCentered:=true; FCursorBeyondEOL:=true; + FIndentSize:=2; + FJumpCentered:=true; + FSourceExtensions:='.pp;.pas;.lpr;.dpr;.dpk'; + FVisibleEditorLines:=20; + FWriteExceptions:=true; FSourceTools:=TAVLTree.Create(@CompareCodeToolMainSources); end; @@ -1324,6 +1328,8 @@ begin Result.Scanner:=Code.Scanner; FSourceTools.Add(Result); end; + TCodeCompletionCodeTool(Result).AdjustTopLineDueToComment:= + FAdjustTopLineDueToComment; Result.CheckFilesOnDisk:=FCheckFilesOnDisk; Result.IndentSize:=FIndentSize; Result.VisibleEditorLines:=FVisibleEditorLines; diff --git a/components/codetools/codetree.pas b/components/codetools/codetree.pas index 3241695d26..8cbdfe770f 100644 --- a/components/codetools/codetree.pas +++ b/components/codetools/codetree.pas @@ -92,12 +92,13 @@ const ctnProcedureType = 66; ctnSetType = 67; ctnRangeType = 68; - ctnEnumType = 69; - ctnLabelType = 70; - ctnTypeType = 71; - ctnFileType = 72; - ctnPointerType = 73; - ctnClassOfType = 74; + ctnEnumerationType = 69; + ctnEnumIdentifier = 70; + ctnLabelType = 71; + ctnTypeType = 72; + ctnFileType = 73; + ctnPointerType = 74; + ctnClassOfType = 75; ctnBeginBlock = 80; ctnAsmBlock = 81; @@ -122,8 +123,9 @@ const AllPascalTypes = [ctnClass, ctnIdentifier,ctnArrayType,ctnRecordType,ctnRecordCase,ctnRecordVariant, - ctnProcedureType,ctnSetType,ctnRangeType,ctnEnumType,ctnLabelType, - ctnTypeType,ctnFileType,ctnPointerType,ctnClassOfType]; + ctnProcedureType,ctnSetType,ctnRangeType,ctnEnumerationType, + ctnEnumIdentifier,ctnLabelType,ctnTypeType,ctnFileType,ctnPointerType, + ctnClassOfType]; AllSourceTypes = [ctnProgram,ctnPackage,ctnLibrary,ctnUnit]; AllUsableSoureTypes = @@ -290,15 +292,19 @@ begin ctnProcedureType: Result:='Procedure Type'; ctnSetType: Result:='Set Type'; ctnRangeType: Result:='Subrange Type'; - ctnEnumType: Result:='Enumeration Type'; + ctnEnumerationType: Result:='Enumeration Type'; + ctnEnumIdentifier: Result:='Enumeration Identifier'; ctnLabelType: Result:='Label Type'; ctnTypeType: Result:='''Type'' Type'; ctnFileType: Result:='File Type'; - ctnPointerType: Result:='Pointer ''^'' Type'; + ctnPointerType: Result:='Pointer ^ Type'; ctnClassOfType: Result:='Class Of Type'; ctnWithVariable: Result:='With Variable'; - ctnWithStatement: Result:='With Statement' + ctnWithStatement: Result:='With Statement'; + ctnCaseBlock: Result:='Case Block'; + ctnCaseVariable: Result:='Case Variable'; + ctnCaseStatement: Result:='Case Statement'; else Result:='invalid descriptor'; diff --git a/components/codetools/customcodetool.pas b/components/codetools/customcodetool.pas index 2214ca48ac..43b942579d 100644 --- a/components/codetools/customcodetool.pas +++ b/components/codetools/customcodetool.pas @@ -191,9 +191,19 @@ end; procedure TCustomCodeTool.RaiseException(const AMessage: string); var CaretXY: TCodeXYPosition; CursorPos: integer; + Node: TCodeTreeNode; begin ErrorPosition.Code:=nil; CursorPos:=CurPos.StartPos; + // close all open nodes, so that FindDeepestNodeAtPos works in the code + // already parsed + Node:=CurNode; + while (Node<>nil) do begin + if (Node.StartPos>=Node.EndPos) then + Node.EndPos:=CursorPos; + Node:=Node.Parent; + end; + // convert cursor pos to caret pos, which is more human readable if (CursorPos>SrcLen) and (SrcLen>0) then CursorPos:=SrcLen; if (CleanPosToCaret(CursorPos,CaretXY)) and (CaretXY.Code<>nil) then begin @@ -202,6 +212,7 @@ begin ErrorPosition.Code:=TCodeBuffer(Scanner.MainCode); ErrorPosition.Y:=-1; end; + // raise the exception raise ECodeToolError.Create(Self,AMessage); end; diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 0c3e33c860..c837375f74 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -29,15 +29,15 @@ - many things, search for 'ToDo' - Difficulties: - 1. Searching recursively + 1. SOLVED. Searching recursively - ParentNodes - Ancestor Classes/Objects/Interfaces - with statements - operators: '.', '()', 'A()', '^', 'inherited' - 2. Searching enums must be searched in sub nodes + 2. SOLVED. Searching enums must be searched in sub nodes -> all classes node trees must be built - 3. Searching in used units (interface USES and implementation USES) - 4. Searching forward for pointer types e.g. ^Tralala + 3. SOLVED. Searching in used units (interface USES and implementation USES) + 4. SOLVED. Searching forward for pointer types e.g. ^Tralala 5. Mass Search: searching a compatible proc will result in searching every parameter type of every reachable proc (implementation section + interface section @@ -673,7 +673,7 @@ if (ContextNode.Desc=ctnClass) then end; end; - ctnTypeDefinition, ctnVarDefinition, ctnConstDefinition, ctnEnumType: + ctnTypeDefinition, ctnVarDefinition, ctnConstDefinition: begin if CompareSrcIdentifiers(ContextNode.StartPos,Params.Identifier) then begin @@ -901,7 +901,7 @@ begin BuildSubTreeForClass(Params.ContextNode); Params.ContextNode:=Params.ContextNode.FirstChild; while Params.ContextNode<>nil do begin - if (Params.ContextNode.Desc in [ctnEnumType]) + if (Params.ContextNode.Desc in [ctnEnumIdentifier]) and CompareSrcIdentifiers(Params.ContextNode.StartPos,Params.Identifier) then begin // identifier found @@ -1219,9 +1219,7 @@ writeln(''); Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); Params.Load(OldInput); end; - - // ToDo string, ansistring, widestring, shortstring - + else MoveCursorToCleanPos(CurAtom.StartPos); RaiseException('illegal qualifier'); @@ -1246,7 +1244,7 @@ writeln(''); if Result.Node<>Params.ContextNode then begin // typecast or function - // ToDo: proc overloading, if parameter types incompatible search next + // ToDo: proc overloading, if parameter types incompatible, search next end else begin // expression @@ -1831,16 +1829,57 @@ end; function TFindDeclarationTool.FindExpressionResultType( Params: TFindDeclarationParams; StartPos, EndPos: integer): TFindContext; +{ + ToDo: + - operators + - mixing ansistring and shortstring gives ansistring + - Pointer +,- Pointer gives Pointer + - Sets: + [enum1] gives set of enumeration type + set *,-,+ set gives set of same type + set <>,=,<,> set gives boolean + - precedence rules table: + 1. brackets + 2. not @ sign + 3. * / div mod and shl shr as + 4. + - or xor + 5. < <> > <= >= in is + - + + - operator overloading + - internal types. e.g. string[], ansistring[], shortstring[], pchar[] to char + - the type of a subrange is the type of the first constant/enum/number/char + - predefined types: + ordinal: + int64, cardinal, QWord, boolean, bytebool, longbool, char + + real: + real, single, double, extended, comp + + - predefined functions: + function pred(ordinal type): ordinal constant of same type; + function succ(ordinal type): ordinal constant of same type; + function ord(ordinal type): ordinal type; + val? + function low(array): type of leftmost index type in the array; + function high(array): type of leftmost index type in the array; + procedure dec(ordinal var); + procedure dec(ordinal var; ordinal type); + procedure dec(pointer var); + procedure dec(pointer var; ordinal type); + procedure inc(ordinal var); + procedure inc(ordinal var; ordinal type); + procedure inc(pointer var); + procedure inc(pointer var; ordinal type); + procedure write(...); + procedure writeln(...); + function SizeOf(type): ordinal constant; + typeinfo? + uniquestring? + procedure include(set type,enum identifier); + procedure exclude(set type,enum identifier); +} begin - - // ToDo: operators - // ToDo: operator overloading - // ToDo: internal types. e.g. String[] is of type char - - // ToDo: constant types: e.g. 1 is constnumber, #1 is constchar, - // '1' is conststring, 1.0 is constreal - // ToDo: set types: [], A * B - // This is a quick hack: Just return the type of the last variable. MoveCursorToCleanPos(EndPos); Result:=FindContextNodeAtCursor(Params); diff --git a/components/codetools/methodjumptool.pas b/components/codetools/methodjumptool.pas index 5b7f34b8ae..e2ef9a6a2c 100644 --- a/components/codetools/methodjumptool.pas +++ b/components/codetools/methodjumptool.pas @@ -42,8 +42,12 @@ uses SourceLog, KeywordFuncLists, BasicCodeTools, LinkScanner, CodeCache, AVL_Tree, TypInfo, SourceChanger; +{ $DEFINE CTDEBUG} + type TMethodJumpingCodeTool = class(TStandardCodeTool) + private + FAdjustTopLineDueToComment: boolean; public function FindJumpPoint(CursorPos: TCodeXYPosition; var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean; @@ -54,9 +58,15 @@ type function FindFirstDifferenceNode(SearchForNodes, SearchInNodes: TAVLTree; var DiffTxtPos: integer): TAVLTreeNode; function JumpToNode(ANode: TCodeTreeNode; - var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean; + var NewPos: TCodeXYPosition; var NewTopLine: integer; + IgnoreJumpCentered: boolean): boolean; + function JumpToCleanPos(NewCleanPos, NewTopLineCleanPos: integer; + var NewPos: TCodeXYPosition; var NewTopLine: integer; + IgnoreJumpCentered: boolean): boolean; function FindNodeInTree(ATree: TAVLTree; const UpperCode: string): TCodeTreeNodeExtension; + property AdjustTopLineDueToComment: boolean + read FAdjustTopLineDueToComment write FAdjustTopLineDueToComment; end; @@ -78,7 +88,6 @@ function TMethodJumpingCodeTool.FindJumpPoint(CursorPos: TCodeXYPosition; FromProcHead, ToProcHead: string; Attr: TProcHeadAttributes; DiffPos: integer; - NewProcCaret: TCodeXYPosition; ProcNode: TCodeTreeNode; begin Result:=false; @@ -99,11 +108,6 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode A ',ProcNode<>nil 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); @@ -138,16 +142,7 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode C "',FromProcHead 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; + Result:=JumpToCleanPos(DiffPos,ProcNode.StartPos,NewPos,NewTopLine,true); end; end; @@ -158,7 +153,6 @@ var CursorNode, ClassNode, ProcNode, StartNode, TypeSectionNode: TCodeTreeNode; SearchedClassname: string; SearchForNodes, SearchInNodes: TAVLTree; DiffNode: TAVLTreeNode; - NewProcCaret: TCodeXYPosition; begin Result:=false; NewPos:=CursorPos; @@ -261,16 +255,8 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint N ',DiffTxtPos); {$ENDIF} if DiffTxtPos>0 then begin // move cursor to first difference in procedure head - if not CleanPosToCaret(DiffTxtPos,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; + Result:=JumpToCleanPos(DiffTxtPos,ProcNode.StartPos, + NewPos,NewTopLine,true); end else // find good position in procedure body Result:=FindJumpPointInProcNode(ProcNode,NewPos,NewTopLine); @@ -373,17 +359,8 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint 4G ',DiffNode<>nil); DiffTxtPos:=ExtractFoundPos; if DiffTxtPos>0 then begin // move cursor to first difference in procedure head - if not CleanPosToCaret(DiffTxtPos,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; + Result:=JumpToCleanPos(DiffTxtPos,ProcNode.StartPos, + NewPos,NewTopLine,true); end else // find good position in procedure body Result:=FindJumpPointInProcNode(ProcNode,NewPos,NewTopLine); @@ -406,14 +383,14 @@ function TMethodJumpingCodeTool.FindJumpPointInProcNode(ProcNode: TCodeTreeNode; var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean; var DestNode: TCodeTreeNode; i, NewCleanPos: integer; - NewProcCaret: TCodeXYPosition; begin Result:=false; // search method body DestNode:=FindProcBody(ProcNode); if DestNode=nil then begin // proc without body -> jump to proc node header - Result:=JumpToNode(ProcNode.FirstChild,NewPos,NewTopLine); + Result:=JumpToCleanPos(ProcNode.FirstChild.StartPos,ProcNode.Startpos, + NewPos,NewTopLine,false); exit; end; // search good position @@ -467,17 +444,10 @@ writeln('[TMethodJumpingCodeTool.FindJumpPointInProcNode] B i=',i,' IndentSize=' end else i:=0; if NewCleanPos>SrcLen then NewCleanPos:=SrcLen; - if not CleanPosToCaret(NewCleanPos,NewPos) then exit; + if not JumpToCleanPos(NewCleanPos,ProcNode.StartPos,NewPos,NewTopLine,true) + then exit; if CursorBeyondEOL then inc(NewPos.x,i); - // 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; @@ -600,17 +570,13 @@ begin end; function TMethodJumpingCodeTool.JumpToNode(ANode: TCodeTreeNode; - var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean; + var NewPos: TCodeXYPosition; var NewTopLine: integer; + IgnoreJumpCentered: boolean): boolean; begin Result:=false; if (ANode=nil) or (ANode.StartPos<1) then exit; - if not CleanPosToCaret(ANode.StartPos,NewPos) then exit; - NewTopLine:=NewPos.Y; - if JumpCentered then begin - dec(NewTopLine,VisibleEditorLines div 2); - if NewTopLine<1 then NewTopLine:=1; - end; - Result:=true; + Result:=JumpToCleanPos(ANode.StartPos,ANode.StartPos, + NewPos,NewTopLine,IgnoreJumpCentered); end; function TMethodJumpingCodeTool.FindNodeInTree(ATree: TAVLTree; @@ -632,6 +598,49 @@ begin Result:=nil; end; +function TMethodJumpingCodeTool.JumpToCleanPos(NewCleanPos, + NewTopLineCleanPos: integer; var NewPos: TCodeXYPosition; + var NewTopLine: integer; IgnoreJumpCentered: boolean): boolean; +var CenteredTopLine: integer; + NewTopLinePos: TCodeXYPosition; +begin + Result:=false; + // convert clean position to line, column and code + if not CleanPosToCaret(NewCleanPos,NewPos) then exit; + NewTopLine:=NewPos.Y; + if AdjustTopLineDueToComment then begin + // if there is a comment in front of the top position, it probably belongs + // to the destination code + // -> adjust the topline position, so that the comment is visible + NewTopLineCleanPos:=FindLineEndOrCodeInFrontOfPosition(Src, + NewTopLineCleanPos,Scanner.NestedComments); + if (NewTopLineCleanPos>=1) and (Src[NewTopLineCleanPos] in [#13,#10]) + then begin + inc(NewTopLineCleanPos); + if (Src[NewTopLineCleanPos] in [#10,#13]) + and (Src[NewTopLineCleanPos]<>Src[NewTopLineCleanPos-1]) then + inc(NewTopLineCleanPos); + end; + end; + // convert clean top line position to line, column and code + if not CleanPosToCaret(NewTopLineCleanPos,NewTopLinePos) then exit; + if NewTopLinePos.Code=NewPos.Code then begin + // top line position is in the same code as the destination position + NewTopLine:=NewTopLinePos.Y; + if JumpCentered and (not IgnoreJumpCentered) then begin + // center the destination position in the source editor + CenteredTopLine:=NewPos.Y-VisibleEditorLines div 2; + if CenteredTopLine read all enums + CreateChildNode; // begin enumeration + CurNode.Desc:=ctnEnumerationType; repeat ReadNextAtom; // read enum name if AtomIsChar(')') then break; - CreateChildNode; - CurNode.Desc:=ctnEnumType; - CurNode.EndPos:=CurPos.EndPos; AtomIsIdentifier(true); + CreateChildNode; + CurNode.Desc:=ctnEnumIdentifier; + CurNode.EndPos:=CurPos.EndPos; + EndChildNode; // close enum node ReadNextAtom; if AtomIs(':=') then begin // read ordinal value - repeat - ReadNextAtom; - if AtomIsChar('(') or AtomIsChar('[') then - ReadTilBracketClose(true) - else if AtomIsChar(')') or AtomIsChar(',') then - break - else if AtomIsKeyWord then - RaiseException( - 'unexpected keyword '+GetAtom+' found'); - until CurPos.StartPos>SrcLen; - CurNode.EndPos:=CurPos.StartPos; + ReadNextAtom; + ReadConstant(true,false,[]); end; - EndChildNode; // close enum node if AtomIsChar(')') then break; if not AtomIsChar(',') then RaiseException(') expected, but '+GetAtom+' found'); until false; CurNode.EndPos:=CurPos.EndPos; + EndChildNode; // close enumeration ReadNextAtom; end else RaiseException('invalid type');