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

* Restructured debugger view classes

Browse Source 
* Fixed help

git-svn-id: trunk@5867 -
This commit is contained in:
marc 2004-08-26 23:50:05 +00:00
parent 28e09a231e
commit b8918ec656
22 changed files with 1891 additions and 1137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

175
debugger/breakpointsdlg.lfm
View File

@ -1,123 +1,120 @@
object BreakpointsDlg: TBreakpointsDlg object BreakpointsDlg: TBreakpointsDlg
CAPTION = 'Breakpoint list' Caption = 'Breakpoint list'
CLIENTHEIGHT = 205 ClientHeight = 205
CLIENTWIDTH = 629 ClientWidth = 560
ONCREATE = BreakpointsDlgCREATE OnCreate = BreakpointsDlgCREATE
VISIBLE = True Visible = True
HORZSCROLLBAR.PAGE = 630 HorzScrollBar.Page = 561
VERTSCROLLBAR.PAGE = 206 VertScrollBar.Page = 206
LEFT = 340 Left = 340
HEIGHT = 205 Height = 205
TOP = 117 Top = 117
WIDTH = 629 Width = 560
HELPTYPE = htkeyword HelpType = htKeyword
object lvBreakPoints: TLISTVIEW object lvBreakPoints: TListView
ANCHORS = [aktop, akleft] Align = alClient
COLUMNS = < Columns = <
item item
CAPTION = 'State' Caption = 'State'
VISIBLE = True
WIDTH = 50
end end
item item
CAPTION = 'Filename/Address' Caption = 'Filename/Address'
VISIBLE = True Width = 150
WIDTH = 150
end end
item item
CAPTION = 'Line/Length' Caption = 'Line/Length'
VISIBLE = True Width = 100
WIDTH = 100
end end
item item
CAPTION = 'Condition' Caption = 'Condition'
VISIBLE = True Width = 75
WIDTH = 75
end end
item item
CAPTION = 'Action' Caption = 'Action'
VISIBLE = True
WIDTH = 50
end end
item item
CAPTION = 'Pass Count' Caption = 'Pass Count'
VISIBLE = True Width = 100
WIDTH = 100
end end
item item
CAPTION = 'Group' Caption = 'Group'
VISIBLE = True Width = 0
WIDTH = 50
end> end>
MULTISELECT = True MultiSelect = True
POPUPMENU = mnuPopup PopupMenu = mnuPopup
VIEWSTYLE = vsreport ViewStyle = vsReport
ONCLICK = lvBreakPointsClick OnClick = lvBreakPointsClick
ONDBLCLICK = lvBreakPointsDBLCLICK OnDblClick = lvBreakPointsDBLCLICK
ONSELECTITEM = lvBreakPointsSelectItem OnSelectItem = lvBreakPointsSelectItem
LEFT = 72 Height = 205
HEIGHT = 205 Width = 560
TOP = 2 HelpType = htKeyword
WIDTH = 557
HELPTYPE = htkeyword
end end
object mnuPopup: TPOPUPMENU object mnuPopup: TPopupMenu
ONPOPUP = mnuPopupPopup OnPopup = mnuPopupPopup
left = 24 left = 24
top = 8 top = 8
object popAdd: TMENUITEM object popShow: TMenuItem
CAPTION = 'Add...' Caption = 'Show'
object popAddSourceBP: TMENUITEM Default = True
CAPTION = '&Source breakpoint' OnClick = popShowClick
ENABLED = False end
ONCLICK = popAddSourceBPClick object N0: TMenuItem
Caption = '-'
end
object popAdd: TMenuItem
Caption = 'Add...'
object popAddSourceBP: TMenuItem
Caption = '&Source breakpoint'
Enabled = False
OnClick = popAddSourceBPClick
end end
end end
object N1: TMENUITEM object N1: TMenuItem
CAPTION = '-' Caption = '-'
end end
object popProperties: TMENUITEM object popProperties: TMenuItem
CAPTION = '&Properties' Caption = '&Properties'
ONCLICK = popPropertiesClick OnClick = popPropertiesClick
end end
object popEnabled: TMENUITEM object popEnabled: TMenuItem
CAPTION = '&Enabled' Caption = '&Enabled'
SHOWALWAYSCHECKABLE = True ShowAlwaysCheckable = True
ONCLICK = popEnabledClick OnClick = popEnabledClick
end end
object popDelete: TMENUITEM object popDelete: TMenuItem
CAPTION = '&Delete' Caption = '&Delete'
ONCLICK = popDeleteClick OnClick = popDeleteClick
end end
object N2: TMENUITEM object N2: TMenuItem
CAPTION = '-' Caption = '-'
end end
object popDisableAll: TMENUITEM object popDisableAll: TMenuItem
CAPTION = 'D&isable All' Caption = 'D&isable All'
ONCLICK = popDisableAllClick OnClick = popDisableAllClick
end end
object popEnableAll: TMENUITEM object popEnableAll: TMenuItem
CAPTION = '&Enable All' Caption = '&Enable All'
ONCLICK = popEnableAllClick OnClick = popEnableAllClick
end end
object popDeleteAll: TMENUITEM object popDeleteAll: TMenuItem
CAPTION = '&Delete All' Caption = '&Delete All'
ONCLICK = popDeleteAllClick OnClick = popDeleteAllClick
end end
object N3: TMENUITEM object N3: TMenuItem
CAPTION = '-' Caption = '-'
end end
object popDisableAllSameSource: TMENUITEM object popDisableAllSameSource: TMenuItem
CAPTION = 'Disable All in same source' Caption = 'Disable All in same source'
ONCLICK = popDisableAllSameSourceCLICK OnClick = popDisableAllSameSourceCLICK
end end
object popEnableAllSameSource: TMENUITEM object popEnableAllSameSource: TMenuItem
CAPTION = 'Enable All in same source' Caption = 'Enable All in same source'
ONCLICK = popEnableAllSameSourceCLICK OnClick = popEnableAllSameSourceCLICK
end end
object popDeleteAllSameSource: TMENUITEM object popDeleteAllSameSource: TMenuItem
CAPTION = 'Delete All in same source' Caption = 'Delete All in same source'
ONCLICK = popDeleteAllSameSourceCLICK OnClick = popDeleteAllSameSourceCLICK
end end
end end
end end

66
debugger/breakpointsdlg.lrs
View File

@ -1,37 +1,37 @@
{ This is an automatically generated lazarus resource file } { This is an automatically generated lazarus resource file }
LazarusResources.Add('TBreakpointsDlg','FORMDATA',[ LazarusResources.Add('TBreakpointsDlg','FORMDATA',[
'TPF0'#15'TBreakpointsDlg'#14'BreakpointsDlg'#7'CAPTION'#6#15'Breakpoint list' 'TPF0'#15'TBreakpointsDlg'#14'BreakpointsDlg'#7'Caption'#6#15'Breakpoint list'
+#12'CLIENTHEIGHT'#3#205#0#11'CLIENTWIDTH'#3'u'#2#8'ONCREATE'#7#20'Breakpoint' +#12'ClientHeight'#3#205#0#11'ClientWidth'#3'0'#2#8'OnCreate'#7#20'Breakpoint'
+'sDlgCREATE'#7'VISIBLE'#9#18'HORZSCROLLBAR.PAGE'#3'v'#2#18'VERTSCROLLBAR.PAG' +'sDlgCREATE'#7'Visible'#9#18'HorzScrollBar.Page'#3'1'#2#18'VertScrollBar.Pag'
+'E'#3#206#0#4'LEFT'#3'T'#1#6'HEIGHT'#3#205#0#3'TOP'#2'u'#5'WIDTH'#3'u'#2#8'H' +'e'#3#206#0#4'Left'#3'T'#1#6'Height'#3#205#0#3'Top'#2'u'#5'Width'#3'0'#2#8'H'
+'ELPTYPE'#7#9'htkeyword'#0#9'TLISTVIEW'#13'lvBreakPoints'#7'ANCHORS'#11#5'ak' +'elpType'#7#9'htKeyword'#0#9'TListView'#13'lvBreakPoints'#5'Align'#7#8'alCli'
+'top'#6'akleft'#0#7'COLUMNS'#14#1#7'CAPTION'#6#5'State'#7'VISIBLE'#9#5'WIDTH' +'ent'#7'Columns'#14#1#7'Caption'#6#5'State'#0#1#7'Caption'#6#16'Filename/Add'
+#2'2'#0#1#7'CAPTION'#6#16'Filename/Address'#7'VISIBLE'#9#5'WIDTH'#3#150#0#0#1 +'ress'#5'Width'#3#150#0#0#1#7'Caption'#6#11'Line/Length'#5'Width'#2'd'#0#1#7
+#7'CAPTION'#6#11'Line/Length'#7'VISIBLE'#9#5'WIDTH'#2'd'#0#1#7'CAPTION'#6#9 +'Caption'#6#9'Condition'#5'Width'#2'K'#0#1#7'Caption'#6#6'Action'#0#1#7'Capt'
+'Condition'#7'VISIBLE'#9#5'WIDTH'#2'K'#0#1#7'CAPTION'#6#6'Action'#7'VISIBLE' +'ion'#6#10'Pass Count'#5'Width'#2'd'#0#1#7'Caption'#6#5'Group'#5'Width'#2#0#0
+#9#5'WIDTH'#2'2'#0#1#7'CAPTION'#6#10'Pass Count'#7'VISIBLE'#9#5'WIDTH'#2'd'#0 +#0#11'MultiSelect'#9#9'PopupMenu'#7#8'mnuPopup'#9'ViewStyle'#7#8'vsReport'#7
+#1#7'CAPTION'#6#5'Group'#7'VISIBLE'#9#5'WIDTH'#2'2'#0#0#11'MULTISELECT'#9#9 +'OnClick'#7#18'lvBreakPointsClick'#10'OnDblClick'#7#21'lvBreakPointsDBLCLICK'
+'POPUPMENU'#7#8'mnuPopup'#9'VIEWSTYLE'#7#8'vsreport'#7'ONCLICK'#7#18'lvBreak' +#12'OnSelectItem'#7#23'lvBreakPointsSelectItem'#6'Height'#3#205#0#5'Width'#3
+'PointsClick'#10'ONDBLCLICK'#7#21'lvBreakPointsDBLCLICK'#12'ONSELECTITEM'#7 +'0'#2#8'HelpType'#7#9'htKeyword'#0#0#10'TPopupMenu'#8'mnuPopup'#7'OnPopup'#7
+#23'lvBreakPointsSelectItem'#4'LEFT'#2'H'#6'HEIGHT'#3#205#0#3'TOP'#2#2#5'WID' +#13'mnuPopupPopup'#4'left'#2#24#3'top'#2#8#0#9'TMenuItem'#7'popShow'#7'Capti'
+'TH'#3'-'#2#8'HELPTYPE'#7#9'htkeyword'#0#0#10'TPOPUPMENU'#8'mnuPopup'#7'ONPO' +'on'#6#4'Show'#7'Default'#9#7'OnClick'#7#12'popShowClick'#0#0#9'TMenuItem'#2
+'PUP'#7#13'mnuPopupPopup'#4'left'#2#24#3'top'#2#8#0#9'TMENUITEM'#6'popAdd'#7 +'N0'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#6'popAdd'#7'Caption'#6#6'Add...'#0#9
+'CAPTION'#6#6'Add...'#0#9'TMENUITEM'#14'popAddSourceBP'#7'CAPTION'#6#18'&Sou' +'TMenuItem'#14'popAddSourceBP'#7'Caption'#6#18'&Source breakpoint'#7'Enabled'
+'rce breakpoint'#7'ENABLED'#8#7'ONCLICK'#7#19'popAddSourceBPClick'#0#0#0#9'T' +#8#7'OnClick'#7#19'popAddSourceBPClick'#0#0#0#9'TMenuItem'#2'N1'#7'Caption'#6
+'MENUITEM'#2'N1'#7'CAPTION'#6#1'-'#0#0#9'TMENUITEM'#13'popProperties'#7'CAPT' +#1'-'#0#0#9'TMenuItem'#13'popProperties'#7'Caption'#6#11'&Properties'#7'OnCl'
+'ION'#6#11'&Properties'#7'ONCLICK'#7#18'popPropertiesClick'#0#0#9'TMENUITEM' +'ick'#7#18'popPropertiesClick'#0#0#9'TMenuItem'#10'popEnabled'#7'Caption'#6#8
+#10'popEnabled'#7'CAPTION'#6#8'&Enabled'#19'SHOWALWAYSCHECKABLE'#9#7'ONCLICK' +'&Enabled'#19'ShowAlwaysCheckable'#9#7'OnClick'#7#15'popEnabledClick'#0#0#9
+#7#15'popEnabledClick'#0#0#9'TMENUITEM'#9'popDelete'#7'CAPTION'#6#7'&Delete' +'TMenuItem'#9'popDelete'#7'Caption'#6#7'&Delete'#7'OnClick'#7#14'popDeleteCl'
+#7'ONCLICK'#7#14'popDeleteClick'#0#0#9'TMENUITEM'#2'N2'#7'CAPTION'#6#1'-'#0#0 +'ick'#0#0#9'TMenuItem'#2'N2'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#13'popDisabl'
+#9'TMENUITEM'#13'popDisableAll'#7'CAPTION'#6#12'D&isable All'#7'ONCLICK'#7#18 +'eAll'#7'Caption'#6#12'D&isable All'#7'OnClick'#7#18'popDisableAllClick'#0#0
+'popDisableAllClick'#0#0#9'TMENUITEM'#12'popEnableAll'#7'CAPTION'#6#11'&Enab' +#9'TMenuItem'#12'popEnableAll'#7'Caption'#6#11'&Enable All'#7'OnClick'#7#17
+'le All'#7'ONCLICK'#7#17'popEnableAllClick'#0#0#9'TMENUITEM'#12'popDeleteAll' +'popEnableAllClick'#0#0#9'TMenuItem'#12'popDeleteAll'#7'Caption'#6#11'&Delet'
+#7'CAPTION'#6#11'&Delete All'#7'ONCLICK'#7#17'popDeleteAllClick'#0#0#9'TMENU' +'e All'#7'OnClick'#7#17'popDeleteAllClick'#0#0#9'TMenuItem'#2'N3'#7'Caption'
+'ITEM'#2'N3'#7'CAPTION'#6#1'-'#0#0#9'TMENUITEM'#23'popDisableAllSameSource'#7 +#6#1'-'#0#0#9'TMenuItem'#23'popDisableAllSameSource'#7'Caption'#6#26'Disable'
+'CAPTION'#6#26'Disable All in same source'#7'ONCLICK'#7#28'popDisableAllSame' +' All in same source'#7'OnClick'#7#28'popDisableAllSameSourceCLICK'#0#0#9'TM'
+'SourceCLICK'#0#0#9'TMENUITEM'#22'popEnableAllSameSource'#7'CAPTION'#6#25'En' +'enuItem'#22'popEnableAllSameSource'#7'Caption'#6#25'Enable All in same sour'
+'able All in same source'#7'ONCLICK'#7#27'popEnableAllSameSourceCLICK'#0#0#9 +'ce'#7'OnClick'#7#27'popEnableAllSameSourceCLICK'#0#0#9'TMenuItem'#22'popDel'
+'TMENUITEM'#22'popDeleteAllSameSource'#7'CAPTION'#6#25'Delete All in same so' +'eteAllSameSource'#7'Caption'#6#25'Delete All in same source'#7'OnClick'#7#27
+'urce'#7'ONCLICK'#7#27'popDeleteAllSameSourceCLICK'#0#0#0#0 +'popDeleteAllSameSourceCLICK'#0#0#0#0
]); ]);

68
debugger/breakpointsdlg.pp
View File

@ -49,6 +49,8 @@ type
TBreakPointsDlg = class(TDebuggerDlg) TBreakPointsDlg = class(TDebuggerDlg)
lvBreakPoints: TListView; lvBreakPoints: TListView;
N0: TMenuItem;
popShow: TMenuItem;
mnuPopup: TPopupMenu; mnuPopup: TPopupMenu;
popAdd: TMenuItem; popAdd: TMenuItem;
popAddSourceBP: TMenuItem; popAddSourceBP: TMenuItem;
@ -80,6 +82,7 @@ type
procedure popDisableAllClick(Sender: TObject); procedure popDisableAllClick(Sender: TObject);
procedure popEnableAllClick(Sender: TObject); procedure popEnableAllClick(Sender: TObject);
procedure popDeleteAllClick(Sender: TObject); procedure popDeleteAllClick(Sender: TObject);
procedure popShowClick(Sender: TObject);
private private
FBaseDirectory: string; FBaseDirectory: string;
FBreakPoints: TIDEBreakPoints; FBreakPoints: TIDEBreakPoints;
@ -92,6 +95,7 @@ type
procedure BreakPointRemove(const ASender: TIDEBreakPoints; procedure BreakPointRemove(const ASender: TIDEBreakPoints;
const ABreakpoint: TIDEBreakPoint); const ABreakpoint: TIDEBreakPoint);
procedure SetBaseDirectory(const AValue: string); procedure SetBaseDirectory(const AValue: string);
procedure SetBreakPoints(const AValue: TIDEBreakPoints); procedure SetBreakPoints(const AValue: TIDEBreakPoints);
procedure UpdateItem(const AnItem: TListItem; procedure UpdateItem(const AnItem: TListItem;
@ -99,8 +103,7 @@ type
procedure UpdateAll; procedure UpdateAll;
protected protected
procedure DoEndUpdate; override; procedure DoEndUpdate; override;
procedure BreakPointsUpdate; virtual; procedure JumpToCurrentBreakPoint; virtual;
procedure DoJumpToCurrentBreakPoint; virtual;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
@ -118,7 +121,7 @@ implementation
function GetBreakPointStateDescription(ABreakpoint: TBaseBreakpoint): string; function GetBreakPointStateDescription(ABreakpoint: TBaseBreakpoint): string;
const const
// enabled valid // enabled valid
DEBUG_STATE: array[Boolean, TValidState] of String = ( DEBUG_STATE: array[Boolean, TValidState] of ShortString = (
{vsUnknown, vsValid, vsInvalid} {vsUnknown, vsValid, vsInvalid}
{Disabled} ('? (Off)','Disabled','Invalid (Off)'), {Disabled} ('? (Off)','Disabled','Invalid (Off)'),
{Endabled} ('? (On)', 'Enabled', 'Invalid (On)')); {Endabled} ('? (On)', 'Enabled', 'Invalid (On)'));
@ -128,7 +131,7 @@ end;
function GetBreakPointActionsDescription(ABreakpoint: TBaseBreakpoint): string; function GetBreakPointActionsDescription(ABreakpoint: TBaseBreakpoint): string;
const const
DEBUG_ACTION: array[TIDEBreakPointAction] of string = DEBUG_ACTION: array[TIDEBreakPointAction] of ShortString =
('Break', 'Enable Group', 'Disable Group'); ('Break', 'Enable Group', 'Disable Group');
var var
@ -198,15 +201,30 @@ begin
end; end;
procedure TBreakPointsDlg.SetBreakPoints(const AValue: TIDEBreakPoints); procedure TBreakPointsDlg.SetBreakPoints(const AValue: TIDEBreakPoints);
var
i: Integer;
begin begin
if FBreakPoints=AValue then exit; if FBreakPoints = AValue then Exit;
lvBreakPoints.Items.Clear;
if FBreakPoints<>nil then BeginUpdate;
FBreakPoints.RemoveNotification(FBreakpointsNotification); try
FBreakPoints:=AValue; lvBreakPoints.Items.Clear;
if FBreakPoints<>nil then begin if FBreakPoints <> nil
FBreakPoints.AddNotification(FBreakpointsNotification); then begin
BreakPointsUpdate; FBreakPoints.RemoveNotification(FBreakpointsNotification);
end;
FBreakPoints:=AValue;
if FBreakPoints <> nil
then begin
FBreakPoints.AddNotification(FBreakpointsNotification);
for i:=0 to FBreakPoints.Count-1 do
BreakPointUpdate(FBreakPoints, FBreakPoints.Items[i]);
end;
finally
EndUpdate;
end; end;
end; end;
@ -223,7 +241,7 @@ end;
destructor TBreakPointsDlg.Destroy; destructor TBreakPointsDlg.Destroy;
begin begin
SetDebugger(nil); SetBreakPoints(nil);
FBreakpointsNotification.OnAdd := nil; FBreakpointsNotification.OnAdd := nil;
FBreakpointsNotification.OnUpdate := nil; FBreakpointsNotification.OnUpdate := nil;
FBreakpointsNotification.OnRemove := nil; FBreakpointsNotification.OnRemove := nil;
@ -231,16 +249,7 @@ begin
inherited; inherited;
end; end;
procedure TBreakPointsDlg.BreakPointsUpdate; procedure TBreakPointsDlg.JumpToCurrentBreakPoint;
var
i: Integer;
begin
if FBreakPoints=nil then exit;
for i:=0 to FBreakPoints.Count-1 do
BreakPointUpdate(FBreakPoints,FBreakPoints.Items[i]);
end;
procedure TBreakPointsDlg.DoJumpToCurrentBreakPoint;
var var
CurItem: TListItem; CurItem: TListItem;
CurBreakPoint: TIDEBreakPoint; CurBreakPoint: TIDEBreakPoint;
@ -262,7 +271,7 @@ end;
procedure TBreakPointsDlg.lvBreakPointsDBLCLICK(Sender: TObject); procedure TBreakPointsDlg.lvBreakPointsDBLCLICK(Sender: TObject);
begin begin
DoJumpToCurrentBreakPoint; JumpToCurrentBreakPoint;
end; end;
procedure TBreakPointsDlg.lvBreakPointsSelectItem(Sender: TObject; procedure TBreakPointsDlg.lvBreakPointsSelectItem(Sender: TObject;
@ -380,6 +389,11 @@ begin
TIDEBreakPoint(lvBreakPoints.Items[n].Data).Free; TIDEBreakPoint(lvBreakPoints.Items[n].Data).Free;
end; end;
procedure TBreakPointsDlg.popShowClick(Sender: TObject);
begin
JumpToCurrentBreakPoint;
end;
procedure TBreakPointsDlg.popDeleteClick(Sender: TObject); procedure TBreakPointsDlg.popDeleteClick(Sender: TObject);
var var
CurItem: TListItem; CurItem: TListItem;
@ -464,7 +478,7 @@ begin
// line // line
if ABreakpoint.Line > 0 if ABreakpoint.Line > 0
then AnItem.SubItems[1] := IntToStr(ABreakpoint.GetSourceLine) then AnItem.SubItems[1] := IntToStr(ABreakpoint.SourceLine)
else AnItem.SubItems[1] := ''; else AnItem.SubItems[1] := '';
// expression // expression
@ -506,6 +520,10 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.22 2004/08/26 23:50:05 marc
* Restructured debugger view classes
* Fixed help
Revision 1.21 2004/05/02 12:01:15 mattias Revision 1.21 2004/05/02 12:01:15 mattias
removed unneeded units in uses sections removed unneeded units in uses sections

70
debugger/callstackdlg.lfm
View File

@ -1,36 +1,52 @@
object CallStackDlg: TCallStackDlg object CallStackDlg: TCallStackDlg
CAPTION = 'CallStack' Caption = 'CallStack'
CLIENTHEIGHT = 200 ClientHeight = 200
CLIENTWIDTH = 500 ClientWidth = 500
VISIBLE = True Visible = True
HORZSCROLLBAR.PAGE = 501 HorzScrollBar.Page = 501
VERTSCROLLBAR.PAGE = 201 VertScrollBar.Page = 201
LEFT = 359 Left = 843
HEIGHT = 200 Height = 200
TOP = 126 Top = 202
WIDTH = 500 Width = 500
object lvCallStack: TLISTVIEW object lvCallStack: TListView
ALIGN = alclient Align = alClient
ANCHORS = [aktop, akleft] Columns = <
COLUMNS = <
item item
CAPTION = 'Source' Caption = 'Source'
VISIBLE = True ImageIndex = -1
WIDTH = 150 Visible = True
Width = 150
end end
item item
CAPTION = 'Line' Caption = 'Line'
VISIBLE = True ImageIndex = -1
WIDTH = 50 Visible = True
Width = 50
end end
item item
CAPTION = 'Function' Caption = 'Function'
VISIBLE = True ImageIndex = -1
WIDTH = 300 Visible = True
end> end>
VIEWSTYLE = vsreport ViewStyle = vsReport
ONDBLCLICK = lvCallStackDBLCLICK OnDblClick = lvCallStackDBLCLICK
HEIGHT = 200 Height = 200
WIDTH = 500 Width = 500
end
object mnuPopup: TPopupMenu
left = 66
top = 88
object popShow: TMenuItem
Caption = 'Show'
Default = True
OnClick = popShowClick
end
object N1: TMenuItem
Caption = '-'
end
object popSetAsCurrent: TMenuItem
Caption = 'Set as current'
end
end end
end end

22
debugger/callstackdlg.lrs
View File

@ -1,13 +1,17 @@
{ This is an automatically generated lazarus resource file } { This is an automatically generated lazarus resource file }
LazarusResources.Add('TCallStackDlg','FORMDATA',[ LazarusResources.Add('TCallStackDlg','FORMDATA',[
'TPF0'#13'TCallStackDlg'#12'CallStackDlg'#7'CAPTION'#6#9'CallStack'#12'CLIENT' 'TPF0'#13'TCallStackDlg'#12'CallStackDlg'#7'Caption'#6#9'CallStack'#12'Client'
+'HEIGHT'#3#200#0#11'CLIENTWIDTH'#3#244#1#7'VISIBLE'#9#18'HORZSCROLLBAR.PAGE' +'Height'#3#200#0#11'ClientWidth'#3#244#1#7'Visible'#9#18'HorzScrollBar.Page'
+#3#245#1#18'VERTSCROLLBAR.PAGE'#3#201#0#4'LEFT'#3'g'#1#6'HEIGHT'#3#200#0#3'T' +#3#245#1#18'VertScrollBar.Page'#3#201#0#4'Left'#3'K'#3#6'Height'#3#200#0#3'T'
+'OP'#2'~'#5'WIDTH'#3#244#1#0#9'TLISTVIEW'#11'lvCallStack'#5'ALIGN'#7#8'alcli' +'op'#3#202#0#5'Width'#3#244#1#0#9'TListView'#11'lvCallStack'#5'Align'#7#8'al'
+'ent'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#7'COLUMNS'#14#1#7'CAPTION'#6#6'Sour' +'Client'#7'Columns'#14#1#7'Caption'#6#6'Source'#10'ImageIndex'#2#255#7'Visib'
+'ce'#7'VISIBLE'#9#5'WIDTH'#3#150#0#0#1#7'CAPTION'#6#4'Line'#7'VISIBLE'#9#5'W' +'le'#9#5'Width'#3#150#0#0#1#7'Caption'#6#4'Line'#10'ImageIndex'#2#255#7'Visi'
+'IDTH'#2'2'#0#1#7'CAPTION'#6#8'Function'#7'VISIBLE'#9#5'WIDTH'#3','#1#0#0#9 +'ble'#9#5'Width'#2'2'#0#1#7'Caption'#6#8'Function'#10'ImageIndex'#2#255#7'Vi'
+'VIEWSTYLE'#7#8'vsreport'#10'ONDBLCLICK'#7#19'lvCallStackDBLCLICK'#6'HEIGHT' +'sible'#9#0#0#9'ViewStyle'#7#8'vsReport'#10'OnDblClick'#7#19'lvCallStackDBLC'
+#3#200#0#5'WIDTH'#3#244#1#0#0#0 +'LICK'#6'Height'#3#200#0#5'Width'#3#244#1#0#0#10'TPopupMenu'#8'mnuPopup'#4'l'
+'eft'#2'B'#3'top'#2'X'#0#9'TMenuItem'#7'popShow'#7'Caption'#6#4'Show'#7'Defa'
+'ult'#9#7'OnClick'#7#12'popShowClick'#0#0#9'TMenuItem'#2'N1'#7'Caption'#6#1
+'-'#0#0#9'TMenuItem'#15'popSetAsCurrent'#7'Caption'#6#14'Set as current'#0#0
+#0#0
]); ]);

185
debugger/callstackdlg.pp
View File

@ -37,24 +37,31 @@ interface
uses uses
LResources, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, LResources, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Debugger, DebuggerDlg; ComCtrls, Debugger, DebuggerDlg, Menus;
type type
TCallStackDlg = class(TDebuggerDlg) TCallStackDlg = class(TDebuggerDlg)
lvCallStack: TListView; lvCallStack: TListView;
N1: TMenuItem;
popSetAsCurrent: TMenuItem;
popShow: TMenuItem;
mnuPopup: TPopupMenu;
procedure lvCallStackDBLCLICK(Sender: TObject); procedure lvCallStackDBLCLICK(Sender: TObject);
private procedure popShowClick(Sender: TObject);
private
FCallStack: TIDECallStack;
FCallStackNotification: TIDECallStackNotification;
procedure CallStackChanged(Sender: TObject); procedure CallStackChanged(Sender: TObject);
procedure SetCallStack(const AValue: TIDECallStack);
procedure JumpToSource;
protected protected
procedure SetDebugger(const ADebugger: TDebugger); override; procedure DoBeginUpdate; override;
procedure DoEndUpdate; override;
public public
published constructor Create(AOwner: TComponent); override;
// publish some properties until fpcbug #1888 is fixed destructor Destroy; override;
property Top;
property Left; property CallStack: TIDECallStack read FCallStack write SetCallStack;
property Width;
property Height;
property Caption;
end; end;
@ -62,7 +69,81 @@ implementation
{ TCallStackDlg } { TCallStackDlg }
procedure TCallStackDlg.lvCallStackDBLCLICK(Sender: TObject); constructor TCallStackDlg.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCallStackNotification := TIDECallStackNotification.Create;
FCallStackNotification.AddReference;
FCallStackNotification.OnChange := @CallStackChanged;
end;
procedure TCallStackDlg.CallStackChanged(Sender: TObject);
var
n, m: Integer;
Item: TListItem;
S: String;
Entry: TCallStackEntry;
begin
BeginUpdate;
try
if CallStack = nil
then begin
lvCallStack.Items.Clear;
exit;
end;
// Reuse entries, so add and remove only
// Remove unneded
for n := lvCallStack.Items.Count - 1 downto CallStack.Count do
lvCallStack.Items.Delete(n);
// Add needed
for n := lvCallStack.Items.Count to CallStack.Count - 1 do
begin
Item := lvCallStack.Items.Add;
Item.SubItems.Add('');
Item.SubItems.Add('');
end;
for n := 0 to lvCallStack.Items.Count - 1 do
begin
Item := lvCallStack.Items[n];
Entry := CallStack.Entries[n];
Item.Caption := Entry.Source;
Item.SubItems[0] := IntToStr(Entry.Line);
S := '';
for m := 0 to Entry.ArgumentCount - 1 do
begin
if S <> ''
then S := S + ', ';
S := S + Entry.ArgumentValues[m];
end;
if S <> ''
then S := '(' + S + ')';
Item.SubItems[1] := Entry.FunctionName + S;
end;
finally
EndUpdate;
end;
end;
destructor TCallStackDlg.Destroy;
begin
inherited Destroy;
end;
procedure TCallStackDlg.DoBeginUpdate;
begin
lvCallStack.BeginUpdate;
end;
procedure TCallStackDlg.DoEndUpdate;
begin
lvCallStack.EndUpdate;
end;
procedure TCallStackDlg.JumpToSource;
var var
CurItem: TListItem; CurItem: TListItem;
Filename: String; Filename: String;
@ -76,66 +157,38 @@ begin
DoJumpToCodePos(Filename,Line,0); DoJumpToCodePos(Filename,Line,0);
end; end;
procedure TCallStackDlg.CallStackChanged(Sender: TObject); procedure TCallStackDlg.lvCallStackDBLCLICK(Sender: TObject);
var begin
n, m: Integer; JumpToSource;
Item: TListItem;
S: String;
Entry: TDBGCallStackEntry;
begin
if Debugger=nil then begin
lvCallStack.Items.Clear;
exit;
end;
// Reuse entries, so add and remove only
// Remove unneded
for n := lvCallStack.Items.Count - 1 downto Debugger.CallStack.Count do
lvCallStack.Items.Delete(n);
// Add needed
for n := lvCallStack.Items.Count to Debugger.CallStack.Count - 1 do
begin
Item := lvCallStack.Items.Add;
Item.SubItems.Add('');
Item.SubItems.Add('');
end;
for n := 0 to lvCallStack.Items.Count - 1 do
begin
Item := lvCallStack.Items[n];
Entry := Debugger.CallStack.Entries[n];
Item.Caption := Entry.Source;
Item.SubItems[0] := IntToStr(Entry.Line);
S := '';
for m := 0 to Entry.ArgumentCount - 1 do
begin
if S <> ''
then S := S + ', ';
S := S + Entry.ArgumentValues[m];
end;
if S <> ''
then S := '(' + S + ')';
Item.SubItems[1] := Entry.FunctionName + S;
end;
end; end;
procedure TCallStackDlg.SetDebugger(const ADebugger: TDebugger); procedure TCallStackDlg.popShowClick(Sender: TObject);
begin begin
if ADebugger <> Debugger JumpToSource;
then begin end;
if Debugger <> nil
procedure TCallStackDlg.SetCallStack(const AValue: TIDECallStack);
begin
if FCallStack = AValue then Exit;
BeginUpdate;
try
if FCallStack <> nil
then begin then begin
Debugger.CallStack.OnChange := nil; FCallStack.RemoveNotification(FCallStackNotification);
end; end;
inherited;
if Debugger <> nil FCallStack := AValue;
if FCallStack <> nil
then begin then begin
Debugger.CallStack.OnChange := @CallStackChanged; FCallStack.AddNotification(FCallStackNotification);
CallStackChanged(Debugger.CallStack);
end; end;
end
else inherited; CallStackChanged(FCallStack);
finally
EndUpdate;
end;
end; end;
initialization initialization
@ -145,6 +198,10 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.5 2004/08/26 23:50:05 marc
* Restructured debugger view classes
* Fixed help
Revision 1.4 2004/05/02 12:01:15 mattias Revision 1.4 2004/05/02 12:01:15 mattias
removed unneeded units in uses sections removed unneeded units in uses sections

28
debugger/dbgoutputform.lfm
View File

@ -1,23 +1,29 @@
object DbgOutputForm1: TDbgOutputForm object DbgOutputForm: TDbgOutputForm
CAPTION = 'Debug output' Caption = 'Debug output'
ClientHeight = 200
ClientWidth = 400
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
HEIGHT = 200 HorzScrollBar.Page = 401
WIDTH = 400 VertScrollBar.Page = 201
Left = 108
Height = 200
Top = 140
Width = 400
object txtOutput: TMemo object txtOutput: TMemo
Left = 8
Top = 104
Width = 600
Height = 150
Align = alClient Align = alClient
PopupMenu = mnuPopup PopupMenu = mnuPopup
PopupMenu = mnuPopup
TabOrder = 0
Height = 200
Width = 400
end end
object mnuPopup: TPopupMenu object mnuPopup: TPopupMenu
Left = 400 left = 400
Top = 96 top = 96
object popClear: TMenuItem object popClear: TMenuItem
Caption = '&Clear' Caption = '&Clear'
OnClick = popClearClick OnClick = popClearClick
end end
end end
end end

21
debugger/dbgoutputform.lrs
View File

@ -1,9 +1,12 @@
LazarusResources.Add('TDbgOutputForm','FORMDATA', { This is an automatically generated lazarus resource file }
'TPF0'#14'TDbgOutputForm'#14'DbgOutputForm1'#7'CAPTION'#6#12'Debug output'
+#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#6'HEIGHT'#3#200#0 LazarusResources.Add('TDbgOutputForm','FORMDATA',[
+#5'WIDTH'#3#144#1#0#5'TMemo'#9'txtOutput'#4'Left'#2#8#3'Top'#2'h'#5'Width' 'TPF0'#14'TDbgOutputForm'#13'DbgOutputForm'#7'Caption'#6#12'Debug output'#12
+#3'X'#2#6'Height'#3#150#0#5'Align'#7#8'alClient'#9'PopupMenu'#7#8'mnuPopu' +'ClientHeight'#3#200#0#11'ClientWidth'#3#144#1#7'OnClose'#7#9'FormClose'#8'O'
+'p'#0#0#10'TPopupMenu'#8'mnuPopup'#4'Left'#3#144#1#3'Top'#2'`'#0#9'TMenuI' +'nCreate'#7#10'FormCreate'#18'HorzScrollBar.Page'#3#145#1#18'VertScrollBar.P'
+'tem'#8'popClear'#7'Caption'#6#6'&Clear'#7'OnClick'#7#13'popClearClick'#0 +'age'#3#201#0#4'Left'#2'l'#6'Height'#3#200#0#3'Top'#3#140#0#5'Width'#3#144#1
+#0#0#0 +#0#5'TMemo'#9'txtOutput'#5'Align'#7#8'alClient'#9'PopupMenu'#7#8'mnuPopup'#9
); +'PopupMenu'#7#8'mnuPopup'#8'TabOrder'#2#0#6'Height'#3#200#0#5'Width'#3#144#1
+#0#0#10'TPopupMenu'#8'mnuPopup'#4'left'#3#144#1#3'top'#2'`'#0#9'TMenuItem'#8
+'popClear'#7'Caption'#6#6'&Clear'#7'OnClick'#7#13'popClearClick'#0#0#0#0
]);

1070
debugger/debugger.pp
View File

File diff suppressed because it is too large Load Diff

28
debugger/debuggerdlg.pp
View File

@ -52,17 +52,14 @@ type
TDebuggerDlg = class(TForm) TDebuggerDlg = class(TForm)
private private
FDebugger: TDebugger;
FOnGetFullDebugFilename: TGetFullDebugFilenameEvent; FOnGetFullDebugFilename: TGetFullDebugFilenameEvent;
FOnJumpToCodePos: TJumpToCodePosEvent; FOnJumpToCodePos: TJumpToCodePosEvent;
FUpdateCount: integer; FUpdateCount: integer;
protected protected
procedure SetDebugger(const ADebugger: TDebugger); virtual;
procedure DoClose(var CloseAction: TCloseAction); override; procedure DoClose(var CloseAction: TCloseAction); override;
procedure DoBeginUpdate; virtual; procedure DoBeginUpdate; virtual;
procedure DoEndUpdate; virtual; procedure DoEndUpdate; virtual;
public public
destructor Destroy; override;
procedure BeginUpdate; procedure BeginUpdate;
procedure EndUpdate; procedure EndUpdate;
function UpdateCount: integer; function UpdateCount: integer;
@ -70,7 +67,6 @@ type
): TModalresult; ): TModalresult;
function DoGetFullDebugFilename(var Filename: string; AskUser: boolean function DoGetFullDebugFilename(var Filename: string; AskUser: boolean
): TModalresult; ): TModalresult;
property Debugger: TDebugger read FDebugger write SetDebugger;
property OnJumpToCodePos: TJumpToCodePosEvent read FOnJumpToCodePos property OnJumpToCodePos: TJumpToCodePosEvent read FOnJumpToCodePos
write FOnJumpToCodePos; write FOnJumpToCodePos;
property OnGetFullDebugFilename: TGetFullDebugFilenameEvent property OnGetFullDebugFilename: TGetFullDebugFilenameEvent
@ -81,27 +77,22 @@ implementation
{ TDebuggerDlg } { TDebuggerDlg }
destructor TDebuggerDlg.Destroy;
begin
Debugger := nil;
inherited;
end;
procedure TDebuggerDlg.BeginUpdate; procedure TDebuggerDlg.BeginUpdate;
begin begin
inc(FUpdateCount); Inc(FUpdateCount);
if FUpdateCount = 1 then DoBeginUpdate;
end; end;
procedure TDebuggerDlg.EndUpdate; procedure TDebuggerDlg.EndUpdate;
begin begin
if FUpdateCount<1 then RaiseException('TDebuggerDlg.EndUpdate'); if FUpdateCount < 1 then RaiseException('TDebuggerDlg.EndUpdate');
dec(FUpdateCount); Dec(FUpdateCount);
if FUpdateCount=0 then DoEndUpdate; if FUpdateCount = 0 then DoEndUpdate;
end; end;
function TDebuggerDlg.UpdateCount: integer; function TDebuggerDlg.UpdateCount: integer;
begin begin
Result:=FUpdateCount; Result := FUpdateCount;
end; end;
function TDebuggerDlg.DoJumpToCodePos(const Filename: string; Line, function TDebuggerDlg.DoJumpToCodePos(const Filename: string; Line,
@ -122,11 +113,12 @@ begin
Result:=mrCancel; Result:=mrCancel;
end; end;
(*
procedure TDebuggerDlg.SetDebugger(const ADebugger: TDebugger); procedure TDebuggerDlg.SetDebugger(const ADebugger: TDebugger);
begin begin
FDebugger := ADebugger; FDebugger := ADebugger;
end; end;
*)
procedure TDebuggerDlg.DoClose(var CloseAction: TCloseAction); procedure TDebuggerDlg.DoClose(var CloseAction: TCloseAction);
begin begin
CloseAction := caFree; // we default to free CloseAction := caFree; // we default to free
@ -146,6 +138,10 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.10 2004/08/26 23:50:05 marc
* Restructured debugger view classes
* Fixed help
Revision 1.9 2004/02/02 16:59:28 mattias Revision 1.9 2004/02/02 16:59:28 mattias
more Actions TAction, TBasicAction, ... more Actions TAction, TBasicAction, ...

94
debugger/gdbmidebugger.pp
View File

@ -188,10 +188,10 @@ type
procedure AddLocals(const AParams:String); procedure AddLocals(const AParams:String);
protected protected
procedure DoStateChange; override; procedure DoStateChange; override;
function GetCount: Integer; override;
function GetName(const AnIndex: Integer): String; override; function GetName(const AnIndex: Integer): String; override;
function GetValue(const AnIndex: Integer): String; override; function GetValue(const AnIndex: Integer): String; override;
public public
function Count: Integer; override;
constructor Create(const ADebugger: TDebugger); constructor Create(const ADebugger: TDebugger);
destructor Destroy; override; destructor Destroy; override;
end; end;
@ -213,13 +213,10 @@ type
TGDBMICallStack = class(TDBGCallStack) TGDBMICallStack = class(TDBGCallStack)
private private
FCount: Integer; // -1 means uninitialized
protected protected
function CreateStackEntry(const AIndex: Integer): TDBGCallStackEntry; override; function CheckCount: Boolean; override;
procedure DoStateChange; override; function CreateStackEntry(const AIndex: Integer): TCallStackEntry; override;
function GetCount: Integer; override;
public public
constructor Create(const ADebugger: TDebugger);
end; end;
TGDBMIExpression = class(TObject) TGDBMIExpression = class(TObject)
@ -1150,7 +1147,6 @@ function TGDBMIDebugger.ProcessStopped(const AParams: String; const AIgnoreSigIn
Location.SrcFile := Frame.Values['file']; Location.SrcFile := Frame.Values['file'];
Location.SrcLine := StrToIntDef(Frame.Values['line'], -1); Location.SrcLine := StrToIntDef(Frame.Values['line'], -1);
TGDBMILocals(Locals).AddLocals(Frame.Values['args']);
Frame.Free; Frame.Free;
DoCurrent(Location); DoCurrent(Location);
@ -1752,17 +1748,6 @@ begin
FreeAndNil(LocList); FreeAndNil(LocList);
end; end;
function TGDBMILocals.Count: Integer;
begin
if (Debugger <> nil)
and (Debugger.State = dsPause)
then begin
LocalsNeeded;
Result := FLocals.Count;
end
else Result := 0;
end;
constructor TGDBMILocals.Create(const ADebugger: TDebugger); constructor TGDBMILocals.Create(const ADebugger: TDebugger);
begin begin
FLocals := TStringList.Create; FLocals := TStringList.Create;
@ -1790,6 +1775,17 @@ begin
end; end;
end; end;
function TGDBMILocals.GetCount: Integer;
begin
if (Debugger <> nil)
and (Debugger.State = dsPause)
then begin
LocalsNeeded;
Result := FLocals.Count;
end
else Result := 0;
end;
function TGDBMILocals.GetName(const AnIndex: Integer): String; function TGDBMILocals.GetName(const AnIndex: Integer): String;
begin begin
if (Debugger <> nil) if (Debugger <> nil)
@ -1821,6 +1817,16 @@ begin
if Debugger = nil then Exit; if Debugger = nil then Exit;
if not FLocalsValid if not FLocalsValid
then begin then begin
// args
TGDBMIDebugger(Debugger).ExecuteCommand('frame', S, []);
List := CreateMIValueList(S);
S := List.Values['frame'];
FreeAndNil(List);
List := CreateMIValueList(S);
AddLocals(List.Values['args']);
FreeAndNil(List);
// variables
TGDBMIDebugger(Debugger).ExecuteCommand('-stack-list-locals 1', S, []); TGDBMIDebugger(Debugger).ExecuteCommand('-stack-list-locals 1', S, []);
List := CreateMIValueList(S); List := CreateMIValueList(S);
AddLocals(List.Values['locals']); AddLocals(List.Values['locals']);
@ -1856,7 +1862,7 @@ begin
if Debugger.State in [dsPause, dsStop] if Debugger.State in [dsPause, dsStop]
then FEvaluated := False; then FEvaluated := False;
if Debugger.State = dsPause then Changed(False); if Debugger.State = dsPause then Changed;
end; end;
procedure TGDBMIWatch.EvaluationNeeded; procedure TGDBMIWatch.EvaluationNeeded;
@ -1903,13 +1909,22 @@ end;
{ TGDBMICallStack } { TGDBMICallStack }
{ =========================================================================== } { =========================================================================== }
constructor TGDBMICallStack.Create(const ADebugger: TDebugger); function TGDBMICallStack.CheckCount: Boolean;
var
S: String;
List: TStrings;
begin begin
FCount := -1; Result := inherited CheckCount;
inherited;
if not Result then Exit;
TGDBMIDebugger(Debugger).ExecuteCommand('-stack-info-depth', S, []);
List := CreateMIValueList(S);
SetCount(StrToIntDef(List.Values['depth'], 0));
FreeAndNil(List);
end; end;
function TGDBMICallStack.CreateStackEntry(const AIndex: Integer): TDBGCallStackEntry; function TGDBMICallStack.CreateStackEntry(const AIndex: Integer): TCallStackEntry;
var var
n: Integer; n: Integer;
S: String; S: String;
@ -1948,7 +1963,7 @@ begin
S := List.Values['frame']; S := List.Values['frame'];
FreeAndNil(List); FreeAndNil(List);
List := CreateMIValueList(S); List := CreateMIValueList(S);
Result := TDBGCallStackEntry.Create( Result := TCallStackEntry.Create(
AIndex, AIndex,
Pointer(StrToIntDef(List.Values['addr'], 0)), Pointer(StrToIntDef(List.Values['addr'], 0)),
Arguments, Arguments,
@ -1961,33 +1976,6 @@ begin
Arguments.Free; Arguments.Free;
end; end;
procedure TGDBMICallStack.DoStateChange;
begin
if Debugger.State <> dsPause
then FCount := -1;
inherited;
end;
function TGDBMICallStack.GetCount: Integer;
var
S: String;
List: TStrings;
begin
if FCount = -1
then begin
if Debugger = nil
then FCount := 0
else begin
TGDBMIDebugger(Debugger).ExecuteCommand('-stack-info-depth', S, []);
List := CreateMIValueList(S);
FCount := StrToIntDef(List.Values['depth'], 0);
FreeAndNil(List);
end;
end;
Result := FCount;
end;
{ =========================================================================== } { =========================================================================== }
{ TGDBMIExpression } { TGDBMIExpression }
{ =========================================================================== } { =========================================================================== }
@ -2262,6 +2250,10 @@ initialization
end. end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.48 2004/08/26 23:50:05 marc
* Restructured debugger view classes
* Fixed help
Revision 1.47 2004/07/19 22:29:46 marc Revision 1.47 2004/07/19 22:29:46 marc
* Temp (?) fix for FPC 1.9.5 [2004/07/15] * Temp (?) fix for FPC 1.9.5 [2004/07/15]

25
debugger/localsdlg.lfm
View File

@ -1,25 +1,30 @@
object LocalsDlg: TLocalsDlg object LocalsDlg: TLocalsDlg
Caption = 'Locals'
ClientHeight = 200
ClientWidth = 500
HorzScrollBar.Page = 501
VertScrollBar.Page = 201
Left = 359 Left = 359
Height = 200
Top = 126 Top = 126
Width = 500 Width = 500
Height = 200
Caption = 'Locals'
object lvLocals: TListView object lvLocals: TListView
Left = 0
Top = 0
Width = 484
Height = 200
Align = alClient Align = alClient
Columns = < Columns = <
item item
Caption = 'Name' Caption = 'Name'
ImageIndex = -1
Visible = True
Width = 150 Width = 150
end end
item item
Caption = 'Value' Caption = 'Value'
Width = 400 ImageIndex = -1
Visible = True
end> end>
MultiSelect = True MultiSelect = True
ViewStyle = vsReport ViewStyle = vsReport
Height = 200
Width = 500
end end
end end

19
debugger/localsdlg.lrs
View File

@ -1,8 +1,11 @@
LazarusResources.Add('TLocalsDlg','FORMDATA', { This is an automatically generated lazarus resource file }
'TPF0'#10'TLocalsDlg'#9'LocalsDlg'#4'Left'#3'g'#1#3'Top'#2'~'#5'Width'#3
+#244#1#6'Height'#3#200#0#7'Caption'#6#6'Locals'#0#9'TListView'#8'lvLocals' LazarusResources.Add('TLocalsDlg','FORMDATA',[
+#4'Left'#2#0#3'Top'#2#0#5'Width'#3#228#1#6'Height'#3#200#0#5'Align'#7#8'a' 'TPF0'#10'TLocalsDlg'#9'LocalsDlg'#7'Caption'#6#6'Locals'#12'ClientHeight'#3
+'lClient'#7'Columns'#14#1#7'Caption'#6#4'Name'#5'Width'#3#150#0#0#1#7'Cap' +#200#0#11'ClientWidth'#3#244#1#18'HorzScrollBar.Page'#3#245#1#18'VertScrollB'
+'tion'#6#5'Value'#5'Width'#3#144#1#0#0#11'MultiSelect'#9#9'ViewStyle'#7#8 +'ar.Page'#3#201#0#4'Left'#3'g'#1#6'Height'#3#200#0#3'Top'#2'~'#5'Width'#3#244
+'vsReport'#0#0#0 +#1#0#9'TListView'#8'lvLocals'#5'Align'#7#8'alClient'#7'Columns'#14#1#7'Capti'
); +'on'#6#4'Name'#10'ImageIndex'#2#255#7'Visible'#9#5'Width'#3#150#0#0#1#7'Capt'
+'ion'#6#5'Value'#10'ImageIndex'#2#255#7'Visible'#9#0#0#11'MultiSelect'#9#9'V'
+'iewStyle'#7#8'vsReport'#6'Height'#3#200#0#5'Width'#3#244#1#0#0#0
]);

154
debugger/localsdlg.pp
View File

@ -42,18 +42,19 @@ uses
type type
TLocalsDlg = class(TDebuggerDlg) TLocalsDlg = class(TDebuggerDlg)
lvLocals: TListView; lvLocals: TListView;
private private
FLocals: TIDELocals;
FLocalsNotification: TIDELocalsNotification;
procedure LocalsChanged(Sender: TObject); procedure LocalsChanged(Sender: TObject);
procedure SetLocals(const AValue: TIDELocals);
protected protected
procedure SetDebugger(const ADebugger: TDebugger); override; procedure DoBeginUpdate; override;
procedure DoEndUpdate; override;
public public
published constructor Create(AOwner: TComponent); override;
// publish some properties until fpcbug #1888 is fixed destructor Destroy; override;
property Top;
property Left; property Locals: TIDELocals read FLocals write SetLocals;
property Width;
property Height;
property Caption;
end; end;
@ -61,6 +62,21 @@ implementation
{ TLocalsDlg } { TLocalsDlg }
constructor TLocalsDlg.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FLocalsNotification := TIDELocalsNotification.Create;
FLocalsNotification.AddReference;
FLocalsNotification.OnChange := @LocalsChanged;
end;
destructor TLocalsDlg.Destroy;
begin
FLocalsNotification.OnChange := nil;
FLocalsNotification.ReleaseReference;
inherited Destroy;
end;
procedure TLocalsDlg.LocalsChanged(Sender: TObject); procedure TLocalsDlg.LocalsChanged(Sender: TObject);
var var
n, idx: Integer; n, idx: Integer;
@ -69,57 +85,87 @@ var
S: String; S: String;
begin begin
List := TStringList.Create; List := TStringList.Create;
//Get existing items try
for n := 0 to lvLocals.Items.Count - 1 do BeginUpdate;
begin try
Item := lvLocals.Items[n]; if FLocals = nil
S := Item.Caption; then begin
S := UpperCase(S); lvLocals.Items.Clear;
List.AddObject(S, Item); Exit;
end; end;
// add/update entries
for n := 0 to Debugger.Locals.Count - 1 do
begin
idx := List.IndexOf(Uppercase(Debugger.Locals.Names[n]));
if idx = -1
then begin
// New entry
Item := lvLocals.Items.Add;
Item.Caption := Debugger.Locals.Names[n];
Item.SubItems.Add(Debugger.Locals.Values[n]);
end
else begin
// Existing entry
Item := TListItem(List.Objects[idx]);
Item.SubItems[0] := Debugger.Locals.Values[n];
List.Delete(idx);
end;
end;
// remove obsolete entries
for n := 0 to List.Count - 1 do
lvLocals.Items.Delete(TListItem(List.Objects[n]).Index);
List.Free; //Get existing items
for n := 0 to lvLocals.Items.Count - 1 do
begin
Item := lvLocals.Items[n];
S := Item.Caption;
S := UpperCase(S);
List.AddObject(S, Item);
end;
// add/update entries
for n := 0 to FLocals.Count - 1 do
begin
idx := List.IndexOf(Uppercase(FLocals.Names[n]));
if idx = -1
then begin
// New entry
Item := lvLocals.Items.Add;
Item.Caption := FLocals.Names[n];
Item.SubItems.Add(FLocals.Values[n]);
end
else begin
// Existing entry
Item := TListItem(List.Objects[idx]);
Item.SubItems[0] := FLocals.Values[n];
List.Delete(idx);
end;
end;
// remove obsolete entries
for n := 0 to List.Count - 1 do
lvLocals.Items.Delete(TListItem(List.Objects[n]).Index);
finally
EndUpdate;
end;
finally
List.Free;
end;
end; end;
procedure TLocalsDlg.SetDebugger(const ADebugger: TDebugger); procedure TLocalsDlg.SetLocals(const AValue: TIDELocals);
begin begin
if ADebugger <> Debugger if FLocals = AValue then Exit;
then begin
if Debugger <> nil BeginUpdate;
try
if FLocals <> nil
then begin then begin
Debugger.Locals.OnChange := nil; FLocals.RemoveNotification(FLocalsNotification);
end; end;
inherited;
if Debugger <> nil FLocals := AValue;
if FLocals <> nil
then begin then begin
Debugger.Locals.OnChange := @LocalsChanged; FLocals.AddNotification(FLocalsNotification);
LocalsChanged(Debugger.Locals);
end; end;
end
else inherited; LocalsChanged(FLocals);
finally
EndUpdate;
end;
end;
procedure TLocalsDlg.DoBeginUpdate;
begin
lvLocals.BeginUpdate;
end;
procedure TLocalsDlg.DoEndUpdate;
begin
lvLocals.EndUpdate;
end; end;
initialization initialization
@ -129,6 +175,10 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.5 2004/08/26 23:50:05 marc
* Restructured debugger view classes
* Fixed help
Revision 1.4 2004/05/02 12:01:15 mattias Revision 1.4 2004/05/02 12:01:15 mattias
removed unneeded units in uses sections removed unneeded units in uses sections

119
debugger/watchesdlg.pp
View File

@ -39,7 +39,7 @@ interface
uses uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LResources, StdCtrls, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LResources, StdCtrls,
Buttons, Menus, ComCtrls, Debugger, DebuggerDlg, WatchPropertyDlg; Buttons, Menus, ComCtrls, Debugger, DebuggerDlg, BaseDebugManager;
type type
TWatchesDlg = class(TDebuggerDlg) TWatchesDlg = class(TDebuggerDlg)
@ -63,20 +63,22 @@ type
procedure popDisableAllClick(Sender: TObject); procedure popDisableAllClick(Sender: TObject);
procedure popEnableAllClick(Sender: TObject); procedure popEnableAllClick(Sender: TObject);
procedure popDeleteAllClick(Sender: TObject); procedure popDeleteAllClick(Sender: TObject);
private private
FWatchesNotification: TDBGWatchesNotification; FWatches: TIDEWatches;
function GetSelected: TDBGWatch; FWatchesNotification: TIDEWatchesNotification;
procedure WatchAdd(const ASender: TDBGWatches; const AWatch: TDBGWatch); function GetSelected: TIDEWatch;
procedure WatchUpdate(const ASender: TDBGWatches; const AWatch: TDBGWatch); procedure SetWatches(const AValue: TIDEWatches);
procedure WatchRemove(const ASender: TDBGWatches; const AWatch: TDBGWatch); procedure WatchAdd(const ASender: TIDEWatches; const AWatch: TIDEWatch);
procedure WatchUpdate(const ASender: TIDEWatches; const AWatch: TIDEWatch);
procedure WatchRemove(const ASender: TIDEWatches; const AWatch: TIDEWatch);
procedure UpdateItem(const AItem: TListItem; const AWatch: TDBGWatch); procedure UpdateItem(const AItem: TListItem; const AWatch: TIDEWatch);
protected protected
procedure SetDebugger(const ADebugger: TDebugger); override;
public public
procedure WatchesUpdate(const TheWatches: TDBGWatches);
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
property Watches: TIDEWatches read FWatches write SetWatches;
end; end;
@ -89,7 +91,7 @@ constructor TWatchesDlg.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
Name:='WatchesDlg'; Name:='WatchesDlg';
FWatchesNotification := TDBGWatchesNotification.Create; FWatchesNotification := TIDEWatchesNotification.Create;
FWatchesNotification.AddReference; FWatchesNotification.AddReference;
FWatchesNotification.OnAdd := @WatchAdd; FWatchesNotification.OnAdd := @WatchAdd;
FWatchesNotification.OnUpdate := @WatchUpdate; FWatchesNotification.OnUpdate := @WatchUpdate;
@ -98,7 +100,7 @@ end;
destructor TWatchesDlg.Destroy; destructor TWatchesDlg.Destroy;
begin begin
SetDebugger(nil); SetWatches(nil);
FWatchesNotification.OnAdd := nil; FWatchesNotification.OnAdd := nil;
FWatchesNotification.OnUpdate := nil; FWatchesNotification.OnUpdate := nil;
FWatchesNotification.OnRemove := nil; FWatchesNotification.OnRemove := nil;
@ -106,14 +108,44 @@ begin
inherited; inherited;
end; end;
function TWatchesDlg.GetSelected: TDBGWatch; function TWatchesDlg.GetSelected: TIDEWatch;
var var
Item: TListItem; Item: TListItem;
begin begin
Item := lvWatches.Selected; Item := lvWatches.Selected;
if Item = nil if Item = nil
then Result := nil then Result := nil
else Result := TDBGWatch(Item.Data); else Result := TIDEWatch(Item.Data);
end;
procedure TWatchesDlg.SetWatches(const AValue: TIDEWatches);
var
i: Integer;
begin
if FWatches = AValue then Exit;
BeginUpdate;
try
lvWatches.Items.Clear;
if FWatches <> nil
then begin
FWatches.RemoveNotification(FWatchesNotification);
end;
FWatches:=AValue;
if FWatches <> nil
then begin
FWatches.AddNotification(FWatchesNotification);
for i:=0 to FWatches.Count-1 do
WatchUpdate(FWatches, FWatches.Items[i]);
end;
finally
EndUpdate;
end;
end; end;
procedure TWatchesDlg.lvWatchesClick(Sender: TObject); procedure TWatchesDlg.lvWatchesClick(Sender: TObject);
@ -123,7 +155,7 @@ end;
procedure TWatchesDlg.lvWatchesSelectItem(Sender: TObject; AItem: TListItem; Selected: Boolean); procedure TWatchesDlg.lvWatchesSelectItem(Sender: TObject; AItem: TListItem; Selected: Boolean);
var var
Enable: Boolean; Enable: Boolean;
Watch: TDBGWatch; Watch: TIDEWatch;
begin begin
Watch := GetSelected; Watch := GetSelected;
Enable := Watch <> nil; Enable := Watch <> nil;
@ -135,11 +167,7 @@ end;
procedure TWatchesDlg.popAddClick(Sender: TObject); procedure TWatchesDlg.popAddClick(Sender: TObject);
begin begin
with TWatchPropertyDlg.Create(Self, nil, Debugger) do DebugBoss.ShowWatchProperties(nil);
begin
ShowModal;
Free;
end;
end; end;
procedure TWatchesDlg.popDeleteAllClick(Sender: TObject); procedure TWatchesDlg.popDeleteAllClick(Sender: TObject);
@ -147,7 +175,7 @@ var
n: Integer; n: Integer;
begin begin
for n := lvWatches.Items.Count - 1 downto 0 do for n := lvWatches.Items.Count - 1 downto 0 do
TDBGWatch(lvWatches.Items[n].Data).Free; TIDEWatch(lvWatches.Items[n].Data).Free;
end; end;
procedure TWatchesDlg.popDeleteClick(Sender: TObject); procedure TWatchesDlg.popDeleteClick(Sender: TObject);
@ -164,7 +192,7 @@ begin
begin begin
Item := lvWatches.Items[n]; Item := lvWatches.Items[n];
if Item.Data <> nil if Item.Data <> nil
then TDBGWatch(Item.Data).Enabled := False; then TIDEWatch(Item.Data).Enabled := False;
end; end;
end; end;
@ -177,13 +205,13 @@ begin
begin begin
Item := lvWatches.Items[n]; Item := lvWatches.Items[n];
if Item.Data <> nil if Item.Data <> nil
then TDBGWatch(Item.Data).Enabled := True; then TIDEWatch(Item.Data).Enabled := True;
end; end;
end; end;
procedure TWatchesDlg.popEnabledClick(Sender: TObject); procedure TWatchesDlg.popEnabledClick(Sender: TObject);
var var
Watch: TDBGWatch; Watch: TIDEWatch;
begin begin
Watch := GetSelected; Watch := GetSelected;
if Watch = nil then Exit; if Watch = nil then Exit;
@ -193,14 +221,10 @@ end;
procedure TWatchesDlg.popPropertiesClick(Sender: TObject); procedure TWatchesDlg.popPropertiesClick(Sender: TObject);
begin begin
with TWatchPropertyDlg.Create(Self, GetSelected, Debugger) do DebugBoss.ShowWatchProperties(GetSelected);
begin
ShowModal;
Free;
end;
end; end;
procedure TWatchesDlg.UpdateItem(const AItem: TListItem; const AWatch: TDBGWatch); procedure TWatchesDlg.UpdateItem(const AItem: TListItem; const AWatch: TIDEWatch);
begin begin
// Expression // Expression
// Result // Result
@ -208,32 +232,7 @@ begin
AItem.SubItems[0] := AWatch.Value; AItem.SubItems[0] := AWatch.Value;
end; end;
procedure TWatchesDlg.SetDebugger(const ADebugger: TDebugger); procedure TWatchesDlg.WatchAdd(const ASender: TIDEWatches; const AWatch: TIDEWatch);
begin
if ADebugger <> Debugger
then begin
if Debugger <> nil
then begin
Debugger.Watches.RemoveNotification(FWatchesNotification);
end;
inherited;
if Debugger <> nil
then begin
Debugger.Watches.AddNotification(FWatchesNotification);
end;
end
else inherited;
end;
procedure TWatchesDlg.WatchesUpdate(const TheWatches: TDBGWatches);
var
i: Integer;
begin
for i:=0 to TheWatches.Count-1 do
WatchUpdate(TheWatches,TheWatches[i]);
end;
procedure TWatchesDlg.WatchAdd(const ASender: TDBGWatches; const AWatch: TDBGWatch);
var var
Item: TListItem; Item: TListItem;
begin begin
@ -248,7 +247,7 @@ begin
UpdateItem(Item, AWatch); UpdateItem(Item, AWatch);
end; end;
procedure TWatchesDlg.WatchUpdate(const ASender: TDBGWatches; const AWatch: TDBGWatch); procedure TWatchesDlg.WatchUpdate(const ASender: TIDEWatches; const AWatch: TIDEWatch);
var var
Item: TListItem; Item: TListItem;
begin begin
@ -260,7 +259,7 @@ begin
else UpdateItem(Item, AWatch); else UpdateItem(Item, AWatch);
end; end;
procedure TWatchesDlg.WatchRemove(const ASender: TDBGWatches; const AWatch: TDBGWatch); procedure TWatchesDlg.WatchRemove(const ASender: TIDEWatches; const AWatch: TIDEWatch);
begin begin
lvWatches.Items.FindData(AWatch).Free; lvWatches.Items.FindData(AWatch).Free;
end; end;
@ -272,6 +271,10 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.8 2004/08/26 23:50:05 marc
* Restructured debugger view classes
* Fixed help
Revision 1.7 2004/05/02 12:01:15 mattias Revision 1.7 2004/05/02 12:01:15 mattias
removed unneeded units in uses sections removed unneeded units in uses sections

27
debugger/watchpropertydlg.lfm
View File

@ -1,13 +1,13 @@
object WatchPropertyDlg: TWatchPropertyDlg object WatchPropertyDlg: TWatchPropertyDlg
Caption = 'Watch Properties' Caption = 'Watch Properties'
ClientHeight = 200 ClientHeight = 206
ClientWidth = 420 ClientWidth = 420
Position = poScreenCenter Position = poScreenCenter
HorzScrollBar.Page = 421 HorzScrollBar.Page = 421
VertScrollBar.Page = 201 VertScrollBar.Page = 207
Left = 339 Left = 358
Height = 200 Height = 206
Top = 283 Top = 238
Width = 420 Width = 420
object lblExpression: TLabel object lblExpression: TLabel
Caption = 'Expression:' Caption = 'Expression:'
@ -93,28 +93,31 @@ object WatchPropertyDlg: TWatchPropertyDlg
'Default' 'Default'
'Memory Dump' 'Memory Dump'
) )
ParentColor = True
Left = 15 Left = 15
Height = 70 Height = 78
Top = 90 Top = 90
Width = 390 Width = 390
end end
object btnOK: TButton object btnOK: TButton
ModalResult = 1
Caption = 'OK' Caption = 'OK'
TabOrder = 9 Default = True
ModalResult = 1
OnClick = btnOKClick OnClick = btnOKClick
TabOrder = 9
Left = 170 Left = 170
Height = 25 Height = 25
Top = 170 Top = 176
Width = 75 Width = 75
end end
object btnCancel: TButton object btnCancel: TButton
ModalResult = 2 Cancel = True
Caption = 'Cancel' Caption = 'Cancel'
ModalResult = 2
TabOrder = 10 TabOrder = 10
Left = 250 Left = 250
Height = 25 Height = 25
Top = 170 Top = 176
Width = 75 Width = 75
end end
object btnHelp: TButton object btnHelp: TButton
@ -122,7 +125,7 @@ object WatchPropertyDlg: TWatchPropertyDlg
TabOrder = 11 TabOrder = 11
Left = 330 Left = 330
Height = 25 Height = 25
Top = 170 Top = 176
Width = 75 Width = 75
end end
end end

23
debugger/watchpropertydlg.lrs
View File

@ -2,9 +2,9 @@
LazarusResources.Add('TWatchPropertyDlg','FORMDATA',[ LazarusResources.Add('TWatchPropertyDlg','FORMDATA',[
'TPF0'#17'TWatchPropertyDlg'#16'WatchPropertyDlg'#7'Caption'#6#16'Watch Prope' 'TPF0'#17'TWatchPropertyDlg'#16'WatchPropertyDlg'#7'Caption'#6#16'Watch Prope'
+'rties'#12'ClientHeight'#3#200#0#11'ClientWidth'#3#164#1#8'Position'#7#14'po' +'rties'#12'ClientHeight'#3#206#0#11'ClientWidth'#3#164#1#8'Position'#7#14'po'
+'ScreenCenter'#18'HorzScrollBar.Page'#3#165#1#18'VertScrollBar.Page'#3#201#0 +'ScreenCenter'#18'HorzScrollBar.Page'#3#165#1#18'VertScrollBar.Page'#3#207#0
+#4'Left'#3'S'#1#6'Height'#3#200#0#3'Top'#3#27#1#5'Width'#3#164#1#0#6'TLabel' +#4'Left'#3'f'#1#6'Height'#3#206#0#3'Top'#3#238#0#5'Width'#3#164#1#0#6'TLabel'
+#13'lblExpression'#7'Caption'#6#11'Expression:'#4'Left'#2#16#6'Height'#2#17#3 +#13'lblExpression'#7'Caption'#6#11'Expression:'#4'Left'#2#16#6'Height'#2#17#3
+'Top'#2#14#5'Width'#2'A'#0#0#5'TEdit'#13'txtExpression'#8'TabOrder'#2#2#8'Ta' +'Top'#2#14#5'Width'#2'A'#0#0#5'TEdit'#13'txtExpression'#8'TabOrder'#2#2#8'Ta'
+'bOrder'#2#2#4'Left'#2'i'#6'Height'#2#23#3'Top'#2#8#5'Width'#3','#1#0#0#6'TL' +'bOrder'#2#2#4'Left'#2'i'#6'Height'#2#23#3'Top'#2#8#5'Width'#3','#1#0#0#6'TL'
@ -22,12 +22,13 @@ LazarusResources.Add('TWatchPropertyDlg','FORMDATA',[
+'Height'#2#20#3'Top'#2'A'#5'Width'#2#1#0#0#11'TRadioGroup'#7'rgStyle'#7'Capt' +'Height'#2#20#3'Top'#2'A'#5'Width'#2#1#0#0#11'TRadioGroup'#7'rgStyle'#7'Capt'
+'ion'#6#5'Style'#7'Columns'#2#3#9'ItemIndex'#2#7#13'Items.Strings'#1#6#9'Cha' +'ion'#6#5'Style'#7'Columns'#2#3#9'ItemIndex'#2#7#13'Items.Strings'#1#6#9'Cha'
+'racter'#6#6'String'#6#7'Decimal'#6#11'Hexadecimal'#6#14'Floating Point'#6#7 +'racter'#6#6'String'#6#7'Decimal'#6#11'Hexadecimal'#6#14'Floating Point'#6#7
+'Pointer'#6#16'Record/Structure'#6#7'Default'#6#11'Memory Dump'#0#4'Left'#2 +'Pointer'#6#16'Record/Structure'#6#7'Default'#6#11'Memory Dump'#0#11'ParentC'
+#15#6'Height'#2'F'#3'Top'#2'Z'#5'Width'#3#134#1#0#0#7'TButton'#5'btnOK'#11'M' +'olor'#9#4'Left'#2#15#6'Height'#2'N'#3'Top'#2'Z'#5'Width'#3#134#1#0#0#7'TBut'
+'odalResult'#2#1#7'Caption'#6#2'OK'#8'TabOrder'#2#9#7'OnClick'#7#10'btnOKCli' +'ton'#5'btnOK'#7'Caption'#6#2'OK'#7'Default'#9#11'ModalResult'#2#1#7'OnClick'
+'ck'#4'Left'#3#170#0#6'Height'#2#25#3'Top'#3#170#0#5'Width'#2'K'#0#0#7'TButt' +#7#10'btnOKClick'#8'TabOrder'#2#9#4'Left'#3#170#0#6'Height'#2#25#3'Top'#3#176
+'on'#9'btnCancel'#11'ModalResult'#2#2#7'Caption'#6#6'Cancel'#8'TabOrder'#2#10 +#0#5'Width'#2'K'#0#0#7'TButton'#9'btnCancel'#6'Cancel'#9#7'Caption'#6#6'Canc'
+#4'Left'#3#250#0#6'Height'#2#25#3'Top'#3#170#0#5'Width'#2'K'#0#0#7'TButton'#7 +'el'#11'ModalResult'#2#2#8'TabOrder'#2#10#4'Left'#3#250#0#6'Height'#2#25#3'T'
+'btnHelp'#7'Caption'#6#4'Help'#8'TabOrder'#2#11#4'Left'#3'J'#1#6'Height'#2#25 +'op'#3#176#0#5'Width'#2'K'#0#0#7'TButton'#7'btnHelp'#7'Caption'#6#4'Help'#8
+#3'Top'#3#170#0#5'Width'#2'K'#0#0#0 +'TabOrder'#2#11#4'Left'#3'J'#1#6'Height'#2#25#3'Top'#3#176#0#5'Width'#2'K'#0
+#0#0
]); ]);

30
debugger/watchpropertydlg.pp
View File

@ -40,7 +40,7 @@ interface
uses uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LResources, StdCtrls, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LResources, StdCtrls,
Buttons, Extctrls, Debugger; Buttons, Extctrls, Debugger, BaseDebugManager, Menus;
type type
@ -59,19 +59,10 @@ type
txtDigits: TEdit; txtDigits: TEdit;
procedure btnOKClick(Sender: TObject); procedure btnOKClick(Sender: TObject);
private private
FWatch: TDBGWatch; FWatch: TIDEWatch;
FDebugger: TDebugger;
public public
constructor Create(AOWner: TComponent; const AWatch: TDBGWatch; constructor Create(AOWner: TComponent; const AWatch: TIDEWatch); overload;
const ADebugger: TDebugger); overload;
destructor Destroy; override; destructor Destroy; override;
published
// publish some properties until fpcbug #1888 is fixed
property Top;
property Left;
property Width;
property Height;
property Caption;
end; end;
implementation implementation
@ -82,21 +73,24 @@ procedure TWatchPropertyDlg.btnOKClick(Sender: TObject);
begin begin
if FWatch = nil if FWatch = nil
then begin then begin
if FDebugger = nil then Exit; FWatch := DebugBoss.Watches.Add(txtExpression.Text);
FWatch := FDebugger.Watches.Add(txtExpression.Text); end
else begin
FWatch.Expression := txtExpression.Text;
end; end;
FWatch.Expression := txtExpression.Text;
FWatch.Enabled := chkEnabled.Checked; FWatch.Enabled := chkEnabled.Checked;
end; end;
constructor TWatchPropertyDlg.Create(AOwner: TComponent; const AWatch: TDBGWatch; const ADebugger: TDebugger); constructor TWatchPropertyDlg.Create(AOwner: TComponent; const AWatch: TIDEWatch);
begin begin
FWatch := AWatch; FWatch := AWatch;
FDebugger := ADebugger;
inherited Create(AOwner); inherited Create(AOwner);
if FWatch <> nil if FWatch = nil
then begin then begin
chkEnabled.Checked := True;
end
else begin
txtExpression.Text := FWatch.Expression; txtExpression.Text := FWatch.Expression;
chkEnabled.Checked := FWatch.Enabled; chkEnabled.Checked := FWatch.Enabled;
end; end;

28
ide/basedebugmanager.pas
View File

@ -58,9 +58,12 @@ type
protected protected
FDestroying: boolean; FDestroying: boolean;
FDebugger: TDebugger; FDebugger: TDebugger;
FCallStack: TIDECallStack;
FExceptions: TIDEExceptions; FExceptions: TIDEExceptions;
FSignals: TIDESignals; FSignals: TIDESignals;
FBreakPoints: TIDEBreakPoints; FBreakPoints: TIDEBreakPoints;
FLocals: TIDELocals;
FWatches: TIDEWatches;
FManagerStates: TDebugManagerStates; FManagerStates: TDebugManagerStates;
function FindDebuggerClass(const Astring: String): TDebuggerClass; function FindDebuggerClass(const Astring: String): TDebuggerClass;
function GetState: TDBGState; virtual; abstract; function GetState: TDBGState; virtual; abstract;
@ -73,6 +76,9 @@ type
procedure LoadProjectSpecificInfo(XMLConfig: TXMLConfig); virtual; abstract; procedure LoadProjectSpecificInfo(XMLConfig: TXMLConfig); virtual; abstract;
procedure SaveProjectSpecificInfo(XMLConfig: TXMLConfig); virtual; abstract; procedure SaveProjectSpecificInfo(XMLConfig: TXMLConfig); virtual; abstract;
function DebuggerCount: Integer;
procedure DoRestoreDebuggerMarks(AnUnitInfo: TUnitInfo); virtual; abstract; procedure DoRestoreDebuggerMarks(AnUnitInfo: TUnitInfo); virtual; abstract;
function DoInitDebugger: TModalResult; virtual; abstract; function DoInitDebugger: TModalResult; virtual; abstract;
@ -94,18 +100,22 @@ type
): TModalResult; virtual; abstract; ): TModalResult; virtual; abstract;
function DoDeleteBreakPointAtMark(const ASourceMark: TSourceMark function DoDeleteBreakPointAtMark(const ASourceMark: TSourceMark
): TModalResult; virtual; abstract; ): TModalResult; virtual; abstract;
function DoViewBreakPointProperties(ABreakpoint: TIDEBreakPoint): TModalresult; virtual; abstract;
function DoCreateWatch(const AExpression: string): TModalResult; virtual; abstract; function ShowBreakPointProperties(const ABreakpoint: TIDEBreakPoint): TModalresult; virtual; abstract;
function ShowWatchProperties(const AWatch: TIDEWatch): TModalresult; virtual; abstract;
function DebuggerCount: Integer;
public public
property Commands: TDBGCommands read GetCommands; // All current available commands of the debugger property Commands: TDBGCommands read GetCommands; // All current available commands of the debugger
property Debuggers[const AIndex: Integer]: TDebuggerClass read GetDebuggerClass; property Debuggers[const AIndex: Integer]: TDebuggerClass read GetDebuggerClass;
property Destroying: boolean read FDestroying; property Destroying: boolean read FDestroying;
property State: TDBGState read GetState; // The current state of the debugger property State: TDBGState read GetState; // The current state of the debugger
property BreakPoints: TIDEBreakPoints read FBreakpoints;
property Exceptions: TIDEExceptions read FExceptions; // A list of exceptions we should ignore property BreakPoints: TIDEBreakPoints read FBreakpoints; // A list of breakpoints for the current project
property Signals: TIDESignals read FSignals; // A list of actions for signals we know of property Exceptions: TIDEExceptions read FExceptions; // A list of exceptions we should ignore
property CallStack: TIDECallStack read FCallStack;
property Locals: TIDELocals read FLocals;
property Signals: TIDESignals read FSignals; // A list of actions for signals we know of
property Watches: TIDEWatches read FWatches;
end; end;
procedure RegisterDebugger(const ADebuggerClass: TDebuggerClass); procedure RegisterDebugger(const ADebuggerClass: TDebuggerClass);
@ -159,6 +169,10 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.20 2004/08/26 23:50:04 marc
* Restructured debugger view classes
* Fixed help
Revision 1.19 2004/01/05 15:22:41 mattias Revision 1.19 2004/01/05 15:22:41 mattias
improved debugger: saved log, error handling in initialization, better reinitialize improved debugger: saved log, error handling in initialization, better reinitialize

760
ide/debugmanager.pas
View File

File diff suppressed because it is too large Load Diff

12
ide/mainbase.pas
View File

@ -571,11 +571,13 @@ begin
CreateMenuItem(ParentMI,itmViewMessage,'itmViewMessage',lisMenuViewMessages); CreateMenuItem(ParentMI,itmViewMessage,'itmViewMessage',lisMenuViewMessages);
CreateMenuItem(ParentMI,itmViewSearchResults,'itmViewSearchResults',lisMenuViewSearchResults); CreateMenuItem(ParentMI,itmViewSearchResults,'itmViewSearchResults',lisMenuViewSearchResults);
CreateMenuItem(ParentMI,itmViewDebugWindows,'itmViewDebugWindows',lisMenuDebugWindows,'menu_debugger'); CreateMenuItem(ParentMI,itmViewDebugWindows,'itmViewDebugWindows',lisMenuDebugWindows,'menu_debugger');
CreateMenuItem(ParentMI,itmViewWatches,'itmViewWatches',lisMenuViewWatches,'menu_watches'); begin
CreateMenuItem(ParentMI,itmViewBreakPoints,'itmViewBreakPoints',lisMenuViewBreakPoints,'menu_breakpoints'); CreateMenuItem(itmViewDebugWindows,itmViewWatches,'itmViewWatches',lisMenuViewWatches,'menu_watches');
CreateMenuItem(ParentMI,itmViewLocals,'itmViewLocals',lisMenuViewLocalVariables,''); CreateMenuItem(itmViewDebugWindows,itmViewBreakPoints,'itmViewBreakPoints',lisMenuViewBreakPoints,'menu_breakpoints');
CreateMenuItem(ParentMI,itmViewCallStack,'itmViewCallStack',lisMenuViewCallStack,'menu_callstack'); CreateMenuItem(itmViewDebugWindows,itmViewLocals,'itmViewLocals',lisMenuViewLocalVariables,'');
CreateMenuItem(ParentMI,itmViewDebugOutput,'itmViewDebugOutput',lisMenuViewDebugOutput,'menu_debugoutput'); CreateMenuItem(itmViewDebugWindows,itmViewCallStack,'itmViewCallStack',lisMenuViewCallStack,'menu_callstack');
CreateMenuItem(itmViewDebugWindows,itmViewDebugOutput,'itmViewDebugOutput',lisMenuViewDebugOutput,'menu_debugoutput');
end;
end; end;
end; end;

4
ideintf/helpintf.pas
View File

@ -430,7 +430,7 @@ type
property Items[Index: integer]: THelpDatabase read GetItems; default; property Items[Index: integer]: THelpDatabase read GetItems; default;
public public
function FindDatabase(ID: THelpDatabaseID): THelpDatabase; function FindDatabase(ID: THelpDatabaseID): THelpDatabase;
function GetDatabase(ID: THelpDatabaseID; HelpDB: THelpDatabase; function GetDatabase(ID: THelpDatabaseID; var HelpDB: THelpDatabase;
var HelpResult: TShowHelpResult; var ErrMsg: string): boolean; var HelpResult: TShowHelpResult; var ErrMsg: string): boolean;
function IndexOf(ID: THelpDatabaseID): integer; function IndexOf(ID: THelpDatabaseID): integer;
function CreateUniqueDatabaseID(const WishID: string): THelpDatabaseID; function CreateUniqueDatabaseID(const WishID: string): THelpDatabaseID;
@ -1196,7 +1196,7 @@ begin
Result:=nil; Result:=nil;
end; end;
function THelpDatabases.GetDatabase(ID: THelpDatabaseID; HelpDB: THelpDatabase; function THelpDatabases.GetDatabase(ID: THelpDatabaseID; var HelpDB: THelpDatabase;
var HelpResult: TShowHelpResult; var ErrMsg: string): boolean; var HelpResult: TShowHelpResult; var ErrMsg: string): boolean;
begin begin
HelpDB:=FindDatabase(ID); HelpDB:=FindDatabase(ID);