From c30685c57e72221529d0c268ff44ce6c79d0b18b Mon Sep 17 00:00:00 2001 From: mattias Date: Sun, 8 Aug 2004 21:52:02 +0000 Subject: [PATCH] change component class dlg now works with child controls git-svn-id: trunk@5752 - --- components/codetools/codetoolmanager.pas | 8 +- components/codetools/stdcodetools.pas | 207 +++++++++++++---------- designer/changeclassdialog.pas | 5 +- ide/checklfmdlg.pas | 54 +++--- ide/main.pp | 10 +- 5 files changed, 158 insertions(+), 126 deletions(-) diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 73adec4d74..a287655110 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -353,7 +353,8 @@ type read FOnGetDefineProperties write FOnGetDefineProperties; function FindLFMFileName(Code: TCodeBuffer): string; function CheckLFM(UnitCode, LFMBuf: TCodeBuffer; - var LFMTree: TLFMTree; RootMustBeClassInIntf: boolean): boolean; + var LFMTree: TLFMTree; + RootMustBeClassInIntf, ObjectsMustExists: boolean): boolean; function FindNextResourceFile(Code: TCodeBuffer; var LinkIndex: integer): TCodeBuffer; function AddLazarusResourceHeaderComment(Code: TCodeBuffer; @@ -2032,7 +2033,8 @@ begin end; function TCodeToolManager.CheckLFM(UnitCode, LFMBuf: TCodeBuffer; - var LFMTree: TLFMTree; RootMustBeClassInIntf: boolean): boolean; + var LFMTree: TLFMTree; RootMustBeClassInIntf, ObjectsMustExists: boolean + ): boolean; begin Result:=false; {$IFDEF CTDEBUG} @@ -2041,7 +2043,7 @@ begin if not InitCurCodeTool(UnitCode) then exit; try Result:=FCurCodeTool.CheckLFM(LFMBuf,LFMTree,OnGetDefineProperties, - RootMustBeClassInIntf); + RootMustBeClassInIntf,ObjectsMustExists); except on e: Exception do HandleException(e); end; diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index 04e47cdc08..caa22bc84e 100644 --- a/components/codetools/stdcodetools.pas +++ b/components/codetools/stdcodetools.pas @@ -117,7 +117,7 @@ type SourceChangeCache: TSourceChangeCache): boolean; function CheckLFM(LFMBuf: TCodeBuffer; var LFMTree: TLFMTree; const OnGetDefineProperties: TOnGetDefineProperties; - RootMustBeClassInIntf: boolean): boolean; + RootMustBeClassInIntf, ObjectsMustExists: boolean): boolean; // Application.Createform statements function FindCreateFormStatement(StartPos: integer; @@ -894,7 +894,7 @@ end; function TStandardCodeTool.CheckLFM(LFMBuf: TCodeBuffer; var LFMTree: TLFMTree; const OnGetDefineProperties: TOnGetDefineProperties; - RootMustBeClassInIntf: boolean): boolean; + RootMustBeClassInIntf, ObjectsMustExists: boolean): boolean; var RootContext: TFindContext; @@ -932,7 +932,7 @@ var function FindLFMIdentifier(LFMNode: TLFMTreeNode; DefaultErrorPosition: integer; const IdentName: string; const ClassContext: TFindContext; - SearchAlsoInDefineProperties: boolean; + SearchAlsoInDefineProperties, ErrorOnNotFound: boolean; var IdentContext: TFindContext): boolean; var Params: TFindDeclarationParams; @@ -971,6 +971,14 @@ var if IdentContext.Node<>nil then begin Result:=true; + if (IdentContext.Node.Parent<>nil) + and (IdentContext.Node.Parent.Desc<>ctnClassPublished) + then begin + LFMTree.AddError(lfmeIdentifierNotPublished,LFMNode, + 'identifier '+IdentName+' is not published', + DefaultErrorPosition); + exit; + end; end else begin // no node found if SearchAlsoInDefineProperties then begin @@ -981,7 +989,7 @@ var end; end; end; - if not Result then begin + if (not Result) and ErrorOnNotFound then begin LFMTree.AddError(lfmeIdentifierNotFound,LFMNode, 'identifier '+IdentName+' not found', DefaultErrorPosition); @@ -1039,8 +1047,45 @@ var Result:=Result+'('+IntToStr(Caret.Y)+','+IntToStr(Caret.X)+')'; end; + function FindClassContext(const ClassName: string): TFindContext; + var + Params: TFindDeclarationParams; + Identifier: PChar; + OldInput: TFindDeclarationInput; + StartTool: TStandardCodeTool; + begin + Result:=CleanFindContext; + Params:=TFindDeclarationParams.Create; + StartTool:=Self; + Identifier:=PChar(ClassName); + try + Params.Flags:=[fdfExceptionOnNotFound, + fdfSearchInParentNodes, + fdfExceptionOnPredefinedIdent,fdfIgnoreMissingParams, + fdfIgnoreOverloadedProcs]; + Params.ContextNode:=FindInterfaceNode; + if Params.ContextNode=nil then + Params.ContextNode:=FindMainUsesSection; + Params.SetIdentifier(StartTool,Identifier,nil); + try + Params.Save(OldInput); + if FindIdentifierInContext(Params) then begin + Params.Load(OldInput); + Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); + if (Result.Node=nil) or (Result.Node.Desc<>ctnClass) then + Result:=CleanFindContext; + end; + except + // ignore search/parse errors + on E: ECodeToolError do ; + end; + finally + Params.Free; + end; + end; + procedure CheckLFMChildObject(LFMObject: TLFMObjectNode; - const ParentContext: TFindContext); + const ParentContext: TFindContext; SearchAlsoInDefineProperties: boolean); var LFMObjectName: String; ChildContext: TFindContext; @@ -1058,60 +1103,80 @@ var LFMObject.StartPos); exit; end; + if not FindLFMIdentifier(LFMObject,LFMObject.NamePosition, - LFMObjectName,RootContext,false,ChildContext) then exit; - if ChildContext.Node=nil then begin - // this is an extra entry, created via DefineProperties. - // There is no generic way to test such things - exit; + LFMObjectName,RootContext,SearchAlsoInDefineProperties,ObjectsMustExists, + ChildContext) + then begin + // object name not found + if ObjectsMustExists then + exit; end; - // check if identifier is variable - if not ChildContext.Node.Desc=ctnVarDefinition then begin - LFMTree.AddError(lfmeObjectIncompatible,LFMObject, - LFMObjectName+' is not a variable' - +CreateFootNote(ChildContext), - LFMObject.NamePosition); - exit; - end; - DefinitionNode:=ChildContext.Tool.FindTypeNodeOfDefinition( - ChildContext.Node); - if DefinitionNode=nil then begin - ChildContext.Node:=DefinitionNode; - LFMTree.AddError(lfmeObjectIncompatible,LFMObject, - LFMObjectName+' is not a variable.' - +CreateFootNote(ChildContext), - LFMObject.NamePosition); - exit; - end; + if ObjectsMustExists or (ChildContext.Node<>nil) then begin + if ChildContext.Node=nil then begin + // this is an extra entry, created via DefineProperties. + // There is no generic way to test such things + exit; + end; - // check if variable has a compatible type - if LFMObject.TypeName<>'' then begin - VariableTypeName:=ChildContext.Tool.ExtractDefinitionNodeType( - ChildContext.Node); - if (VariableTypeName='') - or (AnsiCompareText(VariableTypeName,LFMObject.TypeName)<>0) then begin + // check if identifier is variable + if (not ChildContext.Node.Desc=ctnVarDefinition) then begin + LFMTree.AddError(lfmeObjectIncompatible,LFMObject, + LFMObjectName+' is not a variable' + +CreateFootNote(ChildContext), + LFMObject.NamePosition); + exit; + end; + DefinitionNode:=ChildContext.Tool.FindTypeNodeOfDefinition( + ChildContext.Node); + if DefinitionNode=nil then begin ChildContext.Node:=DefinitionNode; LFMTree.AddError(lfmeObjectIncompatible,LFMObject, - VariableTypeName+' expected, but '+LFMObject.TypeName+' found.' - +CreateFootNote(ChildContext), - LFMObject.NamePosition); + LFMObjectName+' is not a variable.' + +CreateFootNote(ChildContext), + LFMObject.NamePosition); + exit; + end; + + // check if variable has a compatible type + if LFMObject.TypeName<>'' then begin + VariableTypeName:=ChildContext.Tool.ExtractDefinitionNodeType( + ChildContext.Node); + if (VariableTypeName='') + or (AnsiCompareText(VariableTypeName,LFMObject.TypeName)<>0) then begin + ChildContext.Node:=DefinitionNode; + LFMTree.AddError(lfmeObjectIncompatible,LFMObject, + VariableTypeName+' expected, but '+LFMObject.TypeName+' found.' + +CreateFootNote(ChildContext), + LFMObject.NamePosition); + exit; + end; + end; + + // check if variable is published + if (ChildContext.Node.Parent=nil) + or (ChildContext.Node.Parent.Desc<>ctnClassPublished) then begin + LFMTree.AddError(lfmeIdentifierNotPublished,LFMObject, + LFMObjectName+' is not published', + LFMObject.NamePosition); + exit; + end; + + // find class node + ClassContext:=FindClassNodeForLFMObject(LFMObject,LFMObject.TypeNamePosition, + ChildContext.Tool,DefinitionNode); + end else begin + // try the object type + ClassContext:=FindClassContext(LFMObject.TypeName); + if ClassContext.Node=nil then begin + // object type not found + LFMTree.AddError(lfmeIdentifierNotFound,LFMObject, + 'type '+LFMObject.TypeName+' not found', + LFMObject.TypeNamePosition); exit; end; end; - - // check if variable is published - if (ChildContext.Node.Parent=nil) - or (ChildContext.Node.Parent.Desc<>ctnClassPublished) then begin - LFMTree.AddError(lfmeIdentifierNotPublished,LFMObject, - LFMObjectName+' is not published', - LFMObject.NamePosition); - exit; - end; - - // find class node - ClassContext:=FindClassNodeForLFMObject(LFMObject,LFMObject.TypeNamePosition, - ChildContext.Tool,DefinitionNode); if ClassContext.Node=nil then exit; // check child LFM nodes @@ -1185,7 +1250,8 @@ var CurName:=LFMProperty.NameParts.Names[i]; if not FindLFMIdentifier(LFMProperty, LFMProperty.NameParts.NamePositions[i], - CurName,SearchContext,true,CurPropertyContext) + CurName,SearchContext,true,true, + CurPropertyContext) then break; if CurPropertyContext.Node=nil then begin @@ -1211,7 +1277,7 @@ var case CurLFMNode.TheType of lfmnObject: - CheckLFMChildObject(TLFMObjectNode(CurLFMNode),ClassContext); + CheckLFMChildObject(TLFMObjectNode(CurLFMNode),ClassContext,false); lfmnProperty: CheckLFMProperty(TLFMPropertyNode(CurLFMNode),ClassContext); @@ -1222,43 +1288,6 @@ var Result:=true; end; - function FindClassContext(const ClassName: string): TFindContext; - var - Params: TFindDeclarationParams; - Identifier: PChar; - OldInput: TFindDeclarationInput; - StartTool: TStandardCodeTool; - begin - Result:=CleanFindContext; - Params:=TFindDeclarationParams.Create; - StartTool:=Self; - Identifier:=PChar(ClassName); - try - Params.Flags:=[fdfExceptionOnNotFound, - fdfSearchInParentNodes, - fdfExceptionOnPredefinedIdent,fdfIgnoreMissingParams, - fdfIgnoreOverloadedProcs]; - Params.ContextNode:=FindInterfaceNode; - if Params.ContextNode=nil then - Params.ContextNode:=FindMainUsesSection; - Params.SetIdentifier(StartTool,Identifier,nil); - try - Params.Save(OldInput); - if FindIdentifierInContext(Params) then begin - Params.Load(OldInput); - Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); - if (Result.Node=nil) or (Result.Node.Desc<>ctnClass) then - Result:=CleanFindContext; - end; - except - // ignore search/parse errors - on E: ECodeToolError do ; - end; - finally - Params.Free; - end; - end; - function CheckLFMRoot(RootLFMNode: TLFMTreeNode): boolean; var LookupRootLFMNode: TLFMObjectNode; diff --git a/designer/changeclassdialog.pas b/designer/changeclassdialog.pas index 16e8763a86..0d30944b2c 100644 --- a/designer/changeclassdialog.pas +++ b/designer/changeclassdialog.pas @@ -167,7 +167,8 @@ var end; ComponentStream.Position:=0; LFMBuffer.LoadFromStream(ComponentStream); - if not CodeToolBoss.CheckLFM(UnitCode,LFMBuffer,LFMTree,false) then begin + if not CodeToolBoss.CheckLFM(UnitCode,LFMBuffer,LFMTree,false,false) then + begin debugln('ChangePersistentClass-Before--------------------------------------------'); debugln(LFMBuffer.Source); debugln('ChangePersistentClass-Before--------------------------------------------'); @@ -210,7 +211,7 @@ var function CheckProperties: boolean; begin - Result:=CheckLFMBuffer(UnitCode,LFMBuffer,nil,false); + Result:=CheckLFMBuffer(UnitCode,LFMBuffer,nil,false,false); if not Result and (CodeToolBoss.ErrorMessage<>'') then MainIDEInterface.DoJumpToCodeToolBossError; end; diff --git a/ide/checklfmdlg.pas b/ide/checklfmdlg.pas index 22443fcd6e..6d07fa2f6e 100644 --- a/ide/checklfmdlg.pas +++ b/ide/checklfmdlg.pas @@ -33,8 +33,8 @@ interface uses // FCL+LCL - Classes, SysUtils, Math, LResources, Forms, Controls, Graphics, Dialogs, - Buttons, StdCtrls, + Classes, SysUtils, Math, LCLProc, LResources, Forms, Controls, Graphics, + Dialogs, Buttons, StdCtrls, // components SynHighlighterLFM, SynEdit, BasicCodeTools, CodeCache, CodeToolManager, LFMTrees, @@ -78,9 +78,11 @@ type end; function CheckLFMBuffer(PascalBuffer, LFMBuffer: TCodeBuffer; - const OnOutput: TOnOutputString; RootMustBeClassInIntf: boolean): boolean; + const OnOutput: TOnOutputString; + RootMustBeClassInIntf, ObjectsMustExists: boolean): boolean; function CheckLFMText(PascalBuffer: TCodeBuffer; var LFMText: string; - const OnOutput: TOnOutputString; RootMustBeClassInIntf: boolean): boolean; + const OnOutput: TOnOutputString; + RootMustBeClassInIntf, ObjectsMustExists: boolean): boolean; function ShowRepairLFMWizard(LFMBuffer: TCodeBuffer; LFMTree: TLFMTree): boolean; @@ -95,7 +97,8 @@ type end; function CheckLFMBuffer(PascalBuffer, LFMBuffer: TCodeBuffer; - const OnOutput: TOnOutputString; RootMustBeClassInIntf: boolean): boolean; + const OnOutput: TOnOutputString; + RootMustBeClassInIntf, ObjectsMustExists: boolean): boolean; var LFMTree: TLFMTree; @@ -125,7 +128,7 @@ begin LFMTree:=nil; try Result:=CodeToolBoss.CheckLFM(PascalBuffer,LFMBuffer,LFMTree, - RootMustBeClassInIntf); + RootMustBeClassInIntf,ObjectsMustExists); if Result then exit; WriteLFMErrors; Result:=ShowRepairLFMWizard(LFMBuffer,LFMTree); @@ -135,7 +138,8 @@ begin end; function CheckLFMText(PascalBuffer: TCodeBuffer; var LFMText: string; - const OnOutput: TOnOutputString; RootMustBeClassInIntf: boolean): boolean; + const OnOutput: TOnOutputString; + RootMustBeClassInIntf, ObjectsMustExists: boolean): boolean; var LFMBuf: TCodeBuffer; begin @@ -143,7 +147,8 @@ begin LFMBuf:=CodeToolBoss.CreateTempFile('temp.lfm'); try LFMBuf.Source:=LFMText; - Result:=CheckLFMBuffer(PascalBuffer,LFMBuf,OnOutput,RootMustBeClassInIntf); + Result:=CheckLFMBuffer(PascalBuffer,LFMBuf,OnOutput,RootMustBeClassInIntf, + ObjectsMustExists); LFMText:=LFMBuf.Source; finally CodeToolBoss.ReleaseTempFile(LFMBuf); @@ -293,6 +298,7 @@ begin // New and Entry intersects if (Entry.NewText='') and (NewText='') then begin // both are deletes => combine + debugln('TCheckLFMDialog.AddReplacement Combine Deletion: Old=',dbgs(Entry.StartPos),'-',dbgs(Entry.EndPos),' New=',dbgs(StartPos),'-',dbgs(EndPos)); StartPos:=Min(StartPos,Entry.StartPos); EndPos:=Max(EndPos,Entry.EndPos); end else begin @@ -304,20 +310,14 @@ begin // combine deletions if NewText='' then begin - for i:=0 to LFMChangeList.Count-1 do begin + for i:=LFMChangeList.Count-1 downto 0 do begin Entry:=TLFMChangeEntry(LFMChangeList[i]); if ((Entry.StartPosStartPos)) then begin // New and Entry intersects - Entry.StartPos:=Min(StartPos,Entry.StartPos); - Entry.EndPos:=Max(EndPos,Entry.EndPos); - if (i remove Entry + debugln('TCheckLFMDialog.AddReplacement Intersecting Deletion: Old=',dbgs(Entry.StartPos),'-',dbgs(Entry.EndPos),' New=',dbgs(StartPos),'-',dbgs(EndPos)); + LFMChangeList.Delete(i); + Entry.Free; end; end; end; @@ -332,18 +332,14 @@ begin end else begin for i:=0 to LFMChangeList.Count-1 do begin Entry:=TLFMChangeEntry(LFMChangeList[i]); - if Entry.StartPos>EndPos then begin + if EndPos<=Entry.StartPos then begin + // insert in front LFMChangeList.Insert(i,NewEntry); break; - end else begin - if (iEndPos then begin - LFMChangeList.Insert(i+1,NewEntry); - break; - end; + end else if i=LFMChangeList.Count-1 then begin + // insert behind + LFMChangeList.Add(NewEntry); + break; end; end; end; diff --git a/ide/main.pp b/ide/main.pp index 23f575da2c..9528d1ed5c 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -6550,7 +6550,8 @@ begin DoArrangeSourceEditorAndMessageView(false); // parse the LFM file and the pascal unit - if not CheckLFMBuffer(PascalBuf,LFMUnitInfo.Source,@MessagesView.AddMsg,true) + if not CheckLFMBuffer(PascalBuf,LFMUnitInfo.Source,@MessagesView.AddMsg, + true,true) then begin DoJumpToCompilerMessage(-1,true); end; @@ -6637,8 +6638,8 @@ begin if HasDFMFile and (LFMCode=nil) then writeln('WARNING: TMainIDE.DoConvertDelphiUnit unable to load LFMCode'); if (LFMCode<>nil) - and (not CheckLFMBuffer(UnitCode,LFMCode,@MessagesView.AddMsg,true)) then - begin + and (not CheckLFMBuffer(UnitCode,LFMCode,@MessagesView.AddMsg,true,true)) + then begin DoJumpToCompilerMessage(-1,true); exit; end; @@ -10532,6 +10533,9 @@ end. { ============================================================================= $Log$ + Revision 1.748 2004/08/08 21:52:01 mattias + change component class dlg now works with child controls + Revision 1.747 2004/08/08 20:51:15 mattias replaced TDBEdit.WMKillFocus by EditingDone, Change Class basically working