paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-04 05:59:49 +01:00
Code Issues Packages Projects Releases Wiki Activity

DBG: reduced flicker in Data windows, added debugln

Browse Source 
git-svn-id: trunk@31150 -
This commit is contained in:
martin 2011-06-10 00:44:18 +00:00
parent ad7eb43d19
commit ac70d0ff2f
5 changed files with 77 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
debugger/callstackdlg.pp
View File

@ -103,13 +103,11 @@ type
FViewStart: Integer;
FPowerImgIdx, FPowerImgIdxGrey: Integer;
FInUpdateView: Boolean;
FUpdateFlags: set of (ufNeedUpdating);
function GetImageIndex(Entry: TCallStackEntry): Integer;
procedure SetViewLimit(const AValue: Integer);
procedure SetViewStart(AStart: Integer);
procedure SetViewMax;
procedure BreakPointChanged(const ASender: TIDEBreakPoints; const ABreakpoint: TIDEBreakPoint);
procedure CallStackChanged(Sender: TObject);
procedure CallStackCurrent(Sender: TObject);
procedure GotoIndex(AIndex: Integer);
function GetCurrentEntry: TCallStackEntry;
function GetFunction(const Entry: TCallStackEntry): string;
@ -118,7 +116,6 @@ type
procedure CopyToClipBoard;
procedure ToggleBreakpoint(Item: TListItem);
protected
procedure DoBreakPointsChanged; override;
procedure DoBeginUpdate; override;
procedure DoEndUpdate; override;
procedure DisableAllActions;
@ -126,6 +123,10 @@ type
function GetSelectedSnapshot: TSnapshot;
function GetSelectedThreads(Snap: TSnapshot): TThreads;
function GetSelectedCallstack: TCallStack;
procedure DoBreakPointsChanged; override;
procedure BreakPointChanged(const ASender: TIDEBreakPoints; const ABreakpoint: TIDEBreakPoint);
procedure CallStackChanged(Sender: TObject);
procedure CallStackCurrent(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
property BreakPoints;
@ -173,6 +174,7 @@ end;
procedure TCallStackDlg.CallStackChanged(Sender: TObject);
begin
{$IFDEF DBG_DATA_MONITORS} DebugLn(['DebugDataMonitor: TCallStackDlg.CallStackChanged from ', DbgSName(Sender), ' Upd:', IsUpdating]); {$ENDIF}
if not ToolButtonPower.Down then exit;
if FViewStart = 0
then UpdateView
@ -182,6 +184,7 @@ end;
procedure TCallStackDlg.CallStackCurrent(Sender: TObject);
begin
{$IFDEF DBG_DATA_MONITORS} DebugLn(['DebugDataMonitor: TCallStackDlg.CallStackCurrent from ', DbgSName(Sender), ' Upd:', IsUpdating]); {$ENDIF}
if not ToolButtonPower.Down then exit;
UpdateView;
end;
@ -231,6 +234,15 @@ var
CStack: TCallStack;
begin
if (not ToolButtonPower.Down) or FInUpdateView then exit;
if IsUpdating then begin
{$IFDEF DBG_DATA_MONITORS} DebugLn(['DebugDataMonitor: TCallStackDlg.UpdateView in IsUpdating']); {$ENDIF}
Include(FUpdateFlags, ufNeedUpdating);
exit;
end;
{$IFDEF DBG_DATA_MONITORS} DebugLn(['DebugDataMonitor: TCallStackDlg.UpdateView']); {$ENDIF}
Exclude(FUpdateFlags, ufNeedUpdating);
BeginUpdate;
lvCallStack.BeginUpdate;
try
@ -241,6 +253,7 @@ begin
FInUpdateView := True; // ignore change triggered by count, if there is a change event, then Count will be updated already
CStack := GetSelectedCallstack;
if CStack <> nil then CStack.Count; // trigger the update-notification, if executed immediately
FInUpdateView := False;
if (CStack = nil) or ((Snap <> nil) and (CStack.Count = 0)) then begin
@ -329,6 +342,7 @@ end;
procedure TCallStackDlg.DoEndUpdate;
begin
if ufNeedUpdating in FUpdateFlags then UpdateView;
lvCallStack.EndUpdate;
EnableAllActions;
end;
@ -613,6 +627,7 @@ var
Entry: TCallStackEntry;
Stack: TCallStack;
begin
{$IFDEF DBG_DATA_MONITORS} DebugLn(['DebugDataMonitor: TCallStackDlg.BreakPointChanged ', DbgSName(ASender), ' Upd:', IsUpdating]); {$ENDIF}
Stack := GetSelectedCallstack;
if (BreakPoints = nil) or (Stack = nil) then
Exit;

23
debugger/debugger.pp
View File

@ -35,6 +35,9 @@ unit Debugger;
{$IFDEF linux} {$DEFINE DBG_ENABLE_TERMINAL} {$ENDIF}
{$IFDEF DBG_STATE} {$DEFINE DBG_STATE_EVENT} {$ENDIF}
{$IFDEF DBG_EVENTS} {$DEFINE DBG_STATE_EVENT} {$ENDIF}
interface
uses
@ -4261,6 +4264,7 @@ end;
procedure TCurrentThreads.SetCurrentThreadId(const AValue: Integer);
begin
if FCurrentThreadId = AValue then exit;
inherited SetCurrentThreadId(AValue);
FMonitor.CurrentChanged; // TODO ChangedSelection
end;
@ -4844,7 +4848,9 @@ end;
procedure TDebugger.DoCurrent(const ALocation: TDBGLocationRec);
begin
{$IFDEF DBG_EVENTS} DebugLnEnter(['DebugEvent: Enter >> DoCurrent (Location) >> State=', DBGStateNames[FState]]); {$ENDIF}
if Assigned(FOnCurrent) then FOnCurrent(Self, ALocation);
{$IFDEF DBG_EVENTS} DebugLnExit(['DebugEvent: Exit << DoCurrent (Location) <<']); {$ENDIF}
end;
procedure TDebugger.DoDbgOutput(const AText: String);
@ -4854,19 +4860,24 @@ begin
end;
procedure TDebugger.DoDbgEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
{$IFDEF DBG_EVENTS} var s: String; {$ENDIF}
begin
{$IFDEF DBG_EVENTS} writestr(s, ACategory); DebugLnEnter(['DebugEvent: Enter >> DoDbgEvent >> State=', DBGStateNames[FState], ' Category=', s]); {$ENDIF}
if Assigned(FOnDbgEvent) then FOnDbgEvent(Self, ACategory, AEventType, AText);
{$IFDEF DBG_EVENTS} DebugLnExit(['DebugEvent: Exit << DoDbgEvent <<']); {$ENDIF}
end;
procedure TDebugger.DoException(const AExceptionType: TDBGExceptionType;
const AExceptionClass: String; AExceptionAddress: TDBGPtr; const AExceptionText: String; out AContinue: Boolean);
begin
{$IFDEF DBG_EVENTS} DebugLnEnter(['DebugEvent: Enter >> DoException >> State=', DBGStateNames[FState]]); {$ENDIF}
if AExceptionType = deInternal then
DoDbgEvent(ecDebugger, etExceptionRaised, Format('Exception class "%s" at $%.' + IntToStr(TargetWidth div 4) + 'x with message "%s"', [AExceptionClass, AExceptionAddress, AExceptionText]));
if Assigned(FOnException) then
FOnException(Self, AExceptionType, AExceptionClass, AExceptionText, AContinue)
else
AContinue := True;
{$IFDEF DBG_EVENTS} DebugLnExit(['DebugEvent: Exit << DoException <<']); {$ENDIF}
end;
procedure TDebugger.DoOutput(const AText: String);
@ -4876,18 +4887,24 @@ end;
procedure TDebugger.DoBreakpointHit(const ABreakPoint: TBaseBreakPoint; var ACanContinue: Boolean);
begin
{$IFDEF DBG_EVENTS} DebugLnEnter(['DebugEvent: Enter >> DoBreakpointHit << State=', DBGStateNames[FState]]); {$ENDIF}
if Assigned(FOnBreakpointHit)
then FOnBreakpointHit(Self, ABreakPoint, ACanContinue);
{$IFDEF DBG_EVENTS} DebugLnExit(['DebugEvent: Exit >> DoBreakpointHit <<']); {$ENDIF}
end;
procedure TDebugger.DoBeforeState(const OldState: TDBGState);
begin
{$IFDEF DBG_STATE_EVENT} DebugLnEnter(['DebugEvent: Enter >> DoBeforeState << State=', DBGStateNames[FState]]); {$ENDIF}
if Assigned(FOnBeforeState) then FOnBeforeState(Self, OldState);
{$IFDEF DBG_STATE_EVENT} DebugLnExit(['DebugEvent: Exit >> DoBeforeState <<']); {$ENDIF}
end;
procedure TDebugger.DoState(const OldState: TDBGState);
begin
{$IFDEF DBG_STATE_EVENT} DebugLnEnter(['DebugEvent: Enter >> DoState << State=', DBGStateNames[FState]]); {$ENDIF}
if Assigned(FOnState) then FOnState(Self, OldState);
{$IFDEF DBG_STATE_EVENT} DebugLnExit(['DebugEvent: Exit >> DoState <<']); {$ENDIF}
end;
procedure TDebugger.EnvironmentChanged(Sender: TObject);
@ -5122,6 +5139,9 @@ begin
if AValue <> FState
then begin
{$IFDEF DBG_STATE}
DebugLnEnter(['DebuggerState: Setting to ', DBGStateNames[AValue],', from ', DBGStateNames[FState]]);
{$ENDIF}
OldState := FState;
FState := AValue;
DoBeforeState(OldState);
@ -5136,6 +5156,9 @@ begin
FWatches.DoStateChange(OldState);
finally
DoState(OldState);
{$IFDEF DBG_STATE}
DebugLnExit(['DebuggerState: Finished ', DBGStateNames[AValue]]);
{$ENDIF}
end;
end;
end;

6
debugger/debuggerdlg.pp
View File

@ -56,6 +56,7 @@ type
procedure BeginUpdate;
procedure EndUpdate;
function UpdateCount: integer;
function IsUpdating: Boolean;
private (* provide some common properties *)
FSnapshotManager: TSnapshotManager;
FSnapshotNotification: TSnapshotNotification;
@ -128,6 +129,11 @@ begin
Result := FUpdateCount;
end;
function TDebuggerDlg.IsUpdating: Boolean;
begin
Result := FUpdateCount > 0;
end;
function TDebuggerDlg.GetSnapshotNotification: TSnapshotNotification;
begin
If FSnapshotNotification = nil then begin

23
debugger/threaddlg.pp
View File

@ -5,7 +5,7 @@ unit ThreadDlg;
interface
uses
Classes, SysUtils, ComCtrls, Debugger, DebuggerDlg, LazarusIDEStrConsts,
Classes, SysUtils, ComCtrls, LCLProc, Debugger, DebuggerDlg, LazarusIDEStrConsts,
BaseDebugManager, MainBase, IDEImagesIntf;
type
@ -19,12 +19,15 @@ type
tbGoto: TToolButton;
procedure lvThreadsDblClick(Sender: TObject);
procedure tbCurrentClick(Sender: TObject);
procedure ThreadsChanged(Sender: TObject);
private
imgCurrentLine: Integer;
FUpdateFlags: set of (ufThreadChanged);
procedure JumpToSource;
function GetSelectedSnapshot: TSnapshot;
function GetSelectedThreads(Snap: TSnapshot): TThreads;
protected
procedure DoEndUpdate; override;
procedure ThreadsChanged(Sender: TObject);
public
{ public declarations }
constructor Create(TheOwner: TComponent); override;
@ -46,6 +49,15 @@ var
Threads: TThreads;
Snap: TSnapshot;
begin
if IsUpdating then begin
{$IFDEF DBG_DATA_MONITORS} DebugLn(['DebugDataMonitor: TThreadsDlg.ThreadsChanged from ', DbgSName(Sender), ' in IsUpdating']); {$ENDIF}
Include(FUpdateFlags, ufThreadChanged);
exit;
end;
{$IFDEF DBG_DATA_MONITORS} DebugLn(['DebugDataMonitor: TThreadsDlg.ThreadsChanged from ', DbgSName(Sender)]); {$ENDIF}
Exclude(FUpdateFlags, ufThreadChanged);
if ThreadsMonitor = nil then begin
lvThreads.Clear;
exit;
@ -169,6 +181,11 @@ begin
else Result := ThreadsMonitor.Snapshots[Snap];
end;
procedure TThreadsDlg.DoEndUpdate;
begin
if ufThreadChanged in FUpdateFlags then ThreadsChanged(nil);
end;
constructor TThreadsDlg.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
@ -183,7 +200,7 @@ begin
tbGoto.Caption := lisThreadsGoto;
SnapshotNotification.OnCurrent := @ThreadsChanged;
ThreadsNotification.OnChange := @ThreadsChanged;;
ThreadsNotification.OnChange := @ThreadsChanged;
imgCurrentLine := IDEImages.LoadImage(16, 'debugger_current_line');
lvThreads.SmallImages := IDEImages.Images_16;

10
debugger/watchesdlg.pp
View File

@ -44,7 +44,11 @@ uses
type
TWatchesDlgStateFlags = set of (wdsfUpdating, wdsfNeedDeleteAll, wdsfNeedDeleteCurrent);
TWatchesDlgStateFlags = set of (
wdsfUpdating,
wdsfNeedDeleteAll,
wdsfNeedDeleteCurrent
);
{ TWatchesDlg }
@ -366,6 +370,7 @@ end;
procedure TWatchesDlg.ContextChanged(Sender: TObject);
begin
{$IFDEF DBG_DATA_MONITORS} DebugLn(['DebugDataMonitor: TWatchesDlg.ContextChanged ', DbgSName(Sender), ' Upd:', IsUpdating]); {$ENDIF}
UpdateAll;
end;
@ -435,6 +440,7 @@ procedure TWatchesDlg.SnapshotChanged(Sender: TObject);
var
NewWatches: TWatches;
begin
{$IFDEF DBG_DATA_MONITORS} DebugLn(['DebugDataMonitor: TWatchesDlg.SnapshotChanged ', DbgSName(Sender), ' Upd:', IsUpdating]); {$ENDIF}
lvWatches.BeginUpdate;
try
NewWatches := Watches;
@ -614,6 +620,7 @@ var
i, l: Integer;
Snap: TSnapshot;
begin
{$IFDEF DBG_DATA_MONITORS} DebugLn(['UpdateAll: TWatchesDlg.UpdateAll Upd:', IsUpdating]); {$ENDIF}
Snap := GetSelectedSnapshot;
if Snap <> nil
then Caption:= liswlWatchList + ' (' + Snap.LocationAsText + ')'
@ -687,6 +694,7 @@ var
begin
if AWatch = nil then Exit;
if AWatch.Collection <> FWatchesInView then exit;
{$IFDEF DBG_DATA_MONITORS} DebugLn(['DebugDataMonitor: TWatchesDlg.WatchUpdate Upd:', IsUpdating, ' Watch=',AWatch.Expression]); {$ENDIF}
Item := lvWatches.Items.FindData(AWatch);
if Item = nil