mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-19 22:29:37 +01:00
MG: many fixes on my way to events
git-svn-id: trunk@1391 -
This commit is contained in:
lazarus
parent
8c25cb5870
commit
46ae7f0d85
@ -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;
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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.
|
||||
|
||||
|
||||
@ -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 }
|
||||
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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:='<Unpublished>';
|
||||
end else
|
||||
Result:='No LookupRoot';
|
||||
Result:='<No LookupRoot>';
|
||||
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
|
||||
|
||||
@ -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 (i<length(s))
|
||||
and ((s[i]='$') and (s[i+1] in ['(','{']))
|
||||
and ((i=1) or (s[i-1]<>SpecialChar))
|
||||
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;
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -13,5 +13,7 @@
|
||||
|
||||
{ $DEFINE IDE_DEBUG}
|
||||
|
||||
{ $DEFINE TestEvents}
|
||||
|
||||
// end.
|
||||
|
||||
|
||||
107
ide/main.pp
107
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
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user