mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 08:38:14 +02:00
2354 lines
64 KiB
ObjectPascal
2354 lines
64 KiB
ObjectPascal
{
|
|
This file is part of the Free Pascal Integrated Development Environment
|
|
Copyright (c) 1998 by Berczi Gabor
|
|
|
|
Symbol browse support routines for the IDE
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
{$i globdir.inc}
|
|
unit FPSymbol;
|
|
|
|
interface
|
|
|
|
uses Objects,Drivers,Views,Menus,Dialogs,
|
|
{$ifdef HASOUTLINE}
|
|
Outline,
|
|
{$endif HASOUTLINE}
|
|
BrowCol,
|
|
WViews,
|
|
FPViews;
|
|
|
|
const
|
|
{ Browser tab constants }
|
|
btScope = 0;
|
|
btReferences = 1;
|
|
btInheritance = 2;
|
|
btMemInfo = 3;
|
|
btUnitInfo = 4;
|
|
btBreakWatch = 7;
|
|
|
|
{Symbol Flags}
|
|
bfUnits = $00000001;
|
|
bfLabels = $00000002;
|
|
bfConstants = $00000004;
|
|
bfTypes = $00000008;
|
|
bfVariables = $00000010;
|
|
bfProcedures = $00000020;
|
|
bfInherited = $00000040;
|
|
{Display Flags}
|
|
bfQualifiedSymbols = $40000000;
|
|
bfSortAlways = $80000000;
|
|
|
|
const
|
|
DefaultSymbolFlags : longint = bfUnits or
|
|
bfLabels or bfConstants or bfTypes or bfVariables or bfProcedures;
|
|
DefaultDispayFlags : longint = (bfQualifiedSymbols) shr 30;
|
|
{ Note: default browser flags will be created with formula:
|
|
BrowserFlags:=DefaultDispayFlags shl 30 or DefaultSymbolFlags;
|
|
}
|
|
DefaultBrowserSub : longint = 0;
|
|
DefaultBrowserPane : longint = 0;
|
|
|
|
|
|
type
|
|
PBrowserWindow = ^TBrowserWindow;
|
|
|
|
PGDBValueCollection = ^TGDBValueCollection;
|
|
|
|
PGDBValue = ^TGDBValue;
|
|
TGDBValue = Object(TObject)
|
|
constructor Init(Const AExpr : String;ASym : PSymbol);
|
|
procedure GetValue;
|
|
function GetText : String;
|
|
destructor Done;virtual;
|
|
private
|
|
expr : Pstring;
|
|
St : Pstring;
|
|
S : PSymbol;
|
|
GDBI : longint;
|
|
end;
|
|
|
|
TGDBValueCollection = Object(TCollection)
|
|
function At(Index: sw_Integer): PGDBValue;
|
|
end;
|
|
|
|
|
|
PFilteredSym = ^TFilteredSym;
|
|
TFilteredSym = Object(TObject)
|
|
constructor Init(AItemSym:Sw_Integer;ASym : PSymbol);
|
|
function GetText:String;
|
|
destructor Done;virtual;
|
|
private
|
|
Sym:PSymbol;
|
|
ItemSym : Sw_Integer;
|
|
end;
|
|
|
|
PFilteredSymCollection=^TFilteredSymCollection;
|
|
TFilteredSymCollection = Object(TCollection)
|
|
function At(Index: sw_Integer): PFilteredSym;
|
|
end;
|
|
|
|
|
|
PSymbolView = ^TSymbolView;
|
|
TSymbolView = object(THSListBox)
|
|
constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
|
|
destructor Done;virtual;
|
|
procedure HandleEvent(var Event: TEvent); virtual;
|
|
procedure SetState(AState: Word; Enable: Boolean); virtual;
|
|
function GotoItem(Item: sw_integer): boolean; virtual;
|
|
function TrackItem(Item: sw_integer; AutoTrack: boolean): boolean; virtual;
|
|
function GetPalette: PPalette; virtual;
|
|
function GetLocalMenu: PMenu; virtual;
|
|
procedure ClearHighlights;
|
|
procedure AutoTrackSource; virtual;
|
|
procedure Browse; virtual;
|
|
procedure GotoSource; virtual;
|
|
procedure TrackSource; virtual;
|
|
procedure OptionsDlg; virtual;
|
|
private
|
|
MyBW : PBrowserWindow;
|
|
function TrackReference(R: PReference; AutoTrack: boolean): boolean; virtual;
|
|
function GotoReference(R: PReference): boolean; virtual;
|
|
end;
|
|
|
|
PSymbolScopeView = ^TSymbolScopeView;
|
|
TSymbolScopeView = object(TSymbolView)
|
|
constructor Init(var Bounds: TRect; ASymbols: PSymbolCollection; AHScrollBar, AVScrollBar: PScrollBar);
|
|
destructor Done; virtual;
|
|
procedure SetGDBCol;
|
|
procedure FilterSymbols(AFilter:boolean);
|
|
function GetText(Item,MaxLen: Sw_Integer): String; virtual;
|
|
procedure HandleEvent(var Event: TEvent); virtual;
|
|
procedure Draw; virtual;
|
|
procedure LookUp(S: string); virtual;
|
|
function GotoItem(Item: sw_integer): boolean; virtual;
|
|
function TrackItem(Item: sw_integer; AutoTrack: boolean): boolean; virtual;
|
|
private
|
|
FilteredSym: PFilteredSymCollection;
|
|
Symbols: PSymbolCollection;
|
|
SymbolsValue : PGDBValueCollection;
|
|
LookupStr: string;
|
|
end;
|
|
|
|
PSymbolReferenceView = ^TSymbolReferenceView;
|
|
TSymbolReferenceView = object(TSymbolView)
|
|
constructor Init(var Bounds: TRect; AReferences: PReferenceCollection; AHScrollBar, AVScrollBar: PScrollBar);
|
|
destructor Done; virtual;
|
|
procedure HandleEvent(var Event: TEvent); virtual;
|
|
function GetText(Item,MaxLen: Sw_Integer): String; virtual;
|
|
procedure SelectItem(Item: Sw_Integer); virtual;
|
|
function GotoItem(Item: sw_integer): boolean; virtual;
|
|
function TrackItem(Item: sw_integer; AutoTrack: boolean): boolean; virtual;
|
|
procedure Browse; virtual;
|
|
private
|
|
References: PReferenceCollection;
|
|
end;
|
|
|
|
PSymbolMemInfoView = ^TSymbolMemInfoView;
|
|
TSymbolMemInfoView = object(TStaticText)
|
|
constructor Init(var Bounds: TRect; AMemInfo: PSymbolMemInfo);
|
|
destructor Done; virtual;
|
|
procedure GetText(var S: String); virtual;
|
|
function GetPalette: PPalette; virtual;
|
|
private
|
|
MemInfo: PSymbolMemInfo;
|
|
MyBW : PBrowserWindow;
|
|
end;
|
|
|
|
PSymbolMemoView = ^TSymbolMemoView;
|
|
TSymbolMemoView = object(TFPMemo)
|
|
function GetPalette: PPalette; virtual;
|
|
end;
|
|
|
|
PSymbolInheritanceView = ^TSymbolInheritanceView;
|
|
{$ifdef HASOUTLINE}
|
|
TSymbolInheritanceView = object(TLocalMenuOutlineViewer)
|
|
{$else notHASOUTLINE}
|
|
TSymbolInheritanceView = object(TLocalMenuListBox)
|
|
{$endif HASOUTLINE}
|
|
constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar; ARoot: PObjectSymbol);
|
|
destructor Done; virtual;
|
|
function GetRoot: Pointer; virtual;
|
|
function HasChildren(Node: Pointer): Boolean; virtual;
|
|
function GetChild(Node: Pointer; I: sw_Integer): Pointer; virtual;
|
|
function GetNumChildren(Node: Pointer): sw_Integer; virtual;
|
|
function GetNumChildrenExposed(Node: Pointer) : sw_Integer; virtual;
|
|
procedure Adjust(Node: Pointer; Expand: Boolean); virtual;
|
|
function IsExpanded(Node: Pointer): Boolean; virtual;
|
|
{$ifdef HASOUTLINE}
|
|
function GetText(Node: Pointer): String; virtual;
|
|
{$else not HASOUTLINE}
|
|
procedure ExpandAll(Node: Pointer);
|
|
function GetNode(I : sw_Integer) : Pointer; virtual;
|
|
function GetLineNode(Item : sw_Integer) : Pointer; virtual;
|
|
function GetText(Item,MaxLen: Sw_Integer): String; virtual;
|
|
{$endif HASOUTLINE}
|
|
procedure NodeSelected(P: pointer); virtual;
|
|
procedure Selected(I: sw_Integer); virtual;
|
|
procedure HandleEvent(var Event: TEvent); virtual;
|
|
function GetPalette: PPalette; virtual;
|
|
function GetLocalMenu: PMenu; virtual;
|
|
function SaveToFile(const AFileName: string): boolean; virtual;
|
|
function SaveAs: Boolean; virtual;
|
|
private
|
|
Root : PObjectSymbol;
|
|
MyBW : PBrowserWindow;
|
|
end;
|
|
|
|
PBrowserTabItem = ^TBrowserTabItem;
|
|
TBrowserTabItem = record
|
|
Sign : AnsiChar;
|
|
Link : PView;
|
|
Next : PBrowserTabItem;
|
|
end;
|
|
|
|
PBrowserTab = ^TBrowserTab;
|
|
TBrowserTab = object(TView)
|
|
Items: PBrowserTabItem;
|
|
constructor Init(var Bounds: TRect; AItems: PBrowserTabItem);
|
|
function GetItemCount: sw_integer; virtual;
|
|
function GetItem(Index: sw_integer): PBrowserTabItem; virtual;
|
|
procedure SetParams(AFlags: word; ACurrent: Sw_integer); virtual;
|
|
procedure SelectItem(Index: Sw_integer); virtual;
|
|
procedure Draw; virtual;
|
|
function GetPalette: PPalette; virtual;
|
|
procedure HandleEvent(var Event: TEvent); virtual;
|
|
destructor Done; virtual;
|
|
private
|
|
Flags : word;
|
|
Current : Sw_integer;
|
|
end;
|
|
|
|
PUnitInfoPanel = ^TUnitInfoPanel;
|
|
TUnitInfoPanel = object(TPanel)
|
|
InOwnerCall: boolean;
|
|
procedure HandleEvent(var Event: TEvent); virtual;
|
|
end;
|
|
|
|
TBrowserWindow = object(TFPWindow)
|
|
constructor Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Sw_Integer;ASym : PSymbol;
|
|
const AName,APrefix: string; ASymbols: PSymbolCollection; AReferences: PReferenceCollection;
|
|
AInheritance: PObjectSymbol; AMemInfo: PSymbolMemInfo);
|
|
procedure HandleEvent(var Event: TEvent); virtual;
|
|
procedure SetState(AState: Word; Enable: Boolean); virtual;
|
|
procedure Close; virtual;
|
|
procedure SelectTab(BrowserTab: Sw_integer); virtual;
|
|
function GetPalette: PPalette; virtual;
|
|
function Disassemble : boolean;
|
|
function GetFlags: longint; virtual;
|
|
procedure SetFlags(AFlags: longint); virtual;
|
|
destructor Done;virtual;
|
|
private
|
|
BrowserFlags : Longint;
|
|
PageTab : PBrowserTab;
|
|
ST : PStaticText;
|
|
Sym : PSymbol;
|
|
ScopeView : PSymbolScopeView;
|
|
ReferenceView : PSymbolReferenceView;
|
|
InheritanceView: PSymbolInheritanceView;
|
|
MemInfoView : PSymbolMemInfoView;
|
|
UnitInfoText : PSymbolMemoView;
|
|
UnitInfoUsed : PSymbolScopeView;
|
|
UnitInfoDependent : PSymbolScopeView;
|
|
UnitInfo : PUnitInfoPanel;
|
|
Prefix : PString;
|
|
IsValid : boolean;
|
|
DebuggerValue : PGDBValue;
|
|
end;
|
|
|
|
procedure OpenSymbolBrowser(X,Y: Sw_integer;const Name,Line: string;S : PSymbol;
|
|
ParentBrowser : PBrowserWindow;
|
|
Symbols: PSymbolCollection; References: PReferenceCollection;
|
|
Inheritance: PObjectSymbol; MemInfo: PSymbolMemInfo);
|
|
|
|
function IsSymbolInfoAvailable: boolean;
|
|
|
|
procedure OpenOneSymbolBrowser(Name : String);
|
|
|
|
procedure CloseAllBrowsers;
|
|
|
|
procedure RemoveBrowsersCollection;
|
|
|
|
const
|
|
GlobalsCollection : PSortedCollection = nil;
|
|
ProcedureCollection : PSortedCollection = nil;
|
|
ModulesCollection : PSortedCollection = nil;
|
|
|
|
implementation
|
|
|
|
uses App,Strings,Stddlg,
|
|
FVConsts,
|
|
{$ifdef BROWSERCOL}
|
|
symconst,
|
|
{$endif BROWSERCOL}
|
|
WUtils,WEditor,WConsts,
|
|
FPConst,FPUtils,FPVars,{$ifndef FPDEBUG}FPDebug{$endif},FPIDE;
|
|
|
|
{$ifdef USERESSTRINGS}
|
|
resourcestring
|
|
{$else}
|
|
const
|
|
{$endif}
|
|
msg_symbolnotfound = #3'Symbol %s not found';
|
|
msg_nobrowserinfoavailable = 'No Browser info available';
|
|
msg_cantfindfile = 'Can''t find %s';
|
|
|
|
menu_local_gotosource = '~G~oto source';
|
|
menu_local_tracksource = '~T~rack source';
|
|
menu_local_options = '~O~ptions...';
|
|
menu_local_clear = '~C~lear';
|
|
menu_local_saveas = 'Save ~a~s';
|
|
|
|
{ Symbol view local menu items }
|
|
menu_symlocal_browse = '~B~rowse';
|
|
menu_symlocal_gotosource = '~G~oto source';
|
|
menu_symlocal_tracksource = '~T~rack source';
|
|
menu_symlocal_saveas = 'Save ~a~s';
|
|
menu_symlocal_options = '~O~ptions...';
|
|
|
|
{ Symbol browser meminfo page }
|
|
msg_sizeinmemory = 'Size in memory';
|
|
msg_sizeonstack = 'Size on stack';
|
|
|
|
msg_usedfirstin = 'Used first in';
|
|
msg_mainsource = 'Main source';
|
|
msg_sourcefiles = 'Source files';
|
|
|
|
dialog_browse = 'Browse: %s';
|
|
|
|
const { Symbol browser tabs }
|
|
{ must be AnsiChar constants (so cannot be resourcestring)}
|
|
label_browsertab_scope = 'S';
|
|
label_browsertab_reference = 'R';
|
|
label_browsertab_inheritance = 'I';
|
|
label_browsertab_memory = 'M';
|
|
label_browsertab_unit = 'U';
|
|
|
|
procedure CloseAllBrowsers;
|
|
procedure SendCloseIfBrowser(P: PView);
|
|
begin
|
|
if assigned(P) and
|
|
((TypeOf(P^)=TypeOf(TBrowserWindow)) or
|
|
(TypeOf(P^)=TypeOf(TSymbolView)) or
|
|
(TypeOf(P^)=TypeOf(TSymbolScopeView)) or
|
|
(TypeOf(P^)=TypeOf(TSymbolReferenceView)) or
|
|
(TypeOf(P^)=TypeOf(TSymbolMemInfoView)) or
|
|
(TypeOf(P^)=TypeOf(TSymbolInheritanceView)) or
|
|
(TypeOf(P^)=TypeOf(TSymbolMemoView))) then
|
|
Message(P,evCommand,cmClose,nil);
|
|
end;
|
|
|
|
begin
|
|
Desktop^.ForEach(TCallbackProcParam(@SendCloseIfBrowser));
|
|
end;
|
|
|
|
procedure RemoveBrowsersCollection;
|
|
begin
|
|
if assigned(GlobalsCollection) then
|
|
begin
|
|
GlobalsCollection^.deleteAll;
|
|
Dispose(GlobalsCollection,done);
|
|
GlobalsCollection:=nil;
|
|
end;
|
|
if assigned(ProcedureCollection) then
|
|
begin
|
|
ProcedureCollection^.deleteAll;
|
|
Dispose(ProcedureCollection,done);
|
|
ProcedureCollection:=nil;
|
|
end;
|
|
if assigned(ModulesCollection) then
|
|
begin
|
|
ModulesCollection^.deleteAll;
|
|
Dispose(ModulesCollection,done);
|
|
ModulesCollection:=nil;
|
|
end;
|
|
end;
|
|
|
|
function NewBrowserTabItem(ASign: AnsiChar; ALink: PView; ANext: PBrowserTabItem): PBrowserTabItem;
|
|
var P: PBrowserTabItem;
|
|
begin
|
|
New(P); FillChar(P^,SizeOf(P^),0);
|
|
with P^ do begin Sign:=ASign; Link:=ALink; Next:=ANext; end;
|
|
NewBrowserTabItem:=P;
|
|
end;
|
|
|
|
procedure DisposeBrowserTabItem(P: PBrowserTabItem);
|
|
begin
|
|
if P<>nil then Dispose(P);
|
|
end;
|
|
|
|
procedure DisposeBrowserTabList(P: PBrowserTabItem);
|
|
begin
|
|
if P<>nil then
|
|
begin
|
|
if P^.Next<>nil then DisposeBrowserTabList(P^.Next);
|
|
DisposeBrowserTabItem(P);
|
|
end;
|
|
end;
|
|
|
|
function IsSymbolInfoAvailable: boolean;
|
|
begin
|
|
IsSymbolInfoAvailable:=BrowCol.Modules<>nil;
|
|
end;
|
|
|
|
procedure OpenOneSymbolBrowser(Name : String);
|
|
|
|
var Index : sw_integer;
|
|
PS,S : PSymbol;
|
|
Anc : PObjectSymbol;
|
|
P : Pstring;
|
|
Symbols: PSymbolCollection;
|
|
|
|
function Search(P : PSymbol) : boolean;
|
|
begin
|
|
Search:=UpcaseStr(P^.Items^.LookUp(Name,Index))=Name;
|
|
end;
|
|
|
|
begin
|
|
Name:=UpcaseStr(Name);
|
|
If BrowCol.Modules<>nil then
|
|
begin
|
|
PS:=BrowCol.Modules^.FirstThat(TCallbackFunBoolParam(@Search));
|
|
If assigned(PS) then
|
|
begin
|
|
S:=PS^.Items^.At(Index);
|
|
Symbols:=S^.Items;
|
|
if (not assigned(symbols) or (symbols^.count=0)) and
|
|
assigned(S^.Ancestor) then
|
|
Symbols:=S^.Ancestor^.Items;
|
|
if (S^.Flags and (sfObject or sfClass))=0 then
|
|
Anc:=nil
|
|
else if S^.Ancestor=nil then
|
|
Anc:=ObjectTree
|
|
else
|
|
Anc:=SearchObjectForSymbol(S^.Ancestor);
|
|
OpenSymbolBrowser(0,20,
|
|
PS^.Items^.At(Index)^.GetName,
|
|
PS^.Items^.At(Index)^.GetText,
|
|
PS^.Items^.At(Index),nil,
|
|
Symbols,PS^.Items^.At(Index)^.References,Anc,PS^.MemInfo);
|
|
end
|
|
else
|
|
begin
|
|
P:=@Name;
|
|
ErrorBox(msg_symbolnotfound,@P);
|
|
end;
|
|
end
|
|
else
|
|
ErrorBox(msg_nobrowserinfoavailable,nil);
|
|
end;
|
|
|
|
(*procedure ReadBrowseLog(FileName: string);
|
|
var f: text;
|
|
IOOK,EndOfFile: boolean;
|
|
Line: string;
|
|
procedure NextLine;
|
|
begin
|
|
readln(f,Line);
|
|
EndOfFile:=Eof(f);
|
|
end;
|
|
var Level: integer;
|
|
procedure ProcessSymTable(Indent: integer; Owner: PSymbolCollection);
|
|
var IndentS,S,Source: string;
|
|
Sym: PSymbol;
|
|
Ref: PSymbolReference;
|
|
P: byte;
|
|
PX: TPoint;
|
|
PS: PString;
|
|
PCount: integer;
|
|
Params: array[0..30] of PString;
|
|
Typ: tsymtyp;
|
|
ExitBack: boolean;
|
|
begin
|
|
Inc(Level);
|
|
IndentS:=CharStr(' ',Indent); ExitBack:=false;
|
|
Sym:=nil;
|
|
repeat
|
|
if copy(Line,1,length(IndentS))<>IndentS then ExitBack:=true else
|
|
if copy(Line,Indent+1,3)='***' then
|
|
{ new symbol }
|
|
begin
|
|
S:=copy(Line,Indent+1+3,255);
|
|
P:=Pos('***',S); if P=0 then P:=length(S)+1;
|
|
S:=Trim(copy(S,1,P-1));
|
|
if (copy(S,1,1)='_') and (Pos('$$',S)>0) then
|
|
begin
|
|
repeat
|
|
P:=Pos('$$',S);
|
|
if P>0 then Delete(S,1,P+1);
|
|
until P=0;
|
|
P:=Pos('$',S);
|
|
Delete(S,1,P);
|
|
PCount:=0;
|
|
repeat
|
|
P:=Pos('$',S); if P=0 then P:=length(S)+1;
|
|
Params[PCount]:=TypeNames^.Add(copy(S,1,P-1));
|
|
Inc(PCount);
|
|
Delete(S,1,P);
|
|
until S='';
|
|
Sym^.Typ:=procsym;
|
|
Sym^.SetParams(PCount,@Params);
|
|
end
|
|
else
|
|
New(Sym, Init(S, varsym, 0, nil));
|
|
Owner^.Insert(Sym);
|
|
NextLine;
|
|
end else
|
|
if copy(Line,Indent+1,3)='---' then
|
|
{ child symtable }
|
|
begin
|
|
S:=Trim(copy(Line,Indent+1+12,255));
|
|
if Level=1 then Typ:=unitsym else
|
|
Typ:=typesym;
|
|
if (Sym<>nil) and (Sym^.GetName=S) then
|
|
else
|
|
begin
|
|
New(Sym, Init(S, Typ, 0, nil));
|
|
Owner^.Insert(Sym);
|
|
end;
|
|
Sym^.Typ:=Typ;
|
|
NextLine;
|
|
New(Sym^.Items, Init(0,50));
|
|
ProcessSymTable(Indent+2,Sym^.Items);
|
|
end else
|
|
{ if Sym<>nil then}
|
|
if copy(Line,Indent+1,1)=' ' then
|
|
{ reference }
|
|
begin
|
|
S:=copy(Line,Indent+1+2,255);
|
|
P:=Pos('(',S); if P=0 then P:=length(S)+1;
|
|
Source:=Trim(copy(S,1,P-1)); Delete(S,1,P);
|
|
P:=Pos(',',S); if P=0 then P:=length(S)+1;
|
|
PX.Y:=StrToInt(copy(S,1,P-1)); Delete(S,1,P);
|
|
P:=Pos(')',S); if P=0 then P:=length(S)+1;
|
|
PX.X:=StrToInt(copy(S,1,P-1)); Delete(S,1,P);
|
|
PS:=ModuleNames^.Add(Source);
|
|
New(Ref, Init(PS, PX));
|
|
if Sym^.References=nil then
|
|
New(Sym^.References, Init(10,50));
|
|
Sym^.References^.Insert(Ref);
|
|
end;
|
|
if ExitBack=false then
|
|
NextLine;
|
|
until EndOfFile or ExitBack;
|
|
Dec(Level);
|
|
end;
|
|
begin
|
|
DoneSymbolBrowser;
|
|
InitSymbolBrowser;
|
|
|
|
{$I-}
|
|
Assign(f,FileName);
|
|
Reset(f);
|
|
Level:=0;
|
|
NextLine;
|
|
while (IOResult=0) and (EndOfFile=false) do
|
|
ProcessSymTable(0,Modules);
|
|
Close(f);
|
|
EatIO;
|
|
{$I+}
|
|
end;*)
|
|
|
|
|
|
{****************************************************************************
|
|
TGDBValue
|
|
****************************************************************************}
|
|
|
|
constructor TGDBValue.Init(Const AExpr : String;ASym : PSymbol);
|
|
begin
|
|
St := nil;
|
|
S := ASym;
|
|
Expr:=NewStr(AExpr);
|
|
GDBI:=-1;
|
|
end;
|
|
|
|
destructor TGDBValue.Done;
|
|
begin
|
|
If Assigned(St) then
|
|
begin
|
|
DisposeStr(St);
|
|
st:=nil;
|
|
end;
|
|
If Assigned(Expr) then
|
|
begin
|
|
DisposeStr(Expr);
|
|
Expr:=nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TGDBValue.GetValue;
|
|
var
|
|
p : PAnsiChar;
|
|
begin
|
|
{$ifdef BROWSERCOL}
|
|
{$ifndef NODEBUG}
|
|
if not assigned(Debugger) then
|
|
exit;
|
|
if not Debugger^.IsRunning then
|
|
exit;
|
|
if (S^.typ in [fieldvarsym,staticvarsym,localvarsym,paravarsym]) or (GDBI=Debugger^.RunCount) then
|
|
exit;
|
|
If Assigned(St) then
|
|
DisposeStr(St);
|
|
if assigned(Expr) then
|
|
begin
|
|
{ avoid infinite recursion here }
|
|
GDBI:=Debugger^.RunCount;
|
|
p:=Debugger^.GetValue(Expr^);
|
|
St:=NewStr(GetPChar(p));
|
|
if assigned(p) then
|
|
StrDispose(p);
|
|
end;
|
|
{$endif ndef NODEBUG}
|
|
{$endif BROWSERCOL}
|
|
end;
|
|
|
|
function TGDBValue.GetText : String;
|
|
begin
|
|
GetValue;
|
|
if assigned(St) then
|
|
GetText:=S^.GetText+' = '+GetStr(St)
|
|
else
|
|
GetText:=S^.GetText;
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TGDBValueCollection
|
|
****************************************************************************}
|
|
function TGDBValueCollection.At(Index: sw_Integer): PGDBValue;
|
|
begin
|
|
At:= Inherited At(Index);
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TFilteredSym
|
|
****************************************************************************}
|
|
constructor TFilteredSym.Init(AItemSym:Sw_Integer;ASym : PSymbol);
|
|
begin
|
|
inherited Init;
|
|
ItemSym:=AItemSym;
|
|
Sym:=ASym;
|
|
end;
|
|
|
|
function TFilteredSym.GetText:String;
|
|
begin
|
|
GetText:=Sym^.GetText;
|
|
end;
|
|
|
|
destructor TFilteredSym.Done;
|
|
begin
|
|
inherited Done;
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TFilteredSymCollection
|
|
****************************************************************************}
|
|
function TFilteredSymCollection.At(Index: sw_Integer): PFilteredSym;
|
|
begin
|
|
At:= Inherited At(Index);
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TSymbolView
|
|
****************************************************************************}
|
|
|
|
constructor TSymbolView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
|
|
begin
|
|
inherited Init(Bounds,1,AHScrollBar,AVScrollBar);
|
|
{HScrollBar:=AHScrollBar;}
|
|
MyBW:=nil;
|
|
if assigned(HScrollBar) then
|
|
begin
|
|
HScrollBar^.SetRange(1,80);
|
|
end;
|
|
Options:=Options or (ofSelectable+ofTopSelect);
|
|
EventMask:=EventMask or evBroadcast;
|
|
end;
|
|
|
|
procedure TSymbolView.ClearHighlights;
|
|
begin
|
|
Message(Desktop,evBroadcast,cmClearLineHighlights,nil);
|
|
end;
|
|
|
|
procedure TSymbolView.AutoTrackSource;
|
|
begin
|
|
if Range>0 then
|
|
TrackSource;
|
|
end;
|
|
|
|
procedure TSymbolView.OptionsDlg;
|
|
begin
|
|
if MyBW<> nil then
|
|
Message(@IDEApp, evCommand, cmBrowserOptions, MyBW); { Send message }
|
|
end;
|
|
|
|
destructor TSymbolView.Done;
|
|
begin
|
|
EventMask:=EventMask and not evBroadcast;
|
|
Inherited Done;
|
|
end;
|
|
|
|
procedure TSymbolView.SetState(AState: Word; Enable: Boolean);
|
|
var OState: longint;
|
|
begin
|
|
OState:=State;
|
|
inherited SetState(AState,Enable);
|
|
if ((OState xor State) and sfFocused)<>0 then
|
|
if GetState(sfFocused) then
|
|
begin
|
|
if (MiscOptions and moAutoTrackSource)<>0 then
|
|
AutoTrackSource;
|
|
end
|
|
else
|
|
Message(Desktop,evBroadcast,cmClearLineHighlights,nil);
|
|
end;
|
|
|
|
procedure TSymbolView.Browse;
|
|
begin
|
|
SelectItem(Focused);
|
|
end;
|
|
|
|
procedure TSymbolView.GotoSource;
|
|
begin
|
|
if GotoItem(Focused) then
|
|
PutCommand(Owner,evCommand,cmClose,nil);
|
|
end;
|
|
|
|
procedure TSymbolView.TrackSource;
|
|
begin
|
|
TrackItem(Focused,false);
|
|
end;
|
|
|
|
procedure TSymbolView.HandleEvent(var Event: TEvent);
|
|
var DontClear: boolean;
|
|
begin
|
|
case Event.What of
|
|
evKeyDown :
|
|
begin
|
|
DontClear:=false;
|
|
case Event.KeyCode of
|
|
kbEnter :
|
|
Browse;
|
|
kbCtrlEnter :
|
|
GotoSource;
|
|
kbSpaceBar :
|
|
TrackSource;
|
|
kbRight,kbLeft :
|
|
if HScrollBar<>nil then
|
|
HScrollBar^.HandleEvent(Event);
|
|
else DontClear:=true;
|
|
end;
|
|
if DontClear=false then ClearEvent(Event);
|
|
end;
|
|
evMouseDown :
|
|
begin
|
|
if Event.double then
|
|
begin
|
|
Browse;
|
|
ClearEvent(Event);
|
|
end;
|
|
end;
|
|
evCommand :
|
|
begin
|
|
DontClear:=false;
|
|
case Event.Command of
|
|
cmSymBrowse :
|
|
Browse;
|
|
cmSymGotoSource :
|
|
GotoSource;
|
|
cmSymTrackSource :
|
|
TrackSource;
|
|
cmSymSaveAs,cmSaveAs :
|
|
SaveAs;
|
|
cmSymOptions :
|
|
OptionsDlg;
|
|
else DontClear:=true;
|
|
end;
|
|
if DontClear=false then ClearEvent(Event);
|
|
end;
|
|
evBroadcast :
|
|
case Event.Command of
|
|
cmListFocusChanged :
|
|
if Event.InfoPtr=@Self then
|
|
if (MiscOptions and moAutoTrackSource)<>0 then
|
|
if GetState(sfFocused) then
|
|
AutoTrackSource;
|
|
end;
|
|
end;
|
|
inherited HandleEvent(Event);
|
|
end;
|
|
|
|
function TSymbolView.GetPalette: PPalette;
|
|
const
|
|
P: string[length(CBrowserListBox)] = CBrowserListBox;
|
|
begin
|
|
GetPalette:=@P;
|
|
end;
|
|
|
|
function TSymbolView.GetLocalMenu: PMenu;
|
|
begin
|
|
GetLocalMenu:=NewMenu(
|
|
NewItem(menu_symlocal_browse,'',kbNoKey,cmSymBrowse,hcSymBrowse,
|
|
NewItem(menu_symlocal_gotosource,'',kbNoKey,cmSymGotoSource,hcSymGotoSource,
|
|
NewItem(menu_symlocal_tracksource,'',kbNoKey,cmSymTrackSource,hcSymTrackSource,
|
|
NewLine(
|
|
NewItem(menu_symlocal_saveas,'',kbNoKey,cmSymSaveAs,hcSymSaveAs,
|
|
NewItem(menu_symlocal_options,'',kbNoKey,cmSymOptions,hcSymOptions,
|
|
nil)))))));
|
|
end;
|
|
|
|
function TSymbolView.GotoItem(Item: sw_integer): boolean;
|
|
begin
|
|
SelectItem(Item);
|
|
GotoItem:=true;
|
|
end;
|
|
|
|
function TSymbolView.TrackItem(Item: sw_integer; AutoTrack: boolean): boolean;
|
|
begin
|
|
SelectItem(Item);
|
|
TrackItem:=true;
|
|
end;
|
|
|
|
function LastBrowserWindow: PBrowserWindow;
|
|
var BW: PBrowserWindow;
|
|
procedure IsBW(P: PView);
|
|
begin
|
|
if (P^.HelpCtx=hcBrowserWindow) then
|
|
BW:=pointer(P);
|
|
end;
|
|
begin
|
|
BW:=nil;
|
|
Desktop^.ForEach(TCallbackProcParam(@IsBW));
|
|
LastBrowserWindow:=BW;
|
|
end;
|
|
|
|
function TSymbolView.TrackReference(R: PReference; AutoTrack: boolean): boolean;
|
|
var W: PSourceWindow;
|
|
BW: PBrowserWindow;
|
|
P: TPoint;
|
|
begin
|
|
ClearHighlights;
|
|
Desktop^.Lock;
|
|
P.X:=R^.Position.X-1; P.Y:=R^.Position.Y-1;
|
|
if AutoTrack then
|
|
W:=SearchOnDesktop(R^.GetFileName,false)
|
|
else
|
|
W:=TryToOpenFile(nil,R^.GetFileName,P.X,P.Y,true);
|
|
if not assigned(W) then
|
|
begin
|
|
Desktop^.Unlock;
|
|
if IDEApp.OpenSearch(R^.GetFileName+'*') then
|
|
begin
|
|
W:=TryToOpenFile(nil,R^.GetFileName,R^.Position.X-1,R^.Position.Y-1,true);
|
|
if Assigned(W) then
|
|
W^.Select;
|
|
end;
|
|
Desktop^.Lock;
|
|
end;
|
|
if W<>nil then
|
|
begin
|
|
BW:=LastBrowserWindow;
|
|
if BW=nil then
|
|
W^.Select
|
|
else
|
|
begin
|
|
Desktop^.Delete(W);
|
|
Desktop^.InsertBefore(W,BW^.NextView);
|
|
end;
|
|
W^.Editor^.SetLineFlagExclusive(lfHighlightRow,P.Y);
|
|
end;
|
|
Desktop^.UnLock;
|
|
if Assigned(W)=false then
|
|
ErrorBox(FormatStrStr(msg_cantfindfile,R^.GetFileName),nil);
|
|
|
|
TrackReference:=W<>nil;
|
|
end;
|
|
|
|
function TSymbolView.GotoReference(R: PReference): boolean;
|
|
var W: PSourceWindow;
|
|
begin
|
|
Desktop^.Lock;
|
|
W:=TryToOpenFile(nil,R^.GetFileName,R^.Position.X-1,R^.Position.Y-1,true);
|
|
if Assigned(W) then
|
|
W^.Select
|
|
else
|
|
begin
|
|
Desktop^.Unlock;
|
|
if IDEApp.OpenSearch(R^.GetFileName+'*') then
|
|
begin
|
|
W:=TryToOpenFile(nil,R^.GetFileName,R^.Position.X-1,R^.Position.Y-1,true);
|
|
if Assigned(W) then
|
|
W^.Select;
|
|
end;
|
|
Desktop^.Lock;
|
|
end;
|
|
Desktop^.UnLock;
|
|
if Assigned(W)=false then
|
|
ErrorBox(FormatStrStr(msg_cantfindfile,R^.GetFileName),nil);
|
|
GotoReference:=W<>nil;
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TSymbolScopeView
|
|
****************************************************************************}
|
|
|
|
constructor TSymbolScopeView.Init(var Bounds: TRect; ASymbols: PSymbolCollection; AHScrollBar, AVScrollBar: PScrollBar);
|
|
begin
|
|
inherited Init(Bounds,AHScrollBar, AVScrollBar);
|
|
Symbols:=ASymbols;
|
|
New(SymbolsValue,Init(50,50));
|
|
New(FilteredSym,Init(50,50));
|
|
FilterSymbols(false); {select all}
|
|
NewList(FilteredSym);
|
|
SetRange(FilteredSym^.Count);
|
|
end;
|
|
|
|
destructor TSymbolScopeView.Done;
|
|
begin
|
|
{if assigned(Symbols) then
|
|
begin
|
|
the elements belong to other lists
|
|
Symbols^.DeleteAll;
|
|
dispose(Symbols,done);
|
|
end;}
|
|
if Assigned(SymbolsValue) then
|
|
begin
|
|
Dispose(SymbolsValue,Done);
|
|
SymbolsValue:=nil;
|
|
end;
|
|
if Assigned(FilteredSym) then
|
|
begin
|
|
Dispose(FilteredSym,Done);
|
|
FilteredSym:=nil;
|
|
end;
|
|
Inherited Done;
|
|
end;
|
|
|
|
procedure TSymbolScopeView.HandleEvent(var Event: TEvent);
|
|
var OldFocus: sw_integer;
|
|
begin
|
|
case Event.What of
|
|
evKeyDown :
|
|
case Event.KeyCode of
|
|
kbBack :
|
|
begin
|
|
LookUp(copy(LookUpStr,1,length(LookUpStr)-1));
|
|
ClearEvent(Event);
|
|
end;
|
|
else
|
|
if Event.CharCode in[#33..#255] then
|
|
begin
|
|
LookUp(LookUpStr+Event.CharCode);
|
|
ClearEvent(Event);
|
|
end;
|
|
end;
|
|
end;
|
|
OldFocus:=Focused;
|
|
inherited HandleEvent(Event);
|
|
if OldFocus<>Focused then
|
|
Lookup('');
|
|
end;
|
|
|
|
procedure TSymbolScopeView.Draw;
|
|
var DeltaX: sw_integer;
|
|
begin
|
|
inherited Draw;
|
|
if Assigned(HScrollBar)=false then DeltaX:=0 else
|
|
DeltaX:=HScrollBar^.Value-HScrollBar^.Min;
|
|
SetCursor(2+SymbolTypLen+length(LookUpStr)-DeltaX,Focused-TopItem);
|
|
end;
|
|
|
|
procedure TSymbolScopeView.LookUp(S: string);
|
|
var LookUpS : String;
|
|
|
|
function GetFilteredLookUpIdx(Item:Sw_Integer):Sw_Integer;
|
|
var I, Count : Sw_Integer;
|
|
F : PFilteredSym;
|
|
UpS,LeftS : String;
|
|
begin
|
|
GetFilteredLookUpIdx:=-1;
|
|
Count:=FilteredSym^.Count;
|
|
if Count > 0 then
|
|
for I:=0 to Count-1 do
|
|
begin
|
|
F:=FilteredSym^.At(I);
|
|
if F^.ItemSym = Item then {perfect match}
|
|
begin
|
|
GetFilteredLookUpIdx:=I;
|
|
break;
|
|
end;
|
|
if F^.ItemSym > Item then { test next item if perfect match is missing}
|
|
begin
|
|
LeftS:=UpcaseStr(F^.Sym^.GetName);
|
|
UpS:=UpcaseStr(LookUpS);
|
|
if copy(LeftS,1,length(UpS))=UpS then {perfect match}
|
|
GetFilteredLookUpIdx:=I;
|
|
break; {all you get is one second chance, it wont be any better from here}
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var Idx,Slength,I: Sw_integer;
|
|
NS: string;
|
|
begin
|
|
NS:=LookUpStr;
|
|
Slength:=Length(S);
|
|
LookUpS:=S;
|
|
if (Symbols=nil) or (S='') then NS:='' else
|
|
begin
|
|
S:=Symbols^.LookUp(S,Idx);
|
|
if Idx<>-1 then
|
|
begin
|
|
{ Have found, but get filtered list index first
|
|
Some entries might be missing if need then look up agin }
|
|
Idx:=GetFilteredLookUpIdx(Idx);
|
|
if Idx<>-1 then
|
|
begin
|
|
NS:=S;
|
|
FocusItem(Idx);
|
|
end;
|
|
end;
|
|
end;
|
|
LookUpStr:=Copy(NS,1,Slength);
|
|
SetState(sfCursorVis,LookUpStr<>'');
|
|
DrawView;
|
|
end;
|
|
|
|
function TSymbolScopeView.GotoItem(Item: sw_integer): boolean;
|
|
var S: PSymbol;
|
|
OK: boolean;
|
|
F : PFilteredSym;
|
|
begin
|
|
OK:=Range>0;
|
|
if OK then
|
|
begin
|
|
F:=List^.At(Item);
|
|
S:=F^.Sym;
|
|
OK:=(S^.References<>nil) and (S^.References^.Count>0);
|
|
if OK then
|
|
OK:=GotoReference(S^.References^.At(0));
|
|
end;
|
|
GotoItem:=OK;
|
|
end;
|
|
|
|
function TSymbolScopeView.TrackItem(Item: sw_integer; AutoTrack: boolean): boolean;
|
|
var S: PSymbol;
|
|
OK: boolean;
|
|
F: PFilteredSym;
|
|
begin
|
|
OK:=Range>0;
|
|
if OK then
|
|
begin
|
|
F:=List^.At(Item);
|
|
S:=F^.Sym;
|
|
OK:=(S^.References<>nil) and (S^.References^.Count>0);
|
|
if OK then
|
|
OK:=TrackReference(S^.References^.At(0),AutoTrack);
|
|
end;
|
|
TrackItem:=OK;
|
|
end;
|
|
|
|
procedure TSymbolScopeView.SetGDBCol;
|
|
var S : PSymbol;
|
|
I : sw_integer;
|
|
begin
|
|
if assigned(MyBW) and (SymbolsValue^.Count=0) then
|
|
begin
|
|
For i:=0 to Symbols^.Count-1 do
|
|
begin
|
|
S:=Symbols^.At(I);
|
|
SymbolsValue^.Insert(New(PGDBValue,Init(GetStr(MyBW^.Prefix)+S^.GetName,S)));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSymbolScopeView.FilterSymbols(AFilter:boolean);
|
|
var S : PSymbol;
|
|
I : sw_integer;
|
|
Flags : Longint;
|
|
bUni, bLab, bcon, btyp, bvar, bprc, binh: boolean;
|
|
begin
|
|
Flags:=0;
|
|
if assigned(MyBW) then
|
|
Flags:=MyBW^.GetFlags;
|
|
bUni:=(Flags and bfUnits)<>0;
|
|
bLab:=(Flags and bfLabels)<>0;
|
|
bCon:=(Flags and bfConstants)<>0;
|
|
bTyp:=(Flags and bfTypes)<>0;
|
|
bVar:=(Flags and bfVariables)<>0;
|
|
bPrc:=(Flags and bfProcedures)<>0;
|
|
bInh:=(Flags and bfInherited)<>0;
|
|
FilteredSym^.FreeAll;
|
|
if Symbols^.Count = 0 then exit;
|
|
For i:=0 to Symbols^.Count-1 do
|
|
begin
|
|
S:=Symbols^.At(I);
|
|
if AFilter then begin
|
|
{---------- only selected ones ----------}
|
|
case S^.typ of
|
|
labelsym: if not bLab then continue;
|
|
namespacesym,staticvarsym,localvarsym,paravarsym,
|
|
fieldvarsym,absolutevarsym,programparasym: if not bVar then continue;
|
|
procsym,propertysym,syssym : if not bPrc then continue;
|
|
typesym : if not bTyp then continue;
|
|
constsym,enumsym : if not bCon then continue;
|
|
unitsym : if not bUni then continue;
|
|
errorsym,macrosym,undefinedsym: ; {accepted anyway}
|
|
end;
|
|
end;
|
|
FilteredSym^.Insert(New(PFilteredSym,Init(I,S)));
|
|
end;
|
|
end;
|
|
|
|
function TSymbolScopeView.GetText(Item,MaxLen: Sw_Integer): String;
|
|
var S1: string;
|
|
S : PSymbol;
|
|
SG : PGDBValue;
|
|
F : PFilteredSym;
|
|
begin
|
|
F:=FilteredSym^.At(Item);
|
|
Item:=F^.ItemSym;
|
|
S:=Symbols^.At(Item);
|
|
if Assigned(SymbolsValue) and (SymbolsValue^.Count>Item) then
|
|
SG:=SymbolsValue^.At(Item)
|
|
else
|
|
SG:=nil;
|
|
if assigned(SG) then
|
|
S1:=SG^.getText
|
|
else
|
|
S1:=S^.GetText;
|
|
GetText:=copy(S1,1,MaxLen);
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TSymbolReferenceView
|
|
****************************************************************************}
|
|
|
|
constructor TSymbolReferenceView.Init(var Bounds: TRect; AReferences: PReferenceCollection;
|
|
AHScrollBar, AVScrollBar: PScrollBar);
|
|
begin
|
|
inherited Init(Bounds,AHScrollBar, AVScrollBar);
|
|
References:=AReferences;
|
|
NewList(AReferences);
|
|
SetRange(References^.Count);
|
|
end;
|
|
|
|
destructor TSymbolReferenceView.Done;
|
|
begin
|
|
Inherited Done;
|
|
end;
|
|
|
|
procedure TSymbolReferenceView.HandleEvent(var Event: TEvent);
|
|
var OldFocus: sw_integer;
|
|
DontClear: boolean;
|
|
begin
|
|
OldFocus:=Focused;
|
|
case Event.What of
|
|
evKeyDown :
|
|
begin
|
|
DontClear:=false;
|
|
case Event.KeyCode of
|
|
kbEnter :
|
|
TrackItem(Focused,false);
|
|
kbCtrlEnter :
|
|
GotoItem(Focused);
|
|
else DontClear:=true;
|
|
end;
|
|
if DontClear=false then ClearEvent(Event);
|
|
end;
|
|
end;
|
|
inherited HandleEvent(Event);
|
|
if OldFocus<>Focused then
|
|
if (MiscOptions and moAutoTrackSource)=0 then
|
|
ClearHighlights;
|
|
end;
|
|
|
|
procedure TSymbolReferenceView.Browse;
|
|
begin
|
|
{ do nothing here }
|
|
end;
|
|
|
|
function TSymbolReferenceView.GetText(Item,MaxLen: Sw_Integer): String;
|
|
var S: string;
|
|
P: PReference;
|
|
begin
|
|
P:=References^.At(Item);
|
|
S:=P^.GetFileName+'('+IntToStr(P^.Position.Y)+','+IntToStr(P^.Position.X)+')';
|
|
GetText:=copy(S,1,MaxLen);
|
|
end;
|
|
|
|
function TSymbolReferenceView.GotoItem(Item: sw_integer): boolean;
|
|
var OK: boolean;
|
|
begin
|
|
OK:=Range>0;
|
|
if OK then
|
|
OK:=GotoReference(List^.At(Item));
|
|
GotoItem:=OK;
|
|
end;
|
|
|
|
function TSymbolReferenceView.TrackItem(Item: sw_integer; AutoTrack: boolean): boolean;
|
|
var OK: boolean;
|
|
begin
|
|
OK:=Range>0;
|
|
if OK then
|
|
OK:=TrackReference(List^.At(Item),AutoTrack);
|
|
TrackItem:=OK;
|
|
end;
|
|
|
|
procedure TSymbolReferenceView.SelectItem(Item: Sw_Integer);
|
|
begin
|
|
GotoItem(Item);
|
|
end;
|
|
|
|
|
|
constructor TSymbolMemInfoView.Init(var Bounds: TRect; AMemInfo: PSymbolMemInfo);
|
|
begin
|
|
inherited Init(Bounds,'');
|
|
Options:=Options or (ofSelectable+ofTopSelect);
|
|
MemInfo:=AMemInfo;
|
|
MyBW:=nil;
|
|
end;
|
|
|
|
destructor TSymbolMemInfoView.Done;
|
|
begin
|
|
{ if assigned(MemInfo) then
|
|
dispose(MemInfo);}
|
|
Inherited Done;
|
|
end;
|
|
|
|
procedure TSymbolMemInfoView.GetText(var S: String);
|
|
function SizeStr(Size: longint): string;
|
|
var S: string[40];
|
|
begin
|
|
S:=IntToStrL(Size,7);
|
|
S:=S+' byte';
|
|
if Size>1 then S:=S+'s';
|
|
if Size=-1 then
|
|
SizeStr:='variable'
|
|
else
|
|
SizeStr:=S;
|
|
end;
|
|
function AddrStr(Addr: longint): string;
|
|
{ Warning this is endian specific code !! (PM) }
|
|
type TLongint = record LoW,HiW: word; end;
|
|
begin
|
|
with TLongint(Addr) do
|
|
AddrStr:='$'+hexstr(HiW,4)+hexstr(LoW,4);
|
|
end;
|
|
begin
|
|
ClearFormatParams;
|
|
AddFormatParamStr(msg_sizeinmemory);
|
|
AddFormatParamStr(msg_sizeonstack);
|
|
S:=
|
|
FormatStrF(
|
|
#13+
|
|
{ ' Memory location: '+AddrStr(MemInfo^.Addr)+#13+
|
|
' Local address: '+AddrStr(MemInfo^.LocalAddr)+#13+}
|
|
|
|
{ ??? internal linker ??? }
|
|
|
|
'%18s: '+SizeStr(MemInfo^.Size)+#13+
|
|
'%18s: '+SizeStr(MemInfo^.PushSize)+#13+
|
|
'',
|
|
FormatParams);
|
|
end;
|
|
|
|
function TSymbolMemInfoView.GetPalette: PPalette;
|
|
begin
|
|
GetPalette:=inherited GetPalette;
|
|
end;
|
|
|
|
function TSymbolMemoView.GetPalette: PPalette;
|
|
const P: string[length(CFPSymbolMemo)] = CFPSymbolMemo;
|
|
begin
|
|
GetPalette:=@P;
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TSymbolInheritanceView
|
|
****************************************************************************}
|
|
|
|
constructor TSymbolInheritanceView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar; ARoot: PObjectSymbol);
|
|
begin
|
|
{$ifdef HASOUTLINE}
|
|
inherited Init(Bounds,AHScrollBar,AVScrollBar);
|
|
{$else not HASOUTLINE}
|
|
inherited Init(Bounds,1,AVScrollBar);
|
|
HScrollBar:=AHScrollBar;
|
|
{$endif not HASOUTLINE}
|
|
Options:=Options or (ofSelectable+ofTopSelect);
|
|
Root:=ARoot;
|
|
MyBW:=nil;
|
|
ExpandAll(Root);
|
|
{$ifdef HASOUTLINE}
|
|
Update;
|
|
{$else not HASOUTLINE}
|
|
SetRange(GetNumChildrenExposed(Root));
|
|
{$endif not HASOUTLINE}
|
|
end;
|
|
|
|
destructor TSymbolInheritanceView.Done;
|
|
begin
|
|
{ do not dispose,
|
|
belongs to a symbolcollection (PM)
|
|
if assigned(Root) then
|
|
dispose(Root,done); }
|
|
Inherited Done;
|
|
end;
|
|
|
|
function TSymbolInheritanceView.GetRoot: Pointer;
|
|
begin
|
|
GetRoot:=Root;
|
|
end;
|
|
|
|
function TSymbolInheritanceView.HasChildren(Node: Pointer): Boolean;
|
|
begin
|
|
HasChildren:=GetNumChildren(Node)>0;
|
|
end;
|
|
|
|
function TSymbolInheritanceView.GetChild(Node: Pointer; I: sw_Integer): Pointer;
|
|
begin
|
|
GetChild:=PObjectSymbol(Node)^.GetDescendant(I);
|
|
end;
|
|
|
|
function TSymbolInheritanceView.GetNumChildren(Node: Pointer): sw_Integer;
|
|
begin
|
|
GetNumChildren:=PObjectSymbol(Node)^.GetDescendantCount;
|
|
end;
|
|
|
|
function TSymbolInheritanceView.GetNumChildrenExposed(Node: Pointer) : sw_Integer;
|
|
var
|
|
Nb : integer;
|
|
P : PObjectSymbol;
|
|
Procedure AddCount(P : PObjectSymbol);
|
|
var
|
|
i,count : integer;
|
|
D : PObjectSymbol;
|
|
begin
|
|
if not assigned(P) then
|
|
exit;
|
|
Count:=P^.GetDescendantCount;
|
|
Inc(Nb,Count);
|
|
for I:=0 to Count-1 do
|
|
begin
|
|
D:=P^.GetDescendant(I);
|
|
AddCount(D);
|
|
end;
|
|
end;
|
|
begin
|
|
Nb:=0;
|
|
AddCount(Node);
|
|
GetNumChildrenExposed:=Nb;
|
|
end;
|
|
|
|
|
|
procedure TSymbolInheritanceView.Adjust(Node: Pointer; Expand: Boolean);
|
|
begin
|
|
PObjectSymbol(Node)^.Expanded:=Expand;
|
|
end;
|
|
|
|
function TSymbolInheritanceView.IsExpanded(Node: Pointer): Boolean;
|
|
begin
|
|
IsExpanded:=PObjectSymbol(Node)^.Expanded;
|
|
end;
|
|
|
|
procedure TSymbolInheritanceView.HandleEvent(var Event: TEvent);
|
|
var DontClear: boolean;
|
|
{$ifndef HASOUTLINE}
|
|
P: TPoint;
|
|
{$endif HASOUTLINE}
|
|
begin
|
|
case Event.What of
|
|
evKeyDown :
|
|
begin
|
|
DontClear:=false;
|
|
case Event.KeyCode of
|
|
{$ifndef HASOUTLINE}
|
|
kbEnter:
|
|
NodeSelected(GetLineNode(Cursor.Y-Origin.Y));
|
|
{$endif HASOUTLINE}
|
|
kbLeft,kbRight,
|
|
kbCtrlLeft,kbCtrlRight :
|
|
if Assigned(HScrollBar) then
|
|
HScrollBar^.HandleEvent(Event)
|
|
else
|
|
DontClear:=true;
|
|
else DontClear:=true;
|
|
end;
|
|
if DontClear=false then ClearEvent(Event);
|
|
end;
|
|
evMouseDown :
|
|
begin
|
|
{$ifndef HASOUTLINE}
|
|
MakeLocal(Event.Where,P);
|
|
SetCursor(P.X,P.Y);
|
|
{$endif HASOUTLINE}
|
|
if Event.double then
|
|
begin
|
|
Message(@Self,evKeyDown,kbEnter,nil);
|
|
ClearEvent(Event);
|
|
end;
|
|
end;
|
|
evCommand :
|
|
begin
|
|
DontClear:=false;
|
|
case Event.Command of
|
|
cmSymBrowse :
|
|
Message(@Self,evKeyDown,kbEnter,nil);
|
|
cmSymSaveAs,cmSaveAs :
|
|
SaveAs;
|
|
else DontClear:=true;
|
|
end;
|
|
if DontClear=false then ClearEvent(Event);
|
|
end;
|
|
end;
|
|
inherited HandleEvent(Event);
|
|
end;
|
|
|
|
function TSymbolInheritanceView.GetPalette: PPalette;
|
|
const P: string[length(CBrowserOutline)] = CBrowserOutline;
|
|
begin
|
|
GetPalette:=@P;
|
|
end;
|
|
|
|
function TSymbolInheritanceView.GetLocalMenu: PMenu;
|
|
begin
|
|
GetLocalMenu:=NewMenu(
|
|
NewItem(menu_symlocal_browse,'',kbNoKey,cmSymBrowse,hcSymBrowse,
|
|
NewLine(
|
|
NewItem(menu_symlocal_saveas,'',kbNoKey,cmSymSaveAs,hcSymSaveAs,
|
|
nil))));
|
|
end;
|
|
|
|
function TSymbolInheritanceView.SaveToFile(const AFileName: string): boolean;
|
|
var OK: boolean;
|
|
S: PBufStream;
|
|
st : string;
|
|
P : PObjectSymbol;
|
|
|
|
procedure WriteSymbolTree(P:PObjectSymbol;Depth:Sw_Integer);
|
|
var
|
|
Q : PObjectSymbol;
|
|
Nc,Des,Count : integer;
|
|
Space : String;
|
|
begin
|
|
if not assigned(P) then
|
|
exit;
|
|
Des:=0;
|
|
Count:=GetNumChildren{Exposed}(P);
|
|
if Count=0 then exit;
|
|
SetLength(Space,Depth*2);
|
|
for nc:=1 to Length(Space) do Space[nc]:=' ';
|
|
While Count>Des do
|
|
begin
|
|
if not ok then exit;
|
|
Q:=P^.GetDescendant(Des);
|
|
st:=GetText(Q);
|
|
S^.Write(Space[1],Length(Space));
|
|
if not OK then exit;
|
|
S^.Write(St[1],length(St));
|
|
OK:=(S^.Status=stOK);
|
|
if not OK then exit;
|
|
S^.Write(EOL[1],length(EOL));
|
|
OK:=(S^.Status=stOK);
|
|
if not OK then exit;
|
|
if Ok then
|
|
WriteSymbolTree(Q,Depth+1);
|
|
Inc(Des);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
New(S, Init(AFileName,stCreate,4096));
|
|
OK:=Assigned(S) and (S^.Status=stOK);
|
|
if OK then
|
|
begin
|
|
P:=Root;
|
|
st:=GetText(P);
|
|
S^.Write(St[1],length(St));
|
|
OK:=(S^.Status=stOK);
|
|
if OK then
|
|
begin
|
|
S^.Write(EOL[1],length(EOL));
|
|
OK:=(S^.Status=stOK);
|
|
if OK then
|
|
WriteSymbolTree(P,1);
|
|
end;
|
|
end;
|
|
if Assigned(S) then Dispose(S, Done);
|
|
SaveToFile:=OK;
|
|
end;
|
|
|
|
function TSymbolInheritanceView.SaveAs: Boolean;
|
|
var
|
|
DefExt,Title,Filename : string;
|
|
Re : word;
|
|
begin
|
|
SaveAs := False;
|
|
Filename:='list.txt';
|
|
DefExt:='*.txt';
|
|
Title:='Save content';
|
|
Re:=Application^.ExecuteDialog(New(PFPFileDialog, Init(DefExt,
|
|
Title, label_name, fdOkButton, FileId)), @FileName);
|
|
if Re <> cmCancel then
|
|
SaveAs := SaveToFile(FileName);
|
|
end;
|
|
|
|
{$ifdef HASOUTLINE}
|
|
function TSymbolInheritanceView.GetText(Node: Pointer): String;
|
|
begin
|
|
GetText:=PObjectSymbol(Node)^.GetName;
|
|
end;
|
|
|
|
{$else not HASOUTLINE}
|
|
function TSymbolInheritanceView.GetNode(I : sw_Integer) : Pointer;
|
|
var
|
|
P : PObjectSymbol;
|
|
begin
|
|
P:=Root;
|
|
If Assigned(P) then
|
|
P:=P^.GetDescendant(I);
|
|
GetNode:=Pointer(P);
|
|
end;
|
|
|
|
procedure TSymbolInheritanceView.ExpandAll(Node: Pointer);
|
|
var
|
|
i : integer;
|
|
P : Pointer;
|
|
begin
|
|
Adjust(Node,true);
|
|
For i:=0 to GetNumChildren(Node)-1 do
|
|
begin
|
|
P:=GetChild(Node,I);
|
|
if Assigned(P) then
|
|
ExpandAll(P);
|
|
end;
|
|
end;
|
|
|
|
function TSymbolInheritanceView.GetLineNode(Item : sw_Integer) : Pointer;
|
|
var
|
|
P : PObjectSymbol;
|
|
NT: Integer;
|
|
procedure FindSymbol(var P:PObjectSymbol);
|
|
var
|
|
Q : PObjectSymbol;
|
|
Nc,Des : integer;
|
|
begin
|
|
if not assigned(P) then
|
|
exit;
|
|
Des:=0;
|
|
While (NT<Item) and (Des<GetNumChildren(P)) do
|
|
begin
|
|
Q:=P^.GetDescendant(Des);
|
|
Inc(NT);
|
|
if NT=Item then
|
|
begin
|
|
P:=Q;
|
|
exit;
|
|
end;
|
|
Nc:=GetNumChildrenExposed(Q);
|
|
If NT+Nc<Item then
|
|
Inc(NT,Nc)
|
|
else
|
|
begin
|
|
FindSymbol(Q);
|
|
P:=Q;
|
|
exit;
|
|
end;
|
|
Inc(Des);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
P:=Root;
|
|
NT:=0;
|
|
FindSymbol(P);
|
|
GetLineNode:=P;
|
|
end;
|
|
|
|
function TSymbolInheritanceView.GetText(Item,MaxLen: Sw_Integer): String;
|
|
var
|
|
P,Ans : PObjectSymbol;
|
|
NC,NT,NumParents : Integer;
|
|
S : String;
|
|
procedure FindSymbol(var P:PObjectSymbol);
|
|
var
|
|
Q : PObjectSymbol;
|
|
Des : integer;
|
|
begin
|
|
if not assigned(P) then
|
|
exit;
|
|
Des:=0;
|
|
While (NT<Item) and (Des<GetNumChildren(P)) do
|
|
begin
|
|
Q:=P^.GetDescendant(Des);
|
|
Inc(NT);
|
|
if NT=Item then
|
|
begin
|
|
P:=Q;
|
|
exit;
|
|
end;
|
|
Nc:=GetNumChildrenExposed(Q);
|
|
If NT+Nc<Item then
|
|
Inc(NT,Nc)
|
|
else
|
|
begin
|
|
FindSymbol(Q);
|
|
P:=Q;
|
|
exit;
|
|
end;
|
|
Inc(Des);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
P:=Root;
|
|
NT:=0;
|
|
FindSymbol(P);
|
|
|
|
if assigned(P) then
|
|
begin
|
|
S:=P^.GetName;
|
|
Ans:=P^.Parent;
|
|
NumParents:=0;
|
|
While Assigned(Ans) do
|
|
begin
|
|
Inc(NumParents);
|
|
Ans:=Ans^.Parent;
|
|
end;
|
|
S:=CharStr('-',NumParents)+S;
|
|
GetText:=Copy(S,1,MaxLen);
|
|
end
|
|
else
|
|
GetText:='';
|
|
end;
|
|
|
|
{$endif HASOUTLINE}
|
|
|
|
|
|
procedure TSymbolInheritanceView.Selected(I: sw_Integer);
|
|
var P: pointer;
|
|
begin
|
|
P:=GetNode(I);
|
|
NodeSelected(P);
|
|
end;
|
|
|
|
procedure TSymbolInheritanceView.NodeSelected(P: pointer);
|
|
var
|
|
S: PSymbol;
|
|
St : String;
|
|
Anc: PObjectSymbol;
|
|
begin
|
|
if P=nil then Exit;
|
|
|
|
S:=PObjectSymbol(P)^.Symbol;
|
|
|
|
{ this happens for the top objects view (PM) }
|
|
if S=nil then exit;
|
|
|
|
st:=S^.GetName;
|
|
if S^.Ancestor=nil then
|
|
Anc:=ObjectTree
|
|
else
|
|
Anc:=SearchObjectForSymbol(S^.Ancestor);
|
|
OpenSymbolBrowser(Origin.X-1,
|
|
{$ifdef HASOUTLINE}
|
|
FOC-Delta.Y+1,
|
|
{$else not HASOUTLINE}
|
|
Origin.Y+1,
|
|
{$endif not HASOUTLINE}
|
|
st,
|
|
S^.GetText,S,nil,
|
|
S^.Items,S^.References,Anc,S^.MemInfo);
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TBrowserTab
|
|
****************************************************************************}
|
|
|
|
constructor TBrowserTab.Init(var Bounds: TRect; AItems: PBrowserTabItem);
|
|
begin
|
|
inherited Init(Bounds);
|
|
Options:=Options or ofPreProcess;
|
|
Items:=AItems;
|
|
SetParams(0,0);
|
|
end;
|
|
|
|
procedure TBrowserTab.SetParams(AFlags: word; ACurrent: Sw_integer);
|
|
begin
|
|
Flags:=AFlags;
|
|
SelectItem(ACurrent);
|
|
end;
|
|
|
|
procedure TBrowserTab.SelectItem(Index: Sw_integer);
|
|
var P: PBrowserTabItem;
|
|
begin
|
|
Current:=Index;
|
|
P:=GetItem(Current);
|
|
if (P<>nil) and (P^.Link<>nil) then
|
|
P^.Link^.Focus;
|
|
DrawView;
|
|
end;
|
|
|
|
function TBrowserTab.GetItemCount: sw_integer;
|
|
var Count: integer;
|
|
P: PBrowserTabItem;
|
|
begin
|
|
Count:=0; P:=Items;
|
|
while (P<>nil) do
|
|
begin
|
|
Inc(Count);
|
|
P:=P^.Next;
|
|
end;
|
|
GetItemCount:=Count;
|
|
end;
|
|
|
|
function TBrowserTab.GetItem(Index: sw_integer): PBrowserTabItem;
|
|
var Counter: integer;
|
|
P: PBrowserTabItem;
|
|
begin
|
|
P:=Items;
|
|
Counter:=0;
|
|
while (P<>nil) and (Counter<Index) do
|
|
begin
|
|
P:=P^.Next;
|
|
Inc(Counter);
|
|
end;
|
|
GetItem:=P;
|
|
end;
|
|
|
|
procedure TBrowserTab.Draw;
|
|
var B: TDrawBuffer;
|
|
SelColor, NormColor, C: word;
|
|
I,CurX,Count: Sw_integer;
|
|
function Names(Idx: integer): AnsiChar;
|
|
begin
|
|
Names:=GetItem(Idx)^.Sign;
|
|
end;
|
|
begin
|
|
NormColor:=GetColor(1); SelColor:=GetColor(2);
|
|
MoveChar(B,#196{-},SelColor,Size.X);
|
|
CurX:=0; Count:=0;
|
|
for I:=0 to GetItemCount-1 do
|
|
if (Flags and (1 shl I))<>0 then
|
|
begin
|
|
Inc(Count);
|
|
if Current=I then C:=SelColor
|
|
else C:=NormColor;
|
|
if Count=1 then MoveChar(B[CurX],#180,SelColor,1)
|
|
else MoveChar(B[CurX],#179,SelColor,1);
|
|
MoveCStr(B[CurX+1],' '+Names(I)+' ',C);
|
|
Inc(CurX,4);
|
|
end;
|
|
if Count>0 then
|
|
MoveChar(B[CurX],#195,SelColor,1);
|
|
WriteLine(0,0,Size.X,Size.Y,B);
|
|
end;
|
|
|
|
procedure TBrowserTab.HandleEvent(var Event: TEvent);
|
|
var I,Idx: integer;
|
|
DontClear: boolean;
|
|
P: TPoint;
|
|
function GetItemForCoord(X: integer): integer;
|
|
var I,CurX,Idx: integer;
|
|
begin
|
|
CurX:=0; Idx:=-1;
|
|
for I:=0 to GetItemCount-1 do
|
|
if (Flags and (1 shl I))<>0 then
|
|
begin
|
|
if (CurX+1<=X) and (X<=CurX+3) then
|
|
begin Idx:=I; Break; end;
|
|
Inc(CurX,4);
|
|
end;
|
|
GetItemForCoord:=Idx;
|
|
end;
|
|
begin
|
|
case Event.What of
|
|
evMouseDown :
|
|
if MouseInView(Event.Where) then
|
|
begin
|
|
repeat
|
|
MakeLocal(Event.Where,P);
|
|
Idx:=GetItemForCoord(P.X);
|
|
if Idx<>-1 then
|
|
SelectItem(Idx);
|
|
until not MouseEvent(Event, evMouseMove);
|
|
ClearEvent(Event);
|
|
end;
|
|
evKeyDown :
|
|
begin
|
|
DontClear:=false; Idx:=-1;
|
|
for I:=0 to GetItemCount-1 do
|
|
if (GetCtrlCode(GetItem(I)^.Sign)=Event.KeyCode){ or
|
|
(GetItem(I)^.Sign=UpCase(Event.CharCode))} then
|
|
if (Flags and (1 shl I))<>0 then
|
|
begin
|
|
Idx:=I;
|
|
Break;
|
|
end;
|
|
if Idx=-1 then
|
|
DontClear:=true
|
|
else
|
|
SelectItem(Idx);
|
|
if DontClear=false then ClearEvent(Event);
|
|
end;
|
|
end;
|
|
inherited HandleEvent(Event);
|
|
end;
|
|
|
|
function TBrowserTab.GetPalette: PPalette;
|
|
const P: string[length(CBrowserTab)] = CBrowserTab;
|
|
begin
|
|
GetPalette:=@P;
|
|
end;
|
|
|
|
destructor TBrowserTab.Done;
|
|
begin
|
|
if Items<>nil then DisposeBrowserTabList(Items);
|
|
inherited Done;
|
|
end;
|
|
|
|
procedure TUnitInfoPanel.HandleEvent(var Event: TEvent);
|
|
begin
|
|
if (Event.What=evBroadcast) and (Event.Command=cmListItemSelected) and
|
|
(InOwnerCall=false) then
|
|
begin
|
|
InOwnerCall:=true;
|
|
if Assigned(Owner) then
|
|
Owner^.HandleEvent(Event);
|
|
InOwnerCall:=false;
|
|
end;
|
|
inherited HandleEvent(Event);
|
|
end;
|
|
|
|
constructor TBrowserWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Sw_Integer;ASym : PSymbol;
|
|
const AName,APrefix: string; ASymbols: PSymbolCollection; AReferences: PReferenceCollection;
|
|
AInheritance: PObjectSymbol; AMemInfo: PSymbolMemINfo);
|
|
var R,R2,R3: TRect;
|
|
HSB,VSB: PScrollBar;
|
|
CST: PColorStaticText;
|
|
I: sw_integer;
|
|
function CreateVSB(R: TRect): PScrollBar;
|
|
var R2: TRect;
|
|
SB: PScrollBar;
|
|
begin
|
|
R2.Copy(R); R2.Move(1,0); R2.A.X:=R2.B.X-1;
|
|
New(SB, Init(R2)); SB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
|
|
CreateVSB:=SB;
|
|
end;
|
|
function CreateHSB(R: TRect): PScrollBar;
|
|
var R2: TRect;
|
|
SB: PScrollBar;
|
|
begin
|
|
R2.Copy(R); R2.Move(0,1); R2.A.Y:=R2.B.Y-1;
|
|
New(SB, Init(R2)); SB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY;
|
|
CreateHSB:=SB;
|
|
end;
|
|
begin
|
|
inherited Init(Bounds, FormatStrStr(dialog_browse,ATitle), ANumber);
|
|
HelpCtx:=hcBrowserWindow;
|
|
Sym:=ASym;
|
|
Prefix:=NewStr(APrefix);
|
|
BrowserFlags:=DefaultDispayFlags shl 30 or DefaultSymbolFlags;
|
|
|
|
GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
|
|
{$ifndef NODEBUG}
|
|
if {assigned(Debugger) and Debugger^.IsRunning and}
|
|
assigned(Sym) and (Sym^.typ in [fieldvarsym,staticvarsym,localvarsym,paravarsym]) then
|
|
begin
|
|
New(DebuggerValue,Init(ATitle,Sym));
|
|
New(ST, Init(R, ' '+DebuggerValue^.GetText));
|
|
end
|
|
else
|
|
{$endif NODEBUG}
|
|
begin
|
|
New(ST, Init(R, ' '+AName));
|
|
DebuggerValue:=nil;
|
|
end;
|
|
ST^.GrowMode:=gfGrowHiX;
|
|
Insert(ST);
|
|
|
|
GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);
|
|
if assigned(ASymbols) and (ASymbols^.Count>0) then
|
|
begin
|
|
HSB:=CreateHSB(R);
|
|
Insert(HSB);
|
|
VSB:=CreateVSB(R);
|
|
Insert(VSB);
|
|
New(ScopeView, Init(R, ASymbols, HSB, VSB));
|
|
ScopeView^.GrowMode:=gfGrowHiX+gfGrowHiY;
|
|
Insert(ScopeView);
|
|
ScopeView^.MyBW:=@Self;
|
|
ScopeView^.SetGDBCol;
|
|
ScopeView^.FilterSymbols(true);
|
|
ScopeView^.SetRange(ScopeView^.FilteredSym^.Count);
|
|
end;
|
|
if assigned(AReferences) and (AReferences^.Count>0) then
|
|
begin
|
|
HSB:=CreateHSB(R);
|
|
Insert(HSB);
|
|
VSB:=CreateVSB(R);
|
|
Insert(VSB);
|
|
New(ReferenceView, Init(R, AReferences, HSB, VSB));
|
|
ReferenceView^.GrowMode:=gfGrowHiX+gfGrowHiY;
|
|
Insert(ReferenceView);
|
|
ReferenceView^.MyBW:=@Self;
|
|
end;
|
|
if assigned(AInheritance) then
|
|
begin
|
|
HSB:=CreateHSB(R);
|
|
Insert(HSB);
|
|
VSB:=CreateVSB(R);
|
|
Insert(VSB);
|
|
New(InheritanceView, Init(R, HSB,VSB, AInheritance));
|
|
InheritanceView^.GrowMode:=gfGrowHiX+gfGrowHiY;
|
|
Insert(InheritanceView);
|
|
InheritanceView^.MyBW:=@Self;
|
|
end;
|
|
if assigned(AMemInfo) then
|
|
begin
|
|
New(MemInfoView, Init(R, AMemInfo));
|
|
MemInfoView^.GrowMode:=gfGrowHiX+gfGrowHiY;
|
|
Insert(MemInfoView);
|
|
MemInfoView^.MyBW:=@Self;
|
|
end;
|
|
if Assigned(Asym) and (TypeOf(ASym^)=TypeOf(TModuleSymbol)) then
|
|
with PModuleSymbol(Sym)^ do
|
|
begin
|
|
New(UnitInfo, Init(R));
|
|
UnitInfo^.GetExtent(R3);
|
|
|
|
R2.Copy(R3);
|
|
R2.B.Y:=R2.A.Y+3;
|
|
if (Assigned(UsedUnits) or Assigned(DependentUnits))=false then
|
|
R2.B.Y:=R3.B.Y;
|
|
HSB:=CreateHSB(R2); {UnitInfo^.Insert(HSB); HSB:=nil;}
|
|
VSB:=CreateVSB(R2);
|
|
{UnitInfo^.Insert(VSB);
|
|
VSB will be owned by UnitInfoText PM }
|
|
New(UnitInfoText, Init(R2,HSB,VSB, nil));
|
|
with UnitInfoText^ do
|
|
begin
|
|
GrowMode:=gfGrowHiX;
|
|
if Assigned(LoadedFrom) then
|
|
begin
|
|
AddLine(FormatStrStr2('%s : %s',msg_usedfirstin,GetStr(LoadedFrom)));
|
|
AddLine(FormatStrStr('%s : ',msg_mainsource));
|
|
AddLine(FormatStrStr(' %s',GetStr(MainSource)));
|
|
if Assigned(SourceFiles) and (SourceFiles^.Count>1) then
|
|
begin
|
|
AddLine(FormatStrStr('%s : ',msg_sourcefiles));
|
|
for I:=0 to SourceFiles^.Count-1 do
|
|
AddLine(FormatStrStr(' %s',GetStr(SourceFiles^.At(I))));
|
|
end;
|
|
end;
|
|
end;
|
|
UnitInfo^.Insert(UnitInfoText);
|
|
|
|
if Assigned(UsedUnits) then
|
|
begin
|
|
Inc(R2.A.Y,R2.B.Y-R2.A.Y); R2.B.Y:=R2.A.Y+1;
|
|
New(CST, Init(R2,#180' Used units '#195+CharStr(#196,255),ColorIndex(12),false));
|
|
CST^.GrowMode:=gfGrowHiX;
|
|
UnitInfo^.Insert(CST);
|
|
|
|
Inc(R2.A.Y,R2.B.Y-R2.A.Y); R2.B.Y:=R2.A.Y+4;
|
|
if Assigned(DependentUnits)=false then R2.B.Y:=R3.B.Y;
|
|
{HSB:=CreateHSB(R2); UnitInfo^.Insert(HSB); }
|
|
HSB:=nil;
|
|
VSB:=CreateVSB(R2);
|
|
{UnitInfo^.Insert(VSB); this created crashes,
|
|
that were difficult to findout PM }
|
|
New(UnitInfoUsed, Init(R2,UsedUnits,HSB,VSB));
|
|
UnitInfoUsed^.GrowMode:=gfGrowHiY+gfGrowHiX;
|
|
UnitInfoUsed^.MyBW:=@Self;
|
|
UnitInfo^.Insert(UnitInfoUsed);
|
|
end;
|
|
|
|
if Assigned(DependentUnits) then
|
|
begin
|
|
Inc(R2.A.Y,R2.B.Y-R2.A.Y); R2.B.Y:=R2.A.Y+1;
|
|
New(CST, Init(R2,#180' Dependent units '#195+CharStr(#196,255),ColorIndex(12),false));
|
|
CST^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY;
|
|
UnitInfo^.Insert(CST);
|
|
|
|
Inc(R2.A.Y,R2.B.Y-R2.A.Y); R2.B.Y:=R3.B.Y;
|
|
{HSB:=CreateHSB(R2); UnitInfo^.Insert(HSB); }
|
|
HSB:=nil;
|
|
VSB:=CreateVSB(R2);
|
|
{ UnitInfo^.Insert(VSB); this created crashes,
|
|
that were difficult to findout PM }
|
|
New(UnitInfoDependent, Init(R2,DependentUnits,HSB,VSB));
|
|
UnitInfoDependent^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY;
|
|
UnitInfoDependent^.MyBW:=@Self;
|
|
UnitInfo^.Insert(UnitInfoDependent);
|
|
end;
|
|
|
|
if Assigned(UnitInfoText) then
|
|
UnitInfoText^.Select;
|
|
|
|
Insert(UnitInfo);
|
|
end;
|
|
|
|
GetExtent(R); R.Grow(-1,-1); R.Move(0,1); R.B.Y:=R.A.Y+1;
|
|
New(PageTab, Init(R,
|
|
NewBrowserTabItem(label_browsertab_scope,ScopeView,
|
|
NewBrowserTabItem(label_browsertab_reference,ReferenceView,
|
|
NewBrowserTabItem(label_browsertab_inheritance,InheritanceView,
|
|
NewBrowserTabItem(label_browsertab_memory,MemInfoView,
|
|
NewBrowserTabItem(label_browsertab_unit,UnitInfo,
|
|
nil)))))));
|
|
PageTab^.GrowMode:=gfGrowHiX;
|
|
Insert(PageTab);
|
|
|
|
if assigned(ScopeView) {Scope assinged and chosen to be selected by default}
|
|
and ((DefaultBrowserPane=0) or not assigned(ReferenceView)) then
|
|
SelectTab(btScope)
|
|
else if assigned(ReferenceView) then
|
|
SelectTab(btReferences)
|
|
else if assigned(MemInfoView) then
|
|
SelectTab(btMemInfo)
|
|
else
|
|
if assigned(InheritanceView) then
|
|
SelectTab(btInheritance);
|
|
end;
|
|
|
|
destructor TBrowserWindow.Done;
|
|
begin
|
|
{ UnitInfoText needs to be removed first
|
|
to avoid crashes within the UnitInfo destructor PM }
|
|
if Assigned(UnitInfoText) then
|
|
begin
|
|
UnitInfo^.Delete(UnitInfoText);
|
|
Dispose(UnitInfoText,Done);
|
|
UnitInfoText:=nil;
|
|
end;
|
|
if assigned(DebuggerValue) then
|
|
begin
|
|
Dispose(DebuggerValue,Done);
|
|
DebuggerValue:=nil;
|
|
end;
|
|
if assigned(Prefix) then
|
|
begin
|
|
DisposeStr(Prefix);
|
|
Prefix:=nil;
|
|
end;
|
|
inherited Done;
|
|
end;
|
|
|
|
procedure TBrowserWindow.HandleEvent(var Event: TEvent);
|
|
var DontClear: boolean;
|
|
S: PSymbol;
|
|
Symbols: PSymbolCollection;
|
|
Anc: PObjectSymbol;
|
|
P: TPoint;
|
|
begin
|
|
case Event.What of
|
|
evBroadcast :
|
|
case Event.Command of
|
|
cmDebuggerStopped :
|
|
begin
|
|
if Assigned(DebuggerValue) and
|
|
(DebuggerValue^.GDBI<>PtrInt(Event.InfoPtr)) then
|
|
begin
|
|
If Assigned(ST^.Text) then
|
|
DisposeStr(ST^.Text);
|
|
ST^.Text:=NewStr(DebuggerValue^.GetText);
|
|
ST^.DrawView;
|
|
end;
|
|
end;
|
|
cmSearchWindow :
|
|
ClearEvent(Event);
|
|
cmListItemSelected :
|
|
begin
|
|
S:=nil;
|
|
if (Event.InfoPtr=ScopeView) then
|
|
begin
|
|
S:=ScopeView^.FilteredSym^.At(ScopeView^.Focused)^.Sym;
|
|
MakeGlobal(ScopeView^.Origin,P);
|
|
Desktop^.MakeLocal(P,P); Inc(P.Y,ScopeView^.Focused-ScopeView^.TopItem);
|
|
Inc(P.Y);
|
|
end;
|
|
if (Event.InfoPtr=UnitInfoUsed) then
|
|
begin
|
|
S:=UnitInfoUsed^.Symbols^.At(UnitInfoUsed^.Focused);
|
|
MakeGlobal(UnitInfoUsed^.Origin,P);
|
|
Desktop^.MakeLocal(P,P); Inc(P.Y,UnitInfoUsed^.Focused-UnitInfoUsed^.TopItem);
|
|
Inc(P.Y);
|
|
end;
|
|
if (Event.InfoPtr=UnitInfoDependent) then
|
|
begin
|
|
S:=UnitInfoDependent^.Symbols^.At(UnitInfoDependent^.Focused);
|
|
MakeGlobal(UnitInfoDependent^.Origin,P);
|
|
Desktop^.MakeLocal(P,P); Inc(P.Y,UnitInfoDependent^.Focused-UnitInfoDependent^.TopItem);
|
|
Inc(P.Y);
|
|
end;
|
|
if Assigned(S) then
|
|
begin
|
|
if S^.Ancestor=nil then Anc:=nil else
|
|
Anc:=SearchObjectForSymbol(S^.Ancestor);
|
|
Symbols:=S^.Items;
|
|
if (not assigned(Symbols) or (symbols^.count=0)) then
|
|
if assigned(S^.Ancestor) then
|
|
Symbols:=S^.Ancestor^.Items;
|
|
if (S^.GetReferenceCount>0) or (assigned(Symbols) and (Symbols^.Count>0)) or (Anc<>nil) then
|
|
OpenSymbolBrowser(Origin.X-1,P.Y,
|
|
S^.GetName,
|
|
ScopeView^.GetText(ScopeView^.Focused,255),
|
|
S,@self,
|
|
Symbols,S^.References,Anc,S^.MemInfo);
|
|
ClearEvent(Event);
|
|
end;
|
|
end;
|
|
end;
|
|
{ evCommand :
|
|
begin
|
|
DontClear:=false;
|
|
case Event.Command of
|
|
cmGotoSymbol :
|
|
if Event.InfoPtr=ScopeView then
|
|
if ReferenceView<>nil then
|
|
if ReferenceView^.Range>0 then
|
|
ReferenceView^.GotoItem(0);
|
|
cmTrackSymbol :
|
|
if Event.InfoPtr=ScopeView then
|
|
if (ScopeView<>nil) and (ScopeView^.Range>0) then
|
|
begin
|
|
S:=ScopeView^.At(ScopeView^.Focused);
|
|
if (S^.References<>nil) and (S^.References^.Count>0) then
|
|
TrackItem(S^.References^.At(0));
|
|
else DontClear:=true;
|
|
end;
|
|
if DontClear=false then ClearEvent(Event);
|
|
end;}
|
|
evKeyDown :
|
|
begin
|
|
DontClear:=false;
|
|
case Event.KeyCode of
|
|
kbEsc :
|
|
Close;
|
|
kbAltI :
|
|
If not Disassemble then
|
|
DontClear:=true;
|
|
else DontClear:=true;
|
|
end;
|
|
if DontClear=false then ClearEvent(Event);
|
|
end;
|
|
end;
|
|
inherited HandleEvent(Event);
|
|
end;
|
|
|
|
function TBrowserWindow.Disassemble : boolean;
|
|
begin
|
|
Disassemble:=false;
|
|
if not assigned(sym) or (sym^.typ<>procsym) then
|
|
exit;
|
|
{ We need to load exefile }
|
|
{$ifndef NODEBUG}
|
|
InitGDBWindow;
|
|
if not assigned(Debugger) then
|
|
begin
|
|
new(Debugger,Init);
|
|
if assigned(Debugger) then
|
|
Debugger^.SetExe(ExeFile);
|
|
end;
|
|
if not assigned(Debugger) or not Debugger^.HasExe then
|
|
exit;
|
|
{ goto source/assembly mixture }
|
|
InitDisassemblyWindow;
|
|
DisassemblyWindow^.LoadFunction(Sym^.GetName);
|
|
DisassemblyWindow^.SelectInDebugSession;
|
|
Disassemble:=true;
|
|
{$else NODEBUG}
|
|
NoDebugger;
|
|
{$endif NODEBUG}
|
|
end;
|
|
|
|
function TBrowserWindow.GetFlags: longint;
|
|
begin
|
|
GetFlags:=BrowserFlags;
|
|
end;
|
|
|
|
procedure TBrowserWindow.SetFlags(AFlags: longint);
|
|
begin
|
|
BrowserFlags:=AFlags;
|
|
if assigned(ScopeView) then
|
|
begin
|
|
ScopeView^.FilterSymbols(true);
|
|
ScopeView^.SetRange(ScopeView^.FilteredSym^.Count);
|
|
ScopeView^.DrawView;
|
|
end;
|
|
end;
|
|
|
|
procedure TBrowserWindow.SetState(AState: Word; Enable: Boolean);
|
|
var OldState: word;
|
|
begin
|
|
OldState:=State;
|
|
inherited SetState(AState,Enable);
|
|
if ((AState and sfActive)<>0) and (((OldState xor State) and sfActive)<>0) then
|
|
SetCmdState([cmSaveAs],Enable);
|
|
{ if ((State xor OldState) and sfActive)<>0 then
|
|
if GetState(sfActive)=false then
|
|
Message(Desktop,evBroadcast,cmClearLineHighlights,nil);}
|
|
end;
|
|
|
|
procedure TBrowserWindow.Close;
|
|
begin
|
|
inherited Close;
|
|
end;
|
|
|
|
procedure TBrowserWindow.SelectTab(BrowserTab: Sw_integer);
|
|
var Tabs: Sw_integer;
|
|
{$ifndef NODEBUG}
|
|
PB : PBreakpoint;
|
|
{$endif}
|
|
PS :PString;
|
|
l : longint;
|
|
begin
|
|
case BrowserTab of
|
|
btScope :
|
|
if assigned(ScopeView) then
|
|
ScopeView^.Select;
|
|
btReferences :
|
|
if assigned(ReferenceView) then
|
|
ReferenceView^.Select;
|
|
btMemInfo:
|
|
if assigned(MemInfoView) then
|
|
MemInfoView^.Select;
|
|
{$ifndef NODEBUG}
|
|
btBreakWatch :
|
|
begin
|
|
if Assigned(Sym) then
|
|
begin
|
|
if Pos('proc',Sym^.GetText)>0 then
|
|
{ insert function breakpoint }
|
|
begin
|
|
{ make it visible }
|
|
PS:=Sym^.Name;
|
|
l:=Length(PS^);
|
|
If PS^[l]='*' then
|
|
begin
|
|
PB:=BreakpointsCollection^.GetType(bt_function,copy(GetStr(PS),1,l-1));
|
|
If Assigned(PB) then
|
|
BreakpointsCollection^.Delete(PB);
|
|
Sym^.Name:=NewStr(copy(GetStr(PS),1,l-1));
|
|
DrawView;
|
|
DisposeStr(PS);
|
|
end
|
|
else
|
|
begin
|
|
Sym^.Name:=NewStr(GetStr(PS)+'*');
|
|
DrawView;
|
|
New(PB,init_function(GetStr(PS)));
|
|
DisposeStr(PS);
|
|
BreakpointsCollection^.Insert(PB);
|
|
BreakpointsCollection^.Update;
|
|
end;
|
|
end
|
|
else if pos('var',Sym^.GetText)>0 then
|
|
{ insert watch point }
|
|
begin
|
|
{ make it visible }
|
|
PS:=Sym^.Name;
|
|
l:=Length(PS^);
|
|
If PS^[l]='*' then
|
|
begin
|
|
PB:=BreakpointsCollection^.GetType(bt_awatch,copy(PS^,1,l-1));
|
|
If Assigned(PB) then
|
|
BreakpointsCollection^.Delete(PB);
|
|
Sym^.Name:=NewStr(copy(PS^,1,l-1));
|
|
DrawView;
|
|
DisposeStr(PS);
|
|
end
|
|
else
|
|
begin
|
|
Sym^.Name:=NewStr(GetStr(PS)+'*');
|
|
DrawView;
|
|
New(PB,init_type(bt_awatch,GetStr(PS)));
|
|
DisposeStr(PS);
|
|
BreakpointsCollection^.Insert(PB);
|
|
BreakpointsCollection^.Update;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{$endif NODEBUG}
|
|
end;
|
|
Tabs:=0;
|
|
if assigned(ScopeView) then
|
|
Tabs:=Tabs or (1 shl btScope);
|
|
if assigned(ReferenceView) then
|
|
Tabs:=Tabs or (1 shl btReferences);
|
|
if assigned(InheritanceView) then
|
|
Tabs:=Tabs or (1 shl btInheritance);
|
|
if assigned(MemInfoView) then
|
|
Tabs:=Tabs or (1 shl btMemInfo);
|
|
{$ifndef NODEBUG}
|
|
if Assigned(Sym) then
|
|
if (Pos('proc',Sym^.GetText)>0) or (Pos('var',Sym^.GetText)>0) then
|
|
Tabs:=Tabs or (1 shl btBreakWatch);
|
|
{$endif NODEBUG}
|
|
if assigned(UnitInfo) then
|
|
Tabs:=Tabs or (1 shl btUnitInfo);
|
|
if PageTab<>nil then PageTab^.SetParams(Tabs,BrowserTab);
|
|
end;
|
|
|
|
function TBrowserWindow.GetPalette: PPalette;
|
|
const S: string[length(CBrowserWindow)] = CBrowserWindow;
|
|
begin
|
|
GetPalette:=@S;
|
|
end;
|
|
|
|
procedure OpenSymbolBrowser(X,Y: Sw_integer;const Name,Line: string;S : PSymbol;
|
|
ParentBrowser : PBrowserWindow;
|
|
Symbols: PSymbolCollection; References: PReferenceCollection;
|
|
Inheritance: PObjectSymbol; MemInfo: PSymbolMemInfo);
|
|
var R: TRect;
|
|
PB : PBrowserWindow;
|
|
St,st2 : string;
|
|
begin
|
|
if X=0 then X:=Desktop^.Size.X-35;
|
|
R.A.X:=X; R.A.Y:=Y;
|
|
R.B.X:=R.A.X+35; R.B.Y:=R.A.Y+15;
|
|
while (R.B.Y>Desktop^.Size.Y) do R.Move(0,-1);
|
|
if assigned(ParentBrowser) and assigned(ParentBrowser^.Prefix) and
|
|
assigned(ParentBrowser^.sym) and
|
|
(ParentBrowser^.sym^.typ<>unitsym)
|
|
then
|
|
begin
|
|
st:=GetStr(ParentBrowser^.Prefix)+' '+Name;
|
|
end
|
|
else
|
|
st:=Name;
|
|
st2:=st;
|
|
if assigned(S) and ((S^.Flags and sfPointer)<>0) then
|
|
begin
|
|
st:=st+'^';
|
|
if assigned(S^.Ancestor) and
|
|
((S^.Ancestor^.Flags and sfRecord)<>0) then
|
|
st:=st+'.';
|
|
end
|
|
else if assigned(S) and ((S^.Flags and sfRecord)<>0) then
|
|
st:=st+'.';
|
|
|
|
PB:=New(PBrowserWindow, Init(R,
|
|
st2,SearchFreeWindowNo,S,Line,st,
|
|
Symbols,References,Inheritance,MemInfo));
|
|
if (assigned(S) and (S^.typ in [fieldvarsym,staticvarsym,localvarsym,paravarsym])) or
|
|
(assigned(ParentBrowser) and ParentBrowser^.IsValid) then
|
|
PB^.IsValid:=true;
|
|
|
|
Desktop^.Insert(PB);
|
|
end;
|
|
|
|
END.
|