diff --git a/components/codetools/codetree.pas b/components/codetools/codetree.pas index e343fc0e54..f04b8f224d 100644 --- a/components/codetools/codetree.pas +++ b/components/codetools/codetree.pas @@ -212,6 +212,8 @@ type function ConsistencyCheck: integer; // 0 = ok end; + { TCodeTree } + TCodeTree = class private FNodeCount: integer; @@ -221,6 +223,7 @@ type procedure DeleteNode(ANode: TCodeTreeNode); procedure AddNodeAsLastChild(ParentNode, ANode: TCodeTreeNode); function FindLastPosition: integer; + function ContainsNode(ANode: TCodeTreeNode): boolean; procedure Clear; constructor Create; destructor Destroy; override; @@ -678,6 +681,14 @@ begin Result:=ANode.EndPos; end; +function TCodeTree.ContainsNode(ANode: TCodeTreeNode): boolean; +begin + if ANode=nil then exit(false); + while ANode.Parent<>nil do ANode:=ANode.Parent; + while ANode.PriorBrother<>nil do ANode:=ANode.PriorBrother; + Result:=ANode=Root; +end; + function TCodeTree.ConsistencyCheck: integer; // 0 = ok var RealNodeCount: integer; diff --git a/components/codetools/finddeclarationcache.pas b/components/codetools/finddeclarationcache.pas index 1ff04ef660..326bfe4168 100644 --- a/components/codetools/finddeclarationcache.pas +++ b/components/codetools/finddeclarationcache.pas @@ -82,14 +82,14 @@ type Identifier+Range -> Source Position and can be interpreted as: Identifier is a PChar to the beginning of an identifier string. - Range is a clenaed source range (CleanStartPos-CleanEndPos). + Range is a cleaned source range (CleanStartPos-CleanEndPos). Source position is a tuple of NewTool, NewNode, NewCleanPos. If the current context node is a child of a caching node and it is in the range, then the result is valid. If NewNode=nil then there is no such identifier valid at the context node. - Every node that define local identifiers contains a node cache. - These are: class, proc, record, withstatement + Every node that defines local identifiers contains a node cache. + These are: class, interface, proc, record, withstatement Because node caches can store information of used units, the cache must be deleted every time a used unit is changed. Currently all node caches are @@ -647,7 +647,7 @@ var OldEntry: PCodeTreeNodeCacheEntry; OldNode: TAVLTreeNode; NewSearchRangeFlags: TNodeCacheEntryFlags; - + function ParamsDebugReport: string; var s: string; @@ -704,8 +704,16 @@ var begin OldEntry:=nil; + // consistency checks if CleanStartPos>=CleanEndPos then RaiseConflictException('CleanStartPos>=CleanEndPos'); + if (NewNode<>nil) then begin + if NewTool=nil then + RaiseConflictException('NewNode<>nil and NewTool=nil'); + if not NewTool.Tree.ContainsNode(NewNode) then + RaiseConflictException('NewNode is not a node of NewTool'); + end; + {if GetIdentifier(Identifier)='TDefineAction' then begin DebugLn('[[[[======================================================'); DebugLn('[TCodeTreeNodeCache.Add] Ident=',GetIdentifier(Identifier), diff --git a/components/codetools/identcompletiontool.pas b/components/codetools/identcompletiontool.pas index 010da033b9..b9ed6cc0f9 100644 --- a/components/codetools/identcompletiontool.pas +++ b/components/codetools/identcompletiontool.pas @@ -74,7 +74,10 @@ type TIdentListItemFlag = ( iliHasChilds, - iliBaseExprTypeValid + iliBaseExprTypeValid, + iliIsFunction, + iliIsFunctionValid, + iliParamListValid ); TIdentListItemFlags = set of TIdentListItemFlag; @@ -84,7 +87,6 @@ type private FNext: TIdentifierListItem; FParamList: string; - FParamListValid: boolean; function GetParamList: string; procedure SetParamList(const AValue: string); public @@ -110,6 +112,7 @@ type function CanBeAssigned: boolean; procedure UpdateBaseContext; function HasChilds: boolean; + function IsFunction: boolean; procedure Clear; function CompareParamList(CompareItem: TIdentifierListItem): integer; public @@ -276,8 +279,8 @@ type Node: TCodeTreeNode); public function GatherIdentifiers(const CursorPos: TCodeXYPosition; - var IdentifierList: TIdentifierList; - BeautifyCodeOptions: TBeautifyCodeOptions): boolean; + var IdentifierList: TIdentifierList; + BeautifyCodeOptions: TBeautifyCodeOptions): boolean; function FindCodeContext(const CursorPos: TCodeXYPosition; out CodeContexts: TCodeContextInfo): boolean; end; @@ -854,86 +857,58 @@ const if ANode=nil then Result:=0; end; + procedure AddCompilerProcedure(const AProcName, AParameterList: PChar); + var + NewItem: TIdentifierListItem; + begin + NewItem:=TIdentifierListItem.Create( + icompUnknown, + false, + CompilerFuncHistoryIndex, + AProcName, + CompilerFuncLevel, + nil, + nil, + ctnProcedure); + NewItem.ParamList:=AParameterList; + CurrentIdentifierList.Add(NewItem); + end; + + procedure AddCompilerFunction(const AProcName, AParameterList, + AResultType: PChar); + var + NewItem: TIdentifierListItem; + begin + NewItem:=TIdentifierListItem.Create( + icompUnknown, + false, + CompilerFuncHistoryIndex, + AProcName, + CompilerFuncLevel, + nil, + nil, + ctnProcedure); + NewItem.ParamList:=AParameterList; + NewItem.Flags:=NewItem.Flags+[iliIsFunction,iliIsFunctionValid]; + CurrentIdentifierList.Add(NewItem); + end; + var NewItem: TIdentifierListItem; ProcNode: TCodeTreeNode; begin if Context.Node.Desc in AllPascalStatements then begin - // begin..end -> add 'SetLength' - NewItem:=TIdentifierListItem.Create( - icompUnknown, - false, - CompilerFuncHistoryIndex, - 'SetLength', - CompilerFuncLevel, - nil, - nil, - ctnProcedure); - NewItem.ParamList:='array of type; NewLength: integer'; - CurrentIdentifierList.Add(NewItem); - - // begin..end -> add 'copy' - NewItem:=TIdentifierListItem.Create( - icompUnknown, - false, - CompilerFuncHistoryIndex, - 'Copy', - CompilerFuncLevel, - nil, - nil, - ctnProcedure); - NewItem.ParamList:='const s: string; FromPosition, ToPosition: integer'; - CurrentIdentifierList.Add(NewItem); - - // begin..end -> add 'write' - NewItem:=TIdentifierListItem.Create( - icompUnknown, - false, - CompilerFuncHistoryIndex, - 'Write', - CompilerFuncLevel, - nil, - nil, - ctnProcedure); - NewItem.ParamList:='Args : Arguments'; - CurrentIdentifierList.Add(NewItem); - - // begin..end -> add 'writeln' - NewItem:=TIdentifierListItem.Create( - icompUnknown, - false, - CompilerFuncHistoryIndex, - 'WriteLn', - CompilerFuncLevel, - nil, - nil, - ctnProcedure); - NewItem.ParamList:='Args : Arguments'; - CurrentIdentifierList.Add(NewItem); - - // begin..end -> add 'read' - NewItem:=TIdentifierListItem.Create( - icompUnknown, - false, - CompilerFuncHistoryIndex, - 'Read', - CompilerFuncLevel, - nil, - nil, - ctnProcedure); - CurrentIdentifierList.Add(NewItem); - - // begin..end -> add 'readln' - NewItem:=TIdentifierListItem.Create( - icompUnknown, - false, - CompilerFuncHistoryIndex, - 'ReadLn', - CompilerFuncLevel, - nil, - nil, - ctnProcedure); - CurrentIdentifierList.Add(NewItem); + AddCompilerProcedure('SetLength','array of type; NewLength: integer'); + AddCompilerProcedure('Copy','const s: string; FromPosition, ToPosition: integer'); + AddCompilerProcedure('Write','Args : Arguments'); + AddCompilerProcedure('WriteLn','Args : Arguments'); + AddCompilerProcedure('Read',''); + AddCompilerProcedure('ReadLn',''); + AddCompilerFunction('Length','array of type','ordinal'); + AddCompilerFunction('High','Argument','ordinal'); + AddCompilerFunction('Low','Argument','ordinal'); + AddCompilerProcedure('Include','set of enum; enum'); + AddCompilerProcedure('Exclude','set of enum; enum'); if Context.Tool.NodeIsInAMethod(Context.Node) and (not CurrentIdentifierList.HasIdentifier('Self','')) then begin @@ -1411,7 +1386,6 @@ var function CheckContextIsParameter(var Ok: boolean): boolean; // returns true, on error or context is parameter - // returns false, if no error and context is not parameter var VarNameAtom, ProcNameAtom: TAtomPosition; ParameterIndex: integer; @@ -1420,15 +1394,17 @@ var StartInSubContext: Boolean; begin Result:=false; + // check if in a begin..end block if (CursorNode.Desc<>ctnBeginBlock) and (not CursorNode.HasParentOfType(ctnBeginBlock)) then exit; - //DebugLn('CheckContextIsParameter '); + // check is cursor is in a parameter list behind an identifier if not CheckParameterSyntax(CursorNode, CleanCursorPos, - VarNameAtom, ProcNameAtom, ParameterIndex) then exit; + VarNameAtom, ProcNameAtom, ParameterIndex) + then exit; if VarNameAtom.StartPos<1 then exit; //DebugLn('CheckContextIsParameter Variable=',GetAtom(VarNameAtom),' Proc=',GetAtom(ProcNameAtom),' ParameterIndex=',dbgs(ParameterIndex)); - // it is a parameter -> save ParameterIndex + // it is a parameter -> create context Result:=true; if CurrentContexts=nil then CurrentContexts:=TCodeContextInfo.Create; @@ -1446,9 +1422,9 @@ var CurrentContexts.EndPos:=SrcLen+1; FindCollectionContext(Params,ProcNameAtom.StartPos,CursorNode, - GatherContext,ContextExprStartPos,StartInSubContext); + GatherContext,ContextExprStartPos,StartInSubContext); - // gather declarations of parameter lists + // gather declarations of all parameter lists Params.ContextNode:=GatherContext.Node; Params.SetIdentifier(Self,@Src[ProcNameAtom.StartPos],@CollectAllContexts); Params.Flags:=[fdfSearchInAncestors,fdfCollect,fdfFindVariable]; @@ -1515,7 +1491,7 @@ end; function TIdentifierListItem.GetParamList: string; begin - if not FParamListValid then begin + if not (iliParamListValid in Flags) then begin // Note: if you implement param lists for other than ctnProcedure, check // CompareParamList if (Node<>nil) and (Node.Desc=ctnProcedure) then begin @@ -1525,7 +1501,7 @@ begin //debugln('TIdentifierListItem.GetParamList A ',GetIdentifier(Identifier),' ',Tool.MainFilename,' ',dbgs(Node.StartPos)); end else FParamList:=''; - FParamListValid:=true; + Include(Flags,iliParamListValid); end; Result:=FParamList; end; @@ -1533,7 +1509,7 @@ end; procedure TIdentifierListItem.SetParamList(const AValue: string); begin FParamList:=AValue; - FParamListValid:=true; + Include(Flags,iliParamListValid); end; function TIdentifierListItem.AsString: string; @@ -1641,10 +1617,20 @@ begin Result:=iliHasChilds in Flags; end; +function TIdentifierListItem.IsFunction: boolean; +begin + if not (iliIsFunctionValid in Flags) then begin + if (Node<>nil) + and Tool.NodeIsFunction(Node) then + Include(Flags,iliIsFunction); + Include(Flags,iliIsFunctionValid); + end; + Result:=iliIsFunction in Flags; +end; + procedure TIdentifierListItem.Clear; begin FParamList:=''; - FParamListValid:=false; Compatibility:=icompUnknown; HistoryIndex:=0; Identifier:=nil; diff --git a/ide/sourceeditprocs.pas b/ide/sourceeditprocs.pas index 0516de674a..cd5e108bce 100644 --- a/ide/sourceeditprocs.pas +++ b/ide/sourceeditprocs.pas @@ -166,8 +166,7 @@ begin end; ctnProcedure: - if (IdentItem.Node<>nil) - and IdentItem.Tool.NodeIsFunction(IdentItem.Node) then begin + if IdentItem.IsFunction then begin AColor:=clTeal; s:='function'; end else begin @@ -210,13 +209,15 @@ begin ACanvas.Font.Style:=ACanvas.Font.Style+[fsBold]; s:=GetIdentifier(IdentItem.Identifier); if MeasureOnly then - Inc(Result.X, ACanvas.TextWidth(s)) - else + Inc(Result.X, 1+ACanvas.TextWidth(s)) + else begin ACanvas.TextOut(x+1,y,s); - inc(x,ACanvas.TextWidth(s)); - if x>MaxX then exit; + inc(x,ACanvas.TextWidth(s)); + if x>MaxX then exit; + end; ACanvas.Font.Style:=ACanvas.Font.Style-[fsBold]; - + + s:=''; if IdentItem.Node<>nil then begin case IdentItem.Node.Desc of @@ -259,20 +260,27 @@ begin s:=copy(s,1,50); end; - else - exit; - end; end else begin // IdentItem.Node=nil - exit; + case IdentItem.GetDesc of + ctnProcedure: + begin + s:=IdentItem.ParamList; + if s<>'' then + s:='('+s+')'; + s:=s+';' + end; + end; end; - SetFontColor(clBlack); - if MeasureOnly then - Inc(Result.X, ACanvas.TextWidth(s)) - else - ACanvas.TextOut(x+1,y,s); + if s<>'' then begin + SetFontColor(clBlack); + if MeasureOnly then + Inc(Result.X, ACanvas.TextWidth(s)) + else + ACanvas.TextOut(x+1,y,s); + end; end else begin // parse AKey for text and style