mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-13 15:59:38 +02:00
MG: fixed find declaration of forward def class
git-svn-id: trunk@1617 -
This commit is contained in:
lazarus
parent
4409ebfe2d
commit
d02846cc88
@ -570,10 +570,25 @@ function TFindDeclarationTool.FindDeclaration(CursorPos: TCodeXYPosition;
|
||||
var CleanCursorPos: integer;
|
||||
CursorNode, ClassNode: TCodeTreeNode;
|
||||
Params: TFindDeclarationParams;
|
||||
DirectSearch: boolean;
|
||||
DirectSearch, SkipChecks, SearchForward: boolean;
|
||||
|
||||
procedure CheckIfCursorOnAForwardDefinedClass;
|
||||
begin
|
||||
if SkipChecks then exit;
|
||||
if CursorNode.Desc=ctnTypeDefinition then begin
|
||||
if (CursorNode.FirstChild<>nil) and (CursorNode.FirstChild.Desc=ctnClass)
|
||||
and ((CursorNode.FirstChild.SubDesc and ctnsForwardDeclaration)>0) then
|
||||
begin
|
||||
DirectSearch:=true;
|
||||
SearchForward:=true;
|
||||
SkipChecks:=true;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CheckIfCursorInClassNode;
|
||||
begin
|
||||
if SkipChecks then exit;
|
||||
ClassNode:=CursorNode.GetNodeOfType(ctnClass);
|
||||
if ClassNode<>nil then begin
|
||||
// cursor is in class/object definition
|
||||
@ -585,6 +600,7 @@ var CleanCursorPos: integer;
|
||||
and (CleanCursorPos<ClassNode.FirstChild.StartPos) then begin
|
||||
// identifier is an ancestor/interface identifier
|
||||
DirectSearch:=true;
|
||||
SkipChecks:=true;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -592,6 +608,7 @@ var CleanCursorPos: integer;
|
||||
|
||||
procedure CheckIfCursorInBeginNode;
|
||||
begin
|
||||
if SkipChecks then exit;
|
||||
if CursorNode.Desc=ctnBeginBlock then begin
|
||||
BuildSubTreeForBeginBlock(CursorNode);
|
||||
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
|
||||
@ -601,6 +618,7 @@ var CleanCursorPos: integer;
|
||||
procedure CheckIfCursorInProcNode;
|
||||
var IsMethod: boolean;
|
||||
begin
|
||||
if SkipChecks then exit;
|
||||
if CursorNode.Desc=ctnProcedureHead then
|
||||
CursorNode:=CursorNode.Parent;
|
||||
if CursorNode.Desc=ctnProcedure then begin
|
||||
@ -624,6 +642,7 @@ var CleanCursorPos: integer;
|
||||
// cursor on proc name
|
||||
// -> ignore proc name and search overloaded identifier
|
||||
DirectSearch:=true;
|
||||
SkipChecks:=true;
|
||||
end;
|
||||
end;
|
||||
if CursorNode.Desc=ctnProcedureHead then
|
||||
@ -633,17 +652,21 @@ var CleanCursorPos: integer;
|
||||
|
||||
procedure CheckIfCursorInPropertyNode;
|
||||
begin
|
||||
if SkipChecks then exit;
|
||||
if CursorNode.Desc=ctnProperty then begin
|
||||
MoveCursorToNodeStart(CursorNode);
|
||||
ReadNextAtom; // read 'property'
|
||||
ReadNextAtom; // read property name
|
||||
if CleanCursorPos<CurPos.EndPos then
|
||||
if CleanCursorPos<CurPos.EndPos then begin
|
||||
DirectSearch:=true;
|
||||
SkipChecks:=true;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Result:=false;
|
||||
SkipChecks:=false;
|
||||
ActivateGlobalWriteLock;
|
||||
try
|
||||
// build code tree
|
||||
@ -673,6 +696,8 @@ begin
|
||||
NewPos,NewTopLine);
|
||||
end else begin
|
||||
DirectSearch:=false;
|
||||
SearchForward:=false;
|
||||
CheckIfCursorOnAForwardDefinedClass;
|
||||
CheckIfCursorInClassNode;
|
||||
CheckIfCursorInBeginNode;
|
||||
CheckIfCursorInProcNode;
|
||||
@ -693,13 +718,14 @@ begin
|
||||
Params.ContextNode:=CursorNode;
|
||||
Params.SetIdentifier(Self,@Src[CurPos.StartPos],@CheckSrcIdentifier);
|
||||
Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound,
|
||||
fdfTopLvlResolving];
|
||||
Params.Flags:=Params.Flags
|
||||
+[fdfSearchInAncestors]+fdfAllClassVisibilities;
|
||||
fdfTopLvlResolving,fdfSearchInAncestors]
|
||||
+fdfAllClassVisibilities;
|
||||
if not DirectSearch then begin
|
||||
Result:=FindDeclarationOfIdentAtCursor(Params);
|
||||
end else begin
|
||||
Include(Params.Flags,fdfIgnoreCurContextNode);
|
||||
if SearchForward then
|
||||
Include(Params.Flags,fdfSearchForward);
|
||||
Result:=FindIdentifierInContext(Params);
|
||||
end;
|
||||
if Result then begin
|
||||
|
||||
@ -606,12 +606,10 @@ begin
|
||||
Add('ARRAY',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('ASM',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('BEGIN',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('BREAK',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('CASE',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('CLASS',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('CONST',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('CONSTRUCTOR',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('CONTINUE',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('DESTRUCTOR',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('DIV',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('DO',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
|
||||
131
lcl/stdctrls.pp
131
lcl/stdctrls.pp
@ -113,74 +113,76 @@ type
|
||||
|
||||
|
||||
|
||||
TCustomGroupBox = class (TWinControl) {class(TCustomControl) }
|
||||
public
|
||||
constructor Create(AOwner : TComponent); Override;
|
||||
end;
|
||||
TCustomGroupBox = class (TWinControl) {class(TCustomControl) }
|
||||
public
|
||||
constructor Create(AOwner : TComponent); Override;
|
||||
end;
|
||||
|
||||
TGroupBox = class(TCustomGroupBox)
|
||||
published
|
||||
property Caption;
|
||||
property Visible;
|
||||
end;
|
||||
TGroupBox = class(TCustomGroupBox)
|
||||
published
|
||||
property Caption;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
TComboBoxStyle = (csDropDown, csSimple, csDropDownList, csOwnerDrawFixed,
|
||||
csOwnerDrawVariable);
|
||||
|
||||
TComboBoxStyle = (csDropDown, csSimple, csDropDownList, csOwnerDrawFixed, csOwnerDrawVariable);
|
||||
|
||||
TCustomComboBox = class(TWinControl)
|
||||
private
|
||||
FItems: TStrings;
|
||||
FStyle : TComboBoxStyle;
|
||||
FOnChange : TNotifyEvent;
|
||||
FSorted : boolean;
|
||||
procedure SetItems(Value : TStrings);
|
||||
procedure CNDrawItems(var Message : TLMDrawItems) ; message CN_DrawItem;
|
||||
protected
|
||||
procedure CreateHandle; override;
|
||||
procedure DestroyHandle; override;
|
||||
procedure DoChange(var msg); message LM_CHANGED;
|
||||
function GetSelLength : integer;
|
||||
function GetSelStart : integer;
|
||||
function GetSelText : string;
|
||||
function GetItemIndex : integer; virtual;
|
||||
function GetMaxLength : integer; virtual;
|
||||
procedure SetItemIndex(Val : integer); virtual;
|
||||
procedure SetMaxLength(Val : integer); virtual;
|
||||
procedure SetSelLength(Val : integer);
|
||||
procedure SetSelStart(Val : integer);
|
||||
procedure SetSelText(Val : string);
|
||||
procedure SetSorted(Val : boolean); virtual;
|
||||
procedure SetStyle(Val : TComboBoxStyle); virtual;
|
||||
property Items : TStrings read FItems write SetItems;
|
||||
property ItemIndex : integer read GetItemIndex write SetItemIndex;
|
||||
property MaxLength : integer read GetMaxLength write SetMaxLength;
|
||||
property Sorted : boolean read FSorted write SetSorted;
|
||||
property Style : TComboBoxStyle read FStyle write SetStyle;
|
||||
property OnChange : TNotifyEvent read FOnChange write FOnChange;
|
||||
public
|
||||
constructor Create(AOwner : TComponent); Override;
|
||||
destructor Destroy; override;
|
||||
property SelLength : integer read GetSelLength write SetSelLength;
|
||||
property SelStart : integer read GetSelStart write SetSelStart;
|
||||
property SelText : String read GetSelText write SetSelText;
|
||||
end;
|
||||
private
|
||||
FItems: TStrings;
|
||||
FStyle : TComboBoxStyle;
|
||||
FOnChange : TNotifyEvent;
|
||||
FSorted : boolean;
|
||||
procedure SetItems(Value : TStrings);
|
||||
procedure CNDrawItems(var Message : TLMDrawItems) ; message CN_DrawItem;
|
||||
protected
|
||||
procedure CreateHandle; override;
|
||||
procedure DestroyHandle; override;
|
||||
procedure DoChange(var msg); message LM_CHANGED;
|
||||
function GetSelLength : integer;
|
||||
function GetSelStart : integer;
|
||||
function GetSelText : string;
|
||||
function GetItemIndex : integer; virtual;
|
||||
function GetMaxLength : integer; virtual;
|
||||
procedure SetItemIndex(Val : integer); virtual;
|
||||
procedure SetMaxLength(Val : integer); virtual;
|
||||
procedure SetSelLength(Val : integer);
|
||||
procedure SetSelStart(Val : integer);
|
||||
procedure SetSelText(Val : string);
|
||||
procedure SetSorted(Val : boolean); virtual;
|
||||
procedure SetStyle(Val : TComboBoxStyle); virtual;
|
||||
property Items : TStrings read FItems write SetItems;
|
||||
property ItemIndex : integer read GetItemIndex write SetItemIndex;
|
||||
property MaxLength : integer read GetMaxLength write SetMaxLength;
|
||||
property Sorted : boolean read FSorted write SetSorted;
|
||||
property Style : TComboBoxStyle read FStyle write SetStyle;
|
||||
property OnChange : TNotifyEvent read FOnChange write FOnChange;
|
||||
public
|
||||
constructor Create(AOwner : TComponent); Override;
|
||||
destructor Destroy; override;
|
||||
property SelLength : integer read GetSelLength write SetSelLength;
|
||||
property SelStart : integer read GetSelStart write SetSelStart;
|
||||
property SelText : String read GetSelText write SetSelText;
|
||||
end;
|
||||
|
||||
TComboBox = class(TCustomComboBox)
|
||||
public
|
||||
property ItemIndex;
|
||||
published
|
||||
property Enabled;
|
||||
property Items;
|
||||
property MaxLength;
|
||||
property Sorted;
|
||||
property Style;
|
||||
property Text;
|
||||
property Visible;
|
||||
property OnChange;
|
||||
property OnClick;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyPress;
|
||||
end;
|
||||
TComboBox = class(TCustomComboBox)
|
||||
public
|
||||
property ItemIndex;
|
||||
published
|
||||
property Enabled;
|
||||
property Items;
|
||||
property MaxLength;
|
||||
property Sorted;
|
||||
property Style;
|
||||
property Text;
|
||||
property Visible;
|
||||
property OnChange;
|
||||
property OnClick;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyPress;
|
||||
end;
|
||||
|
||||
TListBoxStyle = (lbStandard, lbOwnerDrawFixed, lbOwnerDrawVariable);
|
||||
|
||||
@ -579,6 +581,9 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.23 2002/04/18 07:53:08 lazarus
|
||||
MG: fixed find declaration of forward def class
|
||||
|
||||
Revision 1.22 2002/03/25 17:59:19 lazarus
|
||||
GTK Cleanup
|
||||
Shane
|
||||
|
||||
Loading…
Reference in New Issue
Block a user