DBG: reduced flicker in Data windows, added debugln

git-svn-id: trunk@31150 -

debugger/callstackdlg.pp

@@ -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;

debugger/debugger.pp

@@ -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;

debugger/debuggerdlg.pp

@@ -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

debugger/threaddlg.pp

@@ -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;

debugger/watchesdlg.pp

@@ -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