paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-08 11:16:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: fixed codetools proc collection

Browse Source 
git-svn-id: trunk@1957 -
This commit is contained in:
lazarus 2002-08-17 23:40:23 +00:00
parent 6d4ac41744
commit f4c9bc475a
3 changed files with 88 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
components/codetools/eventcodetool.pas
View File

@ -220,7 +220,7 @@ begin
try
BuildSubTreeForClass(ClassNode);
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.GetCompatiblePublishedMethods]');
writeln('[TEventsCodeTool.GetCompatiblePublishedMethods] D');
{$ENDIF}
// 1. convert the TypeData to an expression type list
CheckDependsOnNodeCaches;
@ -241,6 +241,9 @@ begin
Params.ContextNode:=ClassNode;
Params.Flags:=[fdfCollect,fdfSearchInAncestors,fdfClassPublished];
Params.SetIdentifier(Self,nil,@CollectPublishedMethods);
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.GetCompatiblePublishedMethods] E Searching ...');
{$ENDIF}
FindIdentifierInContext(Params);
finally
SearchedExprList.Free;
@ -675,9 +678,15 @@ var
ParamCompatibility: TTypeCompatibility;
FirstParameterNode: TCodeTreeNode;
begin
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CollectPublishedMethods] A ',
' Node=',FoundContext.Node.DescAsString,
' "',copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50),'"',
' Tool=',FoundContext.Tool.MainFilename);
{$ENDIF}
if (FoundContext.Node.Desc=ctnProcedure) then begin
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CollectPublishedMethods] ',
writeln('[TEventsCodeTool.CollectPublishedMethods] B ',
' Node=',FoundContext.Node.DescAsString,
' "',copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50),'"',
' Tool=',FoundContext.Tool.MainFilename);

43
components/codetools/finddeclarationtool.pas
View File

@ -58,6 +58,8 @@ interface
{ $DEFINE ShowNodeCache}
{ $DEFINE ShowBaseTypeCache}
{ $DEFINE ShowCacheDependencies}
{$DEFINE ShowCollect}
uses
{$IFDEF MEM_CHECK}
@ -1192,6 +1194,17 @@ var
begin
Result:=true;
FindIdentifierInContext:=NewResult;
{$IFDEF ShowCollect}
if fdfCollect in Params.Flags then begin
writeln('[TFindDeclarationTool.FindIdentifierInContext] COLLECT CheckResult Ident=',
'"',GetIdentifier(Params.Identifier),'"',
' File="',ExtractFilename(MainFilename)+'"',
' Flags=[',FindDeclarationFlagsAsString(Params.Flags),']',
' NewResult=',NewResult,
' CallOnIdentifierFound=',CallOnIdentifierFound
);
end;
{$ENDIF}
if NewResult then begin
// identifier found
if CallOnIdentifierFound then begin
@ -1480,8 +1493,19 @@ begin
' File="',ExtractFilename(MainFilename)+'"',
' Flags=[',FindDeclarationFlagsAsString(Params.Flags),']'
);
{$ELSE}
{$IFDEF ShowCollect}
if fdfCollect in Params.Flags then begin
writeln('[TFindDeclarationTool.FindIdentifierInContext] COLLECT Start Ident=',
'"',GetIdentifier(Params.Identifier),'"',
' Context="',ContextNode.DescAsString,'" "',copy(Src,ContextNode.StartPos,20),'"',
' File="',ExtractFilename(MainFilename)+'"',
' Flags=[',FindDeclarationFlagsAsString(Params.Flags),']'
);
end;
{$ENDIF}
{$ENDIF}
try
// search in the Tree of this tool
repeat
@ -1491,6 +1515,16 @@ begin
' Context="',ContextNode.DescAsString,'" "',copy(Src,ContextNode.StartPos,20),'"',
' Flags=[',FindDeclarationFlagsAsString(Params.Flags),']'
);
{$ELSE}
{$IFDEF ShowCollect}
if fdfCollect in Params.Flags then begin
writeln('[TFindDeclarationTool.FindIdentifierInContext] COLLECT Loop Ident=',
'"',GetIdentifier(Params.Identifier),'"',
' Context="',ContextNode.DescAsString,'" "',copy(Src,ContextNode.StartPos,20),'"',
' Flags=[',FindDeclarationFlagsAsString(Params.Flags),']'
);
end;
{$ENDIF}
{$ENDIF}
// search identifier in current context
LastContextNode:=ContextNode;
@ -1525,7 +1559,7 @@ begin
IdentifierFoundResult:=
FindIdentifierInProcContext(ContextNode,Params);
if IdentifierFoundResult in [ifrAbortSearch,ifrSuccess] then begin
if CheckResult(IdentifierFoundResult=ifrSuccess,false) then
if CheckResult(IdentifierFoundResult=ifrSuccess,true) then
exit;
end;
end;
@ -1948,7 +1982,8 @@ begin
// -> proceed the search normally ...
end else begin
// proc is a proc declaration
if CompareSrcIdentifiers(NameAtom.StartPos,Params.Identifier) then begin
if (fdfCollect in Params.Flags)
or CompareSrcIdentifiers(NameAtom.StartPos,Params.Identifier) then begin
// proc identifier found
{$IFDEF ShowTriedContexts}
writeln('[TFindDeclarationTool.FindIdentifierInProcContext] Proc-Identifier found="',GetIdentifier(Params.Identifier),'"');
@ -3947,7 +3982,7 @@ function TFindDeclarationTool.CheckSrcIdentifier(
Params: TFindDeclarationParams;
FoundContext: TFindContext): TIdentifierFoundResult;
// this is a TOnIdentifierFound function
// if identifier found is a proc it searches for the best overloaded proc
// if identifier found is a proc then it searches for the best overloaded proc
var FirstParameterNode: TCodeTreeNode;
ParamCompatibility: TTypeCompatibility;
OldInput: TFindDeclarationInput;

48
designer/designer.pp
View File

@ -134,12 +134,15 @@ type
Procedure OnFormActivated;
public
ControlSelection : TControlSelection;
constructor Create(Customform : TCustomform; AControlSelection: TControlSelection);
constructor Create(Customform : TCustomform;
AControlSelection: TControlSelection);
destructor Destroy; override;
function IsDesignMsg(Sender: TControl; var TheMessage: TLMessage): Boolean; override;
function IsDesignMsg(Sender: TControl;
var TheMessage: TLMessage): Boolean; override;
procedure Modified; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure PaintGrid; override;
procedure ValidateRename(AComponent: TComponent;
const CurName, NewName: string); override;
@ -147,6 +150,7 @@ type
function NonVisualComponentLeftTop(AComponent: TComponent): TPoint;
function NonVisualComponentAtPos(x,y: integer): TComponent;
procedure DrawNonVisualComponents(DC: HDC);
function GetDesignedComponent(AComponent: TComponent): TComponent;
property ShowGrid: boolean read GetShowGrid write SetShowGrid;
property Form: TCustomForm read FCustomForm write FCustomForm;
@ -156,7 +160,8 @@ type
property IsControl: Boolean read GetIsControl write SetIsControl;
property OnActivated: TNotifyEvent
read FOnActivated write FOnActivated;
property OnAddComponent: TOnAddComponent read FOnAddComponent write FOnAddComponent;
property OnAddComponent: TOnAddComponent
read FOnAddComponent write FOnAddComponent;
property OnComponentListChanged: TNotifyEvent
read FOnComponentListChanged write FOnComponentListChanged;
property OnGetSelectedComponentClass: TOnGetSelectedComponentClass
@ -168,7 +173,8 @@ type
read FOnRemoveComponent write FOnRemoveComponent;
property OnRenameComponent: TOnRenameComponent
read FOnRenameComponent write FOnRenameComponent;
property OnSetDesigning: TOnSetDesigning read FOnSetDesigning write FOnSetDesigning;
property OnSetDesigning: TOnSetDesigning
read FOnSetDesigning write FOnSetDesigning;
property OnUnselectComponentClass: TNotifyEvent
read FOnUnselectComponentClass write FOnUnselectComponentClass;
property OnGetNonVisualCompIconCanvas: TOnGetNonVisualCompIconCanvas
@ -314,11 +320,13 @@ function TDesigner.PaintControl(Sender: TControl; TheMessage: TLMPaint):boolean;
var OldDuringPaintControl: boolean;
begin
Result:=true;
//writeln('TDesigner.PaintControl A ',Sender.Name);
//writeln('*** LM_PAINT A ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8));
OldDuringPaintControl:=FDuringPaintControl;
FDuringPaintControl:=true;
//writeln('TDesigner.PaintControl B ',Sender.Name);
Sender.Dispatch(TheMessage);
//writeln('TDesigner.PaintControl C ',Sender.Name);
if TheMessage.DC<>0 then begin
//writeln('*** LM_PAINT B ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8));
@ -332,7 +340,8 @@ begin
if ControlSelection.RubberBandActive then
ControlSelection.DrawRubberBand(TheMessage.DC);
end;
//writeln('TDesigner.PaintControl D ',Sender.Name);
FDuringPaintControl:=OldDuringPaintControl;
end;
@ -373,10 +382,12 @@ var i,
Begin
FHintTimer.Enabled := False;
FHasSized:=false;
SetCaptureControl(nil);
if (getParentForm(Sender)=nil) then exit;
if MouseDownComponent=nil then begin
MouseDownComponent:=Sender;
MouseDownComponent:=GetDesignedComponent(Sender);
if MouseDownComponent=nil then exit;
MouseDownSender:=Sender;
end;
@ -486,8 +497,14 @@ var
Begin
FHintTimer.Enabled := False;
SetCaptureControl(nil);
SenderParentForm:=GetParentForm(Sender);
if (MouseDownComponent=nil) or (SenderParentForm=nil) then exit;
if (MouseDownComponent=nil) or (SenderParentForm=nil)
or (SenderParentForm<>Form) then begin
MouseDownComponent:=nil;
MouseDownSender:=nil;
exit;
end;
ControlSelection.ActiveGrabber:=nil;
RubberBandWasActive:=ControlSelection.RubberBandActive;
@ -607,6 +624,7 @@ var
SenderParentForm:TCustomForm;
OldMouseMovePos: TPoint;
begin
SetCaptureControl(nil);
if FShowHints then begin
FHintTimer.Enabled := False;
@ -619,7 +637,7 @@ begin
if MouseDownComponent=nil then exit;
SenderParentForm:=GetParentForm(Sender);
if SenderParentForm=nil then exit;
if (SenderParentForm=nil) or (SenderParentForm<>Form) then exit;
OldMouseMovePos:=LastMouseMovePos;
LastMouseMovePos:=GetFormRelativeMousePosition(Form);
@ -677,6 +695,7 @@ procedure TDesigner.MouseRightUpOnControl(Sender : TControl;
TheMessage: TLMMouse);
begin
FHintTimer.Enabled := False;
SetCaptureControl(nil);
MouseUpPos:=GetFormRelativeMousePosition(Form);
BuildPopupMenu;
@ -967,6 +986,15 @@ begin
RestoreDC(DC,SaveIndex);
end;
function TDesigner.GetDesignedComponent(AComponent: TComponent): TComponent;
begin
Result:=AComponent;
while (Result<>nil)
and (Result.Owner<>Form)
and (Result is TControl) do
Result:=TControl(Result).Parent;
end;
function TDesigner.NonVisualComponentAtPos(x,y: integer): TComponent;
var i: integer;
LeftTop: TPoint;