IDE: debugging: DoRUnProject: only start debugger, run debugger on timer so that the loop does not hold the LCL component that processed the event

git-svn-id: trunk@23235 -

ide/basedebugmanager.pas

@@ -49,7 +49,9 @@ type
   TDebugManagerState = (
     dmsInitializingDebuggerObject,
     dmsInitializingDebuggerObjectFailed,
-    dmsDebuggerObjectBroken  // the debugger entered the error state
+    dmsDebuggerObjectBroken,  // the debugger entered the error state
+    dmsWaitForRun, // waiting for call to RunDebugger, set by StartDebugging
+    dmsRunning  // set by RunDebugger
     );
   TDebugManagerStates = set of TDebugManagerState;
 
@@ -107,7 +109,8 @@ type
     procedure DoToggleCallStack; virtual; abstract;
     procedure ProcessCommand(Command: word; var Handled: boolean); virtual; abstract;
 
-    function RunDebugger: TModalResult; virtual; abstract;
+    function StartDebugging: TModalResult; virtual; abstract; // set ToolStatus to itDebugger, but do not run debugger yet
+    function RunDebugger: TModalResult; virtual; abstract; // run program, wait until program ends
     procedure EndDebugging; virtual; abstract;
 
     function Evaluate(const AExpression: String; var AResult: String;

ide/debugmanager.pas

@@ -76,6 +76,7 @@ type
 
   TDebugManager = class(TBaseDebugManager)
     procedure BreakAutoContinueTimer(Sender: TObject);
+    procedure OnRunTimer(Sender: TObject);
     // Menu events
     procedure mnuViewDebugDialogClick(Sender: TObject);
     procedure mnuResetDebuggerClicked(Sender: TObject);
@@ -110,6 +111,8 @@ type
     // when the debug output log is not open, store the debug log internally
     FHiddenDebugOutputLog: TStringList;
 
+    FRunTimer: TTimer;
+
     procedure SetDebugger(const ADebugger: TDebugger);
 
     // Breakpoint routines
@@ -164,7 +167,8 @@ type
     procedure DoToggleCallStack; override;
     procedure ProcessCommand(Command: word; var Handled: boolean); override;
 
-    function RunDebugger: TModalResult; override;
+    function StartDebugging: TModalResult; override; // returns immediately
+    function RunDebugger: TModalResult; override; // waits till program ends
     procedure EndDebugging; override;
     function Evaluate(const AExpression: String; var AResult: String;
                      var ATypeInfo: TDBGType): Boolean; override;
@@ -1320,6 +1324,13 @@ begin
   FDebugger.Run;
 end;
 
+procedure TDebugManager.OnRunTimer(Sender: TObject);
+begin
+  FRunTimer.Enabled:=false;
+  if dmsWaitForRun in FManagerStates then
+    RunDebugger;
+end;
+
 procedure TDebugManager.DebuggerBreakPointHit(ADebugger: TDebugger;
   ABreakPoint: TBaseBreakPoint; var ACanContinue: Boolean);
 begin
@@ -1825,6 +1836,9 @@ begin
   FAutoContinueTimer := TTimer.Create(Self);
   FAutoContinueTimer.Enabled := False;
   FAutoContinueTimer.OnTimer := @BreakAutoContinueTimer;
+  FRunTimer := TTimer.Create(Self);
+  FRunTimer.Interval := 1;
+  FRunTimer.OnTimer := @OnRunTimer;
 
   inherited Create(TheOwner);
 end;
@@ -2359,18 +2373,19 @@ begin
   end;
 end;
 
-function TDebugManager.RunDebugger: TModalResult;
+function TDebugManager.StartDebugging: TModalResult;
 begin
-{$ifdef VerboseDebugger}
+  {$ifdef VerboseDebugger}
-  DebugLn('TDebugManager.RunDebugger A ',DbgS(FDebugger<>nil),' Destroying=',DbgS(Destroying));
+  DebugLn('TDebugManager.StartDebugging A ',DbgS(FDebugger<>nil),' Destroying=',DbgS(Destroying));
-{$endif}
+  {$endif}
   Result:=mrCancel;
   if Destroying then exit;
+  if [dmsWaitForRun,dmsRunning]*FManagerStates<>[] then exit;
   if (FDebugger <> nil) then
   begin
-  {$ifdef VerboseDebugger}
+    {$ifdef VerboseDebugger}
-    DebugLn('TDebugManager.RunDebugger B ',FDebugger.ClassName);
+    DebugLn('TDebugManager.StartDebugging B ',FDebugger.ClassName);
-  {$endif}
+    {$endif}
     // check if debugging needs restart
     if (dmsDebuggerObjectBroken in FManagerStates)
     and (MainIDE.ToolStatus=itDebugger) then begin
@@ -2378,13 +2393,47 @@ begin
       Result:=mrCancel;
       exit;
     end;
-    FDebugger.Run;
+    Include(FManagerStates,dmsWaitForRun);
+    FRunTimer.Enabled:=true;
+    Result:=mrOk;
+  end;
+end;
+
+function TDebugManager.RunDebugger: TModalResult;
+begin
+  {$ifdef VerboseDebugger}
+  DebugLn('TDebugManager.RunDebugger A ',DbgS(FDebugger<>nil),' Destroying=',DbgS(Destroying));
+  {$endif}
+  Result:=mrCancel;
+  if Destroying then exit;
+  Exclude(FManagerStates,dmsWaitForRun);
+  if dmsRunning in FManagerStates then exit;
+  if MainIDE.ToolStatus<>itDebugger then exit;
+  if (FDebugger <> nil) then
+  begin
+    {$ifdef VerboseDebugger}
+    DebugLn('TDebugManager.RunDebugger B ',FDebugger.ClassName);
+    {$endif}
+    // check if debugging needs restart
+    if (dmsDebuggerObjectBroken in FManagerStates)
+    and (MainIDE.ToolStatus=itDebugger) then begin
+      MainIDE.ToolStatus:=itNone;
+      Result:=mrCancel;
+      exit;
+    end;
+    Include(FManagerStates,dmsRunning);
+    try
+      FDebugger.Run;
+    finally
+      Exclude(FManagerStates,dmsRunning);
+    end;
     Result:=mrOk;
   end;
 end;
 
 procedure TDebugManager.EndDebugging;
 begin
+  Exclude(FManagerStates,dmsWaitForRun);
   if FDebugger <> nil then FDebugger.Done;
   // if not already freed
   FreeDebugger;

ide/main.pp

@@ -10250,7 +10250,7 @@ begin
 
   Result := mrCancel;
 
-  Result := DebugBoss.RunDebugger;
+  Result := DebugBoss.StartDebugging;
 //  if Result<>mrOk then exit;
 
   DebugLn('[TMainIDE.DoRunProject] END');

lcl/include/treeview.inc

@@ -23,7 +23,6 @@
     TTreeView for LCL
 
   ToDo:
-    - Editing
     - Columns
 }