diff --git a/debugger/breakpointsdlg.lfm b/debugger/breakpointsdlg.lfm index 32b369c91c..b0fc9f8c73 100644 --- a/debugger/breakpointsdlg.lfm +++ b/debugger/breakpointsdlg.lfm @@ -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 diff --git a/debugger/breakpointsdlg.lrs b/debugger/breakpointsdlg.lrs index 99d88c441d..4ac0723691 100644 --- a/debugger/breakpointsdlg.lrs +++ b/debugger/breakpointsdlg.lrs @@ -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 ]); diff --git a/debugger/breakpointsdlg.pp b/debugger/breakpointsdlg.pp index 339c56f71d..13f9118fbb 100644 --- a/debugger/breakpointsdlg.pp +++ b/debugger/breakpointsdlg.pp @@ -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 diff --git a/debugger/callstackdlg.lfm b/debugger/callstackdlg.lfm index 56e9a56d94..d7cdefec4c 100644 --- a/debugger/callstackdlg.lfm +++ b/debugger/callstackdlg.lfm @@ -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 diff --git a/debugger/callstackdlg.lrs b/debugger/callstackdlg.lrs index 4f518869ab..d3d72101aa 100644 --- a/debugger/callstackdlg.lrs +++ b/debugger/callstackdlg.lrs @@ -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 ]); diff --git a/debugger/callstackdlg.pp b/debugger/callstackdlg.pp index 18a331b824..6ee58e31a3 100644 --- a/debugger/callstackdlg.pp +++ b/debugger/callstackdlg.pp @@ -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 diff --git a/debugger/dbgoutputform.lfm b/debugger/dbgoutputform.lfm index 534287395e..cf36e6d42e 100644 --- a/debugger/dbgoutputform.lfm +++ b/debugger/dbgoutputform.lfm @@ -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 diff --git a/debugger/dbgoutputform.lrs b/debugger/dbgoutputform.lrs index 1a2d50f39f..40a303497b 100644 --- a/debugger/dbgoutputform.lrs +++ b/debugger/dbgoutputform.lrs @@ -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 +]); diff --git a/debugger/debugger.pp b/debugger/debugger.pp index 74d04bcc01..a2a9830d1c 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -138,7 +138,8 @@ type TIDEBreakPoints = class; TIDEBreakPointGroup = class; TIDEBreakPointGroups = class; - TDBGWatches = class; + TIDEWatches = class; + TIDELocals = class; TDebugger = class; TOnSaveFilenameToConfig = procedure(var Filename: string) of object; @@ -186,12 +187,14 @@ type procedure SetLocation(const ASource: String; const ALine: Integer); virtual; procedure SetValid(const AValue: TValidState); + protected // virtual properties function GetEnabled: Boolean; virtual; function GetExpression: String; virtual; function GetHitCount: Integer; virtual; function GetLine: Integer; virtual; function GetSource: String; virtual; + function GetSourceLine: Integer; virtual; function GetValid: TValidState; virtual; procedure SetEnabled(const AValue: Boolean); virtual; @@ -199,13 +202,15 @@ type procedure SetInitialEnabled(const AValue: Boolean); virtual; public constructor Create(ACollection: TCollection); override; - function GetSourceLine: integer; virtual; property Enabled: Boolean read GetEnabled write SetEnabled; property Expression: String read GetExpression write SetExpression; property HitCount: Integer read GetHitCount; property InitialEnabled: Boolean read FInitialEnabled write SetInitialEnabled; property Line: Integer read GetLine; property Source: String read GetSource; + property SourceLine: Integer read GetSourceLine; // the current line of this breakpoint in the source + // this may differ from th location set + // todo: move to manager ? property Valid: TValidState read GetValid; end; TBaseBreakPointClass = class of TBaseBreakPoint; @@ -227,6 +232,7 @@ type const AGroupList: TList); procedure ClearGroupList(const AGroupList: TList); procedure ClearAllGroupLists; + protected // virtual properties function GetActions: TIDEBreakPointActions; virtual; function GetGroup: TIDEBreakPointGroup; virtual; @@ -242,7 +248,7 @@ type procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; const OnLoadFilename: TOnLoadFilenameFromConfig; const OnGetGroup: TOnGetGroupByName); virtual; - procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; + procedure SaveToXMLConfig(const AConfig: TXMLConfig; const APath: string; const OnSaveFilename: TOnSaveFilenameToConfig); virtual; public property Actions: TIDEBreakPointActions read GetActions write SetActions; @@ -298,11 +304,11 @@ type TIDEBreakPoints = class(TBaseBreakPoints) private FNotificationList: TList; - procedure NotifyRemove(const ABreakpoint: TIDEBreakPoint); // called by breakpoint when destructed - procedure NotifyAdd(const ABreakPoint: TIDEBreakPoint); // called when a breakpoint is added function GetItem(const AnIndex: Integer): TIDEBreakPoint; procedure SetItem(const AnIndex: Integer; const AValue: TIDEBreakPoint); protected + procedure NotifyAdd(const ABreakPoint: TIDEBreakPoint); virtual; // called when a breakpoint is added + procedure NotifyRemove(const ABreakpoint: TIDEBreakPoint); virtual; // called by breakpoint when destructed procedure Update(Item: TCollectionItem); override; public constructor Create(const ABreakPointClass: TIDEBreakPointClass); @@ -328,7 +334,7 @@ type function GetItem(const AnIndex: Integer): TDBGBreakPoint; procedure SetItem(const AnIndex: Integer; const AValue: TDBGBreakPoint); protected - procedure DoDebuggerStateChange; virtual; + procedure DoStateChange; virtual; procedure InitTargetStart; virtual; property Debugger: TDebugger read FDebugger; public @@ -414,89 +420,139 @@ type (******************************************************************************) (******************************************************************************) - { TDBGWatch } + { TBaseWatch } - TDBGWatch = class(TCollectionItem) + TBaseWatch = class(TDelayedUdateItem) private FEnabled: Boolean; FExpression: String; - FInitialEnabled: Boolean; FValid: TValidState; - function GetDebugger: TDebugger; - procedure SetEnabled(const AValue: Boolean); - procedure SetExpression(const AValue: String); - procedure SetInitialEnabled(const AValue: Boolean); + function GetEnabled: Boolean; protected procedure AssignTo(Dest: TPersistent); override; procedure DoEnableChange; virtual; procedure DoExpressionChange; virtual; - procedure DoStateChange; virtual; - function GetValue: String; virtual; - function GetValid: TValidState; virtual; procedure SetValid(const AValue: TValidState); - property Debugger: TDebugger read GetDebugger; + + protected + // virtual properties + function GetExpression: String; virtual; + function GetValid: TValidState; virtual; + function GetValue: String; virtual; + + procedure SetEnabled(const AValue: Boolean); virtual; + procedure SetExpression(const AValue: String); virtual; public constructor Create(ACollection: TCollection); override; - procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; - const Path: string); virtual; - procedure SaveToXMLConfig(XMLConfig: TXMLConfig; - const Path: string); virtual; public - property Enabled: Boolean read FEnabled write SetEnabled; - property InitialEnabled: Boolean read FInitialEnabled write SetInitialEnabled; - property Expression: String read FExpression write SetExpression; + property Enabled: Boolean read GetEnabled write SetEnabled; + property Expression: String read GetExpression write SetExpression; property Valid: TValidState read GetValid; property Value: String read GetValue; end; + TBaseWatchClass = class of TBaseWatch; + + TIDEWatch = class(TBaseWatch) + private + protected + public + constructor Create(ACollection: TCollection); override; + destructor Destroy; override; + procedure LoadFromXMLConfig(const AConfig: TXMLConfig; + const APath: string); virtual; + procedure SaveToXMLConfig(const AConfig: TXMLConfig; + const APath: string); virtual; + end; + TIDEWatchClass = class of TIDEWatch; + TDBGWatch = class(TBaseWatch) + private + FSlave: TBaseWatch; + function GetDebugger: TDebugger; + protected + procedure DoChanged; override; + procedure DoStateChange; virtual; + procedure InitTargetStart; virtual; + property Debugger: TDebugger read GetDebugger; + public + constructor Create(ACollection: TCollection); override; + destructor Destroy; override; + property Slave: TBaseWatch read FSlave write FSlave; + end; TDBGWatchClass = class of TDBGWatch; - { TDBGWatches } + { TBaseWatches } - TDBGWatchesEvent = - procedure(const ASender: TDBGWatches; const AWatch: TDBGWatch) of object; + TIDEWatchesEvent = + procedure(const ASender: TIDEWatches; const AWatch: TIDEWatch) of object; - TDBGWatchesNotification = class(TDebuggerNotification) + TIDEWatchesNotification = class(TDebuggerNotification) private - FOnAdd: TDBGWatchesEvent; - FOnUpdate: TDBGWatchesEvent;//Item will be nil in case all items need to be updated - FOnRemove: TDBGWatchesEvent; + FOnAdd: TIDEWatchesEvent; + FOnUpdate: TIDEWatchesEvent;//Item will be nil in case all items need to be updated + FOnRemove: TIDEWatchesEvent; public - property OnAdd: TDBGWatchesEvent read FOnAdd write FOnAdd; - property OnUpdate: TDBGWatchesEvent read FOnUpdate write FOnUpdate; - property OnRemove: TDBGWatchesEvent read FOnRemove write FonRemove; + property OnAdd: TIDEWatchesEvent read FOnAdd write FOnAdd; + property OnUpdate: TIDEWatchesEvent read FOnUpdate write FOnUpdate; + property OnRemove: TIDEWatchesEvent read FOnRemove write FonRemove; end; - TDBGWatches = class(TCollection) + TBaseWatches = class(TCollection) + private + protected + public + constructor Create(const AWatchClass: TBaseWatchClass); + function Add(const AExpression: String): TBaseWatch; + function Find(const AExpression: String): TBaseWatch; + // no items property needed, it is "overridden" anyhow + end; + + TIDEWatches = class(TBaseWatches) + private + FNotificationList: TList; + function GetItem(const AnIndex: Integer): TIDEWatch; + procedure SetItem(const AnIndex: Integer; const AValue: TIDEWatch); + protected + procedure NotifyAdd(const AWatch: TIDEWatch); virtual; // called when a watch is added + procedure NotifyRemove(const AWatch: TIDEWatch); virtual; // called by watch when destructed + procedure Update(Item: TCollectionItem); override; + public + constructor Create(const AWatchClass: TIDEWatchClass); + destructor Destroy; override; + // Watch + function Add(const AExpression: String): TIDEWatch; + function Find(const AExpression: String): TIDEWatch; + // IDE + procedure AddNotification(const ANotification: TIDEWatchesNotification); + procedure RemoveNotification(const ANotification: TIDEWatchesNotification); + procedure LoadFromXMLConfig(const AConfig: TXMLConfig; const APath: string); virtual; + procedure SaveToXMLConfig(const AConfig: TXMLConfig; const APath: string); virtual; + public + property Items[const AnIndex: Integer]: TIDEWatch read GetItem + write SetItem; default; + end; + + TDBGWatches = class(TBaseWatches) private FDebugger: TDebugger; // reference to our debugger - FNotificationList: TList; function GetItem(const AnIndex: Integer): TDBGWatch; procedure SetItem(const AnIndex: Integer; const AValue: TDBGWatch); - procedure Removed(const AWatch: TDBGWatch); // called by watch when destructed protected procedure DoStateChange; virtual; - procedure Update(Item: TCollectionItem); override; + procedure InitTargetStart; virtual; + property Debugger: TDebugger read FDebugger; public constructor Create(const ADebugger: TDebugger; const AWatchClass: TDBGWatchClass); - destructor Destroy; override; + // Watch function Add(const AExpression: String): TDBGWatch; function Find(const AExpression: String): TDBGWatch; - procedure AddNotification(const ANotification: TDBGWatchesNotification); - procedure RemoveNotification(const ANotification: TDBGWatchesNotification); - procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; - const Path: string); virtual; - procedure SaveToXMLConfig(XMLConfig: TXMLConfig; - const Path: string); virtual; - procedure InitTargetStart; virtual; public property Items[const AnIndex: Integer]: TDBGWatch read GetItem write SetItem; default; end; - (******************************************************************************) (******************************************************************************) (** **) @@ -505,25 +561,57 @@ type (******************************************************************************) (******************************************************************************) + { TBaseLocals } + + TBaseLocals = class(TObject) + private + protected + function GetName(const AnIndex: Integer): String; virtual; + function GetValue(const AnIndex: Integer): String; virtual; + public + constructor Create; + function Count: Integer; virtual; + public + property Names[const AnIndex: Integer]: String read GetName; + property Values[const AnIndex: Integer]: String read GetValue; + end; + + { TIDELocals } + + TIDELocalsNotification = class(TDebuggerNotification) + private + FOnChange: TNotifyEvent; + public + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + + TIDELocals = class(TBaseLocals) + private + FNotificationList: TList; + protected + procedure NotifyChange; + public + constructor Create; + destructor Destroy; override; + procedure AddNotification(const ANotification: TIDELocalsNotification); + procedure RemoveNotification(const ANotification: TIDELocalsNotification); + end; + { TDBGLocals } - TDBGLocals = class(TObject) + TDBGLocals = class(TBaseLocals) private FDebugger: TDebugger; // reference to our debugger FOnChange: TNotifyEvent; protected procedure DoChange; procedure DoStateChange; virtual; - function GetName(const AnIndex: Integer): String; virtual; - function GetValue(const AnIndex: Integer): String; virtual; + function GetCount: Integer; virtual; property Debugger: TDebugger read FDebugger; public + function Count: Integer; override; constructor Create(const ADebugger: TDebugger); - function Count: Integer; virtual; - public - property Names[const AnIndex: Integer]: String read GetName; property OnChange: TNotifyEvent read FOnChange write FOnChange; - property Values[const AnIndex: Integer]: String read GetValue; end; @@ -533,11 +621,16 @@ type (** C A L L S T A C K **) (** **) (******************************************************************************) +(******************************************************************************) +(* The entries for the callstack are created on demand. This way when the *) +(* first entry is needed, it isn't required to create the whole stack *) +(* *) +(* TCallStackEntry needs to stay a readonly object so its data can be shared *) (******************************************************************************) - { TDBGCallStackEntry } + { TCallStackEntry } - TDBGCallStackEntry = class(TObject) + TCallStackEntry = class(TObject) private FIndex: Integer; FAdress: Pointer; @@ -553,6 +646,7 @@ type constructor Create(const AIndex:Integer; const AnAdress: Pointer; const AnArguments: TStrings; const AFunctionName: String; const ASource: String; const ALine: Integer); + constructor CreateCopy(const ASource: TCallStackEntry); destructor Destroy; override; property Adress: Pointer read FAdress; property ArgumentCount: Integer read GetArgumentCount; @@ -563,31 +657,67 @@ type property Source: String read FSource; end; - - { TDBGCallStack } + { TBaseCallStack } - TDBGCallStack = class(TObject) + TBaseCallStack = class(TObject) private - FDebugger: TDebugger; // reference to our debugger FEntries: TList; // list of created entries - FOldState: TDBGState; // records the previous debugger state - FOnChange: TNotifyEvent; - procedure Clear; - function GetStackEntry(const AIndex: Integer): TDBGCallStackEntry; + FEntryIndex: TList; // index to created entries + FCount: Integer; + function GetEntry(const AIndex: Integer): TCallStackEntry; protected - procedure DoChange; - function CreateStackEntry(const AIndex: Integer): TDBGCallStackEntry; virtual; - procedure DoStateChange; virtual; - function GetCount: Integer; virtual; - property Debugger: TDebugger read FDebugger; - public + function CheckCount: Boolean; virtual; + procedure Clear; + function CreateStackEntry(const AIndex: Integer): TCallStackEntry; virtual; + function GetStackEntry(const AIndex: Integer): TCallStackEntry; virtual; + procedure SetCount(const ACount: Integer); virtual; + public function Count: Integer; - constructor Create(const ADebugger: TDebugger); + constructor Create; destructor Destroy; override; - property Entries[const AIndex: Integer]: TDBGCallStackEntry read GetStackEntry; - property OnChange: TNotifyEvent read FOnChange write FOnChange; + property Entries[const AIndex: Integer]: TCallStackEntry read GetEntry; end; + { TIDECallStack } + + TIDECallStackNotification = class(TDebuggerNotification) + private + FOnChange: TNotifyEvent; + public + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + + TIDECallStack = class(TBaseCallStack) + private + FNotificationList: TList; + protected + procedure NotifyChange; + public + constructor Create; + destructor Destroy; override; + procedure AddNotification(const ANotification: TIDECallStackNotification); + procedure RemoveNotification(const ANotification: TIDECallStackNotification); + end; + + { TDBGCallStack } + + TDBGCallStack = class(TBaseCallStack) + private + FDebugger: TDebugger; // reference to our debugger + FOldState: TDBGState; + FOnChange: TNotifyEvent; + FOnClear: TNotifyEvent; + protected + function CheckCount: Boolean; override; + procedure DoStateChange; virtual; + property Debugger: TDebugger read FDebugger; + public + constructor Create(const ADebugger: TDebugger); + public + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnClear: TNotifyEvent read FOnClear write FOnClear; + end; + (******************************************************************************) (******************************************************************************) (** **) @@ -1376,7 +1506,7 @@ begin then begin OldState := FState; FState := AValue; - FBreakpoints.DoDebuggerStateChange; + FBreakpoints.DoStateChange; FLocals.DoStateChange; FCallStack.DoStateChange; FWatches.DoStateChange; @@ -1420,13 +1550,6 @@ end; TBaseBreakPoint =========================================================================== } -procedure TBaseBreakPoint.SetInitialEnabled(const AValue: Boolean); -begin - if FInitialEnabled=AValue then exit; - //writeln('TBaseBreakPoint.SetInitialEnabled A Self=',HexStr(Cardinal(Self),8),' ',ClassName,' Line=',Line,' AValue=',AValue); - FInitialEnabled:=AValue; -end; - procedure TBaseBreakPoint.AssignTo(Dest: TPersistent); var DestBreakPoint: TBaseBreakPoint; @@ -1438,7 +1561,6 @@ begin DestBreakPoint.SetLocation(FSource, FLine); DestBreakPoint.SetExpression(FExpression); DestBreakPoint.SetEnabled(FEnabled); - //writeln('TBaseBreakPoint.AssignTo A ',Line,' Enabled=',Enabled,' InitialEnabled=',InitialEnabled); DestBreakPoint.InitialEnabled := FInitialEnabled; end else inherited; @@ -1471,11 +1593,6 @@ begin SetHitCount(ACount); end; -function TBaseBreakPoint.GetSourceLine: integer; -begin - Result:=Line; -end; - function TBaseBreakPoint.GetEnabled: Boolean; begin Result := FEnabled; @@ -1501,6 +1618,11 @@ begin Result := FSource; end; +function TBaseBreakPoint.GetSourceLine: Integer; +begin + Result := Line; +end; + function TBaseBreakPoint.GetValid: TValidState; begin Result := FValid; @@ -1533,6 +1655,12 @@ begin end; end; +procedure TBaseBreakPoint.SetInitialEnabled(const AValue: Boolean); +begin + if FInitialEnabled=AValue then exit; + FInitialEnabled:=AValue; +end; + procedure TBaseBreakPoint.SetLocation (const ASource: String; const ALine: Integer ); begin if (FSource = ASource) and (FLine = ALine) then exit; @@ -1661,16 +1789,6 @@ begin Result := FGroup; end; -procedure TIDEBreakPoint.RemoveDisableGroup(const AGroup: TIDEBreakPointGroup); -begin - RemoveFromGroupList(AGroup,FDisableGroupList); -end; - -procedure TIDEBreakPoint.RemoveEnableGroup(const AGroup: TIDEBreakPointGroup); -begin - RemoveFromGroupList(AGroup,FEnableGroupList); -end; - procedure TIDEBreakPoint.LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; const OnLoadFilename: TOnLoadFilenameFromConfig; const OnGetGroup: TOnGetGroupByName); @@ -1728,19 +1846,38 @@ begin end; end; -procedure TIDEBreakPoint.SaveToXMLConfig(XMLConfig: TXMLConfig; - const Path: string; const OnSaveFilename: TOnSaveFilenameToConfig); +procedure TIDEBreakPoint.RemoveDisableGroup(const AGroup: TIDEBreakPointGroup); +begin + RemoveFromGroupList(AGroup,FDisableGroupList); +end; + +procedure TIDEBreakPoint.RemoveEnableGroup(const AGroup: TIDEBreakPointGroup); +begin + RemoveFromGroupList(AGroup,FEnableGroupList); +end; + +procedure TIDEBreakPoint.RemoveFromGroupList(const AGroup: TIDEBreakPointGroup; + const AGroupList: TList); +begin + if (AGroup = nil) then Exit; + AGroupList.Remove(AGroup); + AGroup.RemoveReference(Self); +end; + +procedure TIDEBreakPoint.SaveToXMLConfig(const AConfig: TXMLConfig; + const APath: string; const OnSaveFilename: TOnSaveFilenameToConfig); - procedure SaveGroupList(GroupList: TList; const ListPath: string); + procedure SaveGroupList(const AList: TList; const AListPath: string); var i: Integer; CurGroup: TIDEBreakPointGroup; begin - XMLConfig.SetDeleteValue(ListPath+'Count',GroupList.Count,0); - for i:=0 to GroupList.Count-1 do begin - CurGroup:=TIDEBreakPointGroup(GroupList[i]); - XMLConfig.SetDeleteValue(ListPath+'Group'+IntToStr(i+1)+'/Name', - CurGroup.Name,''); + AConfig.SetDeleteValue(AListPath + 'Count', AList.Count,0); + for i := 0 to AList.Count - 1 do + begin + CurGroup := TIDEBreakPointGroup(AList[i]); + AConfig.SetDeleteValue(Format('$%sGroup%d/Name', [AListPath, i+1]), + CurGroup.Name, ''); end; end; @@ -1748,20 +1885,26 @@ var Filename: String; CurAction: TIDEBreakPointAction; begin - if Group<>nil then - XMLConfig.SetDeleteValue(Path+'Group/Name',Group.Name,''); - XMLConfig.SetDeleteValue(Path+'Expression/Value',Expression,''); - Filename:=Source; + if Group <> nil + then AConfig.SetDeleteValue(APath+'Group/Name',Group.Name,''); + + AConfig.SetDeleteValue(APath+'Expression/Value',Expression,''); + + Filename := Source; if Assigned(OnSaveFilename) then OnSaveFilename(Filename); - XMLConfig.SetDeleteValue(Path+'Source/Value',Filename,''); - XMLConfig.SetDeleteValue(Path+'InitialEnabled/Value',InitialEnabled,true); - XMLConfig.SetDeleteValue(Path+'Line/Value',Line,-1); - for CurAction:=Low(TIDEBreakPointAction) to High(TIDEBreakPointAction) do - XMLConfig.SetDeleteValue( - Path+'Actions/'+DBGBreakPointActionNames[CurAction], - CurAction in Actions,CurAction in [bpaStop]); - SaveGroupList(FDisableGroupList,Path+'DisableGroups/'); - SaveGroupList(FEnableGroupList,Path+'EnableGroups/'); + + AConfig.SetDeleteValue(APath+'Source/Value',Filename,''); + AConfig.SetDeleteValue(APath+'InitialEnabled/Value',InitialEnabled,true); + AConfig.SetDeleteValue(APath+'Line/Value',Line,-1); + + for CurAction := Low(TIDEBreakPointAction) to High(TIDEBreakPointAction) do + begin + AConfig.SetDeleteValue( + APath+'Actions/'+DBGBreakPointActionNames[CurAction], + CurAction in Actions, CurAction in [bpaStop]); + end; + SaveGroupList(FDisableGroupList, APath + 'DisableGroups/'); + SaveGroupList(FEnableGroupList, APath + 'EnableGroups/'); end; procedure TIDEBreakPoint.SetActions(const AValue: TIDEBreakPointActions); @@ -1795,14 +1938,6 @@ begin end; end; -procedure TIDEBreakPoint.RemoveFromGroupList(const AGroup: TIDEBreakPointGroup; - const AGroupList: TList); -begin - if (AGroup = nil) then Exit; - AGroupList.Remove(AGroup); - AGroup.RemoveReference(Self); -end; - (* procedure TIDEBreakPoint.CopyGroupList(SrcGroupList, DestGroupList: TList; DestGroups: TIDEBreakPointGroups); @@ -2049,7 +2184,7 @@ begin inherited Create(ABreakPointClass); end; -procedure TDBGBreakPoints.DoDebuggerStateChange; +procedure TDBGBreakPoints.DoStateChange; var n: Integer; begin @@ -2352,77 +2487,67 @@ end; (******************************************************************************) { =========================================================================== } -{ TDBGWatch } +{ TBaseWatch } { =========================================================================== } -procedure TDBGWatch.AssignTo(Dest: TPersistent); +procedure TBaseWatch.AssignTo(Dest: TPersistent); begin - if Dest is TDBGWatch + if Dest is TBaseWatch then begin - TDBGWatch(Dest).SetExpression(FExpression); - TDBGWatch(Dest).SetEnabled(FEnabled); + TBaseWatch(Dest).SetExpression(FExpression); + TBaseWatch(Dest).SetEnabled(FEnabled); end else inherited; end; -constructor TDBGWatch.Create(ACollection: TCollection); +constructor TBaseWatch.Create(ACollection: TCollection); begin - inherited Create(ACollection); FEnabled := False; + FValid := vsUnknown; + inherited Create(ACollection); end; -procedure TDBGWatch.LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string - ); + +procedure TBaseWatch.DoEnableChange; begin - Expression:=XMLConfig.GetValue(Path+'Expression/Value',''); - InitialEnabled:=XMLConfig.GetValue(Path+'InitialEnabled/Value',true); - FEnabled:=FInitialEnabled; + Changed; end; -procedure TDBGWatch.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string); +procedure TBaseWatch.DoExpressionChange; begin - XMLConfig.SetDeleteValue(Path+'Expression/Value',Expression,''); - XMLConfig.SetDeleteValue(Path+'InitialEnabled/Value',InitialEnabled,true); + Changed; end; -procedure TDBGWatch.DoEnableChange; +function TBaseWatch.GetEnabled: Boolean; begin - Changed(False); + Result := FEnabled; end; -procedure TDBGWatch.DoExpressionChange; +function TBaseWatch.GetExpression: String; begin - Changed(False); + Result := FExpression; end; -procedure TDBGWatch.DoStateChange; -begin -end; - -function TDBGWatch.GetDebugger: TDebugger; -begin - Result := TDBGWatches(Collection).FDebugger; -end; - -function TDBGWatch.GetValid: TValidState; +function TBaseWatch.GetValid: TValidState; begin Result := vsUnknown; end; -function TDBGWatch.GetValue: String; +function TBaseWatch.GetValue: String; begin if not Enabled then Result := '' - else + else begin case Valid of - vsValid: Result := ''; - vsInvalid: Result := ''; + vsValid: Result := ''; + vsInvalid: Result := ''; else {vsUnknown:}Result := ''; end; + end; end; -procedure TDBGWatch.SetEnabled(const AValue: Boolean); +procedure TBaseWatch.SetEnabled(const AValue: Boolean); begin if FEnabled <> AValue then begin @@ -2431,7 +2556,7 @@ begin end; end; -procedure TDBGWatch.SetExpression(const AValue: String); +procedure TBaseWatch.SetExpression(const AValue: String); begin if AValue <> FExpression then begin @@ -2440,59 +2565,138 @@ begin end; end; -procedure TDBGWatch.SetInitialEnabled(const AValue: Boolean); -begin - if FInitialEnabled=AValue then exit; - FInitialEnabled:=AValue; -end; - -procedure TDBGWatch.SetValid(const AValue: TValidState); +procedure TBaseWatch.SetValid(const AValue: TValidState); begin if FValid <> AValue then begin FValid := AValue; - Changed(False); + Changed; end; end; { =========================================================================== } -{ TDBGWatches } +{ TIDEWatch } { =========================================================================== } -function TDBGWatches.Add(const AExpression: String): TDBGWatch; +constructor TIDEWatch.Create(ACollection: TCollection); +begin + inherited Create(ACollection); +end; + +destructor TIDEWatch.Destroy; +begin + if (TIDEWatches(Collection) <> nil) + then TIDEWatches(Collection).NotifyRemove(Self); + inherited Destroy; +end; + +procedure TIDEWatch.LoadFromXMLConfig(const AConfig: TXMLConfig; const APath: string); +begin + Expression := AConfig.GetValue(APath + 'Expression/Value', ''); + Enabled := AConfig.GetValue(APath + 'Enabled/Value', true); +end; + +procedure TIDEWatch.SaveToXMLConfig(const AConfig: TXMLConfig; const APath: string); +begin + AConfig.SetDeleteValue(APath + 'Expression/Value', Expression, ''); + AConfig.SetDeleteValue(APath + 'Enabled/Value', Enabled, true); +end; + + +{ =========================================================================== } +{ TDBGWatch } +{ =========================================================================== } + +constructor TDBGWatch.Create(ACollection: TCollection); +begin + FSlave := nil; + inherited Create(ACollection); +end; + +destructor TDBGWatch.Destroy; +var + SW: TBaseWatch; +begin + SW := FSlave; + FSlave := nil; + if SW <> nil + then SW.Changed; + inherited Destroy; +end; + +procedure TDBGWatch.DoChanged; +begin + inherited DoChanged; + if FSlave <> nil + then FSlave.Changed; +end; + +procedure TDBGWatch.DoStateChange; +begin +end; + +function TDBGWatch.GetDebugger: TDebugger; +begin + Result := TDBGWatches(Collection).FDebugger; +end; + +procedure TDBGWatch.InitTargetStart; +begin +end; + +{ =========================================================================== } +{ TBaseWatches } +{ =========================================================================== } + +function TBaseWatches.Add(const AExpression: String): TBaseWatch; +begin + Result := TBaseWatch(inherited Add); + Result.Expression := AExpression; +end; + +constructor TBaseWatches.Create(const AWatchClass: TBaseWatchClass); +begin + inherited Create(AWatchClass); +end; + +function TBaseWatches.Find(const AExpression: String): TBaseWatch; var n: Integer; - Notification: TDBGWatchesNotification; + S: String; begin - Result := Find(AExpression); - if Result <> nil then Exit; - - Result := TDBGWatch(inherited Add); - Result.Expression := AExpression; - for n := 0 to FNotificationList.Count - 1 do + S := UpperCase(AExpression); + for n := 0 to Count - 1 do begin - Notification := TDBGWatchesNotification(FNotificationList[n]); - if Assigned(Notification.FOnAdd) - then Notification.FOnAdd(Self, Result); + Result := TBaseWatch(GetItem(n)); + if UpperCase(Result.Expression) = S + then Exit; end; + Result := nil; end; -procedure TDBGWatches.AddNotification( - const ANotification: TDBGWatchesNotification); +{ =========================================================================== } +{ TIDEWatches } +{ =========================================================================== } + +function TIDEWatches.Add(const AExpression: String): TIDEWatch; +begin + Result := TIDEWatch(inherited Add(AExpression)); + NotifyAdd(Result); +end; + +procedure TIDEWatches.AddNotification(const ANotification: TIDEWatchesNotification); begin FNotificationList.Add(ANotification); ANotification.AddReference; end; -constructor TDBGWatches.Create(const ADebugger: TDebugger; - const AWatchClass: TDBGWatchClass); +constructor TIDEWatches.Create(const AWatchClass: TIDEWatchClass); begin - FDebugger := ADebugger; FNotificationList := TList.Create; inherited Create(AWatchClass); end; -destructor TDBGWatches.Destroy; +destructor TIDEWatches.Destroy; var n: Integer; begin @@ -2504,6 +2708,113 @@ begin FreeAndNil(FNotificationList); end; + +function TIDEWatches.Find(const AExpression: String): TIDEWatch; +begin + Result := TIDEWatch(inherited Find(AExpression)); +end; + +function TIDEWatches.GetItem(const AnIndex: Integer): TIDEWatch; +begin + Result := TIDEWatch(inherited GetItem(AnIndex)); +end; + +procedure TIDEWatches.LoadFromXMLConfig(const AConfig: TXMLConfig; const APath: string); +var + NewCount: Integer; + i: Integer; + Watch: TIDEWatch; +begin + Clear; + NewCount := AConfig.GetValue(APath + 'Count', 0); + for i := 0 to NewCount-1 do + begin + Watch := TIDEWatch(inherited Add('')); + Watch.LoadFromXMLConfig(AConfig, Format('%sItem%d/', [APath, i + 1])); + end; +end; + +procedure TIDEWatches.NotifyAdd(const AWatch: TIDEWatch); +var + n: Integer; + Notification: TIDEWatchesNotification; +begin + for n := 0 to FNotificationList.Count - 1 do + begin + Notification := TIDEWatchesNotification(FNotificationList[n]); + if Assigned(Notification.FOnAdd) + then Notification.FOnAdd(Self, AWatch); + end; +end; + +procedure TIDEWatches.NotifyRemove(const AWatch: TIDEWatch); +var + n: Integer; + Notification: TIDEWatchesNotification; +begin + for n := 0 to FNotificationList.Count - 1 do + begin + Notification := TIDEWatchesNotification(FNotificationList[n]); + if Assigned(Notification.FOnRemove) + then Notification.FOnRemove(Self, AWatch); + end; +end; + +procedure TIDEWatches.RemoveNotification(const ANotification: TIDEWatchesNotification); +begin + FNotificationList.Remove(ANotification); + ANotification.ReleaseReference; +end; + +procedure TIDEWatches.SaveToXMLConfig(const AConfig: TXMLConfig; const APath: string); +var + Cnt: Integer; + i: Integer; + Watch: TIDEWatch; +begin + Cnt := Count; + AConfig.SetDeleteValue(APath + 'Count', Cnt, 0); + for i := 0 to Cnt - 1 do + begin + Watch := Items[i]; + Watch.SaveToXMLConfig(AConfig, Format('%sItem%d/', [APath, i + 1])); + end; +end; + +procedure TIDEWatches.SetItem(const AnIndex: Integer; const AValue: TIDEWatch); +begin + inherited SetItem(AnIndex, AValue); +end; + +procedure TIDEWatches.Update(Item: TCollectionItem); +var + n: Integer; + Notification: TIDEWatchesNotification; +begin + // Note: Item will be nil in case all items need to be updated + for n := 0 to FNotificationList.Count - 1 do + begin + Notification := TIDEWatchesNotification(FNotificationList[n]); + if Assigned(Notification.FOnUpdate) + then Notification.FOnUpdate(Self, TIDEWatch(Item)); + end; +end; + +{ =========================================================================== } +{ TDBGWatches } +{ =========================================================================== } + +function TDBGWatches.Add(const AExpression: String): TDBGWatch; +begin + Result := TDBGWatch(inherited Add(AExpression)); +end; + +constructor TDBGWatches.Create(const ADebugger: TDebugger; const AWatchClass: TDBGWatchClass); +begin + FDebugger := ADebugger; + inherited Create(AWatchClass); +end; + procedure TDBGWatches.DoStateChange; var n: Integer; @@ -2513,18 +2824,8 @@ begin end; function TDBGWatches.Find(const AExpression: String): TDBGWatch; -var - n: Integer; - S: String; begin - S := UpperCase(AExpression); - for n := 0 to Count - 1 do - begin - Result := GetItem(n); - if UpperCase(Result.Expression) = S - then Exit; - end; - Result := nil; + Result := TDBGWatch(inherited Find(AExpression)); end; function TDBGWatches.GetItem(const AnIndex: Integer): TDBGWatch; @@ -2532,62 +2833,12 @@ begin Result := TDBGWatch(inherited GetItem(AnIndex)); end; -procedure TDBGWatches.Removed(const AWatch: TDBGWatch); -var - n: Integer; - Notification: TDBGWatchesNotification; -begin - for n := 0 to FNotificationList.Count - 1 do - begin - Notification := TDBGWatchesNotification(FNotificationList[n]); - if Assigned(Notification.FOnRemove) - then Notification.FOnRemove(Self, AWatch); - end; -end; - -procedure TDBGWatches.RemoveNotification( - const ANotification: TDBGWatchesNotification); -begin - FNotificationList.Remove(ANotification); - ANotification.ReleaseReference; -end; - -procedure TDBGWatches.LoadFromXMLConfig(XMLConfig: TXMLConfig; - const Path: string); -var - NewCount: Integer; - i: Integer; - NewWatch: TDBGWatch; -begin - Clear; - NewCount:=XMLConfig.GetValue(Path+'Count',0); - for i:=0 to NewCount-1 do begin - NewWatch:=TDBGWatch(inherited Add); - NewWatch.LoadFromXMLConfig(XMLConfig,Path+'Item'+IntToStr(i+1)+'/'); - end; -end; - -procedure TDBGWatches.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string - ); -var - Cnt: Integer; - i: Integer; - CutWatch: TDBGWatch; -begin - Cnt:=Count; - XMLConfig.SetDeleteValue(Path+'Count',Cnt,0); - for i:=0 to Cnt-1 do begin - CutWatch:=Items[i]; - CutWatch.SaveToXMLConfig(XMLConfig,Path+'Item'+IntToStr(i+1)+'/'); - end; -end; - procedure TDBGWatches.InitTargetStart; var i: Integer; begin - for i:=0 to Count-1 do - Items[i].Enabled:=Items[i].InitialEnabled; + for i := 0 to Count - 1 do + Items[i].InitTargetStart; end; procedure TDBGWatches.SetItem(const AnIndex: Integer; const AValue: TDBGWatch); @@ -2595,19 +2846,6 @@ begin inherited SetItem(AnIndex, AValue); end; -procedure TDBGWatches.Update(Item: TCollectionItem); -var - n: Integer; - Notification: TDBGWatchesNotification; -begin - // Note: Item will be nil in case all items need to be updated - for n := 0 to FNotificationList.Count - 1 do - begin - Notification := TDBGWatchesNotification(FNotificationList[n]); - if Assigned(Notification.FOnUpdate) - then Notification.FOnUpdate(Self, TDBGWatch(Item)); - end; -end; (******************************************************************************) (******************************************************************************) @@ -2617,13 +2855,87 @@ end; (******************************************************************************) (******************************************************************************) +{ =========================================================================== } +{ TBaseLocals } +{ =========================================================================== } + +function TBaseLocals.Count: Integer; +begin + Result := 0; +end; + +constructor TBaseLocals.Create; +begin + inherited Create; +end; + +function TBaseLocals.GetName(const AnIndex: Integer): String; +begin + Result := ''; +end; + +function TBaseLocals.GetValue(const AnIndex: Integer): String; +begin + Result := ''; +end; + +{ =========================================================================== } +{ TIDELocals } +{ =========================================================================== } + +procedure TIDELocals.AddNotification(const ANotification: TIDELocalsNotification); +begin + FNotificationList.Add(ANotification); + ANotification.AddReference; +end; + +constructor TIDELocals.Create; +begin + FNotificationList := TList.Create; + inherited Create; +end; + +destructor TIDELocals.Destroy; +var + n: Integer; +begin + for n := FNotificationList.Count - 1 downto 0 do + TDebuggerNotification(FNotificationList[n]).ReleaseReference; + + inherited; + + FreeAndNil(FNotificationList); +end; + +procedure TIDELocals.NotifyChange; +var + n: Integer; + Notification: TIDELocalsNotification; +begin + for n := 0 to FNotificationList.Count - 1 do + begin + Notification := TIDELocalsNotification(FNotificationList[n]); + if Assigned(Notification.FOnChange) + then Notification.FOnChange(Self); + end; +end; + +procedure TIDELocals.RemoveNotification(const ANotification: TIDELocalsNotification); +begin + FNotificationList.Remove(ANotification); + ANotification.ReleaseReference; +end; + { =========================================================================== } { TDBGLocals } { =========================================================================== } function TDBGLocals.Count: Integer; begin - Result := 0; + if (FDebugger <> nil) + and (FDebugger.State = dsPause) + then Result := GetCount + else Result := 0; end; constructor TDBGLocals.Create(const ADebugger: TDebugger); @@ -2641,14 +2953,9 @@ procedure TDBGLocals.DoStateChange; begin end; -function TDBGLocals.GetName(const AnIndex: Integer): String; +function TDBGLocals.GetCount: Integer; begin - Result := ''; -end; - -function TDBGLocals.GetValue(const AnIndex: Integer): String; -begin - Result := ''; + Result := 0; end; (******************************************************************************) @@ -2663,7 +2970,7 @@ end; { TDBGCallStackEntry } { =========================================================================== } -constructor TDBGCallStackEntry.Create(const AIndex: Integer; +constructor TCallStackEntry.Create(const AIndex: Integer; const AnAdress: Pointer; const AnArguments: TStrings; const AFunctionName: String; const ASource: String; const ALine: Integer); begin @@ -2677,115 +2984,206 @@ begin FLine := ALine; end; -destructor TDBGCallStackEntry.Destroy; +constructor TCallStackEntry.CreateCopy(const ASource: TCallStackEntry); +begin + Create(ASource.FIndex, ASource.FAdress, ASource.FArguments, + ASource.FunctionName, ASource.FSource, ASource.FLine); +end; + +destructor TCallStackEntry.Destroy; begin inherited; FreeAndNil(FArguments); end; -function TDBGCallStackEntry.GetArgumentCount: Integer; +function TCallStackEntry.GetArgumentCount: Integer; begin Result := FArguments.Count; end; -function TDBGCallStackEntry.GetArgumentName(const AnIndex: Integer): String; +function TCallStackEntry.GetArgumentName(const AnIndex: Integer): String; begin Result := FArguments.Names[AnIndex]; end; -function TDBGCallStackEntry.GetArgumentValue(const AnIndex: Integer): String; +function TCallStackEntry.GetArgumentValue(const AnIndex: Integer): String; begin Result := FArguments[AnIndex]; Result := GetPart('=', '', Result); end; { =========================================================================== } -{ TDBGCallStack } +{ TBaseCallStack } { =========================================================================== } -procedure TDBGCallStack.Clear; +function TBaseCallStack.CheckCount: Boolean; +begin + Result := False; +end; + +procedure TBaseCallStack.Clear; var n:Integer; begin - for n := 0 to FEntries.Count - 1 do + for n := 0 to FEntries.Count - 1 do TObject(FEntries[n]).Free; - - FEntries.Clear; + + FEntries.Clear; + FEntryIndex.Clear; + FCount := -1; end; -function TDBGCallStack.Count: Integer; +function TBaseCallStack.CreateStackEntry(const AIndex: Integer): TCallStackEntry; begin - if (FDebugger <> nil) - and (FDebugger.State = dsPause) - then Result := GetCount - else Result := 0; + Result := nil; +end; + +function TBaseCallStack.Count: Integer; +begin + if (FCount = -1) + and not CheckCount + then Result := 0 + else Result := FCount; +end; + +constructor TBaseCallStack.Create; +begin + FEntries := TList.Create; + FEntryIndex := TList.Create; + inherited Create; +end; + +destructor TBaseCallStack.Destroy; +begin + Clear; + inherited Destroy; + FreeAndNil(FEntries); + FreeAndNil(FEntryIndex); +end; + +function TBaseCallStack.GetEntry(const AIndex: Integer): TCallStackEntry; +begin + if (AIndex < 0) + or (AIndex >= Count) + then raise EInvalidOperation.CreateFmt('Index out of range (%d)', [AIndex]); + + Result := GetStackEntry(AIndex); +end; + +function TBaseCallStack.GetStackEntry(const AIndex: Integer): TCallStackEntry; +var + idx: Integer; +begin + idx := Integer(FEntryIndex[AIndex]); + if idx = -1 + then begin + // not created yet + Result := CreateStackEntry(AIndex); + if Result = nil then Exit; + idx := FEntries.Add(Result); + FEntryIndex[AIndex] := Pointer(idx); + end + else begin + Result := TCallStackEntry(FEntries[idx]); + end; +end; + +procedure TBaseCallStack.SetCount(const ACount: Integer); +var + n: integer; +begin + if FCount = ACount then Exit; + Assert(ACount >= 0); + + FEntryIndex.Count := ACount; + if FCount < 0 then FCount := 0; + for n := FCount to ACount - 1 do + FEntryIndex[n] := Pointer(-1); + + FCount := ACount; +end; + +{ =========================================================================== } +{ TIDECallStack } +{ =========================================================================== } + +procedure TIDECallStack.AddNotification(const ANotification: TIDECallStackNotification); +begin + FNotificationList.Add(ANotification); + ANotification.AddReference; +end; + +constructor TIDECallStack.Create; +begin + FNotificationList := TList.Create; + inherited Create; +end; + +destructor TIDECallStack.Destroy; +var + n: Integer; +begin + for n := FNotificationList.Count - 1 downto 0 do + TDebuggerNotification(FNotificationList[n]).ReleaseReference; + + inherited; + + FreeAndNil(FNotificationList); +end; + +procedure TIDECallStack.NotifyChange; +var + n: Integer; + Notification: TIDECallStackNotification; +begin + for n := 0 to FNotificationList.Count - 1 do + begin + Notification := TIDECallStackNotification(FNotificationList[n]); + if Assigned(Notification.FOnChange) + then Notification.FOnChange(Self); + end; +end; + +procedure TIDECallStack.RemoveNotification(const ANotification: TIDECallStackNotification); +begin + FNotificationList.Remove(ANotification); + ANotification.ReleaseReference; +end; + +{ =========================================================================== } +{ TDBGCallStack } +{ =========================================================================== } + +function TDBGCallStack.CheckCount: Boolean; +begin + Result := (FDebugger <> nil) + and (FDebugger.State = dsPause); + if Result then SetCount(0); end; constructor TDBGCallStack.Create(const ADebugger: TDebugger); begin FDebugger := ADebugger; - FEntries := TList.Create; FOldState := FDebugger.State; inherited Create; end; -function TDBGCallStack.CreateStackEntry( - const AIndex: Integer): TDBGCallStackEntry; -begin - Result := nil; -end; - -destructor TDBGCallStack.Destroy; -begin - Clear; - inherited; - FreeAndNil(FEntries); -end; - -procedure TDBGCallStack.DoChange; -begin - if Assigned(FOnChange) then FOnChange(Self); -end; - -procedure TDBGCallStack.DoStateChange; +procedure TDBGCallStack.DoStateChange; begin if FDebugger.State = dsPause - then DoChange + then begin + if Assigned(FOnChange) then FOnChange(Self); + end else begin if FOldState = dsPause then begin Clear; - DoChange; + if Assigned(FOnClear) then FOnClear(Self); end; end; FOldState := FDebugger.State; end; -function TDBGCallStack.GetCount: Integer; -begin - Result := 0; -end; - -function TDBGCallStack.GetStackEntry(const AIndex: Integer): TDBGCallStackEntry; -var - n: Integer; -begin - if (AIndex < 0) - or (AIndex >= Count) - then raise EInvalidOperation.CreateFmt('Index out of range (%d)', [AIndex]); - - for n := 0 to FEntries.Count - 1 do - begin - Result := TDBGCallStackEntry(FEntries[n]); - if Result.FIndex = AIndex - then Exit; - end; - - Result := CreateStackEntry(AIndex); - if Result <> nil - then FEntries.Add(Result); -end; - (******************************************************************************) (******************************************************************************) @@ -3174,6 +3572,10 @@ finalization end. { ============================================================================= $Log$ + Revision 1.60 2004/08/26 23:50:05 marc + * Restructured debugger view classes + * Fixed help + Revision 1.59 2004/06/16 21:36:27 marc * Fixed function in debugger environment diff --git a/debugger/debuggerdlg.pp b/debugger/debuggerdlg.pp index 28dd092459..4763574db2 100644 --- a/debugger/debuggerdlg.pp +++ b/debugger/debuggerdlg.pp @@ -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, ... diff --git a/debugger/gdbmidebugger.pp b/debugger/gdbmidebugger.pp index 89e5e74728..3d2e3c9ef7 100644 --- a/debugger/gdbmidebugger.pp +++ b/debugger/gdbmidebugger.pp @@ -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] diff --git a/debugger/localsdlg.lfm b/debugger/localsdlg.lfm index 68af44e0a0..21162faa9d 100644 --- a/debugger/localsdlg.lfm +++ b/debugger/localsdlg.lfm @@ -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 diff --git a/debugger/localsdlg.lrs b/debugger/localsdlg.lrs index 39adf52151..2da07353f1 100644 --- a/debugger/localsdlg.lrs +++ b/debugger/localsdlg.lrs @@ -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 +]); diff --git a/debugger/localsdlg.pp b/debugger/localsdlg.pp index d987bc535b..1c53b708f5 100644 --- a/debugger/localsdlg.pp +++ b/debugger/localsdlg.pp @@ -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 diff --git a/debugger/watchesdlg.pp b/debugger/watchesdlg.pp index 847e9f353f..0288803164 100644 --- a/debugger/watchesdlg.pp +++ b/debugger/watchesdlg.pp @@ -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 diff --git a/debugger/watchpropertydlg.lfm b/debugger/watchpropertydlg.lfm index 94d96c876c..1dabb919a2 100644 --- a/debugger/watchpropertydlg.lfm +++ b/debugger/watchpropertydlg.lfm @@ -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 diff --git a/debugger/watchpropertydlg.lrs b/debugger/watchpropertydlg.lrs index e81b76d2e8..33bdbc71a2 100644 --- a/debugger/watchpropertydlg.lrs +++ b/debugger/watchpropertydlg.lrs @@ -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 ]); diff --git a/debugger/watchpropertydlg.pp b/debugger/watchpropertydlg.pp index 2265622322..40ef6b253b 100644 --- a/debugger/watchpropertydlg.pp +++ b/debugger/watchpropertydlg.pp @@ -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; diff --git a/ide/basedebugmanager.pas b/ide/basedebugmanager.pas index de8adca665..01c6af2d96 100644 --- a/ide/basedebugmanager.pas +++ b/ide/basedebugmanager.pas @@ -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 diff --git a/ide/debugmanager.pas b/ide/debugmanager.pas index 18ee6e03b3..74b583d67b 100644 --- a/ide/debugmanager.pas +++ b/ide/debugmanager.pas @@ -46,8 +46,9 @@ uses IDEOptionDefs, LazarusIDEStrConsts, MainBar, MainIntf, MainBase, BaseDebugManager, SourceMarks, - DebuggerDlg, Watchesdlg, BreakPointsdlg, LocalsDlg, DBGOutputForm, - GDBMIDebugger, CallStackDlg, SSHGDBMIDebugger; + DebuggerDlg, Watchesdlg, BreakPointsdlg, LocalsDlg, WatchPropertyDlg, + CallStackDlg, DBGOutputForm, + GDBMIDebugger, SSHGDBMIDebugger; type @@ -83,14 +84,7 @@ type function DebuggerDlgGetFullFilename(Sender: TDebuggerDlg; var Filename: string; AskUserIfNotFound: boolean): TModalresult; private - //FDebugger: TDebugger; - FBreakpointsNotification: TIDEBreakPointsNotification; - - // When no debugger is created the IDE stores all debugger settings in its - // own variables. When the debugger object is created these items point - // to the corresponding items in the FDebugger object. FBreakPointGroups: TIDEBreakPointGroups; - FWatches: TDBGWatches; FDialogs: array[TDebugDialogType] of TDebuggerDlg; // When a source file is not found, the user can choose one @@ -98,13 +92,11 @@ type FUserSourceFiles: TStringList; // when the debug output log is not open, store the debug log internally - fHiddenDebugOutputLog: TStringList; + FHiddenDebugOutputLog: TStringList; + + procedure SetDebugger(const ADebugger: TDebugger); // Breakpoint routines - procedure BreakpointAdded(const ASender: TIDEBreakPoints; - const ABreakpoint: TIDEBreakPoint); - procedure BreakpointRemoved(const ASender: TIDEBreakPoints; - const ABreakpoint: TIDEBreakPoint); procedure CreateSourceMarkForBreakPoint(const ABreakpoint: TIDEBreakPoint; ASrcEdit: TSourceEditor); procedure GetSourceEditorForBreakPoint(const ABreakpoint: TIDEBreakPoint; @@ -133,8 +125,6 @@ type procedure LoadProjectSpecificInfo(XMLConfig: TXMLConfig); override; procedure SaveProjectSpecificInfo(XMLConfig: TXMLConfig); override; procedure DoRestoreDebuggerMarks(AnUnitInfo: TUnitInfo); override; - procedure BeginUpdateDialogs; - procedure EndUpdateDialogs; procedure ClearDebugOutputLog; function DoInitDebugger: TModalResult; override; @@ -152,12 +142,14 @@ type function DoCreateBreakPoint(const AFilename: string; ALine: integer): TModalResult; override; + function DoDeleteBreakPoint(const AFilename: string; ALine: integer): TModalResult; override; function DoDeleteBreakPointAtMark( const ASourceMark: TSourceMark): TModalResult; override; - function DoViewBreakPointProperties(ABreakpoint: TIDEBreakPoint): TModalresult; override; - function DoCreateWatch(const AExpression: string): TModalResult; override; + + function ShowBreakPointProperties(const ABreakpoint: TIDEBreakPoint): TModalresult; override; + function ShowWatchProperties(const AWatch: TIDEWatch): TModalresult; override; end; @@ -174,11 +166,6 @@ type private FMaster: TDBGBreakPoint; FSourceMark: TSourceMark; - protected - function GetHitCount: Integer; override; - function GetValid: TValidState; override; - procedure AssignTo(Dest: TPersistent); override; - procedure DoChanged; override; procedure OnSourceMarkBeforeFree(Sender: TObject); procedure OnSourceMarkCreatePopupMenu(SenderMark: TSourceMark; const AddMenuItem: TAddMenuItemProc); @@ -187,6 +174,11 @@ type procedure OnToggleEnableMenuItemClick(Sender: TObject); procedure OnDeleteMenuItemClick(Sender: TObject); procedure OnViewPropertiesMenuItemClick(Sender: TObject); + protected + procedure AssignTo(Dest: TPersistent); override; + procedure DoChanged; override; + function GetHitCount: Integer; override; + function GetValid: TValidState; override; procedure SetEnabled(const AValue: Boolean); override; procedure SetInitialEnabled(const AValue: Boolean); override; procedure SetExpression(const AValue: String); override; @@ -207,13 +199,67 @@ type TManagedBreakPoints = class(TIDEBreakPoints) private FMaster: TDBGBreakPoints; + FManager: TDebugManager; procedure SetMaster(const AValue: TDBGBreakPoints); + protected + procedure NotifyAdd(const ABreakPoint: TIDEBreakPoint); override; + procedure NotifyRemove(const ABreakPoint: TIDEBreakPoint); override; public - constructor Create; - destructor Destroy; override; + constructor Create(const AManager: TDebugManager); property Master: TDBGBreakPoints read FMaster write SetMaster; end; + TManagedWatch = class(TIDEWatch) + private + FMaster: TDBGWatch; + protected + procedure AssignTo(Dest: TPersistent); override; + function GetValid: TValidState; override; + function GetValue: String; override; + public + constructor Create(ACollection: TCollection); override; + procedure ResetMaster; + end; + + TManagedWatches = class(TIDEWatches) + private + FMaster: TDBGWatches; + FManager: TDebugManager; + procedure SetMaster(const AMaster: TDBGWatches); + protected + procedure NotifyAdd(const AWatch: TIDEWatch); override; + procedure NotifyRemove(const AWatch: TIDEWatch); override; + public + constructor Create(const AManager: TDebugManager); + property Master: TDBGWatches read FMaster write SetMaster; + end; + + TManagedLocals = class(TIDELocals) + private + FMaster: TDBGLocals; + procedure LocalsChanged(Sender: TObject); + procedure SetMaster(const AMaster: TDBGLocals); + protected + function GetName(const AnIndex: Integer): String; override; + function GetValue(const AnIndex: Integer): String; override; + public + function Count: Integer; override; + property Master: TDBGLocals read FMaster write SetMaster; + end; + + TManagedCallStack = class(TIDECallStack) + private + FMaster: TDBGCallStack; + procedure CallStackChanged(Sender: TObject); + procedure CallStackClear(Sender: TObject); + procedure SetMaster(const AMaster: TDBGCallStack); + protected + function CheckCount: Boolean; override; + function GetStackEntry(const AIndex: Integer): TCallStackEntry; override; + public + property Master: TDBGCallStack read FMaster write SetMaster; + end; + TManagedSignal = class(TIDESignal) private FMaster: TDBGSignal; @@ -227,10 +273,11 @@ type TManagedSignals = class(TIDESignals) private FMaster: TDBGSignals; + FManager: TDebugManager; procedure SetMaster(const AValue: TDBGSignals); protected public - constructor Create; + constructor Create(const AManager: TDebugManager); property Master: TDBGSignals read FMaster write SetMaster; end; @@ -247,13 +294,208 @@ type TManagedExceptions = class(TIDEExceptions) private FMaster: TDBGExceptions; + FManager: TDebugManager; procedure SetMaster(const AValue: TDBGExceptions); protected public - constructor Create; + constructor Create(const AManager: TDebugManager); property Master: TDBGExceptions read FMaster write SetMaster; end; +{ TManagedCallStack } + +procedure TManagedCallStack.CallStackChanged(Sender: TObject); +begin + // Clear it first to force the count update + Clear; + NotifyChange; +end; + +procedure TManagedCallStack.CallStackClear(Sender: TObject); +begin + // Don't clear, set it to 0 so there are no entries shown + SetCount(0); + NotifyChange; +end; + +function TManagedCallStack.CheckCount: Boolean; +begin + Result := Master <> nil; + if Result + then SetCount(Master.Count); +end; + +function TManagedCallStack.GetStackEntry(const AIndex: Integer): TCallStackEntry; +begin + Assert(FMaster <> nil); + + Result := FMaster.GetStackEntry(AIndex); +end; + +procedure TManagedCallStack.SetMaster(const AMaster: TDBGCallStack); +var + DoNotify: Boolean; +begin + if FMaster = AMaster then Exit; + + if FMaster <> nil + then begin + FMaster.OnChange := nil; + FMaster.OnClear := nil; + DoNotify := FMaster.Count <> 0; + end + else DoNotify := False; + + FMaster := AMaster; + + if FMaster = nil + then begin + SetCount(0); + end + else begin + FMaster.OnChange := @CallStackChanged; + FMaster.OnClear := @CallStackClear; + DoNotify := DoNotify or FMaster.Count <> 0; + end; + + if DoNotify + then NotifyChange; +end; + +{ TManagedLocals } + +procedure TManagedLocals.LocalsChanged(Sender: TObject); +begin + NotifyChange; +end; + +procedure TManagedLocals.SetMaster(const AMaster: TDBGLocals); +var + DoNotify: Boolean; +begin + if FMaster = AMaster then Exit; + + if FMaster <> nil + then begin + FMaster.OnChange := nil; + DoNotify := FMaster.Count <> 0; + end + else DoNotify := False; + + FMaster := AMaster; + + if FMaster <> nil + then begin + FMaster.OnChange := @LocalsChanged; + DoNotify := DoNotify or FMaster.Count <> 0; + end; + + if DoNotify + then NotifyChange; +end; + +function TManagedLocals.GetName(const AnIndex: Integer): String; +begin + if Master = nil + then Result := inherited GetName(AnIndex) + else Result := Master.GetName(AnIndex); +end; + +function TManagedLocals.GetValue(const AnIndex: Integer): String; +begin + if Master = nil + then Result := inherited GetValue(AnIndex) + else Result := Master.GetValue(AnIndex); +end; + +function TManagedLocals.Count: Integer; +begin + if Master = nil + then Result := 0 + else Result := Master.Count; +end; + +{ TManagedWatch } + +procedure TManagedWatch.AssignTo(Dest: TPersistent); +begin + inherited AssignTo(Dest); + if (TManagedWatches(GetOwner).FMaster <> nil) + and (Dest is TDBGWatch) + then begin + FMaster := TDBGWatch(Dest); + FMaster.Slave := Self; + end; +end; + +function TManagedWatch.GetValid: TValidState; +begin + if FMaster = nil + then Result := inherited GetValid + else Result := FMaster.GetValid; +end; + +function TManagedWatch.GetValue: String; +begin + if FMaster = nil + then Result := inherited GetValue + else Result := FMaster.GetValue; +end; + +constructor TManagedWatch.Create(ACollection: TCollection); +begin + inherited Create(ACollection); +end; + +procedure TManagedWatch.ResetMaster; +begin + FMaster := nil; +end; + +{ TManagedWatches } + +procedure TManagedWatches.SetMaster(const AMaster: TDBGWatches); +var + n: Integer; +begin + if FMaster = AMaster then Exit; + + FMaster := AMaster; + if FMaster = nil + then begin + for n := 0 to Count - 1 do + TManagedWatch(Items[n]).ResetMaster; + end + else begin + FMaster.Assign(Self); + end; +end; + +procedure TManagedWatches.NotifyAdd(const AWatch: TIDEWatch); +var + W: TDBGWatch; +begin + inherited; + + if FManager.FDebugger <> nil + then begin + W := FManager.FDebugger.Watches.Add(AWatch.Expression); + W.Assign(AWatch); + end; +end; + +procedure TManagedWatches.NotifyRemove(const AWatch: TIDEWatch); +begin + inherited NotifyRemove(AWatch); +end; + +constructor TManagedWatches.Create(const AManager: TDebugManager); +begin + FMaster := nil; + FManager := AManager; + inherited Create(TManagedWatch); +end; + { TManagedException } constructor TManagedException.Create(ACollection: TCollection); @@ -284,10 +526,14 @@ end; { TManagedExceptions } -constructor TManagedExceptions.Create; +constructor TManagedExceptions.Create(const AManager: TDebugManager); begin FMaster := nil; + FManager := AManager; inherited Create(TManagedException); + + Add('ECodetoolError'); + Add('EFOpenError'); end; procedure TManagedExceptions.SetMaster(const AValue: TDBGExceptions); @@ -338,9 +584,10 @@ end; { TManagedSignals } -constructor TManagedSignals.Create; +constructor TManagedSignals.Create(const AManager: TDebugManager); begin FMaster := nil; + FManager := AManager; inherited Create(TManagedSignal); end; @@ -362,17 +609,13 @@ end; { TManagedBreakPoints } -constructor TManagedBreakPoints.Create; +constructor TManagedBreakPoints.Create(const AManager: TDebugManager); begin FMaster := nil; + FManager := AManager; inherited Create(TManagedBreakPoint); end; -destructor TManagedBreakPoints.Destroy; -begin - inherited Destroy; -end; - procedure TManagedBreakPoints.SetMaster(const AValue: TDBGBreakPoints); var n: Integer; @@ -390,6 +633,37 @@ begin end; end; +procedure TManagedBreakPoints.NotifyAdd(const ABreakPoint: TIDEBreakPoint); +var + BP: TBaseBreakPoint; +begin + writeln('TManagedBreakPoints.NotifyAdd A ',ABreakpoint.Source,' ',ABreakpoint.Line); + ABreakpoint.InitialEnabled := True; + ABreakpoint.Enabled := True; + + inherited; + + if FManager.FDebugger <> nil + then begin + BP := FManager.FDebugger.BreakPoints.Add(ABreakpoint.Source, ABreakpoint.Line); + BP.Assign(ABreakPoint); + end; + FManager.CreateSourceMarkForBreakPoint(ABreakpoint,nil); + Project1.Modified := True; +end; + +procedure TManagedBreakPoints.NotifyRemove(const ABreakPoint: TIDEBreakPoint); +begin + writeln('TManagedBreakPoints.NotifyRemove A ',ABreakpoint.Source,' ',ABreakpoint.Line,' ',TManagedBreakPoint(ABreakpoint).SourceMark <> nil); + + inherited; + + TManagedBreakPoint(ABreakpoint).SourceMark.Free; + + if Project1 <> nil + then Project1.Modified := True; +end; + { TManagedBreakPoint } @@ -432,7 +706,7 @@ end; procedure TManagedBreakPoint.OnViewPropertiesMenuItemClick(Sender: TObject); begin - DebugBoss.DoViewBreakPointProperties(Self); + DebugBoss.ShowBreakPointProperties(Self); end; procedure TManagedBreakPoint.OnSourceMarkBeforeFree(Sender: TObject); @@ -738,7 +1012,10 @@ begin WatchVar := SE.GetWordAtCurrentCaret; if WatchVar = '' then Exit; - if DoCreateWatch(WatchVar)<>mrOk then exit; + if (Watches.Find(WatchVar) = nil) + and (Watches.Add(WatchVar) = nil) + then Exit; + Result:=true; end; @@ -799,10 +1076,11 @@ begin if Destroying or (MainIDE=nil) or (MainIDE.ToolStatus=itExiting) then exit; - if FDebugger.State=dsError then begin + if FDebugger.State=dsError + then begin Include(FManagerStates,dmsDebuggerObjectBroken); - if dmsInitializingDebuggerObject in FManagerStates then - Include(FManagerStates,dmsInitializingDebuggerObjectFailed); + if dmsInitializingDebuggerObject in FManagerStates + then Include(FManagerStates,dmsInitializingDebuggerObjectFailed); end; WriteLN('[TDebugManager.OnDebuggerChangeState] state: ', STATENAME[FDebugger.State]); @@ -813,17 +1091,19 @@ begin // ------------------- UpdateButtonsAndMenuItems; - if MainIDE.ToolStatus in [itNone,itDebugger] then - MainIDE.ToolStatus := TOOLSTATEMAP[FDebugger.State]; + if MainIDE.ToolStatus in [itNone,itDebugger] + then MainIDE.ToolStatus := TOOLSTATEMAP[FDebugger.State]; - if (FDebugger.State in [dsRun]) then begin + if (FDebugger.State in [dsRun]) + then begin // hide IDE during run - if EnvironmentOptions.HideIDEOnRun and (MainIDE.ToolStatus=itDebugger) - then - MainIDE.HideIDE; - end else if (OldState in [dsRun]) then begin - // unhide IDE - MainIDE.UnhideIDE; + if EnvironmentOptions.HideIDEOnRun + and (MainIDE.ToolStatus=itDebugger) + then MainIDE.HideIDE; + end + else begin + if (OldState in [dsRun]) + then MainIDE.UnhideIDE; end; // unmark execution line @@ -867,7 +1147,7 @@ var Editor: TSourceEditor; SrcLine: Integer; i: Integer; - StackEntry: TDBGCallStackEntry; + StackEntry: TCallStackEntry; begin if (Sender<>FDebugger) or (Sender=nil) then exit; if Destroying then exit; @@ -972,16 +1252,17 @@ begin CurDialog.OnGetFullDebugFilename:=@DebuggerDlgGetFullFilename; EnvironmentOptions.IDEWindowLayoutList.Apply(CurDialog,CurDialog.Name); case ADialogType of - ddtOutput: InitDebugOutputDlg; - ddtBreakpoints: InitBreakPointDlg; - ddtWatches: InitWatchesDlg; - ddtLocals: InitLocalsDlg; - ddtCallStack: InitCallStackDlg; + ddtOutput: InitDebugOutputDlg; + ddtBreakpoints: InitBreakPointDlg; + ddtWatches: InitWatchesDlg; + ddtLocals: InitLocalsDlg; + ddtCallStack: InitCallStackDlg; end; - CurDialog.Debugger := FDebugger; - end else begin + end + else begin CurDialog:=FDialogs[ADialogType]; - if (CurDialog is TBreakPointsDlg) then begin + if (CurDialog is TBreakPointsDlg) + then begin if (Project1<>nil) then TBreakPointsDlg(CurDialog).BaseDirectory:=Project1.ProjectDirectory; end; @@ -994,7 +1275,6 @@ procedure TDebugManager.DestroyDebugDialog(const ADialogType: TDebugDialogType); begin if FDialogs[ADialogType] = nil then Exit; FDialogs[ADialogType].OnDestroy := nil; - FDialogs[ADialogType].Debugger := nil; FDialogs[ADialogType].Free; FDialogs[ADialogType] := nil; end; @@ -1003,10 +1283,11 @@ procedure TDebugManager.InitDebugOutputDlg; var TheDialog: TDbgOutputForm; begin - TheDialog:=TDbgOutputForm(FDialogs[ddtOutput]); - if fHiddenDebugOutputLog<>nil then begin - TheDialog.SetLogText(fHiddenDebugOutputLog); - FreeThenNil(fHiddenDebugOutputLog); + TheDialog := TDbgOutputForm(FDialogs[ddtOutput]); + if FHiddenDebugOutputLog <> nil + then begin + TheDialog.SetLogText(FHiddenDebugOutputLog); + FreeAndNil(FHiddenDebugOutputLog); end; end; @@ -1015,25 +1296,33 @@ var TheDialog: TBreakPointsDlg; begin TheDialog:=TBreakPointsDlg(FDialogs[ddtBreakpoints]); - if (Project1<>nil) then - TheDialog.BaseDirectory:=Project1.ProjectDirectory; - TheDialog.BreakPoints:=FBreakPoints; + if Project1 <> nil + then TheDialog.BaseDirectory := Project1.ProjectDirectory; + TheDialog.BreakPoints := FBreakPoints; end; procedure TDebugManager.InitWatchesDlg; var TheDialog: TWatchesDlg; begin - TheDialog:=TWatchesDlg(FDialogs[ddtWatches]); - TheDialog.WatchesUpdate(FWatches); + TheDialog := TWatchesDlg(FDialogs[ddtWatches]); + TheDialog.Watches := FWatches; end; procedure TDebugManager.InitLocalsDlg; +var + TheDialog: TLocalsDlg; begin + TheDialog := TLocalsDlg(FDialogs[ddtLocals]); + TheDialog.Locals := FLocals; end; procedure TDebugManager.InitCallStackDlg; +var + TheDialog: TCallStackDlg; begin + TheDialog := TCallStackDlg(FDialogs[ddtCallStack]); + TheDialog.CallStack := FCallStack; end; constructor TDebugManager.Create(TheOwner: TComponent); @@ -1044,22 +1333,14 @@ begin FDialogs[DialogType] := nil; FDebugger := nil; - FBreakPoints := TManagedBreakPoints.Create; - FBreakpointsNotification := TIDEBreakPointsNotification.Create; - FBreakpointsNotification.AddReference; - FBreakpointsNotification.OnAdd := @BreakpointAdded; - FBreakpointsNotification.OnRemove := @BreakpointRemoved; - FBreakPoints.AddNotification(FBreakpointsNotification); - + FBreakPoints := TManagedBreakPoints.Create(Self); FBreakPointGroups := TIDEBreakPointGroups.Create; - FWatches := TDBGWatches.Create(nil, TDBGWatch); - - FExceptions := TManagedExceptions.Create; - // Temp hack - FExceptions.Add('ECodetoolError'); - FExceptions.Add('EFOpenError'); - FSignals := TManagedSignals.Create; + FWatches := TManagedWatches.Create(Self); + FExceptions := TManagedExceptions.Create(Self); + FSignals := TManagedSignals.Create(Self); + FLocals := TManagedLocals.Create; + FCallStack := TManagedCallStack.Create; FUserSourceFiles := TStringList.Create; @@ -1075,24 +1356,18 @@ begin for DialogType := Low(TDebugDialogType) to High(TDebugDialogType) do DestroyDebugDialog(DialogType); - TManagedBreakpoints(FBreakpoints).Master := nil; + SetDebugger(nil); - if FDebugger <> nil - then begin - if FDebugger.Watches = FWatches - then FWatches := nil; - - FreeAndNil(FDebugger); - end; FreeAndNil(FWatches); FreeAndNil(FBreakPoints); FreeAndNil(FBreakPointGroups); - FreeAndNil(FBreakpointsNotification); + FreeAndNil(FCallStack); FreeAndNil(FExceptions); FreeAndNil(FSignals); + FreeAndNil(FLocals); FreeAndNil(FUserSourceFiles); - FreeAndNil(fHiddenDebugOutputLog); + FreeAndNil(FHiddenDebugOutputLog); inherited Destroy; end; @@ -1210,44 +1485,6 @@ begin end; end; -procedure TDebugManager.BeginUpdateDialogs; -var - DialogType: TDebugDialogType; - CurDialog: TDebuggerDlg; -begin - for DialogType:=Low(FDialogs) to High(FDialogs) do begin - CurDialog:=FDialogs[DialogType]; - if CurDialog<>nil then CurDialog.BeginUpdate; - end; -end; - -procedure TDebugManager.BreakpointAdded(const ASender: TIDEBreakPoints; - const ABreakpoint: TIDEBreakPoint); -var - BP: TBaseBreakPoint; -begin - writeln('TDebugManager.BreakpointAdded A ',ABreakpoint.Source,' ',ABreakpoint.Line); - ABreakpoint.InitialEnabled := True; - ABreakpoint.Enabled := True; - if FDebugger <> nil - then begin - BP := FDebugger.BreakPoints.Add(ABreakpoint.Source, ABreakpoint.Line); - BP.Assign(ABreakPoint); - end; - CreateSourceMarkForBreakPoint(ABreakpoint,nil); - Project1.Modified := True; -end; - -procedure TDebugManager.BreakpointRemoved(const ASender: TIDEBreakPoints; - const ABreakpoint: TIDEBreakPoint); -begin - writeln('TDebugManager.BreakpointRemoved A ',ABreakpoint.Source,' ',ABreakpoint.Line,' ',TManagedBreakPoint(ABreakpoint).SourceMark<>nil); - if TManagedBreakPoint(ABreakpoint).SourceMark<>nil then - TManagedBreakPoint(ABreakpoint).SourceMark.Free; - if Project1<>nil then - Project1.Modified := True; -end; - procedure TDebugManager.CreateSourceMarkForBreakPoint( const ABreakpoint: TIDEBreakPoint; ASrcEdit: TSourceEditor); var @@ -1280,17 +1517,6 @@ begin ASrcEdit:=nil; end; -procedure TDebugManager.EndUpdateDialogs; -var - DialogType: TDebugDialogType; - CurDialog: TDebuggerDlg; -begin - for DialogType:=Low(FDialogs) to High(FDialogs) do begin - CurDialog:=FDialogs[DialogType]; - if CurDialog<>nil then CurDialog.EndUpdate; - end; -end; - procedure TDebugManager.ClearDebugOutputLog; begin if FDialogs[ddtOutput] <> nil then @@ -1304,64 +1530,16 @@ end; //----------------------------------------------------------------------------- function TDebugManager.DoInitDebugger: TModalResult; -var - OldWatches: TDBGWatches; - - procedure SaveDebuggerItems; - begin - // copy the watches - if (FDebugger<>nil) - and (FDebugger.Watches=FWatches) then begin - // wtaches belongs to the current debugger - // -> create debugger independent watches and copy watches - OldWatches := TDBGWatches.Create(nil, TDBGWatch); - OldWatches.Assign(FWatches); - end else begin - // watches are already independent of debugger - // -> keep watches - OldWatches:=FWatches; - end; - FWatches := nil; - end; - - procedure RestoreDebuggerItems; - begin - // restore the watches - if (OldWatches<>nil) then begin - if FWatches=nil then - FWatches:=OldWatches - else if FWatches<>OldWatches then - FWatches.Assign(OldWatches); - end; - end; - - procedure ResetDialogs; - var - DialogType: TDebugDialogType; - begin - for DialogType := Low(TDebugDialogType) to High(TDebugDialogType) do - begin - if FDialogs[DialogType] <> nil - then FDialogs[DialogType].Debugger := FDebugger; - end; - end; - procedure FreeDebugger; + var + dbg: TDebugger; begin - TManagedBreakPoints(FBreakPoints).Master := nil; - TManagedSignals(FSignals).Master := nil; - TManagedExceptions(FExceptions).Master := nil;; - FreeAndNil(FDebugger); + dbg := FDebugger; + SetDebugger(nil); + dbg.Free; Exclude(FManagerStates,dmsDebuggerObjectBroken); - ResetDialogs; end; - procedure SaveAndFreeDebugger; - begin - SaveDebuggerItems; - FreeDebugger; - end; - var LaunchingCmdLine, LaunchingApplication, LaunchingParams: String; NewWorkingDir: String; @@ -1384,84 +1562,70 @@ begin exit; end; - OldWatches := nil; - - BeginUpdateDialogs; - try - try - DebuggerClass := FindDebuggerClass(EnvironmentOptions.DebuggerClass); - if DebuggerClass = nil - then begin - if FDebugger <> nil - then SaveAndFreeDebugger; - Exit; - end; - - if (dmsDebuggerObjectBroken in FManagerStates) then - SaveAndFreeDebugger; - - // check if debugger is already created with the right type - if (FDebugger <> nil) - and (not (FDebugger is DebuggerClass) - or (FDebugger.ExternalDebugger <> EnvironmentOptions.DebuggerFilename) - ) - then begin - // the current debugger is the wrong type -> free it - SaveAndFreeDebugger; - end; - - // create debugger object - if FDebugger = nil - then begin - SaveDebuggerItems; - FDebugger := DebuggerClass.Create(EnvironmentOptions.DebuggerFilename); - - TManagedBreakPoints(FBreakPoints).Master := FDebugger.BreakPoints; - TManagedSignals(FSignals).Master := FDebugger.Signals; - TManagedExceptions(FExceptions).Master := FDebugger.Exceptions; - - FWatches := FDebugger.Watches; - ResetDialogs; - - // restore debugger items - RestoreDebuggerItems; - end; - finally - if FWatches<>OldWatches then - OldWatches.Free; - end; - - ClearDebugOutputLog; - - FDebugger.OnState := @OnDebuggerChangeState; - FDebugger.OnCurrent := @OnDebuggerCurrentLine; - FDebugger.OnDbgOutput := @OnDebuggerOutput; - FDebugger.OnException := @OnDebuggerException; - if FDebugger.State = dsNone then begin - Include(FManagerStates,dmsInitializingDebuggerObject); - Exclude(FManagerStates,dmsInitializingDebuggerObjectFailed); - FDebugger.Init; - Exclude(FManagerStates,dmsInitializingDebuggerObject); - if dmsInitializingDebuggerObjectFailed in FManagerStates then begin - Result:=mrCancel; - exit; - end; - end; - - FDebugger.FileName := LaunchingApplication; - FDebugger.Arguments := LaunchingParams; - Project1.RunParameterOptions.AssignEnvironmentTo(FDebugger.Environment); - NewWorkingDir:=Project1.RunParameterOptions.WorkingDirectory; - if NewWorkingDir='' then - NewWorkingDir:=Project1.ProjectDirectory; - FDebugger.WorkingDir:=NewWorkingDir; - finally - EndUpdateDialogs; + DebuggerClass := FindDebuggerClass(EnvironmentOptions.DebuggerClass); + if DebuggerClass = nil + then begin + if FDebugger <> nil + then FreeDebugger; + Exit; end; + + if (dmsDebuggerObjectBroken in FManagerStates) + then FreeDebugger; + + // check if debugger is already created with the right type + if (FDebugger <> nil) + and (not (FDebugger is DebuggerClass) + or (FDebugger.ExternalDebugger <> EnvironmentOptions.DebuggerFilename) + ) + then begin + // the current debugger is the wrong type -> free it + FreeDebugger; + end; + + // create debugger object + if FDebugger = nil + then SetDebugger(DebuggerClass.Create(EnvironmentOptions.DebuggerFilename)); + + if FDebugger = nil + then begin + // something went wrong + Result := mrCancel; + exit; + end; + + ClearDebugOutputLog; + + FDebugger.OnState := @OnDebuggerChangeState; + FDebugger.OnCurrent := @OnDebuggerCurrentLine; + FDebugger.OnDbgOutput := @OnDebuggerOutput; + FDebugger.OnException := @OnDebuggerException; + + if FDebugger.State = dsNone + then begin + Include(FManagerStates,dmsInitializingDebuggerObject); + Exclude(FManagerStates,dmsInitializingDebuggerObjectFailed); + FDebugger.Init; + Exclude(FManagerStates,dmsInitializingDebuggerObject); + if dmsInitializingDebuggerObjectFailed in FManagerStates + then begin + Result:=mrCancel; + exit; + end; + end; + + FDebugger.FileName := LaunchingApplication; + FDebugger.Arguments := LaunchingParams; + Project1.RunParameterOptions.AssignEnvironmentTo(FDebugger.Environment); + NewWorkingDir:=Project1.RunParameterOptions.WorkingDirectory; + if NewWorkingDir='' + then NewWorkingDir:=Project1.ProjectDirectory; + FDebugger.WorkingDir:=NewWorkingDir; // check if debugging needs restart if ((FDebugger=nil) or (dmsDebuggerObjectBroken in FManagerStates)) - and (MainIDE.ToolStatus=itDebugger) then begin + and (MainIDE.ToolStatus=itDebugger) + then begin MainIDE.ToolStatus:=itNone; Result:=mrCancel; exit; @@ -1604,24 +1768,6 @@ writeln('TDebugManager.DoDeleteBreakPointAtMark B ',OldBreakPoint.ClassName,' ', Result := mrOK end; -function TDebugManager.DoViewBreakPointProperties(ABreakpoint: TIDEBreakPoint - ): TModalresult; -begin - Result:=mrCancel; - // ToDo -end; - -function TDebugManager.DoCreateWatch(const AExpression: string): TModalResult; -var - NewWatch: TDBGWatch; -begin - NewWatch := FWatches.Add(AExpression); - NewWatch.Enabled := True; - NewWatch.InitialEnabled := True; - Project1.Modified:=true; - Result := mrOK -end; - function TDebugManager.DoRunToCursor: TModalResult; var ActiveSrcEdit: TSourceEditor; @@ -1675,10 +1821,52 @@ begin else Result := FDebugger.Commands; end; +function TDebugManager.ShowBreakPointProperties(const ABreakpoint: TIDEBreakPoint): TModalresult; +begin + Result:=mrCancel; + // ToDo +end; + +function TDebugManager.ShowWatchProperties(const AWatch: TIDEWatch): TModalresult; +begin + with TWatchPropertyDlg.Create(Self, AWatch) do + begin + Result := ShowModal; + Free; + end; +end; + +procedure TDebugManager.SetDebugger(const ADebugger: TDebugger); +begin + if FDebugger = ADebugger then Exit; + FDebugger := ADebugger; + if FDebugger = nil + then begin + TManagedBreakpoints(FBreakpoints).Master := nil; + TManagedWatches(FWatches).Master := nil; + TManagedLocals(FLocals).Master := nil; + TManagedCallStack(FCallStack).Master := nil; + TManagedExceptions(FExceptions).Master := nil; + TManagedSignals(FSignals).Master := nil; + end + else begin + TManagedBreakpoints(FBreakpoints).Master := FDebugger.BreakPoints; + TManagedWatches(FWatches).Master := FDebugger.Watches; + TManagedLocals(FLocals).Master := FDebugger.Locals; + TManagedCallStack(FCallStack).Master := FDebugger.CallStack; + TManagedExceptions(FExceptions).Master := FDebugger.Exceptions; + TManagedSignals(FSignals).Master := FDebugger.Signals; + end; +end; + end. { ============================================================================= $Log$ + Revision 1.70 2004/08/26 23:50:05 marc + * Restructured debugger view classes + * Fixed help + Revision 1.69 2004/08/08 18:02:44 mattias splitted TMainIDE (main control instance) and TMainIDEBar (IDE menu and palette), added mainbase.pas and mainintf.pas diff --git a/ide/mainbase.pas b/ide/mainbase.pas index 52811345e1..62dbb6fe71 100644 --- a/ide/mainbase.pas +++ b/ide/mainbase.pas @@ -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; diff --git a/ideintf/helpintf.pas b/ideintf/helpintf.pas index ad1d21ff2e..10ca01b129 100644 --- a/ideintf/helpintf.pas +++ b/ideintf/helpintf.pas @@ -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);