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

66
debugger/breakpointsdlg.lrs
View File

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

68
debugger/breakpointsdlg.pp
View File

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

70
debugger/callstackdlg.lfm
View File

@ -1,36 +1,52 @@
object CallStackDlg: TCallStackDlg
CAPTION = 'CallStack'
CLIENTHEIGHT = 200
CLIENTWIDTH = 500
VISIBLE = True
HORZSCROLLBAR.PAGE = 501
VERTSCROLLBAR.PAGE = 201
LEFT = 359
HEIGHT = 200
TOP = 126
WIDTH = 500
object lvCallStack: TLISTVIEW
ALIGN = alclient
ANCHORS = [aktop, akleft]
COLUMNS = <
Caption = 'CallStack'
ClientHeight = 200
ClientWidth = 500
Visible = True
HorzScrollBar.Page = 501
VertScrollBar.Page = 201
Left = 843
Height = 200
Top = 202
Width = 500
object lvCallStack: TListView
Align = alClient
Columns = <
item
CAPTION = 'Source'
VISIBLE = True
WIDTH = 150
Caption = 'Source'
ImageIndex = -1
Visible = True
Width = 150
end
item
CAPTION = 'Line'
VISIBLE = True
WIDTH = 50
Caption = 'Line'
ImageIndex = -1
Visible = True
Width = 50
end
item
CAPTION = 'Function'
VISIBLE = True
WIDTH = 300
Caption = 'Function'
ImageIndex = -1
Visible = True
end>
VIEWSTYLE = vsreport
ONDBLCLICK = lvCallStackDBLCLICK
HEIGHT = 200
WIDTH = 500
ViewStyle = vsReport
OnDblClick = lvCallStackDBLCLICK
Height = 200
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

22
debugger/callstackdlg.lrs
View File

@ -1,13 +1,17 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TCallStackDlg','FORMDATA',[
'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'
+#3#245#1#18'VERTSCROLLBAR.PAGE'#3#201#0#4'LEFT'#3'g'#1#6'HEIGHT'#3#200#0#3'T'
+'OP'#2'~'#5'WIDTH'#3#244#1#0#9'TLISTVIEW'#11'lvCallStack'#5'ALIGN'#7#8'alcli'
+'ent'#7'ANCHORS'#11#5'aktop'#6'akleft'#0#7'COLUMNS'#14#1#7'CAPTION'#6#6'Sour'
+'ce'#7'VISIBLE'#9#5'WIDTH'#3#150#0#0#1#7'CAPTION'#6#4'Line'#7'VISIBLE'#9#5'W'
+'IDTH'#2'2'#0#1#7'CAPTION'#6#8'Function'#7'VISIBLE'#9#5'WIDTH'#3','#1#0#0#9
+'VIEWSTYLE'#7#8'vsreport'#10'ONDBLCLICK'#7#19'lvCallStackDBLCLICK'#6'HEIGHT'
+#3#200#0#5'WIDTH'#3#244#1#0#0#0
'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'
+#3#245#1#18'VertScrollBar.Page'#3#201#0#4'Left'#3'K'#3#6'Height'#3#200#0#3'T'
+'op'#3#202#0#5'Width'#3#244#1#0#9'TListView'#11'lvCallStack'#5'Align'#7#8'al'
+'Client'#7'Columns'#14#1#7'Caption'#6#6'Source'#10'ImageIndex'#2#255#7'Visib'
+'le'#9#5'Width'#3#150#0#0#1#7'Caption'#6#4'Line'#10'ImageIndex'#2#255#7'Visi'
+'ble'#9#5'Width'#2'2'#0#1#7'Caption'#6#8'Function'#10'ImageIndex'#2#255#7'Vi'
+'sible'#9#0#0#9'ViewStyle'#7#8'vsReport'#10'OnDblClick'#7#19'lvCallStackDBLC'
+'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
LResources, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Debugger, DebuggerDlg;
ComCtrls, Debugger, DebuggerDlg, Menus;
type
TCallStackDlg = class(TDebuggerDlg)
lvCallStack: TListView;
N1: TMenuItem;
popSetAsCurrent: TMenuItem;
popShow: TMenuItem;
mnuPopup: TPopupMenu;
procedure lvCallStackDBLCLICK(Sender: TObject);
private
procedure popShowClick(Sender: TObject);
private
FCallStack: TIDECallStack;
FCallStackNotification: TIDECallStackNotification;
procedure CallStackChanged(Sender: TObject);
procedure SetCallStack(const AValue: TIDECallStack);
procedure JumpToSource;
protected
procedure SetDebugger(const ADebugger: TDebugger); override;
procedure DoBeginUpdate; override;
procedure DoEndUpdate; override;
public
published
// publish some properties until fpcbug #1888 is fixed
property Top;
property Left;
property Width;
property Height;
property Caption;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property CallStack: TIDECallStack read FCallStack write SetCallStack;
end;
@ -62,7 +69,81 @@ implementation
{ 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
CurItem: TListItem;
Filename: String;
@ -76,66 +157,38 @@ begin
DoJumpToCodePos(Filename,Line,0);
end;
procedure TCallStackDlg.CallStackChanged(Sender: TObject);
var
n, m: Integer;
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;
procedure TCallStackDlg.lvCallStackDBLCLICK(Sender: TObject);
begin
JumpToSource;
end;
procedure TCallStackDlg.SetDebugger(const ADebugger: TDebugger);
procedure TCallStackDlg.popShowClick(Sender: TObject);
begin
if ADebugger <> Debugger
then begin
if Debugger <> nil
JumpToSource;
end;
procedure TCallStackDlg.SetCallStack(const AValue: TIDECallStack);
begin
if FCallStack = AValue then Exit;
BeginUpdate;
try
if FCallStack <> nil
then begin
Debugger.CallStack.OnChange := nil;
FCallStack.RemoveNotification(FCallStackNotification);
end;
inherited;
if Debugger <> nil
FCallStack := AValue;
if FCallStack <> nil
then begin
Debugger.CallStack.OnChange := @CallStackChanged;
CallStackChanged(Debugger.CallStack);
FCallStack.AddNotification(FCallStackNotification);
end;
end
else inherited;
CallStackChanged(FCallStack);
finally
EndUpdate;
end;
end;
initialization
@ -145,6 +198,10 @@ end.
{ =============================================================================
$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
removed unneeded units in uses sections

28
debugger/dbgoutputform.lfm
View File

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

21
debugger/dbgoutputform.lrs
View File

@ -1,9 +1,12 @@
LazarusResources.Add('TDbgOutputForm','FORMDATA',
'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
+#5'WIDTH'#3#144#1#0#5'TMemo'#9'txtOutput'#4'Left'#2#8#3'Top'#2'h'#5'Width'
+#3'X'#2#6'Height'#3#150#0#5'Align'#7#8'alClient'#9'PopupMenu'#7#8'mnuPopu'
+'p'#0#0#10'TPopupMenu'#8'mnuPopup'#4'Left'#3#144#1#3'Top'#2'`'#0#9'TMenuI'
+'tem'#8'popClear'#7'Caption'#6#6'&Clear'#7'OnClick'#7#13'popClearClick'#0
+#0#0#0
);
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TDbgOutputForm','FORMDATA',[
'TPF0'#14'TDbgOutputForm'#13'DbgOutputForm'#7'Caption'#6#12'Debug output'#12
+'ClientHeight'#3#200#0#11'ClientWidth'#3#144#1#7'OnClose'#7#9'FormClose'#8'O'
+'nCreate'#7#10'FormCreate'#18'HorzScrollBar.Page'#3#145#1#18'VertScrollBar.P'
+'age'#3#201#0#4'Left'#2'l'#6'Height'#3#200#0#3'Top'#3#140#0#5'Width'#3#144#1
+#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)
private
FDebugger: TDebugger;
FOnGetFullDebugFilename: TGetFullDebugFilenameEvent;
FOnJumpToCodePos: TJumpToCodePosEvent;
FUpdateCount: integer;
protected
procedure SetDebugger(const ADebugger: TDebugger); virtual;
procedure DoClose(var CloseAction: TCloseAction); override;
procedure DoBeginUpdate; virtual;
procedure DoEndUpdate; virtual;
public
destructor Destroy; override;
procedure BeginUpdate;
procedure EndUpdate;
function UpdateCount: integer;
@ -70,7 +67,6 @@ type
): TModalresult;
function DoGetFullDebugFilename(var Filename: string; AskUser: boolean
): TModalresult;
property Debugger: TDebugger read FDebugger write SetDebugger;
property OnJumpToCodePos: TJumpToCodePosEvent read FOnJumpToCodePos
write FOnJumpToCodePos;
property OnGetFullDebugFilename: TGetFullDebugFilenameEvent
@ -81,27 +77,22 @@ implementation
{ TDebuggerDlg }
destructor TDebuggerDlg.Destroy;
begin
Debugger := nil;
inherited;
end;
procedure TDebuggerDlg.BeginUpdate;
begin
inc(FUpdateCount);
Inc(FUpdateCount);
if FUpdateCount = 1 then DoBeginUpdate;
end;
procedure TDebuggerDlg.EndUpdate;
begin
if FUpdateCount<1 then RaiseException('TDebuggerDlg.EndUpdate');
dec(FUpdateCount);
if FUpdateCount=0 then DoEndUpdate;
if FUpdateCount < 1 then RaiseException('TDebuggerDlg.EndUpdate');
Dec(FUpdateCount);
if FUpdateCount = 0 then DoEndUpdate;
end;
function TDebuggerDlg.UpdateCount: integer;
begin
Result:=FUpdateCount;
Result := FUpdateCount;
end;
function TDebuggerDlg.DoJumpToCodePos(const Filename: string; Line,
@ -122,11 +113,12 @@ begin
Result:=mrCancel;
end;
(*
procedure TDebuggerDlg.SetDebugger(const ADebugger: TDebugger);
begin
FDebugger := ADebugger;
end;
*)
procedure TDebuggerDlg.DoClose(var CloseAction: TCloseAction);
begin
CloseAction := caFree; // we default to free
@ -146,6 +138,10 @@ end;
{ =============================================================================
$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
more Actions TAction, TBasicAction, ...

94
debugger/gdbmidebugger.pp
View File

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

25
debugger/localsdlg.lfm
View File

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

19
debugger/localsdlg.lrs
View File

@ -1,8 +1,11 @@
LazarusResources.Add('TLocalsDlg','FORMDATA',
'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'
+#4'Left'#2#0#3'Top'#2#0#5'Width'#3#228#1#6'Height'#3#200#0#5'Align'#7#8'a'
+'lClient'#7'Columns'#14#1#7'Caption'#6#4'Name'#5'Width'#3#150#0#0#1#7'Cap'
+'tion'#6#5'Value'#5'Width'#3#144#1#0#0#11'MultiSelect'#9#9'ViewStyle'#7#8
+'vsReport'#0#0#0
);
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TLocalsDlg','FORMDATA',[
'TPF0'#10'TLocalsDlg'#9'LocalsDlg'#7'Caption'#6#6'Locals'#12'ClientHeight'#3
+#200#0#11'ClientWidth'#3#244#1#18'HorzScrollBar.Page'#3#245#1#18'VertScrollB'
+'ar.Page'#3#201#0#4'Left'#3'g'#1#6'Height'#3#200#0#3'Top'#2'~'#5'Width'#3#244
+#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
TLocalsDlg = class(TDebuggerDlg)
lvLocals: TListView;
private
private
FLocals: TIDELocals;
FLocalsNotification: TIDELocalsNotification;
procedure LocalsChanged(Sender: TObject);
procedure SetLocals(const AValue: TIDELocals);
protected
procedure SetDebugger(const ADebugger: TDebugger); override;
procedure DoBeginUpdate; override;
procedure DoEndUpdate; override;
public
published
// publish some properties until fpcbug #1888 is fixed
property Top;
property Left;
property Width;
property Height;
property Caption;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Locals: TIDELocals read FLocals write SetLocals;
end;
@ -61,6 +62,21 @@ implementation
{ 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);
var
n, idx: Integer;
@ -69,57 +85,87 @@ var
S: String;
begin
List := TStringList.Create;
//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 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);
try
BeginUpdate;
try
if FLocals = nil
then begin
lvLocals.Items.Clear;
Exit;
end;
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;
procedure TLocalsDlg.SetDebugger(const ADebugger: TDebugger);
procedure TLocalsDlg.SetLocals(const AValue: TIDELocals);
begin
if ADebugger <> Debugger
then begin
if Debugger <> nil
if FLocals = AValue then Exit;
BeginUpdate;
try
if FLocals <> nil
then begin
Debugger.Locals.OnChange := nil;
FLocals.RemoveNotification(FLocalsNotification);
end;
inherited;
if Debugger <> nil
FLocals := AValue;
if FLocals <> nil
then begin
Debugger.Locals.OnChange := @LocalsChanged;
LocalsChanged(Debugger.Locals);
FLocals.AddNotification(FLocalsNotification);
end;
end
else inherited;
LocalsChanged(FLocals);
finally
EndUpdate;
end;
end;
procedure TLocalsDlg.DoBeginUpdate;
begin
lvLocals.BeginUpdate;
end;
procedure TLocalsDlg.DoEndUpdate;
begin
lvLocals.EndUpdate;
end;
initialization
@ -129,6 +175,10 @@ end.
{ =============================================================================
$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
removed unneeded units in uses sections

119
debugger/watchesdlg.pp
View File

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

27
debugger/watchpropertydlg.lfm
View File

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

23
debugger/watchpropertydlg.lrs
View File

@ -2,9 +2,9 @@
LazarusResources.Add('TWatchPropertyDlg','FORMDATA',[
'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'
+'ScreenCenter'#18'HorzScrollBar.Page'#3#165#1#18'VertScrollBar.Page'#3#201#0
+#4'Left'#3'S'#1#6'Height'#3#200#0#3'Top'#3#27#1#5'Width'#3#164#1#0#6'TLabel'
+'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#207#0
+#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
+'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'
@ -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'
+'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
+'Pointer'#6#16'Record/Structure'#6#7'Default'#6#11'Memory Dump'#0#4'Left'#2
+#15#6'Height'#2'F'#3'Top'#2'Z'#5'Width'#3#134#1#0#0#7'TButton'#5'btnOK'#11'M'
+'odalResult'#2#1#7'Caption'#6#2'OK'#8'TabOrder'#2#9#7'OnClick'#7#10'btnOKCli'
+'ck'#4'Left'#3#170#0#6'Height'#2#25#3'Top'#3#170#0#5'Width'#2'K'#0#0#7'TButt'
+'on'#9'btnCancel'#11'ModalResult'#2#2#7'Caption'#6#6'Cancel'#8'TabOrder'#2#10
+#4'Left'#3#250#0#6'Height'#2#25#3'Top'#3#170#0#5'Width'#2'K'#0#0#7'TButton'#7
+'btnHelp'#7'Caption'#6#4'Help'#8'TabOrder'#2#11#4'Left'#3'J'#1#6'Height'#2#25
+#3'Top'#3#170#0#5'Width'#2'K'#0#0#0
+'Pointer'#6#16'Record/Structure'#6#7'Default'#6#11'Memory Dump'#0#11'ParentC'
+'olor'#9#4'Left'#2#15#6'Height'#2'N'#3'Top'#2'Z'#5'Width'#3#134#1#0#0#7'TBut'
+'ton'#5'btnOK'#7'Caption'#6#2'OK'#7'Default'#9#11'ModalResult'#2#1#7'OnClick'
+#7#10'btnOKClick'#8'TabOrder'#2#9#4'Left'#3#170#0#6'Height'#2#25#3'Top'#3#176
+#0#5'Width'#2'K'#0#0#7'TButton'#9'btnCancel'#6'Cancel'#9#7'Caption'#6#6'Canc'
+'el'#11'ModalResult'#2#2#8'TabOrder'#2#10#4'Left'#3#250#0#6'Height'#2#25#3'T'
+'op'#3#176#0#5'Width'#2'K'#0#0#7'TButton'#7'btnHelp'#7'Caption'#6#4'Help'#8
+'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
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LResources, StdCtrls,
Buttons, Extctrls, Debugger;
Buttons, Extctrls, Debugger, BaseDebugManager, Menus;
type
@ -59,19 +59,10 @@ type
txtDigits: TEdit;
procedure btnOKClick(Sender: TObject);
private
FWatch: TDBGWatch;
FDebugger: TDebugger;
FWatch: TIDEWatch;
public
constructor Create(AOWner: TComponent; const AWatch: TDBGWatch;
const ADebugger: TDebugger); overload;
constructor Create(AOWner: TComponent; const AWatch: TIDEWatch); overload;
destructor Destroy; override;
published
// publish some properties until fpcbug #1888 is fixed
property Top;
property Left;
property Width;
property Height;
property Caption;
end;
implementation
@ -82,21 +73,24 @@ procedure TWatchPropertyDlg.btnOKClick(Sender: TObject);
begin
if FWatch = nil
then begin
if FDebugger = nil then Exit;
FWatch := FDebugger.Watches.Add(txtExpression.Text);
FWatch := DebugBoss.Watches.Add(txtExpression.Text);
end
else begin
FWatch.Expression := txtExpression.Text;
end;
FWatch.Expression := txtExpression.Text;
FWatch.Enabled := chkEnabled.Checked;
end;
constructor TWatchPropertyDlg.Create(AOwner: TComponent; const AWatch: TDBGWatch; const ADebugger: TDebugger);
constructor TWatchPropertyDlg.Create(AOwner: TComponent; const AWatch: TIDEWatch);
begin
FWatch := AWatch;
FDebugger := ADebugger;
inherited Create(AOwner);
if FWatch <> nil
if FWatch = nil
then begin
chkEnabled.Checked := True;
end
else begin
txtExpression.Text := FWatch.Expression;
chkEnabled.Checked := FWatch.Enabled;
end;

28
ide/basedebugmanager.pas
View File

@ -58,9 +58,12 @@ type
protected
FDestroying: boolean;
FDebugger: TDebugger;
FCallStack: TIDECallStack;
FExceptions: TIDEExceptions;
FSignals: TIDESignals;
FBreakPoints: TIDEBreakPoints;
FLocals: TIDELocals;
FWatches: TIDEWatches;
FManagerStates: TDebugManagerStates;
function FindDebuggerClass(const Astring: String): TDebuggerClass;
function GetState: TDBGState; virtual; abstract;
@ -73,6 +76,9 @@ type
procedure LoadProjectSpecificInfo(XMLConfig: TXMLConfig); virtual; abstract;
procedure SaveProjectSpecificInfo(XMLConfig: TXMLConfig); virtual; abstract;
function DebuggerCount: Integer;
procedure DoRestoreDebuggerMarks(AnUnitInfo: TUnitInfo); virtual; abstract;
function DoInitDebugger: TModalResult; virtual; abstract;
@ -94,18 +100,22 @@ type
): TModalResult; virtual; abstract;
function DoDeleteBreakPointAtMark(const ASourceMark: TSourceMark
): TModalResult; virtual; abstract;
function DoViewBreakPointProperties(ABreakpoint: TIDEBreakPoint): TModalresult; virtual; abstract;
function DoCreateWatch(const AExpression: string): TModalResult; virtual; abstract;
function DebuggerCount: Integer;
function ShowBreakPointProperties(const ABreakpoint: TIDEBreakPoint): TModalresult; virtual; abstract;
function ShowWatchProperties(const AWatch: TIDEWatch): TModalresult; virtual; abstract;
public
property Commands: TDBGCommands read GetCommands; // All current available commands of the debugger
property Debuggers[const AIndex: Integer]: TDebuggerClass read GetDebuggerClass;
property Destroying: boolean read FDestroying;
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 Signals: TIDESignals read FSignals; // A list of actions for signals we know of
property BreakPoints: TIDEBreakPoints read FBreakpoints; // A list of breakpoints for the current project
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;
procedure RegisterDebugger(const ADebuggerClass: TDebuggerClass);
@ -159,6 +169,10 @@ end.
{ =============================================================================
$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
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,itmViewSearchResults,'itmViewSearchResults',lisMenuViewSearchResults);
CreateMenuItem(ParentMI,itmViewDebugWindows,'itmViewDebugWindows',lisMenuDebugWindows,'menu_debugger');
CreateMenuItem(ParentMI,itmViewWatches,'itmViewWatches',lisMenuViewWatches,'menu_watches');
CreateMenuItem(ParentMI,itmViewBreakPoints,'itmViewBreakPoints',lisMenuViewBreakPoints,'menu_breakpoints');
CreateMenuItem(ParentMI,itmViewLocals,'itmViewLocals',lisMenuViewLocalVariables,'');
CreateMenuItem(ParentMI,itmViewCallStack,'itmViewCallStack',lisMenuViewCallStack,'menu_callstack');
CreateMenuItem(ParentMI,itmViewDebugOutput,'itmViewDebugOutput',lisMenuViewDebugOutput,'menu_debugoutput');
begin
CreateMenuItem(itmViewDebugWindows,itmViewWatches,'itmViewWatches',lisMenuViewWatches,'menu_watches');
CreateMenuItem(itmViewDebugWindows,itmViewBreakPoints,'itmViewBreakPoints',lisMenuViewBreakPoints,'menu_breakpoints');
CreateMenuItem(itmViewDebugWindows,itmViewLocals,'itmViewLocals',lisMenuViewLocalVariables,'');
CreateMenuItem(itmViewDebugWindows,itmViewCallStack,'itmViewCallStack',lisMenuViewCallStack,'menu_callstack');
CreateMenuItem(itmViewDebugWindows,itmViewDebugOutput,'itmViewDebugOutput',lisMenuViewDebugOutput,'menu_debugoutput');
end;
end;
end;

4
ideintf/helpintf.pas
View File

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