From 46ae7f0d8510eb26834b8fed01af84b844ad5b92 Mon Sep 17 00:00:00 2001 From: lazarus Date: Sat, 9 Feb 2002 02:30:15 +0000 Subject: [PATCH] MG: many fixes on my way to events git-svn-id: trunk@1391 - --- components/codetools/codecache.pas | 2 + components/codetools/definetemplates.pas | 22 +- components/codetools/eventcodetool.pas | 147 +++++++- components/codetools/finddeclarationtool.pas | 331 ++++++++++++------- components/codetools/pascalparsertool.pas | 43 ++- designer/designer.pp | 24 +- designer/propedits.pp | 90 ++--- ide/editdefinetree.pas | 30 +- ide/environmentopts.pp | 5 +- ide/include/ide.inc | 2 + ide/main.pp | 107 ++++-- ide/uniteditor.pp | 37 ++- 12 files changed, 587 insertions(+), 253 deletions(-) diff --git a/components/codetools/codecache.pas b/components/codetools/codecache.pas index b99dc8175d..a2619097b6 100644 --- a/components/codetools/codecache.pas +++ b/components/codetools/codecache.pas @@ -575,6 +575,8 @@ end; function TCodeBuffer.LoadFromFile(const AFilename: string): boolean; begin +//writeln('[TCodeBuffer.LoadFromFile] WriteLock=',WriteLock,' ReadOnly=',ReadOnly, +//' IsVirtual=',IsVirtual,' Old="',Filename,'" ',CompareFilenames(AFilename,Filename)); if (WriteLock>0) or (ReadOnly) then begin Result:=false; exit; diff --git a/components/codetools/definetemplates.pas b/components/codetools/definetemplates.pas index 4a2bfe027b..3633e62897 100644 --- a/components/codetools/definetemplates.pas +++ b/components/codetools/definetemplates.pas @@ -205,10 +205,10 @@ type var UnitSearchPath: string): TDefineTemplate; function CreateFPCSrcTemplate(const FPCSrcDir, UnitSearchPath: string): TDefineTemplate; - function CreateLCLProjectTemplate(const LazarusSrcDir, WidgetType, - ProjectDir: string): TDefineTemplate; function CreateLazarusSrcTemplate( const LazarusSrcDir, WidgetType: string): TDefineTemplate; + function CreateLCLProjectTemplate(const LazarusSrcDir, WidgetType, + ProjectDir: string): TDefineTemplate; procedure Clear; constructor Create; destructor Destroy; override; @@ -1825,7 +1825,7 @@ begin DirTempl.AddChild(TDefineTemplate.Create('LCL path addition', 'adds lcl to SrcPath', ExternalMacroStart+'SrcPath', - '..'+ds+'lcl' + '..'+ds+'lcl' +';..'+ds+'lcl'+ds+'interfaces'+ds+WidgetType +';'+SrcPath ,da_Define)); @@ -1834,10 +1834,11 @@ begin ExternalMacroStart+'SrcPath', '..;'+SrcPath ,da_Define)); - DirTempl.AddChild(TDefineTemplate.Create('synedit path addition', + DirTempl.AddChild(TDefineTemplate.Create('components path addition', 'adds synedit directory to SrcPath', ExternalMacroStart+'SrcPath', - '../components/synedit;'+SrcPath + '..'+ds+'components'+ds+'synedit;'+'..'+ds+'components'+ds+'codetools;' + +SrcPath ,da_Define)); DirTempl.AddChild(TDefineTemplate.Create('includepath addition', 'adds include to IncPath',ExternalMacroStart+'IncPath', @@ -1848,7 +1849,16 @@ begin // images // debugger - + DirTempl:=TDefineTemplate.Create('Debugger','Debugger Directory', + '','debugger',da_Directory); + DirTempl.AddChild(TDefineTemplate.Create('LCL path addition', + 'adds lcl to SrcPath', + ExternalMacroStart+'SrcPath', + '..'+ds+'lcl' + +';..'+ds+'lcl'+ds+'interfaces'+ds+WidgetType + +';'+SrcPath + ,da_DefineAll)); + if MainDir<>nil then begin Result:=TDefineTemplate.Create(StdDefTemplLazarusSources, 'Lazarus Sources, LCL, IDE, Components, Examples, Tools','','',da_Block); diff --git a/components/codetools/eventcodetool.pas b/components/codetools/eventcodetool.pas index 1223449890..7695545911 100644 --- a/components/codetools/eventcodetool.pas +++ b/components/codetools/eventcodetool.pas @@ -34,22 +34,28 @@ interface {$I codetools.inc} +{$DEFINE CTDEBUG} + uses {$IFDEF MEM_CHECK} MemCheck, {$ENDIF} Classes, SysUtils, CodeTree, CodeAtom, PascalParserTool, MethodJumpTool, SourceLog, KeywordFuncLists, BasicCodeTools, LinkScanner, CodeCache, AVL_Tree, - TypInfo, SourceChanger; + TypInfo, SourceChanger, FindDeclarationTool; type TGetStringProc = procedure(const s: string) of object; TEventsCodeTool = class(TMethodJumpingCodeTool) + private + GetCompatibleMethodsProc: TGetStringProc; protected function InsertNewMethodToClass(ClassSectionNode: TCodeTreeNode; const AMethodName,NewMethod: string; SourceChangeCache: TSourceChangeCache): boolean; + function CollectPublishedMethods(Params: TFindDeclarationParams; + FoundContext: TFindContext): TIdentifierFoundResult; public procedure GetCompatiblePublishedMethods(const UpperClassName: string; TypeData: PTypeData; Proc: TGetStringProc); @@ -77,6 +83,8 @@ type function MethodTypeDataToStr(TypeData: PTypeData; Attr: TProcHeadAttributes): string; + function CreateExprListFromMethodTypeData(TypeData: PTypeData; + Params: TFindDeclarationParams): TExprTypeList; function FindPublishedMethodNodeInClass(ClassNode: TCodeTreeNode; const UpperMethodName: string; TypeData: PTypeData): TCodeTreeNode; function FindProcNodeInImplementation(const UpperClassName, @@ -181,17 +189,38 @@ end; procedure TEventsCodeTool.GetCompatiblePublishedMethods( ClassNode: TCodeTreeNode; TypeData: PTypeData; Proc: TGetStringProc); -var SearchedProc: string; - SectionNode, ANode: TCodeTreeNode; - CurProcHead, CurProcName: string; +var //SearchedProc: string; + //SectionNode, ANode: TCodeTreeNode; + //CurProcHead, CurProcName: string; + Params: TFindDeclarationParams; + ExprList: TExprTypeList; begin if (ClassNode=nil) or (ClassNode.Desc<>ctnClass) or (TypeData=nil) or (Proc=nil) then exit; BuildSubTreeForClass(ClassNode); - SearchedProc:=MethodTypeDataToStr(TypeData,[phpInUpperCase]); {$IFDEF CTDEBUG} -writeln('[TEventsCodeTool.GetCompatibleMethods] SearchedProc="',SearchedProc,'"'); +writeln('[TEventsCodeTool.GetCompatiblePublishedMethods]'); {$ENDIF} + // 1. convert the TypeData to an expression type list + Params:=TFindDeclarationParams.Create; + try + Params.ContextNode:=ClassNode.Parent; + ExprList:=CreateExprListFromMethodTypeData(TypeData,Params); + try + // 2. search all compatible published procs + GetCompatibleMethodsProc:=Proc; + Params.ContextNode:=ClassNode; + Params.Flags:=[fdfCollect,fdfSearchInAncestors,fdfClassPublished]; + Params.SetIdentifier(Self,nil,@CollectPublishedMethods); + FindIdentifierInContext(Params); + finally + ExprList.Free; + end; + finally + Params.Free; + end; + { + SearchedProc:=MethodTypeDataToStr(TypeData,[phpInUpperCase]); SectionNode:=ClassNode.FirstChild; while (SectionNode<>nil) do begin while (SectionNode.Desc<>ctnClassPublished) or (SectionNode.FirstChild=nil) @@ -203,9 +232,6 @@ writeln('[TEventsCodeTool.GetCompatibleMethods] SearchedProc="',SearchedProc,'"' repeat if (ANode.Desc=ctnProcedure) then begin CurProcHead:=ExtractProcHead(ANode,[phpInUpperCase,phpWithoutName]); -{$IFDEF CTDEBUG} -writeln('[TEventsCodeTool.GetCompatibleMethods] CurProcName="',CurProcHead,'"'); -{$ENDIF} if (CurProcHead<>'') and (CompareTextIgnoringSpace(CurProcHead,SearchedProc,true)=0) then begin @@ -218,6 +244,7 @@ writeln('[TEventsCodeTool.GetCompatibleMethods] CurProcName="',CurProcHead,'"'); until ANode=nil; SectionNode:=SectionNode.NextBrother; end; + } end; function TEventsCodeTool.FindPublishedMethodNodeInClass( @@ -661,6 +688,108 @@ writeln('[TEventsCodeTool.InsertNewMethodToClass] L'); Result:=true; end; +function TEventsCodeTool.CreateExprListFromMethodTypeData( + TypeData: PTypeData; Params: TFindDeclarationParams): TExprTypeList; +var i, ParamCount, Len, Offset: integer; + CurTypeIdentifier: string; + OldInput: TFindDeclarationInput; + CurExprType: TExpressionType; +begin +{$IFDEF CTDEBUG} +writeln('[TEventsCodeTool.CreateExprListFromMethodTypeData] START'); +{$ENDIF} + Result:=TExprTypeList.Create; + if TypeData=nil then exit; + ParamCount:=TypeData^.ParamCount; + if ParamCount>0 then begin + + //Result:=Result+'('; + //ParamString:=''; + Offset:=0; + + for i:=0 to ParamCount-1 do begin + + // skip ParamFlags + // ToDo: check this: SizeOf(TParamFlags) is 4, but the data is only 1 byte + Len:=1; // typinfo.pp comment is wrong: SizeOf(TParamFlags) + inc(Offset,Len); + + // skip ParamName + Len:=ord(TypeData^.ParamList[Offset]); + inc(Offset,Len+1); + + // read ParamType + Len:=ord(TypeData^.ParamList[Offset]); + inc(Offset); + SetLength(CurTypeIdentifier,Len); + if CurTypeIdentifier<>'' then + Move(TypeData^.ParamList[Offset],CurTypeIdentifier[1],Len); + inc(Offset,Len); + +{$IFDEF CTDEBUG} +writeln('[TEventsCodeTool.CreateExprListFromMethodTypeData] A ', +' i=',i,'/',ParamCount, +' Ident=',CurTypeIdentifier +); +{$ENDIF} + + // convert ParamType to TExpressionType + Params.Save(OldInput); + Params.SetIdentifier(Self,@CurTypeIdentifier[1],nil); + Params.Flags:=[fdfExceptionOnNotFound,fdfSearchInParentNodes, + fdfIgnoreCurContextNode,fdfClassPublished] + +(fdfGlobals*Params.Flags) + -[fdfSearchInAncestors, + fdfClassPublic,fdfClassProtected,fdfClassPrivate]; + CurExprType:=GetExpressionTypeOfTypeIdentifier(Params); +{$IFDEF CTDEBUG} +writeln('[TEventsCodeTool.CreateExprListFromMethodTypeData] B ', +' i=',i,'/',ParamCount, +' Ident=',CurTypeIdentifier, +' CurExprType=',ExprTypeToString(CurExprType) +); +{$ENDIF} + + Result.Add(CurExprType); + Params.Load(OldInput); + + {// build string + if phpWithVarModifiers in Attr then begin + if pfVar in ParamType.Flags then + s:='var ' + else if pfConst in ParamType.Flags then + s:='const ' + else if pfOut in ParamType.Flags then + s:='out ' + else + s:=''; + end else + s:=''; + if phpWithParameterNames in Attr then + s:=s+ParamType.ParamName; + s:=s+':'+ParamType.TypeName; + if i>0 then s:=s+';'; + ParamString:=s+ParamString;} + end; + //Result:=Result+ParamString+')'; + end; + {if phpInUpperCase in Attr then Result:=UpperCaseStr(Result); + Result:=Result+';';} + +end; + +function TEventsCodeTool.CollectPublishedMethods( + Params: TFindDeclarationParams; FoundContext: TFindContext + ): TIdentifierFoundResult; +begin +{$IFDEF CTDEBUG} +writeln('[TEventsCodeTool.CollectPublishedMethods] ', +' Node=',FoundContext.Node.DescAsString, +' Tool=',FoundContext.Tool.MainFilename); +{$ENDIF} + Result:=ifrProceedSearch; +end; + end. diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index ce21731a4c..8792d8183b 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -40,6 +40,7 @@ interface // activate for debug: { $DEFINE CTDEBUG} +{ $DEFINE ShowSearchPaths} { $DEFINE ShowTriedFiles} { $DEFINE ShowTriedContexts} { $DEFINE ShowExprEval} @@ -80,9 +81,12 @@ type fdfFirstIdentFound, // a first identifier was found, now searching for // the a better one (used for proc overloading) fdfOnlyCompatibleProc, // incompatible procs are ignored - fdfNoExceptionOnStringChar// the bracket operator after a predefined string + fdfNoExceptionOnStringChar,// the bracket operator after a predefined string // is of type char, which is also predefined, so it // can not be resolved normally + fdfFunctionResult, // if searching base type of function, + // return result type + fdfCollect // return every reachable identifier ); TFindDeclarationFlags = set of TFindDeclarationFlag; @@ -297,6 +301,8 @@ type function FindIdentifierInContext(Params: TFindDeclarationParams): boolean; function FindBaseTypeOfNode(Params: TFindDeclarationParams; Node: TCodeTreeNode): TFindContext; + function GetExpressionTypeOfTypeIdentifier( + Params: TFindDeclarationParams): TExpressionType; function FindClassOfMethod(ProcNode: TCodeTreeNode; Params: TFindDeclarationParams; FindClassContext: boolean): boolean; function FindAncestorOfClass(ClassNode: TCodeTreeNode; @@ -343,19 +349,31 @@ type function ConsistencyCheck: integer; override; end; - -implementation - - const fdfAllClassVisibilities = [fdfClassPublished,fdfClassPublic,fdfClassProtected, fdfClassPrivate]; fdfGlobals = [fdfExceptionOnNotFound, fdfIgnoreUsedUnits]; fdfGlobalsSameIdent = fdfGlobals+[fdfIgnoreMissingParams,fdfFirstIdentFound, - fdfOnlyCompatibleProc,fdfSearchInAncestors]; + fdfOnlyCompatibleProc,fdfSearchInAncestors,fdfCollect]; fdfDefaultForExpressions = [fdfSearchInParentNodes,fdfSearchInAncestors, fdfExceptionOnNotFound]+fdfAllClassVisibilities; - + +function ExprTypeToString(ExprType: TExpressionType): string; + + +implementation + + +function ExprTypeToString(ExprType: TExpressionType): string; +begin + Result:='Desc='+ExpressionTypeDescNames[ExprType.Desc] + +' SubDesc='+ExpressionTypeDescNames[ExprType.SubDesc]; + if ExprType.Context.Node<>nil then begin + Result:=Result+' Node='+ExprType.Context.Node.DescAsString + +' File="'+ExprType.Context.Tool.MainFilename+'"'; + end; +end; + { TFindContext } @@ -552,13 +570,13 @@ end; function TFindDeclarationTool.FindUnitSource(const AnUnitName, AnUnitInFilename: string): TCodeBuffer; - function LoadFile(const ExpandedFilename: string; + function LoadFile(const AFilename: string; var NewCode: TCodeBuffer): boolean; begin {$IFDEF ShowTriedFiles} -writeln('TFindDeclarationTool.FindUnitSource.LoadFile ',ExpandedFilename); +writeln('TFindDeclarationTool.FindUnitSource.LoadFile ',AFilename); {$ENDIF} - NewCode:=TCodeBuffer(Scanner.OnLoadSource(Self,ExpandedFilename)); + NewCode:=TCodeBuffer(Scanner.OnLoadSource(Self,ExpandFilename(AFilename))); Result:=NewCode<>nil; end; @@ -683,8 +701,10 @@ writeln('TFindDeclarationTool.FindUnitSource A AnUnitName=',AnUnitName,' AnUnitI UnitSrcSearchPath:=OnGetUnitSourceSearchPath(Self) else UnitSrcSearchPath:=Scanner.Values[ExternalMacroStart+'SrcPath']; -{$IFDEF ShowTriedFiles} -writeln('TFindDeclarationTool.FindUnitSource UnitSrcSearchPath=',UnitSrcSearchPath); +{$IFDEF ShowSearchPaths} +writeln('TFindDeclarationTool.FindUnitSource ', +' Self="',MainFilename,'"', +' UnitSrcSearchPath=',UnitSrcSearchPath); {$ENDIF} //writeln('>>>>>',Scanner.Values.AsString,'<<<<<'); if AnUnitInFilename<>'' then begin @@ -906,15 +926,23 @@ if (ContextNode.Desc=ctnClass) then ctnTypeDefinition, ctnVarDefinition, ctnConstDefinition: begin - if CompareSrcIdentifiers(ContextNode.StartPos,Params.Identifier) - then begin + if not (fdfCollect in Params.Flags) then begin + if CompareSrcIdentifiers(ContextNode.StartPos,Params.Identifier) + then begin {$IFDEF ShowTriedContexts} writeln(' Definition Identifier found="',GetIdentifier(Params.Identifier),'"'); {$ENDIF} - // identifier found - Result:=true; - Params.SetResult(Self,ContextNode); - exit; + // identifier found + Result:=true; + Params.SetResult(Self,ContextNode); + exit; + end; + end else begin + IdentifierFoundResult:=DoOnIdentifierFound(Params,ContextNode); + if IdentifierFoundResult in [ifrAbortSearch,ifrSuccess] then begin + Result:=(IdentifierFoundResult=ifrSuccess); + exit; + end; end; // search for enums Params.ContextNode:=ContextNode; @@ -926,20 +954,9 @@ writeln(' Definition Identifier found="',GetIdentifier(Params.Identifier),'"'); begin IdentifierFoundResult:= FindIdentifierInProcContext(ContextNode,Params); - case IdentifierFoundResult of - - ifrSuccess: - begin - Result:=true; - exit; - end; - - ifrAbortSearch: - begin - Result:=false; - exit; - end; - + if IdentifierFoundResult in [ifrAbortSearch,ifrSuccess] then begin + Result:=(IdentifierFoundResult=ifrSuccess); + exit; end; end; @@ -952,18 +969,26 @@ writeln(' Definition Identifier found="',GetIdentifier(Params.Identifier),'"'); ctnProgram, ctnPackage, ctnLibrary, ctnUnit: begin - MoveCursorToNodeStart(ContextNode); - ReadNextAtom; // read keyword - ReadNextAtom; // read name - if CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier) then - begin - // identifier found + if not (fdfCollect in Params.Flags) then begin + MoveCursorToNodeStart(ContextNode); + ReadNextAtom; // read keyword + ReadNextAtom; // read name + if CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier) then + begin + // identifier found {$IFDEF ShowTriedContexts} writeln(' Source Name Identifier found="',GetIdentifier(Params.Identifier),'"'); {$ENDIF} - Result:=true; - Params.SetResult(Self,ContextNode,CurPos.StartPos); - exit; + Result:=true; + Params.SetResult(Self,ContextNode,CurPos.StartPos); + exit; + end; + end else begin + IdentifierFoundResult:=DoOnIdentifierFound(Params,ContextNode); + if IdentifierFoundResult in [ifrAbortSearch,ifrSuccess] then begin + Result:=(IdentifierFoundResult=ifrSuccess); + exit; + end; end; Result:=FindIdentifierInHiddenUsedUnits(Params); if Result then exit; @@ -971,28 +996,36 @@ writeln(' Source Name Identifier found="',GetIdentifier(Params.Identifier),'"') ctnProperty: begin - if (Params.Identifier[0]<>'[') then begin - MoveCursorToNodeStart(ContextNode); - ReadNextAtom; // read keyword 'property' - ReadNextAtom; // read name - if CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier) then - begin - // identifier found - - // ToDo: identifiers after 'read', 'write' are procs with - // special parameter lists - + if not (fdfCollect in Params.Flags) then begin + if (Params.Identifier[0]<>'[') then begin + MoveCursorToNodeStart(ContextNode); + ReadNextAtom; // read keyword 'property' + ReadNextAtom; // read name + if CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier) then + begin + // identifier found + + // ToDo: identifiers after 'read', 'write' are procs with + // special parameter lists + {$IFDEF ShowTriedContexts} writeln(' Property Identifier found="',GetIdentifier(Params.Identifier),'"'); {$ENDIF} - Result:=true; - Params.SetResult(Self,ContextNode,CurPos.StartPos); - exit; + Result:=true; + Params.SetResult(Self,ContextNode,CurPos.StartPos); + exit; + end; + end else begin + // the default property is searched + Result:=PropertyIsDefault(ContextNode); + if Result then exit; end; end else begin - // the default property is searched - Result:=PropertyIsDefault(ContextNode); - if Result then exit; + IdentifierFoundResult:=DoOnIdentifierFound(Params,ContextNode); + if IdentifierFoundResult in [ifrAbortSearch,ifrSuccess] then begin + Result:=(IdentifierFoundResult=ifrSuccess); + exit; + end; end; end; @@ -1211,6 +1244,8 @@ function TFindDeclarationTool.FindContextNodeAtCursor( 8. (A as B) - CleanPos points to ')': if B is a classtype, the context node will be the class node (ctnClass) + 9. (@A) - CleanPos points to ')': if A is a function, not the result is + returned, but the function itself } type TAtomType = (atNone, atSpace, atIdentifier, atPreDefIdentifier, atPoint, atAS, @@ -1259,7 +1294,7 @@ const var CurAtom, NextAtom: TAtomPosition; OldInput: TFindDeclarationInput; NextAtomType, CurAtomType: TAtomType; - ProcNode: TCodeTreeNode; + ProcNode, FuncResultNode: TCodeTreeNode; ExprType: TExpressionType; begin // start parsing the expression from right to left @@ -1355,7 +1390,10 @@ writeln(''); ProcNode:=Params.ContextNode; while (ProcNode<>nil) do begin if (ProcNode.Desc=ctnProcedure) then begin + Params.Save(OldInput); + Include(Params.Flags,fdfFunctionResult); Result:=Result.Tool.FindBaseTypeOfNode(Params,ProcNode); + Params.Load(OldInput); exit; end; ProcNode:=ProcNode.Parent; @@ -1387,8 +1425,24 @@ writeln(''); finally Params.Load(OldInput); end; - if Result.Node<>nil then + if Result.Node<>nil then begin Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node); + if (Result.Node<>nil) and (Result.Node.Desc=ctnProcedure) then begin + Result.Tool.BuildSubTreeForProcHead(Result.Node,FuncResultNode); + if FuncResultNode<>nil then begin + // this is function + if (NextAtomType in [atSpace,atRoundBracketClose]) then begin + // In Delphi Mode or if there is a @ qualifier return the + // function + + // ToDo: + + end; + // Otherwise return the result type + Result:=Result.Tool.FindBaseTypeOfNode(Params,FuncResultNode); + end; + end; + end; end; atPoint: @@ -1435,9 +1489,8 @@ writeln(''); // for example: // 1. 'PInt = ^integer' pointer type // 2. a^ dereferencing - if not (NextAtomType in [atSpace,atPoint,atUp,atAS,atEdgedBracketClose, - atEdgedBracketOpen,atRoundBracketClose]) then - begin + if not (NextAtomType in [atSpace,atPoint,atUp,atAS,atEdgedBracketOpen]) + then begin MoveCursorToCleanPos(NextAtom.StartPos); ReadNextAtom; RaiseException('illegal qualifier "'+GetAtom+'" found'); @@ -1445,7 +1498,8 @@ writeln(''); if Result.Node<>Params.ContextNode then begin // left side of expression has defined a special context // => this '^' is a dereference - if (not (NextAtomType in [atSpace,atPoint,atAS,atUP])) then begin + if (not (NextAtomType in [atSpace,atPoint,atAS,atUP,atEdgedBracketOpen])) + then begin MoveCursorToCleanPos(NextAtom.StartPos); ReadNextAtom; RaiseException('. expected, but '+GetAtom+' found'); @@ -1616,7 +1670,7 @@ end; function TFindDeclarationTool.FindBaseTypeOfNode(Params: TFindDeclarationParams; Node: TCodeTreeNode): TFindContext; var OldInput: TFindDeclarationInput; - ClassIdentNode: TCodeTreeNode; + ClassIdentNode, DummyNode: TCodeTreeNode; IsPredefinedIdentifier: boolean; NodeStack: TCodeTreeNodeStack; begin @@ -1718,41 +1772,56 @@ writeln('[TFindDeclarationTool.FindBaseTypeOfNode] Class is forward'); end else if (Result.Node.Desc=ctnProperty) then begin // this is a property -> search the type definition of the property - ReadTilTypeOfProperty(Result.Node); - Params.Save(OldInput); - try - Params.SetIdentifier(Self,@Src[CurPos.StartPos],@CheckSrcIdentifier); - Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound] - +(fdfGlobals*Params.Flags) - -[fdfIgnoreUsedUnits]; - Params.ContextNode:=Result.Node.Parent; - FindIdentifierInContext(Params); - if Result.Node.HasAsParent(Params.NewNode) then - break; - Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); - exit; - finally - Params.Load(OldInput); + if ReadTilTypeOfProperty(Result.Node) then begin + // property has type + Params.Save(OldInput); + try + Params.SetIdentifier(Self,@Src[CurPos.StartPos],nil); + Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound] + +(fdfGlobals*Params.Flags) + -[fdfIgnoreUsedUnits]; + Params.ContextNode:=Result.Node.Parent; + FindIdentifierInContext(Params); + if Result.Node.HasAsParent(Params.NewNode) then + break; + Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); + exit; + finally + Params.Load(OldInput); + end; + end else begin + // property has no type + // -> search ancestor property + Params.Save(OldInput); + try + MoveCursorToNodeStart(Result.Node); + ReadNextAtom; // read 'property' + ReadNextAtom; // read name + Params.SetIdentifier(Self,@Src[CurPos.StartPos],nil); + Params.Flags:=[fdfExceptionOnNotFound,fdfSearchInAncestors] + +(fdfGlobalsSameIdent*Params.Flags); + FindIdentifierInAncestors(Result.Node.Parent.Parent,Params); + Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); + exit; + finally + Params.Load(OldInput); + end; end; end else - if (Result.Node.Desc in [ctnProcedure,ctnProcedureHead]) then begin + if (Result.Node.Desc in [ctnProcedure,ctnProcedureHead]) + and (fdfFunctionResult in Params.Flags) then begin // a proc -> if this is a function return the result type - if Result.Node.Desc=ctnProcedureHead then - Result.Node:=Result.Node.Parent; - MoveCursorToNodeStart(Result.Node); - ReadNextAtom; - if UpAtomIs('CLASS') then ReadNextAtom; - if UpAtomIs('FUNCTION') then begin - // in a function -> find the result type - // build nodes for parameter list and result type - BuildSubTreeForProcHead(Result.Node); - // a proc node contains has as FirstChild a proc-head node - // and a proc-head node has as childs the parameterlist and the result - Result.Node:=Result.Node.FirstChild.FirstChild; - if Result.Node.Desc=ctnParameterList then - Result.Node:=Result.Node.NextBrother; - end else - break; + BuildSubTreeForProcHead(Result.Node); + // a proc node contains as FirstChild a proc-head node + DummyNode:=Result.Node; + if DummyNode.Desc=ctnProcedure then + DummyNode:=DummyNode.FirstChild; + // and a proc-head node has as childs the parameterlist and the result + DummyNode:=DummyNode.FirstChild; + if (DummyNode<>nil) and (DummyNode.Desc=ctnParameterList) then + DummyNode:=DummyNode.NextBrother; + if DummyNode<>nil then Result.Node:=DummyNode; + Exclude(Params.Flags,fdfFunctionResult); end else if (Result.Node.Desc=ctnTypeType) then begin // a TypeType is for example 'MyInt = type integer;' @@ -1818,14 +1887,14 @@ begin // -> proceed the search normally ... end else begin // proc is a proc declaration - if CompareSrcIdentifiers(NameAtom.StartPos,Params.Identifier) then - begin - // proc identifier found + if not (fdfCollect in Params.Flags) then begin + if CompareSrcIdentifiers(NameAtom.StartPos,Params.Identifier) then begin + // proc identifier found {$IFDEF CTDEBUG} writeln('[TFindDeclarationTool.FindIdentifierInProcContext] Proc-Identifier found="',GetIdentifier(Params.Identifier),'"'); {$ENDIF} - Params.SetResult(Self,ProcContextNode,NameAtom.StartPos); - Result:=DoOnIdentifierFound(Params,ProcContextNode); + Params.SetResult(Self,ProcContextNode,NameAtom.StartPos); + Result:=DoOnIdentifierFound(Params,ProcContextNode); {$IFDEF CTDEBUG} if Result=ifrSuccess then writeln('[TFindDeclarationTool.FindIdentifierInProcContext] ', @@ -1833,8 +1902,11 @@ if Result=ifrSuccess then ' Params.NewNode="',Params.NewNode.DescAsString,'"' ); {$ENDIF} + end else begin + // proceed the search normally ... + end; end else begin - // proceed the search normally ... + Result:=DoOnIdentifierFound(Params,ProcContextNode); end; end; end; @@ -1847,6 +1919,7 @@ var ClassNameAtom: TAtomPosition; OldInput: TFindDeclarationInput; ClassContext: TFindContext; + IdentifierFoundResult: TIdentifierFoundResult; begin Result:=false; // if proc is a method, search in class @@ -1870,7 +1943,7 @@ begin +(fdfGlobals*Params.Flags) +[fdfExceptionOnNotFound,fdfIgnoreUsedUnits]; Params.ContextNode:=ProcContextNode; - Params.SetIdentifier(Self,@Src[ClassNameAtom.StartPos],@CheckSrcIdentifier); + Params.SetIdentifier(Self,@Src[ClassNameAtom.StartPos],nil); {$IFDEF CTDEBUG} writeln('[TFindDeclarationTool.FindIdentifierInProcContext] Proc="',copy(src,ProcContextNode.StartPos,30),'" searching class of method class="',ExtractIdentifier(ClassNameAtom.StartPos),'"'); {$ENDIF} @@ -1901,17 +1974,25 @@ writeln('[TFindDeclarationTool.FindIdentifierInProcContext] searching identifie end; end else begin // proc is not a method - if CompareSrcIdentifiers(ClassNameAtom.StartPos,Params.Identifier) then - begin - // proc identifier found + if not (fdfCollect in Params.Flags) then begin + if CompareSrcIdentifiers(ClassNameAtom.StartPos,Params.Identifier) then + begin + // proc identifier found {$IFDEF CTDEBUG} writeln('[TFindDeclarationTool.FindIdentifierInProcContext] Proc Identifier found="',GetIdentifier(Params.Identifier),'"'); {$ENDIF} - Result:=true; - Params.SetResult(Self,ProcContextNode,ClassNameAtom.StartPos); - exit; + Result:=true; + Params.SetResult(Self,ProcContextNode,ClassNameAtom.StartPos); + exit; + end else begin + // proceed the search normally ... + end; end else begin - // proceed the search normally ... + IdentifierFoundResult:=DoOnIdentifierFound(Params,ProcContextNode); + if IdentifierFoundResult in [ifrAbortSearch,ifrSuccess] then begin + Result:=(IdentifierFoundResult=ifrSuccess); + exit; + end; end; end; end; @@ -1941,7 +2022,7 @@ writeln('[TFindDeclarationTool.FindClassOfMethod] A '); fdfExceptionOnNotFound,fdfIgnoreUsedUnits] +(fdfGlobals*Params.Flags); Params.ContextNode:=ProcNode; - Params.SetIdentifier(Self,@Src[ClassNameAtom.StartPos],@CheckSrcIdentifier); + Params.SetIdentifier(Self,@Src[ClassNameAtom.StartPos],nil); {$IFDEF CTDEBUG} writeln('[TFindDeclarationTool.FindClassOfMethod] searching class of method class="',ExtractIdentifier(ClassNameAtom.StartPos),'"'); {$ENDIF} @@ -2020,11 +2101,12 @@ writeln('[TFindDeclarationTool.FindAncestorOfClass] ', try Params.Flags:=[fdfSearchInParentNodes,fdfIgnoreCurContextNode, fdfExceptionOnNotFound] - +(fdfGlobals*Params.Flags); + +(fdfGlobals*Params.Flags) + -[fdfIgnoreUsedUnits]; if not SearchTObject then - Params.SetIdentifier(Self,@Src[AncestorAtom.StartPos],@CheckSrcIdentifier) + Params.SetIdentifier(Self,@Src[AncestorAtom.StartPos],nil) else begin - Params.SetIdentifier(Self,'TObject',@CheckSrcIdentifier); + Params.SetIdentifier(Self,'TObject',nil); Exclude(Params.Flags,fdfExceptionOnNotFound); end; Params.ContextNode:=ClassNode; @@ -2164,9 +2246,9 @@ writeln('[TFindDeclarationTool.FindIdentifierInAncestors] ', fdfExceptionOnNotFound] +(fdfGlobals*Params.Flags); if not SearchTObject then - Params.SetIdentifier(Self,@Src[AncestorAtom.StartPos],@CheckSrcIdentifier) + Params.SetIdentifier(Self,@Src[AncestorAtom.StartPos],nil) else begin - Params.SetIdentifier(Self,'TObject',@CheckSrcIdentifier); + Params.SetIdentifier(Self,'TObject',nil); Exclude(Params.Flags,fdfExceptionOnNotFound); end; Params.ContextNode:=ClassNode; @@ -2387,8 +2469,8 @@ begin if (fdfIgnoreUsedUnits in Params.Flags) then begin if CompareSrcIdentifiers(UnitNameAtom.StartPos,Params.Identifier) then begin - // the searched identifier was a uses unitname, but since the unit should - // not be opened, point to identifier in the uses section + // the searched identifier was a uses unitname, but since the unit + // should not be opened, point to identifier in the uses section Result:=true; Params.SetResult(Self,UsesNode,UnitNameAtom.StartPos); exit; @@ -2700,7 +2782,7 @@ writeln('[TFindDeclarationTool.FindIdentifierInHiddenUsedUnits] ', and CompareSrcIdentifiers(Params.Identifier,PChar(SystemUnitName)) then begin // the system unit name itself is searched -> rename searched identifier Params.Save(OldInput); - Params.SetIdentifier(Self,PChar(SystemUnitName),@CheckSrcIdentifier); + Params.SetIdentifier(Self,PChar(SystemUnitName),nil); Result:=FindIdentifierInUsedUnit(SystemUnitName,Params); Params.Load(OldInput); end else @@ -3789,6 +3871,15 @@ writeln(' i=',i,' Node=',Node.DescAsString,' "',copy(Src,Node.StartPos,10),'"') end; end; +function TFindDeclarationTool.GetExpressionTypeOfTypeIdentifier( + Params: TFindDeclarationParams): TExpressionType; +begin + if FindIdentifierInContext(Params) then begin + Result:=Params.NewCodeTool.ConvertNodeToExpressionType(Params.NewNode,Params); + end else + Result:=CleanExpressionType; +end; + { TFindDeclarationParams } diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index 028d1e6414..438780e33e 100644 --- a/components/codetools/pascalparsertool.pas +++ b/components/codetools/pascalparsertool.pas @@ -165,7 +165,7 @@ type function ReadWithStatement(ExceptionOnError, CreateNodes: boolean): boolean; procedure ReadVariableType; - procedure ReadTilTypeOfProperty(PropertyNode: TCodeTreeNode); + function ReadTilTypeOfProperty(PropertyNode: TCodeTreeNode): boolean; public CurSection: TCodeTreeNodeDesc; @@ -181,6 +181,8 @@ type procedure BuildSubTreeForClass(ClassNode: TCodeTreeNode); virtual; procedure BuildSubTreeForBeginBlock(BeginNode: TCodeTreeNode); virtual; procedure BuildSubTreeForProcHead(ProcNode: TCodeTreeNode); virtual; + procedure BuildSubTreeForProcHead(ProcNode: TCodeTreeNode; + var FunctionResult: TCodeTreeNode); function DoAtom: boolean; override; function ExtractPropName(PropNode: TCodeTreeNode; InUpperCase: boolean): string; @@ -214,7 +216,7 @@ type function NodeHasParentOfType(ANode: TCodeTreeNode; NodeDesc: TCodeTreeNodeDesc): boolean; function PropertyIsDefault(PropertyNode: TCodeTreeNode): boolean; - + constructor Create; destructor Destroy; override; end; @@ -1878,10 +1880,16 @@ begin repeat if AtomIsIdentifier(false) then ReadNextAtom; - if AtomIsChar('(') or AtomIsChar('[') then begin - Result:=ReadTilBracketClose(ExceptionOnError); - if not Result then exit; - end; + repeat + if AtomIsChar('(') or AtomIsChar('[') then begin + Result:=ReadTilBracketClose(ExceptionOnError); + if not Result then exit; + ReadNextAtom; + end else if AtomIsChar('^') then begin + ReadNextAtom; + end else + break; + until false; if AtomIsChar('.') then ReadNextAtom else @@ -1918,7 +1926,7 @@ end; function TPascalParserTool.ReadWithStatement(ExceptionOnError, CreateNodes: boolean): boolean; begin - ReadNextAtom; + ReadNextAtom; // read 'with' if CreateNodes then begin CreateChildNode; CurNode.Desc:=ctnWithVariable @@ -3308,7 +3316,8 @@ begin end; end; -procedure TPascalParserTool.ReadTilTypeOfProperty(PropertyNode: TCodeTreeNode); +function TPascalParserTool.ReadTilTypeOfProperty( + PropertyNode: TCodeTreeNode): boolean; begin MoveCursorToNodeStart(PropertyNode); ReadNextAtom; // read keyword 'property' @@ -3320,10 +3329,13 @@ begin ReadTilBracketClose(true); ReadNextAtom; end; - if not AtomIsChar(':') then - RaiseException(': expected, but '+GetAtom+' found'); + if not AtomIsChar(':') then begin + Result:=false; + exit; + end; ReadNextAtom; // read type AtomIsIdentifier(true); + Result:=true; end; function TPascalParserTool.PropertyIsDefault(PropertyNode: TCodeTreeNode @@ -3371,6 +3383,17 @@ begin ProcNode.FirstChild.SubDesc:=ctnsNone; end; +procedure TPascalParserTool.BuildSubTreeForProcHead(ProcNode: TCodeTreeNode; + var FunctionResult: TCodeTreeNode); +begin + BuildSubTreeForProcHead(ProcNode); + FunctionResult:=ProcNode; + if FunctionResult.Desc=ctnProcedure then + FunctionResult:=FunctionResult.FirstChild; + if (FunctionResult<>nil) and (FunctionResult.Desc=ctnParameterList) then + FunctionResult:=FunctionResult.NextBrother; +end; + end. diff --git a/designer/designer.pp b/designer/designer.pp index ece7c4f418..927cc6a62f 100644 --- a/designer/designer.pp +++ b/designer/designer.pp @@ -1,8 +1,6 @@ { /*************************************************************************** - widgetstack.pp - Designer Widget Stack - ------------------- - Implements a widget list created by TDesigner. - + designer.pp - Lazarus IDE unit + -------------------------------- Initial Revision : Sat May 10 23:15:32 CST 1999 @@ -18,16 +16,16 @@ * * ***************************************************************************/ } -unit designer; +unit Designer; {$mode objfpc}{$H+} interface uses - Classes, LCLType, LCLLinux, Forms, Controls, LMessages, Graphics, ControlSelection, - CustomFormEditor, FormEditor, UnitEditor, CompReg, Menus, AlignCompsDlg, - SizeCompsDlg, ScaleCompsDlg, ExtCtrls; + Classes, LCLType, LCLLinux, Forms, Controls, LMessages, Graphics, + ControlSelection, CustomFormEditor, FormEditor, UnitEditor, CompReg, Menus, + AlignCompsDlg, SizeCompsDlg, ScaleCompsDlg, ExtCtrls; type TOnGetSelectedComponentClass = procedure(Sender: TObject; @@ -67,6 +65,7 @@ type FSizeMenuItem: TMenuItem; FBringToFrontMenuItem: TMenuItem; FSendToBackMenuItem: TMenuItem; + FShowHints: boolean; //hint stuff FHintTimer : TTimer; @@ -138,6 +137,7 @@ type procedure DrawNonVisualComponents(DC: HDC); property OnGetNonVisualCompIconCanvas: TOnGetNonVisualCompIconCanvas read FOnGetNonVisualCompIconCanvas write FOnGetNonVisualCompIconCanvas; + property ShowHints: boolean read FShowHints write FShowHints; end; @@ -536,12 +536,13 @@ Begin try UpdateLastMove := True; FHintTimer.Enabled := False; + if not FShowHints then exit; //don't want it enabled when a mouse button is pressed. FHintTimer.Enabled := (Message.keys or (MK_LButton and MK_RButton and MK_MButton) = 0); if FHintWindow.Visible then - FHintWindow.Visible := False; + FHintWindow.Visible := False; if MouseDownComponent=nil then exit; @@ -552,8 +553,8 @@ try SenderOrigin:=GetFormRelativeControlTopLeft(Sender); - MouseX:=Message.Pos.X+SenderOrigin.X; - MouseY:=Message.Pos.Y+SenderOrigin.Y; + MouseX:=Message.Pos.X+SenderOrigin.X; + MouseY:=Message.Pos.Y+SenderOrigin.Y; if (Mouse.CursorPos.X < SenderParentForm.Left) or (Mouse.CursorPos.Y < SenderParentForm.Top) or (Mouse.CursorPos.X > (SenderParentForm.Left+SenderParentForm.Width+(TForm(senderparentform).borderwidth))) or (Mouse.CursorPos.Y > (SenderParentForm.Top+SenderParentForm.Height+(22))) then Begin @@ -1073,6 +1074,7 @@ var Window : TWInControl; begin FHintTimer.Enabled := False; + if not FShowHints then exit; Position := Mouse.CursorPos; Window := FindLCLWindow(Position); diff --git a/designer/propedits.pp b/designer/propedits.pp index 52f950ec60..36d54ddda1 100644 --- a/designer/propedits.pp +++ b/designer/propedits.pp @@ -1,4 +1,3 @@ -unit propedits; { Author: Mattias Gaertner @@ -22,20 +21,21 @@ unit propedits; -many more... see XXX } +unit PropEdits; {$mode objfpc}{$H+} interface uses - Classes, TypInfo, SysUtils, Forms, Controls, GraphType, Graphics, StdCtrls, Buttons, - ComCtrls; + Classes, TypInfo, SysUtils, Forms, Controls, GraphType, Graphics, StdCtrls, + Buttons, ComCtrls; const MaxIdentLength: Byte = 63; // XXX ToDo // this variable should be fetched from consts(x).inc - // like in fcl/inc/classes.inc + // as in fcl/inc/classes.inc srUnknown = 'unknown'; type @@ -456,7 +456,7 @@ type function GetEditLimit: Integer; override; function GetValue: ansistring; override; procedure GetValues(Proc: TGetStringProc); override; - procedure SetValue(const AValue: ansistring); override; + procedure SetValue(const NewValue: ansistring); override; function GetFormMethodName: shortstring; virtual; function GetTrimmedEventName: shortstring; end; @@ -719,29 +719,29 @@ type TPropertyEditorHook = class private // lookup root - FLookupRoot:TComponent; - FOnChangeLookupRoot:TPropHookChangeLookupRoot; + FLookupRoot: TComponent; + FOnChangeLookupRoot: TPropHookChangeLookupRoot; // methods - FOnCreateMethod:TPropHookCreateMethod; - FOnGetMethodName:TPropHookGetMethodName; - FOnGetMethods:TPropHookGetMethods; - FOnMethodExists:TPropHookMethodExists; - FOnRenameMethod:TPropHookRenameMethod; - FOnShowMethod:TPropHookShowMethod; - FOnMethodFromAncestor:TPropHookMethodFromAncestor; - FOnChainCall:TPropHookChainCall; + FOnCreateMethod: TPropHookCreateMethod; + FOnGetMethodName: TPropHookGetMethodName; + FOnGetMethods: TPropHookGetMethods; + FOnMethodExists: TPropHookMethodExists; + FOnRenameMethod: TPropHookRenameMethod; + FOnShowMethod: TPropHookShowMethod; + FOnMethodFromAncestor: TPropHookMethodFromAncestor; + FOnChainCall: TPropHookChainCall; // components - FOnGetComponent:TPropHookGetComponent; - FOnGetComponentName:TPropHookGetComponentName; - FOnGetComponentNames:TPropHookGetComponentNames; - FOnGetRootClassName:TPropHookGetRootClassName; + FOnGetComponent: TPropHookGetComponent; + FOnGetComponentName: TPropHookGetComponentName; + FOnGetComponentNames: TPropHookGetComponentNames; + FOnGetRootClassName: TPropHookGetRootClassName; // persistent objects - FOnGetObject:TPropHookGetObject; - FOnGetObjectName:TPropHookGetObjectName; - FOnGetObjectNames:TPropHookGetObjectNames; + FOnGetObject: TPropHookGetObject; + FOnGetObjectName: TPropHookGetObjectName; + FOnGetObjectNames: TPropHookGetObjectNames; // modifing - FOnModified:TPropHookModified; - FOnRevert:TPropHookRevert; + FOnModified: TPropHookModified; + FOnRevert: TPropHookRevert; procedure SetLookupRoot(AComponent:TComponent); public @@ -772,7 +772,8 @@ type procedure Revert(Instance:TPersistent; PropInfo:PPropInfo); // lookup root - property OnChangeLookupRoot:TPropHookChangeLookupRoot read FOnChangeLookupRoot write FOnChangeLookupRoot; + property OnChangeLookupRoot:TPropHookChangeLookupRoot + read FOnChangeLookupRoot write FOnChangeLookupRoot; // method events property OnCreateMethod:TPropHookCreateMethod read FOnCreateMethod write FOnCreateMethod; property OnGetMethodName:TPropHookGetMethodName read FOnGetMethodName write FOnGetMethodName; @@ -2021,12 +2022,12 @@ begin if GetComponent(0) = PropertyHook.LookupRoot then begin Result := PropertyHook.GetRootClassName; if (Result <> '') and (Result[1] = 'T') then - Delete(Result, 1, 1); + System.Delete(Result, 1, 1); end else begin Result := PropertyHook.GetObjectName(GetComponent(0)); for I := Length(Result) downto 1 do if Result[I] in ['.','[',']'] then - Delete(Result, I, 1); + System.Delete(Result, I, 1); end; if Result = '' then begin {raise EPropertyError.CreateRes(@SCannotCreateName);} @@ -2038,9 +2039,10 @@ end; function TMethodPropertyEditor.GetTrimmedEventName: shortstring; begin Result := GetName; - if (Length(Result) >= 2) and - (Result[1] in ['O','o']) and (Result[2] in ['N','n']) then - Delete(Result,1,2); + if (Length(Result) >= 2) + and (Result[1] in ['O','o']) and (Result[2] in ['N','n']) + then + System.Delete(Result,1,2); end; function TMethodPropertyEditor.GetValue: ansistring; @@ -2053,7 +2055,7 @@ begin PropertyHook.GetMethods(GetTypeData(GetPropType), Proc); end; -procedure TMethodPropertyEditor.SetValue(const AValue: ansistring); +procedure TMethodPropertyEditor.SetValue(const NewValue: ansistring); procedure CheckChainCall(const MethodName: shortstring; Method: TMethod); var @@ -2086,22 +2088,22 @@ var NewMethodExists: boolean; begin CurValue:= GetValue; - NewMethodExists:=PropertyHook.MethodExists(AValue); - if (CurValue <> '') and (AValue <> '') - and (Uppercase(CurValue)<>UpperCase(AValue)) + NewMethodExists:=PropertyHook.MethodExists(NewValue); + if (CurValue <> '') and (NewValue <> '') + and (Uppercase(CurValue)<>UpperCase(NewValue)) and (not NewMethodExists) and (not PropertyHook.MethodFromAncestor(GetMethodValue)) then - PropertyHook.RenameMethod(CurValue, AValue) + PropertyHook.RenameMethod(CurValue, NewValue) else begin - NewMethod := (AValue <> '') and not NewMethodExists; + NewMethod := (NewValue <> '') and not NewMethodExists; OldMethod := GetMethodValue; - SetMethodValue(PropertyHook.CreateMethod(AValue, GetTypeData(GetPropType))); + SetMethodValue(PropertyHook.CreateMethod(NewValue, GetTypeData(GetPropType))); if NewMethod then begin if (PropCount = 1) and (OldMethod.Data <> nil) and (OldMethod.Code <> nil) then - CheckChainCall(AValue, OldMethod); - PropertyHook.ShowMethod(AValue); + CheckChainCall(NewValue, OldMethod); + PropertyHook.ShowMethod(NewValue); end; end; end; @@ -2784,13 +2786,14 @@ begin if Assigned(FOnGetMethodName) then Result:=FOnGetMethodName(Method) else begin + // search the method name with the given code pointer if Assigned(Method.Code) then begin if Assigned(LookupRoot) then begin Result:=LookupRoot.MethodName(Method.Code); if Result='' then - Result:='Unpublished'; + Result:=''; end else - Result:='No LookupRoot'; + Result:=''; end else Result:=''; end; @@ -2805,6 +2808,7 @@ end; function TPropertyEditorHook.MethodExists(const Name:Shortstring):boolean; begin + // check if a published method with given name exists in LookupRoot if Assigned(FOnMethodExists) then Result:=FOnMethodExists(Name) else @@ -2813,18 +2817,22 @@ end; procedure TPropertyEditorHook.RenameMethod(const CurName, NewName:ShortString); begin + // rename published method in LookupRoot object and source if Assigned(FOnRenameMethod) then FOnRenameMethod(CurName,NewName); end; procedure TPropertyEditorHook.ShowMethod(const Name:Shortstring); begin + // jump cursor to published method body if Assigned(FOnShowMethod) then FOnShowMethod(Name); end; function TPropertyEditorHook.MethodFromAncestor(const Method:TMethod):boolean; begin + // check if given Method is not in LookupRoot source, + // but in one of its ancestors if Assigned(FOnMethodFromAncestor) then Result:=FOnMethodFromAncestor(Method) else diff --git a/ide/editdefinetree.pas b/ide/editdefinetree.pas index e3dff794d8..d130c85098 100644 --- a/ide/editdefinetree.pas +++ b/ide/editdefinetree.pas @@ -56,17 +56,23 @@ var Count, i, j: integer; begin Count:=0; - for i:=1 to length(s)-2 do - if (s[i]<>SpecialChar) and (s[i+1]='$') and (s[i+2] in ['(','{']) then + for i:=1 to length(s)-1 do begin + if ((i=1) or (s[i-1]<>SpecialChar)) + and (s[i]='$') and (s[i+1] in ['(','{']) then inc(Count); + end; SetLength(Result,Length(s)+Count); i:=1; j:=1; while (i<=length(s)) do begin - if (i>=3) and (s[i-2]<>SpecialChar) and (s[i-1]='$') and (s[i] in ['(','{']) + if (iSpecialChar)) then begin - Result[j]:='('; - inc(j); + Result[j]:=s[i]; + Result[j+1]:='('; + inc(j,2); + inc(i); Result[j]:=ExternalMacroStart; end else if (i>=2) and (s[i-1]<>SpecialChar) and (s[i]='}') then begin Result[j]:=')'; @@ -97,7 +103,7 @@ begin ProjTempl:=TDefineTemplate.Create(ProjectDirDefTemplName, 'Current Project Directory','',ProjectDir,da_Directory); ProjTempl.Flags:=[dtfAutoGenerated,dtfProjectSpecific]; - + // FPC modes ---------------------------------------------------------------- if CompOpts.DelphiCompat then begin // set mode DELPHI @@ -163,19 +169,19 @@ begin end; if s<>'' then begin // add compiled unit path - ProjTempl.AddChild(TDefineTemplate.Create('UNITPATH', - 'unit path addition',ExternalMacroStart+'UNITPATH', + ProjTempl.AddChild(TDefineTemplate.Create('UnitPath', + 'unit path addition',ExternalMacroStart+'UnitPath', ConvertTransferMacrosToExternalMacros(s)+';' - +'$('+ExternalMacroStart+'UNITPATH)', + +'$('+ExternalMacroStart+'UnitPath)', da_DefineAll)); end; // source path (unitpath + sources for the CodeTools, hidden to the compiler) if s<>'' then begin // add compiled unit path - ProjTempl.AddChild(TDefineTemplate.Create('SRCPATH', - 'source path addition',ExternalMacroStart+'SRCPATH', + ProjTempl.AddChild(TDefineTemplate.Create('SrcPath', + 'source path addition',ExternalMacroStart+'SrcPath', ConvertTransferMacrosToExternalMacros(s+';'+SrcPath)+';' - +'$('+ExternalMacroStart+'SRCPATH)', + +'$('+ExternalMacroStart+'SrcPath)', da_DefineAll)); end; diff --git a/ide/environmentopts.pp b/ide/environmentopts.pp index 881caa910e..5548a9eea7 100644 --- a/ide/environmentopts.pp +++ b/ide/environmentopts.pp @@ -423,8 +423,8 @@ begin FObjectInspectorOptions:=TOIOptions.Create; // hints - FShowHintsForComponentPalette:=true; - FShowHintsForMainSpeedButtons:=true; + FShowHintsForComponentPalette:=false; + FShowHintsForMainSpeedButtons:=false; // files FLazarusDirectory:=ExtractFilePath(ParamStr(0)); @@ -1125,7 +1125,6 @@ begin Width:=FormEditorGroupBox.ClientWidth-2*Left; Height:=23; Caption:='Show editor hints'; - Enabled:=false; Visible:=true; end; diff --git a/ide/include/ide.inc b/ide/include/ide.inc index a78f5ddcc1..d759c38177 100644 --- a/ide/include/ide.inc +++ b/ide/include/ide.inc @@ -13,5 +13,7 @@ { $DEFINE IDE_DEBUG} +{ $DEFINE TestEvents} + // end. diff --git a/ide/main.pp b/ide/main.pp index f069a1026c..510d833f4f 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -41,7 +41,7 @@ uses ProjectOpts, IDEProcs, Process, UnitInfoDlg, Debugger, DBGBreakpoint, DBGWatch, GDBDebugger, RunParamsOpts, ExtToolDialog, MacroPromptDlg, LMessages, ProjectDefs, Watchesdlg, BreakPointsdlg, ColumnDlg, OutputFilter, - BuildLazDialog, MiscOptions, EditDefineTree, CodeToolsOptions; + BuildLazDialog, MiscOptions, EditDefineTree, CodeToolsOptions, TypInfo; const Version_String = '0.8.2 alpha'; @@ -64,7 +64,7 @@ type ViewFormsSpeedBtn : TSpeedButton; NewUnitSpeedBtn : TSpeedButton; OpenFileSpeedBtn : TSpeedButton; - OpenFileArrowSpeedBtn : TSpeedButton; + OpenFileArrowSpeedBtn: TSpeedButton; SaveSpeedBtn : TSpeedButton; SaveAllSpeedBtn : TSpeedButton; ToggleFormSpeedBtn : TSpeedButton; @@ -74,7 +74,7 @@ type StepIntoSpeedButton : TSpeedButton; StepOverSpeedButton : TSpeedButton; OpenFilePopUpMenu : TPopupMenu; - GlobalMouseSpeedButton : TSpeedButton; + GlobalMouseSpeedButton: TSpeedButton; mnuMain: TMainMenu; @@ -227,7 +227,7 @@ type procedure mnuToolBuildLazarusClicked(Sender : TObject); procedure mnuToolConfigBuildLazClicked(Sender : TObject); - // enironment menu + // environment menu procedure mnuEnvGeneralOptionsClicked(Sender : TObject); procedure mnuEnvEditorOptionsClicked(Sender : TObject); procedure mnuEnvCodeToolsOptionsClicked(Sender : TObject); @@ -269,10 +269,11 @@ type Procedure OnSrcNotebookCreateBreakPoint(Sender : TObject; Line : Integer); Procedure OnSrcNotebookDeleteBreakPoint(Sender : TObject; Line : Integer); - // ObjectInspector events + // ObjectInspector + PropertyEditorHook events procedure OIOnAddAvailableComponent(AComponent:TComponent; var Allowed:boolean); procedure OIOnSelectComponent(AComponent:TComponent); + procedure OnPropHookGetMethods(TypeData:PTypeData; Proc:TGetStringProc); // Environment options dialog events procedure OnLoadEnvironmentSettings(Sender: TObject; @@ -327,7 +328,7 @@ type protected procedure ToolButtonClick(Sender : TObject); - Procedure AddWatch(AnExpression : String); + Procedure AddWatch(const AnExpression : String); public ToolStatus: TIDEToolStatus; @@ -378,6 +379,8 @@ type // useful methods procedure GetCurrentUnit(var ActiveSourceEditor:TSourceEditor; var ActiveUnitInfo:TUnitInfo); + procedure DoSwitchToFormSrc(var ActiveSourceEditor:TSourceEditor; + var ActiveUnitInfo:TUnitInfo); procedure GetUnitWithPageIndex(PageIndex:integer; var ActiveSourceEditor:TSourceEditor; var ActiveUnitInfo:TUnitInfo); function DoSaveStreamToFile(AStream:TStream; const Filename:string; @@ -397,7 +400,7 @@ type // methods for codetools procedure InitCodeToolBoss; function BeginCodeTool(var ActiveSrcEdit: TSourceEditor; - var ActiveUnitInfo: TUnitInfo): boolean; + var ActiveUnitInfo: TUnitInfo; SwitchToFormSrc: boolean): boolean; function DoJumpToCodePos(ActiveSrcEdit: TSourceEditor; ActiveUnitInfo: TUnitInfo; NewSource: TCodeBuffer; NewX, NewY, NewTopLine: integer; @@ -696,6 +699,9 @@ begin ObjectInspector1.OnAddAvailComponent:=@OIOnAddAvailableComponent; ObjectInspector1.OnSelectComponentInOI:=@OIOnSelectComponent; PropertyEditorHook1:=TPropertyEditorHook.Create; + {$IFDEF TestEvents} + PropertyEditorHook1.OnGetMethods:=@OnPropHookGetMethods; + {$ENDIF} ObjectInspector1.PropertyEditorHook:=PropertyEditorHook1; ObjectInspector1.Show; @@ -888,6 +894,29 @@ begin TControl(AComponent.Owner).Invalidate; end; +procedure TMainIDE.OnPropHookGetMethods(TypeData:PTypeData; + Proc:TGetStringProc); +var ActiveSrcEdit: TSourceEditor; + ActiveUnitInfo: TUnitInfo; + NewSource: TCodeBuffer; + NewX, NewY, NewTopLine: integer; +begin + if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,true) then exit; +{$IFDEF IDE_DEBUG} +writeln(''); +writeln('[TMainIDE.OnPropHookGetMethods] ************'); +{$ENDIF} + if CodeToolBoss.FindDeclaration(ActiveUnitInfo.Source, + ActiveSrcEdit.EditorComponent.CaretX, + ActiveSrcEdit.EditorComponent.CaretY, + NewSource,NewX,NewY,NewTopLine) then + begin + DoJumpToCodePos(ActiveSrcEdit, ActiveUnitInfo, + NewSource, NewX, NewY, NewTopLine, true); + end else + DoJumpToCodeToolBossError; +end; + Procedure TMainIDE.ToolButtonClick(Sender : TObject); Begin Assert(False, 'Trace:TOOL BUTTON CLICK!'); @@ -999,15 +1028,15 @@ begin ButtonLeft := 1; ViewUnitsSpeedBtn := CreateButton('ViewUnitsSpeedBtn' , 'btn_viewunits' , 1, ButtonLeft, ButtonTop, [mfLeft], @mnuViewUnitsClicked, 'View Units'); ViewFormsSpeedBtn := CreateButton('ViewFormsSpeedBtn' , 'btn_viewforms' , 1, ButtonLeft, ButtonTop, [mfLeft], @mnuViewFormsClicked, 'View Forms'); - inc(ButtonLeft,12); + inc(ButtonLeft,13); RunSpeedButton := CreateButton('RunSpeedButton' , 'btn_run' , 2, ButtonLeft, ButtonTop, [mfLeft], @mnuRunProjectClicked, 'Run'); PauseSpeedButton := CreateButton('PauseSpeedButton' , 'btn_pause' , 2, ButtonLeft, ButtonTop, [mfLeft], @mnuPauseProjectClicked, 'Pause'); PauseSpeedButton.Enabled:=false; StepIntoSpeedButton := CreateButton('StepIntoSpeedButton' , 'btn_stepinto' , 1, ButtonLeft, ButtonTop, [mfLeft], @mnuStepIntoProjectClicked, 'Step Into'); StepOverSpeedButton := CreateButton('StepOverpeedButton' , 'btn_stepover' , 1, ButtonLeft, ButtonTop, [mfLeft, mfTop], @mnuStepOverProjectClicked, 'Step Over'); - pnlSpeedButtons.Width := ButtonLeft; - pnlSpeedButtons.Height := ButtonTop; + pnlSpeedButtons.Width := ButtonLeft+1; + pnlSpeedButtons.Height := ButtonTop+1; // create the popupmenu for the OpenFileArrowSpeedBtn @@ -1944,6 +1973,7 @@ writeln('[TMainIDE.SetDefaultsforForm] B'); OnGetNonVisualCompIconCanvas:=@IDECompList.OnGetNonVisualCompIconCanvas; OnModified:=@OnDesignerModified; OnActivated := @OnDesignerActivated; + ShowHints:=EnvironmentOptions.ShowEditorHints; end; end; @@ -2268,7 +2298,7 @@ Begin FPCSrcDirChanged:=false; FPCCompilerChanged:= OldCompilerFilename<>EnvironmentOptions.CompilerFilename; - ChangeMacroValue('LazarusSrcDir',EnvironmentOptions.LazarusDirectory); + ChangeMacroValue('LazarusDir',EnvironmentOptions.LazarusDirectory); ChangeMacroValue('FPCSrcDir',EnvironmentOptions.FPCSourceDirectory); if MacroValueChanged then CodeToolBoss.DefineTree.ClearCache; @@ -4361,7 +4391,7 @@ end; //----------------------------------------------------------------------------- procedure TMainIDE.GetCurrentUnit(var ActiveSourceEditor:TSourceEditor; - var ActiveUnitInfo:TUnitInfo); + var ActiveUnitInfo:TUnitInfo); begin if SourceNoteBook.NoteBook=nil then begin ActiveSourceEditor:=nil; @@ -5104,7 +5134,7 @@ begin // set global variables with CodeToolBoss.GlobalValues do begin - Variables[ExternalMacroStart+'LazarusSrcDir']:= + Variables[ExternalMacroStart+'LazarusDir']:= EnvironmentOptions.LazarusDirectory; Variables[ExternalMacroStart+'FPCSrcDir']:= EnvironmentOptions.FPCSourceDirectory; @@ -5129,17 +5159,12 @@ begin // create compiler macros for the lazarus sources ADefTempl:=CreateLazarusSrcTemplate( - '$('+ExternalMacroStart+'LazarusSrcDir)', + '$('+ExternalMacroStart+'LazarusDir)', '$('+ExternalMacroStart+'LCLWidgetType)'); AddTemplate(ADefTempl,true, 'NOTE: Could not create Define Template for Lazarus Sources'); end; // build define tree - with CodeToolBoss do begin - DefineTree.Add(DefinePool.CreateLCLProjectTemplate( - '$(#LazarusSrcDir)','$(#LCLWidgetType)','$(#ProjectDir)')); - //DefineTree.WriteDebugReport; - end; c:=CodeToolBoss.ConsistencyCheck; if c<>0 then begin writeln('CodeToolBoss.ConsistencyCheck=',c); @@ -5201,12 +5226,14 @@ begin end; function TMainIDE.BeginCodeTool(var ActiveSrcEdit: TSourceEditor; - var ActiveUnitInfo: TUnitInfo): boolean; + var ActiveUnitInfo: TUnitInfo; SwitchToFormSrc: boolean): boolean; begin Result:=false; if SourceNoteBook.NoteBook=nil then exit; - GetUnitWithPageIndex(SourceNoteBook.NoteBook.PageIndex,ActiveSrcEdit, - ActiveUnitInfo); + if SwitchToFormSrc then + DoSwitchToFormSrc(ActiveSrcEdit,ActiveUnitInfo) + else + GetCurrentUnit(ActiveSrcEdit,ActiveUnitInfo); if (ActiveSrcEdit=nil) or (ActiveUnitInfo=nil) then exit; SaveSourceEditorChangesToCodeCache; CodeToolBoss.VisibleEditorLines:=ActiveSrcEdit.EditorComponent.LinesInWindow; @@ -5260,7 +5287,7 @@ var ActiveSrcEdit: TSourceEditor; NewSource: TCodeBuffer; NewX, NewY, NewTopLine: integer; begin - if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo) then exit; + if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,false) then exit; {$IFDEF IDE_DEBUG} writeln(''); writeln('[TMainIDE.DoJumpToProcedureSection] ************'); @@ -5319,7 +5346,7 @@ var ActiveSrcEdit: TSourceEditor; NewSource: TCodeBuffer; NewX, NewY, NewTopLine: integer; begin - if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo) then exit; + if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,false) then exit; {$IFDEF IDE_DEBUG} writeln(''); writeln('[TMainIDE.DoFindDeclarationAtCursor] ************'); @@ -5341,7 +5368,7 @@ var ActiveSrcEdit: TSourceEditor; NewSource: TCodeBuffer; NewX, NewY, NewTopLine: integer; begin - if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo) then exit; + if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,false) then exit; {$IFDEF IDE_DEBUG} writeln(''); writeln('[TMainIDE.DoGoToPascalBlockOtherEnd] ************'); @@ -5363,7 +5390,7 @@ var ActiveSrcEdit: TSourceEditor; NewSource: TCodeBuffer; NewX, NewY, NewTopLine: integer; begin - if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo) then exit; + if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,false) then exit; {$IFDEF IDE_DEBUG} writeln(''); writeln('[TMainIDE.DoGoToPascalBlockStart] ************'); @@ -5386,7 +5413,7 @@ var ActiveSrcEdit: TSourceEditor; NewSource: TCodeBuffer; StartX, StartY, NewX, NewY, NewTopLine: integer; begin - if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo) then exit; + if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,false) then exit; {$IFDEF IDE_DEBUG} writeln(''); writeln('[TMainIDE.DoGoToPascalBlockEnd] ************'); @@ -5415,7 +5442,7 @@ var ActiveSrcEdit: TSourceEditor; begin FOpenEditorsOnCodeToolChange:=true; try - if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo) then exit; + if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,false) then exit; {$IFDEF IDE_DEBUG} writeln(''); writeln('[TMainIDE.DoCompleteCodeAtCursor] ************'); @@ -5695,7 +5722,7 @@ begin end; //This adds the watch to the TWatches TCollection and to the watches dialog -procedure TMainIDE.AddWatch(AnExpression : String); +procedure TMainIDE.AddWatch(const AnExpression : String); var NewWatch : TdbgWatch; begin @@ -5742,7 +5769,7 @@ Procedure TMainIDE.OnSrcNotebookEditorChanged(Sender : TObject); begin if SourceNotebook.Notebook = nil then Exit; - SaveSpeedBtn.Enabled := SourceNotebook.GetActiveSe.Modified; + SaveSpeedBtn.Enabled := SourceNotebook.GetActiveSE.Modified; end; Procedure TMainIDE.OnSrcNotebookCreateBreakPoint(Sender : TObject; @@ -5792,6 +5819,23 @@ begin DoJumpToCompilerMessage(-1,true); end; +procedure TMainIDE.DoSwitchToFormSrc(var ActiveSourceEditor: TSourceEditor; + var ActiveUnitInfo: TUnitInfo); +var i: integer; +begin + i:=Project.IndexOfUnitWithForm(PropertyEditorHook1.LookupRoot,false); + if (i>=0) then begin + i:=Project.Units[i].EditorIndex; + if (i>=0) then begin + SourceNoteBook.NoteBook.PageIndex:=i; + GetCurrentUnit(ActiveSourceEditor,ActiveUnitInfo); + exit; + end; + end; + ActiveSourceEditor:=nil; + ActiveUnitInfo:=nil; +end; + //----------------------------------------------------------------------------- @@ -5806,6 +5850,9 @@ end. { ============================================================================= $Log$ + Revision 1.218 2002/02/09 20:32:08 lazarus + MG: many fixes on my way to events + Revision 1.217 2002/02/08 21:08:00 lazarus MG: saving of virtual project files will now save the whole project diff --git a/ide/uniteditor.pp b/ide/uniteditor.pp index eea01c1001..05038b1b5c 100644 --- a/ide/uniteditor.pp +++ b/ide/uniteditor.pp @@ -141,6 +141,7 @@ type Function GotoLine(Value : Integer) : Integer; Procedure CreateEditor(AOwner : TComponent; AParent: TWinControl); + procedure SetVisible(Value: boolean); protected FindText : String; ErrorMsgs : TStrings; @@ -172,7 +173,7 @@ type procedure LinesInserted(sender : TObject; FirstLine,Count : Integer); procedure LinesDeleted(sender : TObject; FirstLine,Count : Integer); - property Visible : Boolean read FVisible write FVisible default False; + property Visible : Boolean read FVisible write SetVisible default False; public constructor Create(AOwner : TComponent; AParent : TWinControl); destructor Destroy; override; @@ -515,7 +516,8 @@ begin if (FAOwner<>nil) and (FEditor<>nil) then begin FEditor.Visible:=false; FEditor.Parent:=nil; - TSourceNoteBook(FAOwner).FUnUsedEditorComponents.Add(FEditor); + TSourceNoteBook(FAOwner).FSourceEditorList.Remove(FEditor); + TSourceNoteBook(FAOwner).FUnUsedEditorComponents.Remove(FEditor); end; //writeln('TSourceEditor.Destroy B '); inherited Destroy; @@ -793,7 +795,7 @@ Procedure TSourceEditor.EditorStatusChanged(Sender: TObject; Changes: TSynStatusChanges); Begin If Assigned(OnEditorChange) then - OnEditorChange(sender); + OnEditorChange(Sender); end; procedure TSourceEditor.OnGutterClick(Sender: TObject; X, Y, Line: integer; @@ -1298,6 +1300,7 @@ Begin FOnBeforeClose(Self); Visible := False; + FEditor.Parent:=nil; CodeBuffer := nil; If Assigned(FOnAfterClose) then FOnAfterClose(Self); end; @@ -1485,6 +1488,13 @@ begin end; +procedure TSourceEditor.SetVisible(Value: boolean); +begin + if FVisible=Value then exit; + if FEditor<>nil then FEditor.Visible:=Value; + FVisible:=Value; +end; + {------------------------------------------------------------------------} { TSourceNotebook } @@ -2076,8 +2086,8 @@ End; Procedure TSourceNotebook.ClearUnUsedEditorComponents(Force: boolean); var i:integer; begin - if not Force and FProcessingCommand then exit; - for i:=0 to FUnUsedEditorComponents.Count-1 do + if (not Force) and FProcessingCommand then exit; + for i:=FUnUsedEditorComponents.Count-1 downto 0 do TSynEdit(FUnUsedEditorComponents[i]).Free; FUnUsedEditorComponents.Clear; end; @@ -2199,12 +2209,14 @@ Begin end; -Procedure TSourceNotebook.EditorChanged(sender : TObject); +Procedure TSourceNotebook.EditorChanged(Sender : TObject); +var SenderDeleted: boolean; Begin + SenderDeleted:=FUnUsedEditorComponents.IndexOf(Sender)>=0; ClearUnUsedEditorComponents(false); UpdateStatusBar; - if Assigned(OnEditorChanged) then - OnEditorChanged(sender); + if (not SenderDeleted) and Assigned(OnEditorChanged) then + OnEditorChanged(Sender); End; Function TSourceNotebook.NewSE(PageNum : Integer) : TSourceEditor; @@ -2334,7 +2346,7 @@ Begin Result := nil; if (FSourceEditorList=nil) or (FSourceEditorList.Count=0) or (Notebook=nil) or (Notebook.PageIndex<0) then exit; - Result:= FindSourceEditorWithPageIndex(Notebook.PageIndex); + Result:=FindSourceEditorWithPageIndex(Notebook.PageIndex); end; procedure TSourceNotebook.LockAllEditorsInSourceChangeCache; @@ -2659,11 +2671,14 @@ Begin {$IFDEF IDE_DEBUG} writeln('TSourceNotebook.CloseFile A PageIndex=',PageIndex); {$ENDIF} - TempEditor:= FindSourceEditorWithPageIndex(PageIndex); + TempEditor:=FindSourceEditorWithPageIndex(PageIndex); if TempEditor=nil then exit; TempEditor.Close; FSourceEditorList.Remove(TempEditor); - TempEditor.Free; + if FProcessingCommand then + FUnUsedEditorComponents.Add(TempEditor) + else + TempEditor.Free; if Notebook.Pages.Count>1 then begin //writeln('TSourceNotebook.CloseFile B PageIndex=',PageIndex); Notebook.Pages.Delete(PageIndex);