From e81fcb8abc68fef6a312ae5f708dddb0fad9a91d Mon Sep 17 00:00:00 2001 From: mattias Date: Wed, 19 Sep 2007 09:30:53 +0000 Subject: [PATCH] codetools: fixed mem leak when searching for overloaded procs with default values, IDE: improved searching for event types declaration for TMethodPropertyEditor git-svn-id: trunk@12076 - --- components/codetools/codetoolmanager.pas | 25 +- components/codetools/eventcodetool.pas | 60 ++- .../codetools/examples/finddeclaration.lpi | 7 +- .../codetools/examples/finddeclaration.lpr | 129 +++--- components/codetools/finddeclarationtool.pas | 422 ++++++++++++------ components/codetools/sourcechanger.pas | 4 + components/codetools/stdcodetools.pas | 4 +- ide/main.pp | 10 +- ide/uniteditor.pp | 2 + ideintf/propedits.pp | 32 +- 10 files changed, 436 insertions(+), 259 deletions(-) diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 848e4d0320..2a52d4dc97 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -614,17 +614,15 @@ type function CreatePublishedMethod(Code: TCodeBuffer; const AClassName, NewMethodName: string; ATypeInfo: PTypeInfo; UseTypeInfoForParameters: boolean = false; - const ATypeUnitName: string = ''; - APropertyOwner: TPersistent = nil; - const APropertyName: string = ''): boolean; + const APropertyUnitName: string = ''; const APropertyPath: string = '' + ): boolean; // private class parts function CreatePrivateMethod(Code: TCodeBuffer; const AClassName, NewMethodName: string; ATypeInfo: PTypeInfo; UseTypeInfoForParameters: boolean = false; - const ATypeUnitName: string = ''; - APropertyOwner: TPersistent = nil; const APropertyName: string = '' - ): boolean; + const APropertyUnitName: string = ''; + const APropertyPath: string = ''): boolean; // IDE % directives function GetIDEDirectives(Code: TCodeBuffer; @@ -2700,8 +2698,8 @@ end; function TCodeToolManager.CreatePublishedMethod(Code: TCodeBuffer; const AClassName, NewMethodName: string; ATypeInfo: PTypeInfo; - UseTypeInfoForParameters: boolean; const ATypeUnitName: string; - APropertyOwner: TPersistent; const APropertyName: string): boolean; + UseTypeInfoForParameters: boolean; + const APropertyUnitName: string; const APropertyPath: string): boolean; begin {$IFDEF CTDEBUG} DebugLn('TCodeToolManager.CreatePublishedMethod A'); @@ -2711,9 +2709,7 @@ begin try SourceChangeCache.Clear; Result:=FCurCodeTool.CreateMethod(UpperCaseStr(AClassName), - NewMethodName,ATypeInfo, - ATypeUnitName, - APropertyOwner,APropertyName, + NewMethodName,ATypeInfo,APropertyUnitName,APropertyPath, SourceChangeCache,UseTypeInfoForParameters,pcsPublished); except on e: Exception do Result:=HandleException(e); @@ -2722,8 +2718,8 @@ end; function TCodeToolManager.CreatePrivateMethod(Code: TCodeBuffer; const AClassName, NewMethodName: string; ATypeInfo: PTypeInfo; - UseTypeInfoForParameters: boolean; const ATypeUnitName: string; - APropertyOwner: TPersistent; const APropertyName: string): boolean; + UseTypeInfoForParameters: boolean; + const APropertyUnitName, APropertyPath: string): boolean; begin {$IFDEF CTDEBUG} DebugLn('TCodeToolManager.CreatePrivateMethod A'); @@ -2733,8 +2729,7 @@ begin try SourceChangeCache.Clear; Result:=FCurCodeTool.CreateMethod(UpperCaseStr(AClassName), - NewMethodName,ATypeInfo, - ATypeUnitName,APropertyOwner,APropertyName, + NewMethodName,ATypeInfo,APropertyUnitName,APropertyPath, SourceChangeCache,UseTypeInfoForParameters,pcsPrivate); except on e: Exception do Result:=HandleException(e); diff --git a/components/codetools/eventcodetool.pas b/components/codetools/eventcodetool.pas index a110f81886..f95476f2b0 100644 --- a/components/codetools/eventcodetool.pas +++ b/components/codetools/eventcodetool.pas @@ -87,16 +87,13 @@ type function CreateMethod(const UpperClassName, AMethodName: string; ATypeInfo: PTypeInfo; - const ATypeUnitName: string; - APropertyOwner: TPersistent; const APropertyName: string; + const APropertyUnitName, APropertyPath: string; SourceChangeCache: TSourceChangeCache; UseTypeInfoForParameters: boolean = false; Section: TPascalClassSection = pcsPublished): boolean; function CreateMethod(ClassNode: TCodeTreeNode; const AMethodName: string; - ATypeInfo: PTypeInfo; - const ATypeUnitName: string; - APropertyOwner: TPersistent; const APropertyName: string; + ATypeInfo: PTypeInfo; const APropertyUnitName, APropertyPath: string; SourceChangeCache: TSourceChangeCache; UseTypeInfoForParameters: boolean = false; Section: TPascalClassSection = pcsPublished): boolean; @@ -418,7 +415,7 @@ begin end; Params.SetIdentifier(Self,@TypeName[1],nil); Params.Flags:=[fdfExceptionOnNotFound,fdfSearchInParentNodes]; - DebugLn(['TEventsCodeTool.FindMethodTypeInfo TypeName=',TypeName,' MainFilename=',MainFilename]); + //DebugLn(['TEventsCodeTool.FindMethodTypeInfo TypeName=',TypeName,' MainFilename=',MainFilename]); FindIdentifierInContext(Params); // find proc node if Params.NewNode.Desc<>ctnTypeDefinition then begin @@ -648,8 +645,8 @@ begin end; function TEventsCodeTool.CreateMethod(const UpperClassName, - AMethodName: string; ATypeInfo: PTypeInfo; const ATypeUnitName: string; - APropertyOwner: TPersistent; const APropertyName: string; + AMethodName: string; ATypeInfo: PTypeInfo; + const APropertyUnitName, APropertyPath: string; SourceChangeCache: TSourceChangeCache; UseTypeInfoForParameters: boolean; Section: TPascalClassSection): boolean; @@ -658,14 +655,14 @@ begin Result:=false; BuildTree(false); AClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true); - Result:=CreateMethod(AClassNode,AMethodName,ATypeInfo,ATypeUnitName, - APropertyOwner,APropertyName, + Result:=CreateMethod(AClassNode,AMethodName,ATypeInfo, + APropertyUnitName,APropertyPath, SourceChangeCache,UseTypeInfoForParameters,Section); end; function TEventsCodeTool.CreateMethod(ClassNode: TCodeTreeNode; - const AMethodName: string; ATypeInfo: PTypeInfo; const ATypeUnitName: string; - APropertyOwner: TPersistent; const APropertyName: string; + const AMethodName: string; ATypeInfo: PTypeInfo; + const APropertyUnitName, APropertyPath: string; SourceChangeCache: TSourceChangeCache; UseTypeInfoForParameters: boolean; Section: TPascalClassSection): boolean; @@ -679,6 +676,35 @@ function TEventsCodeTool.CreateMethod(ClassNode: TCodeTreeNode; // search every parameter type and collect units end; + function FindPropertyType(out FindContext: TFindContext): boolean; + begin + Result:=false; + if APropertyPath<>'' then begin + // find unit of property + if APropertyUnitName='' then begin + FindContext.Tool:=Self; + end else begin + FindContext.Tool:=FindCodeToolForUsedUnit(APropertyUnitName,'',true); + if FindContext.Tool=nil then + raise Exception.Create('failed to get codetool for unit '+APropertyUnitName); + end; + // find property with type + if not FindContext.Tool.FindDeclarationOfPropertyPath( + APropertyPath,FindContext,true) + then exit; + if FindContext.Node.Desc<>ctnProperty then + FindContext.Tool.RaiseException( + APropertyPath+' is not a property.' + +' See '+FindContext.Tool.MainFilename + +' '+FindContext.Tool.CleanPosToStr(FindContext.Node.StartPos)); + // find type + FindContext:=(FindContext.Tool as TEventsCodeTool) + .FindMethodTypeInfo(ATypeInfo,''); + end else + FindContext:=FindMethodTypeInfo(ATypeInfo,APropertyUnitName); + Result:=true; + end; + var CleanMethodDefinition, MethodDefinition: string; FindContext: TFindContext; @@ -705,13 +731,7 @@ begin [phpWithoutClassName, phpWithoutName, phpInUpperCase]); end else begin // search typeinfo in source - {$IFDEF EnableNewFindMethodTypeInfo} - if (APropertyOwner<>nil) - and (APropertyName<>'') then - FindContext:=FindMethodTypeInfo(ATypeInfo,APropertyOwner,APropertyName) - else - {$ENDIF} - FindContext:=FindMethodTypeInfo(ATypeInfo,ATypeUnitName); + if not FindPropertyType(FindContext) then exit; AddNeededUnits(FindContext); CleanMethodDefinition:=UpperCaseStr(AMethodName) +FindContext.Tool.ExtractProcHead(FindContext.Node, @@ -837,7 +857,7 @@ begin {$ENDIF} Result.Add(CurExprType); - Params.Load(OldInput); + Params.Load(OldInput,true); end; end; diff --git a/components/codetools/examples/finddeclaration.lpi b/components/codetools/examples/finddeclaration.lpi index f0bbaa107e..f484bdedf7 100644 --- a/components/codetools/examples/finddeclaration.lpi +++ b/components/codetools/examples/finddeclaration.lpi @@ -25,7 +25,7 @@ - + @@ -36,11 +36,6 @@ - - - - - diff --git a/components/codetools/examples/finddeclaration.lpr b/components/codetools/examples/finddeclaration.lpr index be616cc2eb..776cf58944 100644 --- a/components/codetools/examples/finddeclaration.lpr +++ b/components/codetools/examples/finddeclaration.lpr @@ -30,7 +30,7 @@ program FindDeclaration; uses Classes, SysUtils, CodeCache, CodeToolManager, DefineTemplates, - CodeToolsConfig, SimpleUnit1, OverloadedFunction; + CodeToolsConfig, SimpleUnit1; const ConfigFilename = 'codetools.config'; @@ -50,72 +50,77 @@ begin // setup the Options Options:=TCodeToolsOptions.Create; + try - // To not parse the FPC sources every time, the options are saved to a file. - if FileExists(ConfigFilename) then - Options.LoadFromFile(ConfigFilename); + // To not parse the FPC sources every time, the options are saved to a file. + if FileExists(ConfigFilename) then + Options.LoadFromFile(ConfigFilename); - // setup your paths - writeln('Config=',ConfigFilename); - if FileExists(ConfigFilename) then begin - Options.LoadFromFile(ConfigFilename); - end else begin - Options.InitWithEnvironmentVariables; - if Options.FPCPath='' then - Options.FPCPath:='/usr/bin/ppc386'; - if Options.FPCSrcDir='' then + // setup your paths + writeln('Config=',ConfigFilename); + if FileExists(ConfigFilename) then begin + Options.LoadFromFile(ConfigFilename); + end else begin + Options.InitWithEnvironmentVariables; + if Options.FPCPath='' then + Options.FPCPath:='/usr/bin/ppc386'; + if Options.FPCSrcDir='' then + Options.FPCSrcDir:=ExpandFileName('~/freepascal/fpc'); + if Options.LazarusSrcDir='' then + Options.LazarusSrcDir:=ExpandFileName('~/pascal/lazarus'); + { Linux } + {Options.FPCPath:='/usr/bin/ppc386'; Options.FPCSrcDir:=ExpandFileName('~/freepascal/fpc'); - if Options.LazarusSrcDir='' then - Options.LazarusSrcDir:=ExpandFileName('~/pascal/lazarus'); - { Linux } - {Options.FPCPath:='/usr/bin/ppc386'; - Options.FPCSrcDir:=ExpandFileName('~/freepascal/fpc'); - Options.LazarusSrcDir:=ExpandFileName('~/pascal/lazarus');} + Options.LazarusSrcDir:=ExpandFileName('~/pascal/lazarus');} - { Windows - Options.FPCPath:='C:\lazarus\fpc\2.0.4\bin\i386-win32\ppc386.exe'; - Options.FPCSrcDir:='C:\lazarus\fpc\2.0.4\source'; - Options.LazarusSrcDir:='C:\lazarus\';} + { Windows + Options.FPCPath:='C:\lazarus\fpc\2.0.4\bin\i386-win32\ppc386.exe'; + Options.FPCSrcDir:='C:\lazarus\fpc\2.0.4\source'; + Options.LazarusSrcDir:='C:\lazarus\';} + end; + + // optional: ProjectDir and TestPascalFile exists only to easily test some + // things. + Options.ProjectDir:=SetDirSeparators(GetCurrentDir+'/scanexamples/'); + Options.TestPascalFile:=Options.ProjectDir+'simpleunit1.pas'; + + // init the codetools + if not Options.UnitLinkListValid then + writeln('Scanning FPC sources may take a while ...'); + CodeToolBoss.Init(Options); + + // save the options and the FPC unit links results. + Options.SaveToFile(ConfigFilename); + + // Example: find declaration of 'TObject' + X:=5; + Y:=43; + + writeln('FPCSrcDir=',Options.FPCSrcDir); + writeln('FPC=',Options.FPCPath); + if (ParamCount>=3) then begin + Options.TestPascalFile:=ExpandFileName(ParamStr(1)); + X:=StrToInt(ParamStr(2)); + Y:=StrToInt(ParamStr(3)); + end; + + // Step 1: load the file + Code:=CodeToolBoss.LoadFile(Options.TestPascalFile,false,false); + if Code=nil then + raise Exception.Create('loading failed '+Options.TestPascalFile); + + // Step 2: find declaration + if CodeToolBoss.FindDeclaration(Code,X,Y,NewCode,NewX,NewY,NewTopLine) then + begin + writeln('Declaration found: ',NewCode.Filename,' Line=',NewY,' Column=',NewX); + end else begin + writeln('Declaration not found: ',CodeToolBoss.ErrorMessage); + end; + except + on E: Exception do begin + writeln(E.Message); + end; end; - - // optional: ProjectDir and TestPascalFile exists only to easily test some - // things. - Options.ProjectDir:=SetDirSeparators(GetCurrentDir+'/scanexamples/'); - Options.TestPascalFile:=Options.ProjectDir+'simpleunit1.pas'; - - // init the codetools - if not Options.UnitLinkListValid then - writeln('Scanning FPC sources may take a while ...'); - CodeToolBoss.Init(Options); - - // save the options and the FPC unit links results. - Options.SaveToFile(ConfigFilename); - - // Example: find declaration of 'TObject' - X:=5; - Y:=43; - - writeln('FPCSrcDir=',Options.FPCSrcDir); - writeln('FPC=',Options.FPCPath); - if (ParamCount>=3) then begin - Options.TestPascalFile:=ExpandFileName(ParamStr(1)); - X:=StrToInt(ParamStr(2)); - Y:=StrToInt(ParamStr(3)); - end; - - // Step 1: load the file - Code:=CodeToolBoss.LoadFile(Options.TestPascalFile,false,false); - if Code=nil then - raise Exception.Create('loading failed '+Options.TestPascalFile); - - // Step 2: find declaration - if CodeToolBoss.FindDeclaration(Code,X,Y,NewCode,NewX,NewY,NewTopLine) then - begin - writeln('Declaration found: ',NewCode.Filename,' Line=',NewY,' Column=',NewX); - end else begin - writeln('Declaration not found: ',CodeToolBoss.ErrorMessage); - end; - Options.Free; end. diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 3d4dd139e3..ad2ccbcbd1 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -393,6 +393,7 @@ type //---------------------------------------------------------------------------- // TFoundProc is used for comparing overloaded procs + PFoundProc = ^TFoundProc; TFoundProc = record // the expression input list, which should fit into the searched proc ExprInputList: TExprTypeList; @@ -403,8 +404,10 @@ type CacheValid: boolean; ProcCompatibility: TTypeCompatibility; ParamCompatibilityList: TTypeCompatibilityList; + // each TFindDeclarationParams has a list of PFoundProc + Owner: TObject; + Next, Prior: PFoundProc; end; - PFoundProc = ^TFoundProc; //--------------------------------------------------------------------------- type @@ -433,9 +436,33 @@ type FoundProc: PFoundProc; end; - { TFindDeclarationParams } + { TFindDeclarationParams + This contains the parameters for find declaration, the result, the hooks + and the memory management for dynamic search data. + It can be re-used. That means, the search parameters can be saved, changed + and restored (load). + The static parameters are stored on the stack, while the dynamic data + (e.g. FoundProc) is stored in a private list (FirstFoundProc). + For speed reasons the find declaration does not use try..finally and that's + why some saved data is not explicitely freed. Therefore the Load method + frees all dynamic data, that was later saved too. + That's why the following code is forbidden: + Save(Data1); + Save(Data2); + Load(Data1); // this will free Data2 + Load(Data2); + + When searching a procedure, the parameter list must be compared. + The parameter list of the currently best fitting procedure is stored in + FoundProc. + } TFindDeclarationParams = class(TObject) + private + FirstFoundProc: PFoundProc;//list of all saved PFoundProc + LastFoundProc: PFoundProc; + procedure FreeFoundProc(aFoundProc: PFoundProc; FreeNext: boolean); + procedure RemoveFoundProcFromList(aFoundProc: PFoundProc); public // input parameters: Flags: TFindDeclarationFlags; @@ -457,7 +484,7 @@ type destructor Destroy; override; procedure Clear; procedure Save(var Input: TFindDeclarationInput); - procedure Load(var Input: TFindDeclarationInput); + procedure Load(Input: TFindDeclarationInput; FreeInput: boolean); procedure SetResult(const AFindContext: TFindContext); procedure SetResult(ANewCodeTool: TFindDeclarationTool; ANewNode: TCodeTreeNode); @@ -678,7 +705,10 @@ type function FindDeclarationWithMainUsesSection(const Identifier: string; var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean; function FindDeclarationOfPropertyPath(const PropertyPath: string; - var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean; + out NewContext: TFindContext; IgnoreTypeLess: boolean = false): boolean; + function FindDeclarationOfPropertyPath(const PropertyPath: string; + var NewPos: TCodeXYPosition; var NewTopLine: integer; + IgnoreTypeLess: boolean = false): boolean; function FindDeclarationNodeInInterface(const Identifier: string; BuildTheTree: Boolean): TCodeTreeNode; @@ -1411,8 +1441,8 @@ begin end; function TFindDeclarationTool.FindDeclarationOfPropertyPath( - const PropertyPath: string; var NewPos: TCodeXYPosition; - var NewTopLine: integer): boolean; + const PropertyPath: string; out NewContext: TFindContext; + IgnoreTypeLess: boolean): boolean; // example: PropertyPath='TForm1.Font.Color' var StartPos: Integer; @@ -1431,14 +1461,16 @@ var StartPos:=EndPos+1; end; end; - + var Params: TFindDeclarationParams; Identifier: String; IsLastProperty: Boolean; Context: TFindContext; + IsTypeLess: Boolean; begin Result:=false; + NewContext:=CleanFindContext; //DebugLn('TFindDeclarationTool.FindDeclarationOfPropertyPath PropertyPath="',PropertyPath,'"'); if PropertyPath='' then exit; BuildTree(false); @@ -1483,19 +1515,55 @@ begin Context.Node:=Params.NewNode; if Context.Node=nil then exit; if IsLastProperty then begin - Result:=Context.Tool.JumpToNode(Context.Node,NewPos,NewTopLine,false); - break; + if IgnoreTypeLess then begin + repeat + IsTypeLess:=false; + if (Context.Node.Desc=ctnProperty) + and Context.Tool.PropNodeIsTypeLess(Context.Node) then + IsTypeLess:=true; + if not IsTypeLess then break; + //DebugLn(['TFindDeclarationTool.FindDeclarationOfPropertyPath has not type, searching next ...']); + Params.SetIdentifier(Self,PChar(Pointer(Identifier)),nil); + Params.ContextNode:= + Context.Node.GetNodeOfTypes([ctnClass,ctnClassInterface]); + if Params.ContextNode=nil then + Params.ContextNode:=Context.Node; + Params.Flags:=[fdfExceptionOnNotFound,fdfSearchInAncestors, + fdfFindVariable,fdfIgnoreCurContextNode]; + //DebugLn(['TFindDeclarationTool.FindDeclarationOfPropertyPath ',Context.Tool.MainFilename,' ',Params.ContextNode.DescAsString,' ',Context.Tool.CleanPosToStr(Params.ContextNode.StartPos)]); + if not Context.Tool.FindIdentifierInContext(Params) then exit; + Context.Tool:=Params.NewCodeTool; + Context.Node:=Params.NewNode; + if Context.Node=nil then exit; + until false; + end; + //DebugLn(['TFindDeclarationTool.FindDeclarationOfPropertyPath FOUND']); + NewContext:=Context; + Result:=true; + exit; end else begin Context:=Context.Tool.FindBaseTypeOfNode(Params,Context.Node); if Context.Node=nil then exit; end; - until false; + until false; finally Params.Free; DeactivateGlobalWriteLock; end; end; +function TFindDeclarationTool.FindDeclarationOfPropertyPath( + const PropertyPath: string; + var NewPos: TCodeXYPosition; var NewTopLine: integer; + IgnoreTypeLess: boolean): boolean; +var + Context: TFindContext; +begin + Result:=FindDeclarationOfPropertyPath(PropertyPath,Context,IgnoreTypeLess); + if not Result then exit; + Result:=Context.Tool.JumpToNode(Context.Node,NewPos,NewTopLine,false); +end; + function TFindDeclarationTool.FindDeclarationNodeInInterface( const Identifier: string; BuildTheTree: Boolean): TCodeTreeNode; var @@ -2925,7 +2993,7 @@ begin RaiseForwardNotResolved; end; Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); - Params.Load(OldInput); + Params.Load(OldInput,true); exit; end else if (Result.Node.Desc=ctnClassOfType) then @@ -2954,7 +3022,7 @@ begin Params.ContextNode:=Result.Node.Parent; if not FindIdentifierInContext(Params) then begin // then search forwards - Params.Load(OldInput); + Params.Load(OldInput,false); Params.SetIdentifier(Self,@Src[ClassIdentNode.StartPos], @CheckSrcIdentifier); Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound, @@ -2969,7 +3037,7 @@ begin RaiseClassOfNotResolved; end; Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); - Params.Load(OldInput); + Params.Load(OldInput,true); exit; end else if (Result.Node.Desc=ctnOnIdentifier) and (Result.Node.PriorBrother=nil) @@ -3010,7 +3078,7 @@ begin RaiseCharExpectedButAtomFound('.'); ReadNextAtom; // read type identifier AtomIsIdentifier(true); - Params.Load(OldInput); + Params.Load(OldInput,false); Params.SetIdentifier(Self,@Src[CurPos.StartPos], @CheckSrcIdentifier); Params.Flags:=[fdfExceptionOnNotFound] @@ -3038,7 +3106,7 @@ begin end else // predefined identifier Result:=CreateFindContext(Self,Result.Node); - Params.Load(OldInput); + Params.Load(OldInput,true); exit; end else if (Result.Node.Desc=ctnProperty) @@ -3083,7 +3151,7 @@ begin end else // predefined identifier Result:=CreateFindContext(Self,Result.Node); - Params.Load(OldInput); + Params.Load(OldInput,true); exit; end else if (Result.Node.Desc=ctnProperty) then begin // property has no type @@ -3105,7 +3173,7 @@ begin MoveCursorToCleanPos(OldPos); RaiseException(ctsAncestorIsNotProperty); end; - Params.Load(OldInput); + Params.Load(OldInput,true); exit; end; end else @@ -3157,7 +3225,7 @@ begin RaiseCharExpectedButAtomFound('.'); ReadNextAtom; // read type identifier AtomIsIdentifier(true); - Params.Load(OldInput); + Params.Load(OldInput,false); Params.SetIdentifier(Self,@Src[CurPos.StartPos], @CheckSrcIdentifier); Params.Flags:=[fdfExceptionOnNotFound] @@ -3183,7 +3251,7 @@ begin end; Result.Tool:=Params.NewCodeTool; Result.Node:=Result.Tool.FindTypeNodeOfDefinition(Params.NewNode); - Params.Load(OldInput); + Params.Load(OldInput,true); exit; end else break; @@ -3966,40 +4034,37 @@ begin // search the identifier in the class first // 1. search the class in the same unit Params.Save(OldInput); - try - Params.Flags:=[fdfIgnoreCurContextNode,fdfSearchInParentNodes] - +(fdfGlobals*Params.Flags) - +[fdfExceptionOnNotFound,fdfIgnoreUsedUnits] - -[fdfTopLvlResolving]; - Params.ContextNode:=ProcContextNode; - Params.SetIdentifier(Self,@Src[ClassNameAtom.StartPos],nil); - {$IFDEF ShowTriedContexts} - DebugLn('[TFindDeclarationTool.FindIdentifierInClassOfMethod] Proc="',copy(src,ProcContextNode.StartPos,30),'" searching class of method class="',ExtractIdentifier(ClassNameAtom.StartPos),'"'); - {$ENDIF} - FindIdentifierInContext(Params); - ClassContext:=Params.NewCodeTool.FindBaseTypeOfNode( - Params,Params.NewNode); - if (ClassContext.Node=nil) - or (ClassContext.Node.Desc<>ctnClass) then begin - MoveCursorToCleanPos(ClassNameAtom.StartPos); - RaiseException(ctsClassIdentifierExpected); - end; - // class context found - // 2. -> search identifier in class - Params.Load(OldInput); - Params.Flags:=[fdfSearchInAncestors] - +(fdfGlobalsSameIdent*Params.Flags) - -[fdfExceptionOnNotFound]; - Params.ContextNode:=ClassContext.Node; - {$IFDEF ShowTriedContexts} - DebugLn('[TFindDeclarationTool.FindIdentifierInClassOfMethod] searching identifier in class of method'); - {$ENDIF} - Result:=ClassContext.Tool.FindIdentifierInContext(Params); - if Result then - exit; - finally - Params.Load(OldInput); + Params.Flags:=[fdfIgnoreCurContextNode,fdfSearchInParentNodes] + +(fdfGlobals*Params.Flags) + +[fdfExceptionOnNotFound,fdfIgnoreUsedUnits] + -[fdfTopLvlResolving]; + Params.ContextNode:=ProcContextNode; + Params.SetIdentifier(Self,@Src[ClassNameAtom.StartPos],nil); + {$IFDEF ShowTriedContexts} + DebugLn('[TFindDeclarationTool.FindIdentifierInClassOfMethod] Proc="',copy(src,ProcContextNode.StartPos,30),'" searching class of method class="',ExtractIdentifier(ClassNameAtom.StartPos),'"'); + {$ENDIF} + FindIdentifierInContext(Params); + ClassContext:=Params.NewCodeTool.FindBaseTypeOfNode( + Params,Params.NewNode); + if (ClassContext.Node=nil) + or (ClassContext.Node.Desc<>ctnClass) then begin + MoveCursorToCleanPos(ClassNameAtom.StartPos); + RaiseException(ctsClassIdentifierExpected); end; + // class context found + // 2. -> search identifier in class + Params.Load(OldInput,false); + Params.Flags:=[fdfSearchInAncestors] + +(fdfGlobalsSameIdent*Params.Flags) + -[fdfExceptionOnNotFound]; + Params.ContextNode:=ClassContext.Node; + {$IFDEF ShowTriedContexts} + DebugLn('[TFindDeclarationTool.FindIdentifierInClassOfMethod] searching identifier in class of method'); + {$ENDIF} + Result:=ClassContext.Tool.FindIdentifierInContext(Params); + Params.Load(OldInput,true); + if Result then + exit; end; end else begin // proc is not a method @@ -4082,7 +4147,7 @@ begin ClassContext.Tool.BuildSubTreeForClass(ClassContext.Node); end; Result:=true; - Params.Load(OldInput); + Params.Load(OldInput,true); end else begin // proc is not a method end; @@ -4155,38 +4220,35 @@ begin // search ancestor class context CurPos.StartPos:=CurPos.EndPos; Params.Save(OldInput); - try - Params.Flags:=[fdfSearchInParentNodes,fdfIgnoreCurContextNode, - fdfExceptionOnNotFound] - +(fdfGlobals*Params.Flags) - -[fdfTopLvlResolving]; - if not SearchBaseClass then - Params.SetIdentifier(Self,@Src[AncestorAtom.StartPos],nil) - else begin - if ClassNode.Desc=ctnClass then - Params.SetIdentifier(Self,'TObject',nil) - else - Params.SetIdentifier(Self,'IInterface',nil); - Exclude(Params.Flags,fdfExceptionOnNotFound); - end; - Params.ContextNode:=ClassNode; - if not FindIdentifierInContext(Params) then begin - MoveCursorToNodeStart(ClassNode); - if ClassNode.Desc=ctnClass then - RaiseException(ctsDefaultClassAncestorTObjectNotFound) - else - RaiseException(ctsDefaultInterfaceAncestorIInterfaceNotFound); - end; - if FindClassContext then begin - AncestorNode:=Params.NewNode; - AncestorContext:=Params.NewCodeTool.FindBaseTypeOfNode(Params, - AncestorNode); - Params.SetResult(AncestorContext); - end; - Result:=true; - finally - Params.Load(OldInput); + Params.Flags:=[fdfSearchInParentNodes,fdfIgnoreCurContextNode, + fdfExceptionOnNotFound] + +(fdfGlobals*Params.Flags) + -[fdfTopLvlResolving]; + if not SearchBaseClass then + Params.SetIdentifier(Self,@Src[AncestorAtom.StartPos],nil) + else begin + if ClassNode.Desc=ctnClass then + Params.SetIdentifier(Self,'TObject',nil) + else + Params.SetIdentifier(Self,'IInterface',nil); + Exclude(Params.Flags,fdfExceptionOnNotFound); end; + Params.ContextNode:=ClassNode; + if not FindIdentifierInContext(Params) then begin + MoveCursorToNodeStart(ClassNode); + if ClassNode.Desc=ctnClass then + RaiseException(ctsDefaultClassAncestorTObjectNotFound) + else + RaiseException(ctsDefaultInterfaceAncestorIInterfaceNotFound); + end; + if FindClassContext then begin + AncestorNode:=Params.NewNode; + AncestorContext:=Params.NewCodeTool.FindBaseTypeOfNode(Params, + AncestorNode); + Params.SetResult(AncestorContext); + end; + Result:=true; + Params.Load(OldInput,true); end; function TFindDeclarationTool.FindForwardIdentifier( @@ -4197,20 +4259,17 @@ var OldInput: TFindDeclarationInput; begin Params.Save(OldInput); - try - Exclude(Params.Flags,fdfExceptionOnNotFound); + Exclude(Params.Flags,fdfExceptionOnNotFound); + Result:=FindIdentifierInContext(Params); + if not Result then begin + Params.Load(OldInput,false); + Params.Flags:=Params.Flags+[fdfSearchForward,fdfIgnoreCurContextNode]; Result:=FindIdentifierInContext(Params); - if not Result then begin - Params.Load(OldInput); - Params.Flags:=Params.Flags+[fdfSearchForward,fdfIgnoreCurContextNode]; - Result:=FindIdentifierInContext(Params); - IsForward:=true; - end else begin - IsForward:=false; - end; - finally - Params.Load(OldInput); + IsForward:=true; + end else begin + IsForward:=false; end; + Params.Load(OldInput,true); end; function TFindDeclarationTool.FindIdentifierInWithVarContext( @@ -4244,11 +4303,11 @@ begin RaiseException(ctsExprTypeMustBeClassOrRecord); end; // search identifier in with context - Params.Load(OldInput); + Params.Load(OldInput,false); Exclude(Params.Flags,fdfExceptionOnNotFound); Params.ContextNode:=WithVarExpr.Context.Node; Result:=WithVarExpr.Context.Tool.FindIdentifierInContext(Params); - Params.Load(OldInput); + Params.Load(OldInput,true); end; function TFindDeclarationTool.FindIdentifierInAncestors( @@ -4269,7 +4328,7 @@ begin Params.ContextNode:=Params.NewNode; Params.Flags:=Params.Flags-[fdfIgnoreCurContextNode,fdfSearchInParentNodes]; Result:=Params.NewCodeTool.FindIdentifierInContext(Params); - Params.Load(OldInput); + Params.Load(OldInput,true); end; {$IFDEF DebugPrefix} @@ -4661,7 +4720,7 @@ begin +[fdfIgnoreUsedUnits]; Params.ContextNode:=InterfaceNode; Result:=FindIdentifierInContext(Params); - Params.Load(OldInput); + Params.Load(OldInput,true); if (Params.NewCodeTool<>Self) then Result:=false; @@ -4769,7 +4828,7 @@ begin Params.Flags:=[fdfIgnoreUsedUnits]+(fdfGlobalsSameIdent*Params.Flags) -[fdfExceptionOnNotFound]; Result:=NewCodeTool.FindIdentifierInInterface(Self,Params); - Params.Load(OldInput); + Params.Load(OldInput,true); end; end; @@ -4927,7 +4986,7 @@ begin Result:=FindIdentifierInUsedUnit(SystemAlias,Params); finally // ! always reset input, because the string SystemAlias is freed ! - Params.Load(OldInput); + Params.Load(OldInput,true); end; end; end; @@ -5332,10 +5391,10 @@ var end else begin // it's a constructor -> keep the class end; - Params.Load(OldInput); + Params.Load(OldInput,true); end else begin // predefined identifier - Params.Load(OldInput); + Params.Load(OldInput,true); ExprType:=FindExpressionTypeOfPredefinedIdentifier(CurAtom.StartPos, Params); end; @@ -5499,7 +5558,7 @@ var ExprType.Context.Tool.FindIdentifierInContext(Params); ExprType.Context:=Params.NewCodeTool.FindBaseTypeOfNode(Params, Params.NewNode); - Params.Load(OldInput); + Params.Load(OldInput,true); end else begin ExprType.Context:=ExprType.Context.Tool.FindBaseTypeOfNode(Params, ExprType.Context.Node.LastChild); @@ -5523,7 +5582,7 @@ var Params.ContextNode:=ExprType.Context.Node; ExprType.Context.Tool.FindIdentifierInContext(Params); ExprType.Context:=CreateFindContext(Params); - Params.Load(OldInput); + Params.Load(OldInput,true); end; // find base type of property if ExprType.Context.Tool.ReadTilTypeOfProperty(ExprType.Context.Node) @@ -5549,7 +5608,7 @@ var end else begin // predefined identifier end; - Params.Load(OldInput); + Params.Load(OldInput,true); end else RaiseIdentInCurContextNotFound; end; @@ -5649,14 +5708,14 @@ var Params,true); // search identifier only in class ancestor - Params.Load(OldInput); + Params.Load(OldInput,false); Params.SetIdentifier(Self,@Src[CurAtom.StartPos],@CheckSrcIdentifier); Params.ContextNode:=Params.NewNode; Params.Flags:=Params.Flags-[fdfSearchInParentNodes] +[fdfExceptionOnNotFound,fdfSearchInAncestors]; Params.NewCodeTool.FindIdentifierInContext(Params); ExprType.Context:=CreateFindContext(Params); - Params.Load(OldInput); + Params.Load(OldInput,true); ResolveBaseTypeOfIdentifier; end; @@ -5776,7 +5835,7 @@ begin Params.Save(OldInput); Params.ContextNode:=Node; Result:=ReadOperandTypeAtCursor(Params); - Params.Load(OldInput); + Params.Load(OldInput,true); Result.Context:=CreateFindContext(Self,Node); end; @@ -5799,7 +5858,7 @@ begin Params.Save(OldInput); Params.ContextNode:=Node; Result:=ReadOperandTypeAtCursor(Params); - Params.Load(OldInput); + Params.Load(OldInput,true); Result.Context:=CreateFindContext(Self,Node); end; @@ -5832,7 +5891,7 @@ begin Params.Save(OldInput); Params.ContextNode:=Node; Result:=ReadOperandTypeAtCursor(Params); - Params.Load(OldInput); + Params.Load(OldInput,true); Result.Context:=CreateFindContext(Self,Node); end; end; @@ -6154,6 +6213,7 @@ var ParamNode: TCodeTreeNode; i, MinParamCnt, MaxParamCnt: integer; ParamCompatibility: TTypeCompatibility; + CompatibilityListCount: LongInt; begin // quick check: parameter count ParamNode:=FirstTargetParameterNode; @@ -6188,7 +6248,8 @@ begin // check each parameter for compatibility ParamNode:=FirstTargetParameterNode; i:=0; - while (ParamNode<>nil) and (inil) and (i check if missing variables have default variables if (ParamNode.SubDesc and ctnsHasDefaultValue)>0 then begin // the rest params have default values - while ParamNode<>nil do begin - if CompatibilityList<>nil then + if CompatibilityList<>nil then begin + while (ParamNode<>nil) and (i0) - and (Params.FoundProc^.ParamCompatibilityList=nil) then + and (Params.FoundProc^.ParamCompatibilityList=nil) then begin GetMem(Params.FoundProc^.ParamCompatibilityList,CompListSize); + //DebugLn(['TFindDeclarationTool.CheckSrcIdentifier FoundProc=',dbgs(Params.FoundProc),' New ParamCompatibilityList=',dbgs(Params.FoundProc^.ParamCompatibilityList),' CompListSize=',CompListSize]); + end else begin + //DebugLn(['TFindDeclarationTool.CheckSrcIdentifier FoundProc=',dbgs(Params.FoundProc),' Old ParamCompatibilityList=',dbgs(Params.FoundProc^.ParamCompatibilityList),' CompListSize=',CompListSize]); + end; // check the first found proc for compatibility // (compare the expression list with the proc param list) @@ -6524,14 +6590,12 @@ begin {$ENDIF} FirstParameterNode:=Params.FoundProc^.Context.Tool.GetFirstParameterNode( Params.FoundProc^.Context.Node); - Params.Save(OldInput); ParamCompatibility:= Params.FoundProc^.Context.Tool.IsParamExprListCompatibleToNodeList( FirstParameterNode, Params.FoundProc^.ExprInputList, fdfIgnoreMissingParams in Params.Flags, Params,Params.FoundProc^.ParamCompatibilityList); - Params.Load(OldInput); Params.FoundProc^.ProcCompatibility:=ParamCompatibility; Params.FoundProc^.CacheValid:=true; {$IFDEF ShowFoundIdentifier} @@ -6559,20 +6623,19 @@ begin {$ENDIF} if CompListSize>0 then begin GetMem(CurCompatibilityList,CompListSize); + //DebugLn(['TFindDeclarationTool.CheckSrcIdentifier create temp CurCompatibilityList=',dbgs(CurCompatibilityList),' CompListSize=',CompListSize]); end else begin CurCompatibilityList:=nil; end; try FirstParameterNode:= FoundContext.Tool.GetFirstParameterNode(FoundContext.Node); - Params.Save(OldInput); ParamCompatibility:= FoundContext.Tool.IsParamExprListCompatibleToNodeList( FirstParameterNode, Params.FoundProc^.ExprInputList, fdfIgnoreMissingParams in Params.Flags, Params,CurCompatibilityList); - Params.Load(OldInput); {$IFDEF ShowFoundIdentifier} DebugLn('[TFindDeclarationTool.CheckSrcIdentifier]', ' Ident=',GetIdentifier(Params.Identifier), @@ -6601,8 +6664,10 @@ begin end; finally // end overloaded proc search - if CurCompatibilityList<>nil then + if CurCompatibilityList<>nil then begin + //DebugLn(['TFindDeclarationTool.CheckSrcIdentifier free CurCompatibilityList=',dbgs(CurCompatibilityList)]); FreeMem(CurCompatibilityList); + end; end; end else begin Result:=ifrSuccess; @@ -7843,6 +7908,59 @@ end; { TFindDeclarationParams } +procedure TFindDeclarationParams.FreeFoundProc(aFoundProc: PFoundProc; + FreeNext: boolean); +var + Next: PFoundProc; +begin + //DebugLn(['TFindDeclarationParams.FreeFoundProc ',dbgs(aFoundProc)]); + while aFoundProc<>nil do begin + if (aFoundProc^.Owner<>Self) + and ((FirstFoundProc=aFoundProc) + or (aFoundProc^.Prior<>nil) or (aFoundProc^.Next<>nil)) + then + raise Exception.Create('FoundProc is in list, but not owned'); + if FreeNext then + Next:=aFoundProc^.Next + else + Next:=nil; + RemoveFoundProcFromList(aFoundProc); + with aFoundProc^ do begin + //DebugLn(['TFindDeclarationParams.FreeFoundProc ExprInputList=',dbgs(ExprInputList)]); + if ExprInputList<>nil then + FreeAndNil(ExprInputList); + //DebugLn(['TFindDeclarationParams.FreeFoundProc ParamCompatibilityList=',dbgs(ParamCompatibilityList)]); + if ParamCompatibilityList<>nil then begin + FreeMem(ParamCompatibilityList); + ParamCompatibilityList:=nil; + end; + CacheValid:=false; + end; + //DebugLn(['TFindDeclarationParams.FreeFoundProc Dispose ',dbgs(aFoundProc)]); + Dispose(aFoundProc); + aFoundProc:=Next; + end; +end; + +procedure TFindDeclarationParams.RemoveFoundProcFromList(aFoundProc: PFoundProc + ); +begin + //DebugLn(['TFindDeclarationParams.RemoveFoundProcFromList ',dbgs(aFoundProc)]); + if FirstFoundProc=aFoundProc then + FirstFoundProc:=aFoundProc^.Next; + if LastFoundProc=aFoundProc then + LastFoundProc:=aFoundProc^.Next; + with aFoundProc^ do begin + if Next<>nil then + Next^.Prior:=Prior; + if Prior<>nil then + Prior^.Next:=Next; + Prior:=nil; + Next:=nil; + Owner:=nil; + end; +end; + constructor TFindDeclarationParams.Create; begin inherited Create; @@ -7852,6 +7970,7 @@ end; destructor TFindDeclarationParams.Destroy; begin Clear; + FreeFoundProc(FirstFoundProc,true); inherited Destroy; end; @@ -7863,7 +7982,10 @@ begin OnTopLvlIdentifierFound:=nil; end; -procedure TFindDeclarationParams.Load(var Input: TFindDeclarationInput); +procedure TFindDeclarationParams.Load(Input: TFindDeclarationInput; + FreeInput: boolean); +// set FreeInput to true, if the Input is not needed anymore and the dynamic +// data can be freed. begin Flags:=Input.Flags; Identifier:=Input.Identifier; @@ -7871,8 +7993,19 @@ begin OnIdentifierFound:=Input.OnIdentifierFound; IdentifierTool:=Input.IdentifierTool; if FoundProc<>Input.FoundProc then begin - ClearFoundProc; + // free current FoundProc (probably not yet saved) + if FoundProc<>nil then + ClearFoundProc; + // use saved FoundProc FoundProc:=Input.FoundProc; + // free all FoundProcs, that were saved later + if (FoundProc<>nil) then begin + FreeFoundProc(FoundProc^.Next,true); + if FreeInput then begin + Input.FoundProc:=nil; + RemoveFoundProcFromList(FoundProc); + end; + end; end; end; @@ -7884,6 +8017,17 @@ begin Input.OnIdentifierFound:=OnIdentifierFound; Input.IdentifierTool:=IdentifierTool; Input.FoundProc:=FoundProc; + if (FoundProc<>nil) and (FoundProc^.Owner=nil) then begin + // add to list of saves FoundProcs + //DebugLn(['TFindDeclarationParams.Save ',dbgs(FoundProc)]); + FoundProc^.Prior:=LastFoundProc; + if LastFoundProc<>nil then + LastFoundProc^.Next:=FoundProc; + LastFoundProc:=FoundProc; + if FirstFoundProc=nil then + FirstFoundProc:=FoundProc; + FoundProc^.Owner:=Self; + end; end; procedure TFindDeclarationParams.ClearResult(CopyCacheFlags: boolean); @@ -7947,16 +8091,14 @@ end; procedure TFindDeclarationParams.ClearFoundProc; begin if FoundProc=nil then exit; - with FoundProc^ do begin - if ExprInputList<>nil then - FreeAndNil(ExprInputList); - if ParamCompatibilityList<>nil then begin - FreeMem(ParamCompatibilityList); - ParamCompatibilityList:=nil; - end; - CacheValid:=false; - end; - Dispose(FoundProc); + //DebugLn(['TFindDeclarationParams.ClearFoundProc ',dbgs(FoundProc),' Saved=',FoundProc^.Owner<>nil]); + if FoundProc^.Owner=nil then + // the FoundProc is not saved + FreeFoundProc(FoundProc,true) + else if FoundProc^.Next<>nil then + // the FoundProc is saved (release the later FoundProcs, + // which are not needed any more) + FreeFoundProc(FoundProc^.Next,true); FoundProc:=nil; end; @@ -8010,13 +8152,17 @@ begin Identifier:=NewIdentifier; IdentifierTool:=NewIdentifierTool; OnIdentifierFound:=NewOnIdentifierFound; - FoundProc:=nil; + ClearFoundProc; end; procedure TFindDeclarationParams.SetFirstFoundProc( const ProcContext: TFindContext); begin + //DebugLn(['TFindDeclarationParams.SetFirstFoundProc Old=',dbgs(FoundProc)]); + if FoundProc<>nil then + ClearFoundProc; New(FoundProc); + //DebugLn(['TFindDeclarationParams.SetFirstFoundProc New=',dbgs(FoundProc)]); FillChar(FoundProc^,SizeOf(TFoundProc),0); FoundProc^.Context:=ProcContext; end; @@ -8029,9 +8175,11 @@ begin FoundProc^.Context:=ProcContext; FoundProc^.ProcCompatibility:=ProcCompatibility; if (FoundProc^.ParamCompatibilityList<>ParamCompatibilityList) then begin + //DebugLn(['TFindDeclarationParams.ChangeFoundProc Old ParamCompatibilityList=',dbgs(FoundProc^.ParamCompatibilityList)]); if (FoundProc^.ParamCompatibilityList<>nil) then FreeMem(FoundProc^.ParamCompatibilityList); FoundProc^.ParamCompatibilityList:=ParamCompatibilityList; + //DebugLn(['TFindDeclarationParams.ChangeFoundProc New ParamCompatibilityList=',dbgs(FoundProc^.ParamCompatibilityList)]); end; end; diff --git a/components/codetools/sourcechanger.pas b/components/codetools/sourcechanger.pas index c216dfa7aa..dabea02ef7 100644 --- a/components/codetools/sourcechanger.pas +++ b/components/codetools/sourcechanger.pas @@ -1350,6 +1350,7 @@ function TBeautifyCodeOptions.AddClassAndNameToProc(const AProcCode, AClassName, AMethodName: string): string; var StartPos, NamePos, ProcLen: integer; s: string; + KeyWordPos: LongInt; begin if CompareSubStrings('CLASS ',AProcCode,1,1,6,false)<>0 then StartPos:=1 @@ -1359,8 +1360,11 @@ begin // read proc keyword 'procedure', 'function', ... while (StartPos<=ProcLen) and (IsSpaceChar[AProcCode[StartPos]]) do inc(StartPos); + KeyWordPos:=StartPos; while (StartPos<=ProcLen) and (IsIdentChar[AProcCode[StartPos]]) do inc(StartPos); + if KeyWordPos=StartPos then + raise Exception.Create('TBeautifyCodeOptions.AddClassAndNameToProc missing keyword'); while (StartPos<=ProcLen) and (IsSpaceChar[AProcCode[StartPos]]) do inc(StartPos); NamePos:=StartPos; diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index e00e99ab70..fc60eefbdd 100644 --- a/components/codetools/stdcodetools.pas +++ b/components/codetools/stdcodetools.pas @@ -1747,7 +1747,7 @@ var try Params.Save(OldInput); if FindIdentifierInContext(Params) then begin - Params.Load(OldInput); + Params.Load(OldInput,true); Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); if (Result.Node=nil) or (Result.Node.Desc<>ctnClass) then Result:=CleanFindContext; @@ -1800,7 +1800,7 @@ var try Params.Save(OldInput); if FindIdentifierInContext(Params) then begin - Params.Load(OldInput); + Params.Load(OldInput,true); Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); if (Result.Node=nil) or (Result.Node.Desc<>ctnClass) then Result:=CleanFindContext; diff --git a/ide/main.pp b/ide/main.pp index d6b18035ec..e9aa59ef77 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -388,8 +388,8 @@ type IdentIsMethod: boolean): boolean; function OnPropHookCreateMethod(const AMethodName:ShortString; ATypeInfo:PTypeInfo; - APropertyOwner: TPersistent; - const APropertyName: shortstring): TMethod; + APersistent: TPersistent; + const APropertyPath: string): TMethod; procedure OnPropHookShowMethod(const AMethodName:ShortString); procedure OnPropHookRenameMethod(const CurName, NewName:ShortString); function OnPropHookBeforeAddPersistent(Sender: TObject; @@ -12694,7 +12694,7 @@ end; function TMainIDE.OnPropHookCreateMethod(const AMethodName: ShortString; ATypeInfo: PTypeInfo; - APropertyOwner: TPersistent; const APropertyName: shortstring): TMethod; + APersistent: TPersistent; const APropertyPath: string): TMethod; var ActiveSrcEdit: TSourceEditor; ActiveUnitInfo: TUnitInfo; r: boolean; @@ -12707,6 +12707,7 @@ begin {$IFDEF IDE_DEBUG} writeln(''); writeln('[TMainIDE.OnPropHookCreateMethod] ************ ',AMethodName); + DebugLn(['[TMainIDE.OnPropHookCreateMethod] Persistent=',dbgsName(APersistent),' Unit=',GetClassUnitName(APersistent.ClassType),' Path=',APropertyPath]); {$ENDIF} OldChange:=FOpenEditorsOnCodeToolChange; FOpenEditorsOnCodeToolChange:=true; @@ -12714,8 +12715,7 @@ begin // create published method r:=CodeToolBoss.CreatePublishedMethod(ActiveUnitInfo.Source, ActiveUnitInfo.Component.ClassName,AMethodName, - ATypeInfo,false,GetClassUnitName(APropertyOwner.ClassType), - APropertyOwner,APropertyName); + ATypeInfo,false,GetClassUnitName(APersistent.ClassType),APropertyPath); {$IFDEF IDE_DEBUG} writeln(''); writeln('[TMainIDE.OnPropHookCreateMethod] ************2 ',r,' ',AMethodName); diff --git a/ide/uniteditor.pp b/ide/uniteditor.pp index 509380fc47..75fb716218 100644 --- a/ide/uniteditor.pp +++ b/ide/uniteditor.pp @@ -2087,6 +2087,7 @@ begin then begin Result:=true; FCodeTemplates.ExecuteCompletion(AToken,FEditor); + exit; end; end; end; @@ -2109,6 +2110,7 @@ begin then begin Result:=true; FCodeTemplates.ExecuteCompletion(AToken,FEditor); + exit; end; end; end; diff --git a/ideintf/propedits.pp b/ideintf/propedits.pp index f3706673d9..fc45de6bbb 100644 --- a/ideintf/propedits.pp +++ b/ideintf/propedits.pp @@ -300,6 +300,7 @@ type function GetComponent(Index: Integer): TPersistent;// for Delphi compatibility function GetUnitName(Index: Integer = 0): string; function GetPropTypeUnitName(Index: Integer = 0): string; + function GetPropertyPath(Index: integer = 0): string;// e.g. 'TForm1.Color' function GetEditLimit: Integer; virtual; function GetName: shortstring; virtual; procedure GetProperties(Proc: TGetPropEditProc); virtual; @@ -1101,17 +1102,18 @@ type TPropHookChangeLookupRoot = procedure of object; // methods TPropHookCreateMethod = function(const Name: ShortString; ATypeInfo: PTypeInfo; - APropertyOwner: TPersistent; const APropertyName: shortstring): TMethod of object; + APersistent: TPersistent; const APropertyPath: string): TMethod of object; TPropHookGetMethodName = function(const Method: TMethod; CheckOwner: TObject): ShortString of object; TPropHookGetMethods = procedure(TypeData:PTypeData; Proc:TGetStringProc) of object; TPropHookMethodExists = function(const Name:ShortString; TypeData: PTypeData; - var MethodIsCompatible,MethodIsPublished,IdentIsMethod: boolean):boolean of object; + var MethodIsCompatible,MethodIsPublished,IdentIsMethod: boolean + ):boolean of object; TPropHookRenameMethod = procedure(const CurName, NewName:ShortString) of object; TPropHookShowMethod = procedure(const Name:ShortString) of object; TPropHookMethodFromAncestor = function(const Method:TMethod):boolean of object; TPropHookChainCall = procedure(const AMethodName, InstanceName, - InstanceMethod:ShortString; TypeData:PTypeData) of object; + InstanceMethod:ShortString; TypeData:PTypeData) of object; // components TPropHookGetComponent = function(const Name:ShortString):TComponent of object; TPropHookGetComponentName = function(AComponent:TComponent):ShortString of object; @@ -1201,12 +1203,12 @@ type // lookup root property LookupRoot: TPersistent read FLookupRoot write SetLookupRoot; // methods - function CreateMethod(const Name:ShortString; ATypeInfo:PTypeInfo; - APropertyOwner: TPersistent; - const APropertyName: shortstring): TMethod; + function CreateMethod(const Name: ShortString; ATypeInfo:PTypeInfo; + APersistent: TPersistent; + const APropertyPath: string): TMethod; function GetMethodName(const Method: TMethod; CheckOwner: TObject): ShortString; - procedure GetMethods(TypeData:PTypeData; Proc:TGetStringProc); - function MethodExists(const Name:ShortString; TypeData: PTypeData; + procedure GetMethods(TypeData: PTypeData; Proc: TGetStringProc); + function MethodExists(const Name: ShortString; TypeData: PTypeData; var MethodIsCompatible,MethodIsPublished,IdentIsMethod: boolean):boolean; procedure RenameMethod(const CurName, NewName: ShortString); procedure ShowMethod(const Name: ShortString); @@ -2087,6 +2089,11 @@ begin end; end; +function TPropertyEditor.GetPropertyPath(Index: integer): string; +begin + Result:=GetComponent(Index).ClassName+'.'+GetName; +end; + function TPropertyEditor.GetFloatValue:Extended; begin Result:=GetFloatValueAt(0); @@ -3937,7 +3944,8 @@ begin //writeln('### TMethodPropertyEditor.SetValue E'); CreateNewMethod := IsValidIdent(NewValue) and not NewMethodExists; SetMethodValue( - PropertyHook.CreateMethod(NewValue,GetPropType,GetComponent(0),GetName)); + PropertyHook.CreateMethod(NewValue,GetPropType, + GetComponent(0),GetPropertyPath(0))); //writeln('### TMethodPropertyEditor.SetValue F NewValue=',GetValue); if CreateNewMethod then begin {if (PropCount = 1) and (OldMethod.Data <> nil) and (OldMethod.Code <> nil) @@ -5097,9 +5105,9 @@ end; { TPropertyEditorHook } -function TPropertyEditorHook.CreateMethod(const Name:Shortstring; +function TPropertyEditorHook.CreateMethod(const Name: Shortstring; ATypeInfo: PTypeInfo; - APropertyOwner: TPersistent; const APropertyName: shortstring): TMethod; + APersistent: TPersistent; const APropertyPath: string): TMethod; var i: Integer; Handler: TPropHookCreateMethod; @@ -5110,7 +5118,7 @@ begin i:=GetHandlerCount(htCreateMethod); while GetNextHandlerIndex(htCreateMethod,i) do begin Handler:=TPropHookCreateMethod(FHandlers[htCreateMethod][i]); - Result:=Handler(Name,ATypeInfo,APropertyOwner,APropertyName); + Result:=Handler(Name,ATypeInfo,APersistent,APropertyPath); if (Result.Data<>nil) or (Result.Code<>nil) then exit; end; end;