Debugger: start refactor event-log handling / allow resource strings for common events to be stored in the IDE (rather than each debugger back end)

git-svn-id: trunk@58433 -

components/debuggerintf/dbgintfdebuggerbase.pp

@@ -1727,6 +1727,27 @@ type
   TDebuggerPropertiesClass= class of TDebuggerProperties;
 
 
+  {$INTERFACES CORBA} // no ref counting needed
+
+  { TDebuggerEventLogInterface
+    Methods for the EventLogger that a debugger may call
+  }
+  //TODO: remove TDebuggerIntf.OnEvent
+
+  TDebuggerEventLogInterface = interface
+    procedure LogCustomEvent(const ACategory: TDBGEventCategory;
+                const AEventType: TDBGEventType; const AText: String);
+    procedure LogEventBreakPointHit(const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec);
+    procedure LogEventWatchPointTriggered(const ABreakpoint: TDBGBreakPoint;
+                const ALocation: TDBGLocationRec; const AOldWatchedVal, ANewWatchedVal: String);
+    procedure LogEventWatchPointScope(const ABreakpoint: TDBGBreakPoint;
+                const ALocation: TDBGLocationRec);
+  end;
+
+  //TDebuggerActionInterface = interface
+  //  // prompt user
+  //end;
+
   { TDebuggerIntf }
 
   TDebuggerIntf = class
@@ -1757,6 +1778,7 @@ type
     FCallStack: TCallStackSupplier;
     FWatches: TWatchesSupplier;
     FThreads: TThreadsSupplier;
+    FEventLogHandler: TDebuggerEventLogInterface;
     FOnCurrent: TDBGCurrentLineEvent;
     FOnException: TDBGExceptionEvent;
     FOnOutput: TDBGOutputEvent;
@@ -1793,6 +1815,7 @@ type
     procedure DoCurrent(const ALocation: TDBGLocationRec);
     procedure DoDbgOutput(const AText: String);
     procedure DoDbgEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
+      deprecated 'swich to EventLogHandler';
     procedure DoException(const AExceptionType: TDBGExceptionType;
                           const AExceptionClass: String;
                           const AExceptionLocation: TDBGLocationRec;
@@ -1903,9 +1926,11 @@ type
     //property UnitInfoProvider: TDebuggerUnitInfoProvider                        // Provided by DebugBoss, to map files to packages or project
     //         read GetUnitInfoProvider write FUnitInfoProvider;
     // Events
+    property EventLogHandler: TDebuggerEventLogInterface read FEventLogHandler write FEventLogHandler;
     property OnCurrent: TDBGCurrentLineEvent read FOnCurrent write FOnCurrent;   // Passes info about the current line being debugged
     property OnDbgOutput: TDBGOutputEvent read FOnDbgOutput write FOnDbgOutput;  // Passes all debuggeroutput
     property OnDbgEvent: TDBGEventNotify read FOnDbgEvent write FOnDbgEvent;     // Passes recognized debugger events, like library load or unload
+      deprecated 'swich to EventLogHandler';
     property OnException: TDBGExceptionEvent read FOnException write FOnException;  // Fires when the debugger received an ecxeption
     property OnOutput: TDBGOutputEvent read FOnOutput write FOnOutput;           // Passes all output of the debugged target
     property OnBeforeState: TDebuggerStateChangedEvent read FOnBeforeState write FOnBeforeState;   // Fires when the current state of the debugger changes
@@ -5745,7 +5770,7 @@ end;
 procedure TDebuggerIntf.DoDbgEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
 begin
   DebugLnEnter(DBG_EVENTS, ['DebugEvent: Enter >> DoDbgEvent >>  State=', dbgs(FState), ' Category=', dbgs(ACategory)]);
-  if Assigned(FOnDbgEvent) then FOnDbgEvent(Self, ACategory, AEventType, AText);
+  if Assigned(FEventLogHandler) then FEventLogHandler.LogCustomEvent(ACategory, AEventType, AText);
   DebugLnExit(DBG_EVENTS, ['DebugEvent: Exit  << DoDbgEvent <<']);
 end;
 

components/lazdebuggergdbmi/gdbmidebugger.pp

@@ -902,7 +902,7 @@ type
     procedure DoUnknownException(Sender: TObject; AnException: Exception);
 
     procedure DoNotifyAsync(Line: String);
-    procedure DoDbgBreakpointEvent(ABreakpoint: TDBGBreakPoint; Location: TDBGLocationRec;
+    procedure DoDbgBreakpointEvent(ABreakpoint: TDBGBreakPoint; ALocation: TDBGLocationRec;
                                    AReason: TGDBMIBreakpointReason;
                                    AOldVal: String = ''; ANewVal: String = '');
     procedure AddThreadGroup(const S: String);
@@ -7911,52 +7911,18 @@ begin
 end;
 
 procedure TGDBMIDebugger.DoDbgBreakpointEvent(ABreakpoint: TDBGBreakPoint;
-  Location: TDBGLocationRec; AReason: TGDBMIBreakpointReason;
+  ALocation: TDBGLocationRec; AReason: TGDBMIBreakpointReason; AOldVal: String;
-  AOldVal: String = ''; ANewVal: String = '');
+  ANewVal: String);
-var
-  SrcName, Msg: String;
-  SrcLine: Integer;
 begin
-  SrcName := Location.SrcFullName;
+  if not Assigned(EventLogHandler) then exit;
-  if SrcName = '' then
-    SrcName := Location.SrcFile;
-  if (SrcName = '') and (ABreakPoint <> nil) and (ABreakPoint.Kind = bpkSource) then
-    SrcName := ABreakpoint.Source;
-  SrcLine := Location.SrcLine;
-  if (SrcLine < 1) and (ABreakPoint <> nil) and (ABreakPoint.Kind = bpkSource) then
-    SrcLine := ABreakpoint.Line;
 
-  if ABreakpoint = nil then begin
+  case AReason of
-    Msg := Format('Unknown %s', [GDBMIBreakPointReasonNames[AReason]]);
+    gbrBreak:        EventLogHandler.LogEventBreakPointHit(ABreakpoint, ALocation);
-    if AReason = gbrWatchTrigger then
+    gbrWatchTrigger: EventLogHandler.LogEventWatchPointTriggered(
-      Msg := Msg + Format(' changed from "%s" to "%s"', [AOldVal, ANewVal]);
+      ABreakpoint, ALocation, AOldVal, ANewVal);
-  end
+    gbrWatchScope:   EventLogHandler.LogEventWatchPointScope(ABreakpoint, ALocation);
-  else begin
-    case ABreakPoint.Kind of
-      bpkSource:  Msg := 'Source Breakpoint';
-      bpkAddress: Msg := 'Address Breakpoint';
-      bpkData:
-        begin
-          if AReason = gbrWatchScope then
-            Msg := Format('Watchpoint for "%s" out of scope', [ABreakpoint.WatchData])
-          else
-            Msg := Format('Watchpoint for "%s" was triggered. Old value "%s", New Value "%s"', [ABreakpoint.WatchData, AOldVal, ANewVal]);
   end;
 end;
-  end;
-
-  if SrcName <> '' then begin
-    DoDbgEvent(ecBreakpoint, etBreakpointHit,
-               Format('%s at $%.' + IntToStr(TargetPtrSize * 2) + 'x: %s line %d',
-                      [Msg, Location.Address, SrcName, SrcLine]));
-  end
-  else begin
-    DoDbgEvent(ecBreakpoint, etBreakpointHit,
-               Format('%s at $%.' + IntToStr(TargetPtrSize * 2) + 'x',
-                      [Msg, Location.Address]));
-  end;
-
-end;
 
 function TGDBMIDebugger.ExecuteCommand(const ACommand: String;
   const AValues: array of const; const AFlags: TGDBMICommandFlags): Boolean;

ide/debugmanager.pas

@@ -61,6 +61,34 @@ uses
 
 
 type
+
+  { TDebugEventLogManager }
+
+  TDebugEventLogManager = class(TObject, TDebuggerEventLogInterface)
+  private
+    FEventDialog: TDbgEventsForm;
+    FHiddenDebugEventsLog: TStringList;
+    FTargetWidth: Integer;
+    procedure SetEventDialog(AValue: TDbgEventsForm);
+    function  FormatBreakPointAddress(const ABreakpoint: TDBGBreakPoint;
+                const ALocation: TDBGLocationRec): String;
+  protected
+    procedure DebuggerEvent(Sender: TObject; const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
+  public
+    procedure LogCustomEvent(const ACategory: TDBGEventCategory;
+                const AEventType: TDBGEventType; const AText: String);
+    procedure LogEventBreakPointHit(const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec);
+    procedure LogEventWatchPointTriggered(const ABreakpoint: TDBGBreakPoint;
+                const ALocation: TDBGLocationRec; const AOldWatchedVal, ANewWatchedVal: String);
+    procedure LogEventWatchPointScope(const ABreakpoint: TDBGBreakPoint;
+                const ALocation: TDBGLocationRec);
+  public
+    destructor Destroy; override;
+    procedure ClearDebugEventsLog;
+    property EventDialog: TDbgEventsForm read FEventDialog write SetEventDialog;
+    property TargetWidth: Integer read FTargetWidth write FTargetWidth;
+  end;
+
   { TDebugManager }
 
   TDebugManager = class(TBaseDebugManager)
@@ -85,7 +113,6 @@ type
     procedure DebuggerChangeState(ADebugger: TDebuggerIntf; OldState: TDBGState);
     procedure DebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
     procedure DebuggerOutput(Sender: TObject; const AText: String);
-    procedure DebuggerEvent(Sender: TObject; const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
     procedure DebuggerConsoleOutput(Sender: TObject; const AText: String);
     function DebuggerFeedback(Sender: TObject; const AText, AInfo: String;
       AType: TDBGFeedbackType; AButtons: TDBGFeedbackResults): TDBGFeedbackResult;
@@ -100,6 +127,7 @@ type
     procedure DebugDialogDestroy(Sender: TObject);
   private
     FDebugger: TDebuggerIntf;
+    FEventLogManager: TDebugEventLogManager;
     FUnitInfoProvider: TDebuggerUnitInfoProvider;
     FDialogs: array[TDebugDialogType] of TDebuggerDlg;
     FInStateChange: Boolean;
@@ -118,7 +146,6 @@ type
 
     // when the debug output log is not open, store the debug log internally
     FHiddenDebugOutputLog: TStringList;
-    FHiddenDebugEventsLog: TStringList;
 
     FRunTimer: TTimer;
     FAttachToID: String;
@@ -328,6 +355,148 @@ type
     procedure Update(Item: TCollectionItem); override;
   end;
 
+{ TDebugEventLogManager }
+
+procedure TDebugEventLogManager.SetEventDialog(AValue: TDbgEventsForm);
+begin
+  if FEventDialog = AValue then Exit;
+
+  If AValue = nil then begin
+    if FHiddenDebugEventsLog=nil then
+      FHiddenDebugEventsLog:=TStringList.Create;
+    FEventDialog.GetEvents(FHiddenDebugEventsLog);
+  end
+  else
+  if FHiddenDebugEventsLog <> nil then begin
+    AValue.SetEvents(FHiddenDebugEventsLog);
+    FreeAndNil(FHiddenDebugEventsLog);
+  end;
+
+  FEventDialog := AValue;
+end;
+
+function TDebugEventLogManager.FormatBreakPointAddress(
+  const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec): String;
+var
+  SrcName: String;
+begin
+  SrcName := ALocation.SrcFullName;
+  if SrcName = '' then
+    SrcName := ALocation.SrcFile;
+
+  if SrcName <> '' then
+    Result := Format(dbgEventBreakAtAddressSourceLine,
+                      [IntToHex(ALocation.Address, FTargetWidth), SrcName, ALocation.SrcLine])
+  else
+  if (ABreakpoint <> nil) and (ABreakPoint.Kind = bpkSource) then
+    Result := Format(dbgEventBreakAtAddressOriginSourceOriginLine,
+                      [IntToHex(ALocation.Address, FTargetWidth), ABreakpoint.Source, ABreakpoint.Line])
+  else
+    Result := Format(dbgEventBreakAtAddress, [IntToHex(ALocation.Address,
+      FTargetWidth)]);
+end;
+
+procedure TDebugEventLogManager.DebuggerEvent(Sender: TObject;
+  const ACategory: TDBGEventCategory; const AEventType: TDBGEventType;
+  const AText: String);
+var
+  Rec: TDBGEventRec;
+begin
+  if EventDialog <> nil
+  then begin
+    EventDialog.AddEvent(ACategory, AEventType, AText)
+  end
+  else begin
+    // store it internally, and copy it to the dialog, when the user opens it
+    if FHiddenDebugEventsLog=nil
+    then FHiddenDebugEventsLog := TStringList.Create;
+    if EnvironmentOptions.DebuggerEventLogCheckLineLimit
+    then begin
+      while FHiddenDebugEventsLog.Count >= EnvironmentOptions.DebuggerEventLogLineLimit do
+        FHiddenDebugEventsLog.Delete(0);
+    end;
+    Rec.Category := Ord(ACategory);
+    Rec.EventType := Ord(AEventType);
+    FHiddenDebugEventsLog.AddObject(AText, TObject(Rec.Ptr));
+  end;
+end;
+
+procedure TDebugEventLogManager.LogCustomEvent(
+  const ACategory: TDBGEventCategory; const AEventType: TDBGEventType;
+  const AText: String);
+begin
+  DebuggerEvent(nil, ACategory, AEventType, AText);
+end;
+
+procedure TDebugEventLogManager.LogEventBreakPointHit(
+  const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec);
+var
+  Msg: String;
+begin
+  if ABreakpoint = nil then
+    Msg := dbgEventBreakUnknownBreakPoint
+  else
+  case ABreakPoint.Kind of
+    bpkSource:  Msg := dbgEventBreakSourceBreakPoint;
+    bpkAddress: Msg := dbgEventBreakAddressBreakPoint;
+    bpkData:    Msg := dbgEventBreakWatchPoint; // should not be here, use LogEventWatchPointTriggered();
+  end;
+
+  LogCustomEvent(ecBreakpoint, etBreakpointHit,
+    Format(Msg, [FormatBreakPointAddress(ABreakpoint, ALocation)]));
+end;
+
+procedure TDebugEventLogManager.LogEventWatchPointTriggered(
+  const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec;
+  const AOldWatchedVal, ANewWatchedVal: String);
+var
+  Msg, Loc: String;
+begin
+  Loc := FormatBreakPointAddress(ABreakpoint, ALocation);
+  if ABreakpoint = nil then
+    Msg := Format(dbgEventUnknownWatchPointTriggered, [Loc, AOldWatchedVal, ANewWatchedVal])
+  else
+  case ABreakPoint.Kind of
+    bpkSource:  Msg := Format(dbgEventBreakSourceBreakPoint , [Loc]); // should not be here
+    bpkAddress: Msg := Format(dbgEventBreakAddressBreakPoint, [Loc]); // should not be here
+    bpkData:    Msg := Format(dbgEventWatchTriggered, [Loc, ABreakpoint.WatchData,
+      AOldWatchedVal, ANewWatchedVal]);
+  end;
+
+  LogCustomEvent(ecBreakpoint, etBreakpointHit, Msg );
+end;
+
+procedure TDebugEventLogManager.LogEventWatchPointScope(
+  const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec);
+var
+  Msg, Loc: String;
+begin
+  Loc := FormatBreakPointAddress(ABreakpoint, ALocation);
+  if ABreakpoint = nil then
+    Msg := Format(dbgEventUnknownWatchPointScopeEnded, [Loc])
+  else
+  case ABreakPoint.Kind of
+    bpkSource:  Msg := Format(dbgEventBreakSourceBreakPoint , [Loc]); // should not be here
+    bpkAddress: Msg := Format(dbgEventBreakAddressBreakPoint, [Loc]); // should not be here
+    bpkData:    Format(dbgEventWatchScopeEnded, [ABreakpoint.WatchData, Loc])
+  end;
+
+  LogCustomEvent(ecBreakpoint, etBreakpointHit, Msg );
+end;
+
+destructor TDebugEventLogManager.Destroy;
+begin
+  FreeAndNil(FHiddenDebugEventsLog);
+  inherited Destroy;
+end;
+
+procedure TDebugEventLogManager.ClearDebugEventsLog;
+begin
+  if EventDialog <> nil then
+    EventDialog.Clear;
+  FreeAndNil(FHiddenDebugEventsLog);
+end;
+
 { TProjectExceptions }
 
 procedure TProjectExceptions.SetIgnoreAll(const AValue: Boolean);
@@ -1066,30 +1235,6 @@ begin
   end;
 end;
 
-procedure TDebugManager.DebuggerEvent(Sender: TObject; const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
-var
-  Rec: TDBGEventRec;
-begin
-  if Destroying then exit;
-  if FDialogs[ddtEvents] <> nil
-  then begin
-    TDbgEventsForm(FDialogs[ddtEvents]).AddEvent(ACategory, AEventType, AText)
-  end
-  else begin
-    // store it internally, and copy it to the dialog, when the user opens it
-    if FHiddenDebugEventsLog=nil
-    then FHiddenDebugEventsLog := TStringList.Create;
-    if EnvironmentOptions.DebuggerEventLogCheckLineLimit
-    then begin
-      while FHiddenDebugEventsLog.Count >= EnvironmentOptions.DebuggerEventLogLineLimit do
-        FHiddenDebugEventsLog.Delete(0);
-    end;
-    Rec.Category := Ord(ACategory);
-    Rec.EventType := Ord(AEventType);
-    FHiddenDebugEventsLog.AddObject(AText, TObject(Rec.Ptr));
-  end;
-end;
-
 procedure TDebugManager.DebuggerBeforeChangeState(ADebugger: TDebuggerIntf;
   AOldState: TDBGState);
 var
@@ -1432,9 +1577,7 @@ begin
       end;
     ddtEvents:
       begin
-        if FHiddenDebugEventsLog=nil then
+        FEventLogManager.EventDialog := nil;
-          FHiddenDebugEventsLog:=TStringList.Create;
-        TDbgEventsForm(FDialogs[ddtEvents]).GetEvents(FHiddenDebugEventsLog);
       end;
     end;
     FDialogs[DlgType]:=nil;
@@ -1546,9 +1689,7 @@ var
   TheDialog: TDbgEventsForm;
 begin
   TheDialog := TDbgEventsForm(FDialogs[ddtEvents]);
-  TheDialog.SetEvents(FHiddenDebugEventsLog);
+  FEventLogManager.EventDialog := TheDialog;
-  if FHiddenDebugEventsLog <> nil then
-    FreeAndNil(FHiddenDebugEventsLog);
 end;
 
 procedure TDebugManager.InitBreakPointDlg;
@@ -1720,6 +1861,8 @@ begin
   RegisterValueFormatter(skFloat, 'TTime', @DBGDateTimeFormatter);
   RegisterValueFormatter(skSimple, 'TDateTime', @DBGDateTimeFormatter);
   RegisterValueFormatter(skFloat, 'TDateTime', @DBGDateTimeFormatter);
+
+  FEventLogManager := TDebugEventLogManager.Create;
 end;
 
 destructor TDebugManager.Destroy;
@@ -1736,6 +1879,7 @@ begin
 
   SetDebugger(nil);
 
+  FreeAndNil(FEventLogManager);
   FreeAndNil(FSnapshots);
   FreeAndNil(FWatches);
   FreeAndNil(FThreads);
@@ -1751,7 +1895,6 @@ begin
 
   FreeAndNil(FUserSourceFiles);
   FreeAndNil(FHiddenDebugOutputLog);
-  FreeAndNil(FHiddenDebugEventsLog);
   FreeAndNil(FUnitInfoProvider);
 
   inherited Destroy;
@@ -2113,10 +2256,7 @@ end;
 
 procedure TDebugManager.ClearDebugEventsLog;
 begin
-  if FDialogs[ddtEvents] <> nil then
+  FEventLogManager.ClearDebugEventsLog;
-    TDbgEventsForm(FDialogs[ddtEvents]).Clear
-  else if FHiddenDebugEventsLog<>nil then
-    FHiddenDebugEventsLog.Clear;
 end;
 
 //-----------------------------------------------------------------------------
@@ -2302,11 +2442,14 @@ begin
     FDebugger.OnState         := @DebuggerChangeState;
     FDebugger.OnCurrent       := @DebuggerCurrentLine;
     FDebugger.OnDbgOutput     := @DebuggerOutput;
-    FDebugger.OnDbgEvent      := @DebuggerEvent;
+    FDebugger.OnDbgEvent      := @FEventLogManager.DebuggerEvent;
     FDebugger.OnException     := @DebuggerException;
     FDebugger.OnConsoleOutput := @DebuggerConsoleOutput;
     FDebugger.OnFeedback      := @DebuggerFeedback;
     FDebugger.OnIdle          := @DebuggerIdle;
+    FDebugger.EventLogHandler := FEventLogManager;
+
+    FEventLogManager.TargetWidth := FDebugger.TargetWidth div 8;
 
     if FDebugger.State = dsNone
     then begin
@@ -2993,6 +3136,7 @@ begin
     FDebugger.OnFeedback      := nil;
     FDebugger.OnIdle          := nil;
     FDebugger.Exceptions := nil;
+    FDebugger.EventLogHandler := nil;
   end;
 
   FDebugger := ADebugger;

ide/lazarusidestrconsts.pas

@@ -6440,6 +6440,22 @@ resourcestring
   lisDsgToggleShowingNonVisualComponents = 'Toggle showing nonvisual '
     +'components';
   lisDsgShowNonVisualComponents = 'Show nonvisual components';
+
+  // * Debug Event Log *
+  // Snippet for break location: .... at $04123456: unit1.pas line 15 ...
+  dbgEventBreakAtAddressSourceLine = 'at $%s: %s line %d';
+  dbgEventBreakAtAddressOriginSourceOriginLine = 'at $%s: from origin %s line %d'; // Source/Line from Breakpoint (origin)
+  dbgEventBreakAtAddress = 'at $%s'; // unknows source/line
+  // Breakpoint hit events (first param is location): "Source Breakpoint at $0x00000..."
+  dbgEventBreakSourceBreakPoint = 'Source Breakpoint %s';
+  dbgEventBreakAddressBreakPoint = 'Address Breakpoint %s';
+  dbgEventBreakUnknownBreakPoint = 'Unknown Breakpoint %s';
+  dbgEventBreakWatchPoint = 'Watchpoint %s';
+  dbgEventWatchTriggered = 'Watchpoint for "%s" was triggered %s. Old value "%s", New Value "%s"';
+  dbgEventUnknownWatchPointTriggered = 'Unknown Watchpoint triggered %s. Old value "%s", New Value "%s"';
+  dbgEventWatchScopeEnded = 'Watchpoint for "%s" out of scope %s';
+  dbgEventUnknownWatchPointScopeEnded = 'Unknown Watchpoint out of scope %s';
+
 implementation
 
 end.