diff --git a/.gitattributes b/.gitattributes index 9bd8d6bda0..80c3ca6d31 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2756,6 +2756,8 @@ debugger/frames/debugger_signals_options.pas svneol=native#text/pascal debugger/gdbmidebugger.pp svneol=native#text/pascal debugger/gdbmimiscclasses.pp svneol=native#text/pascal debugger/gdbtypeinfo.pp svneol=native#text/pascal +debugger/historydlg.lfm svneol=native#text/plain +debugger/historydlg.pp svneol=native#text/pascal debugger/inspectdlg.lfm svneol=native#text/plain debugger/inspectdlg.pas svneol=native#text/pascal debugger/localsdlg.lfm svneol=native#text/plain diff --git a/debugger/breakpointsdlg.pp b/debugger/breakpointsdlg.pp index 3496034093..f51a619230 100644 --- a/debugger/breakpointsdlg.pp +++ b/debugger/breakpointsdlg.pp @@ -587,7 +587,7 @@ procedure TBreakPointsDlg.popDeleteClick(Sender: TObject); begin try DisableAllActions; - DeleteSelectedBreakpoints + DeleteSelectedBreakpoints; finally lvBreakPointsSelectItem(nil, nil, False); end; diff --git a/debugger/callstackdlg.pp b/debugger/callstackdlg.pp index 502dd1637a..4b7b49675f 100644 --- a/debugger/callstackdlg.pp +++ b/debugger/callstackdlg.pp @@ -102,8 +102,10 @@ type FBreakPoints: TIDEBreakPoints; FCallStackMonitor: TCallStackMonitor; FCallStackNotification: TCallStackNotification; + FSnapshotManager: TSnapshotManager; FThreadNotification: TThreadsNotification; FBreakpointsNotification: TIDEBreakPointsNotification; + FSnapshotNotification: TSnapshotNotification; FThreadsMonitor: TThreadsMonitor; FViewCount: Integer; FViewLimit: Integer; @@ -112,6 +114,7 @@ type FInUpdateView: Boolean; function GetImageIndex(Entry: TCallStackEntry): Integer; procedure SetBreakPoints(const AValue: TIDEBreakPoints); + procedure SetSnapshotManager(const AValue: TSnapshotManager); procedure SetThreadsMonitor(const AValue: TThreadsMonitor); procedure SetViewLimit(const AValue: Integer); procedure SetViewStart(AStart: Integer); @@ -120,6 +123,7 @@ type procedure CallStackChanged(Sender: TObject); procedure CallStackCurrent(Sender: TObject); procedure ThreadsCurrent(Sender: TObject); + procedure SnapshotChanged(Sender: TObject); procedure GotoIndex(AIndex: Integer); function GetCurrentEntry: TCallStackEntry; function GetFunction(const Entry: TCallStackEntry): string; @@ -133,6 +137,8 @@ type procedure DoEndUpdate; override; procedure DisableAllActions; procedure EnableAllActions; + function GetSelectedSnapshot: TSnapshot; + function GetSelectedThreads(Snap: TSnapshot): TThreads; function GetSelectedCallstack: TCallStack; public constructor Create(AOwner: TComponent); override; @@ -141,6 +147,7 @@ type property BreakPoints: TIDEBreakPoints read FBreakPoints write SetBreakPoints; property CallStackMonitor: TCallStackMonitor read FCallStackMonitor write SetCallStackMonitor; property ThreadsMonitor: TThreadsMonitor read FThreadsMonitor write SetThreadsMonitor; + property SnapshotManager: TSnapshotManager read FSnapshotManager write SetSnapshotManager; property ViewLimit: Integer read FViewLimit write SetViewLimit; end; @@ -179,6 +186,11 @@ begin FThreadNotification.AddReference; FThreadNotification.OnCurrent := @ThreadsCurrent; + FSnapshotNotification := TSnapshotNotification.Create; + FSnapshotNotification.AddReference; + FSnapshotNotification.OnChange := @SnapshotChanged; + FSnapshotNotification.OnCurrent := @SnapshotChanged; + FViewLimit := 10; FViewCount := 10; FViewStart := 0; @@ -243,10 +255,17 @@ var Entry: TCallStackEntry; First, Count: Integer; Source: String; + Snap: TSnapshot; begin if (not ToolButtonPower.Down) or FInUpdateView then exit; BeginUpdate; + lvCallStack.BeginUpdate; try + Snap := GetSelectedSnapshot; + if Snap <> nil + then Caption:= lisMenuViewCallStack + ' (' + Snap.LocationAsText + ')' + else Caption:= lisMenuViewCallStack; + FInUpdateView := True; // ignore change triggered by count, if there is a change event, then Count will be updated already if (GetSelectedCallstack = nil) or (GetSelectedCallstack.Count=0) then begin @@ -256,10 +275,15 @@ begin end; FInUpdateView := False; - First := FViewStart; - if First + FViewLimit <= GetSelectedCallstack.Count - then Count := FViewLimit - else Count := GetSelectedCallstack.Count - First; + if Snap <> nil then begin + First := 0; + Count := GetSelectedCallstack.Count; + end else begin + First := FViewStart; + if First + FViewLimit <= GetSelectedCallstack.Count + then Count := FViewLimit + else Count := GetSelectedCallstack.Count - First; + end; // Reuse entries, so add and remove only // Remove unneded @@ -306,6 +330,7 @@ begin finally FInUpdateView := False; + lvCallStack.EndUpdate; EndUpdate; end; end; @@ -325,6 +350,11 @@ begin SetThreadsMonitor(nil); FThreadNotification.OnCurrent := nil; FThreadNotification.ReleaseReference; + + SetSnapshotManager(nil); + FSnapshotNotification.OnChange := nil; + FSnapshotNotification.OnCurrent := nil; + FSnapshotNotification.ReleaseReference; inherited Destroy; end; @@ -351,17 +381,56 @@ end; procedure TCallStackDlg.EnableAllActions; var i: Integer; + Snap: TSnapshot; begin for i := 0 to aclActions.ActionCount - 1 do (aclActions.Actions[i] as TAction).Enabled := True; + Snap := GetSelectedSnapshot; + if snap <> nil then begin + actViewLimit.Enabled := False; + actViewMore.Enabled := False; + end; + ToolButtonPower.Enabled := Snap = nil; +end; + +function TCallStackDlg.GetSelectedSnapshot: TSnapshot; +begin + Result := nil; + if (SnapshotManager <> nil) and (SnapshotManager.HistorySelected) + then Result := SnapshotManager.SelectedEntry; +end; + +function TCallStackDlg.GetSelectedThreads(Snap: TSnapshot): TThreads; +begin + if FThreadsMonitor = nil then exit(nil); + if Snap = nil + then Result := FThreadsMonitor.CurrentThreads + else Result := FThreadsMonitor.Snapshots[Snap]; end; function TCallStackDlg.GetSelectedCallstack: TCallStack; +var + Snap: TSnapshot; + Threads: TThreads; + tid: LongInt; begin if (CallStackMonitor = nil) or (ThreadsMonitor = nil) - then Result := nil - else Result := CallStackMonitor.CurrentCallStackList.EntriesForThreads - [ThreadsMonitor.CurrentThreads.CurrentThreadId]; + then begin + Result := nil; + exit; + end; + + Snap := GetSelectedSnapshot; + Threads := GetSelectedThreads(Snap); + // There should always be a thread object + Assert(Threads<>nil, 'TCallStackDlg.GetSelectedCallstack missing thread object'); + if Threads <> nil + then tid := Threads.CurrentThreadId + else tid := 1; + + if (Snap <> nil) + then Result := CallStackMonitor.Snapshots[Snap].EntriesForThreads[tid] + else Result := CallStackMonitor.CurrentCallStackList.EntriesForThreads[tid]; end; function TCallStackDlg.GetCurrentEntry: TCallStackEntry; @@ -471,6 +540,11 @@ begin actViewLimit.Caption := TMenuItem(Sender).Caption; end; +procedure TCallStackDlg.SnapshotChanged(Sender: TObject); +begin + CallStackChanged(nil); +end; + procedure TCallStackDlg.ThreadsCurrent(Sender: TObject); begin CallStackChanged(nil); @@ -511,6 +585,8 @@ begin if Entry = nil then Exit; GetSelectedCallstack.ChangeCurrentIndex(Entry.Index); + if GetSelectedSnapshot <> nil + then CallStackMonitor.NotifyCurrent; // TODO: move to snapshot callstack object finally EnableAllActions; end; @@ -753,6 +829,15 @@ begin UpdateView; end; +procedure TCallStackDlg.SetSnapshotManager(const AValue: TSnapshotManager); +begin + if FSnapshotManager = AValue then exit; + if FSnapshotManager <> nil then FSnapshotManager.RemoveNotification(FSnapshotNotification); + FSnapshotManager := AValue; + if FSnapshotManager <> nil then FSnapshotManager.AddNotification(FSnapshotNotification); + UpdateView; +end; + procedure TCallStackDlg.SetThreadsMonitor(const AValue: TThreadsMonitor); begin if FThreadsMonitor = AValue then exit; diff --git a/debugger/debugger.pp b/debugger/debugger.pp index 829a09f8ab..f3e65b093c 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -212,9 +212,10 @@ type TIDEBreakPoints = class; TIDEBreakPointGroup = class; TIDEBreakPointGroups = class; + TWatch = class; + TWatches = class; TCurrentWatch = class; TCurrentWatches = class; - TWatch = class; TWatchesMonitor = class; TWatchesSupplier = class; TLocalsMonitor = class; @@ -267,7 +268,47 @@ type destructor Destroy; override; end; -(******************************************************************************) + { TDebuggerDataSnapShot } + + TDebuggerDataSnapShot = class + public + destructor Destroy; override; + public + DataObject: TObject; + SnapShotId: Pointer; + end; + + { TDebuggerDataSnapShotList } + + TDebuggerDataSnapShotList = class + private + FList: TList; + function GetSnapShot(AnID: Pointer): TObject; + public + constructor Create; + destructor Destroy; override; + procedure Clear; + procedure AddSnapShot(AnID: Pointer; AnObject: TObject); + procedure RemoveSnapShot(AnID: Pointer); + property SnapShot[AnID: Pointer]: TObject read GetSnapShot; + end; + + { TDebuggerDataMonitorEx } + + TDebuggerDataMonitorEx = class(TDebuggerDataMonitor) + private + FSnapshots: TDebuggerDataSnapShotList; + protected + function CreateSnapshot: TObject; virtual; + function GetSnapshotObj(AnID: Pointer): TObject; virtual; + public + constructor Create; + destructor Destroy; override; + procedure NewSnapshot(AnID: Pointer); + procedure RemoveSnapshot(AnID: Pointer); + end; + +{$region Breakpoints **********************************************************} (******************************************************************************) (** **) (** B R E A K P O I N T S **) @@ -601,9 +642,10 @@ type read GetItem write SetItem; default; end; +{%endregion ^^^^^ Breakpoints ^^^^^ } -(******************************************************************************) +{$region Debug Info ***********************************************************} (******************************************************************************) (** **) (** D E B U G I N F O R M A T I O N **) @@ -721,6 +763,7 @@ type property Members: TStrings read FMembers; property Result: TDBGType read FResult; end; +{%endregion ^^^^^ Debug Info ^^^^^ } {%region Watches ************************************************************** ****************************************************************************** @@ -756,7 +799,7 @@ const type TWatchesEvent = - procedure(const ASender: TCurrentWatches; const AWatch: TCurrentWatch) of object; + procedure(const ASender: TWatches; const AWatch: TWatch) of object; TWatchesNotification = class(TDebuggerNotification) private @@ -781,7 +824,6 @@ type property Items[AIndex: Integer]: TWatchesNotification read GetItem; default; end; - { TWatchValue } TWatchValue = class @@ -826,6 +868,7 @@ type FWatch: TWatch; function GetEntry(const AThreadId: Integer; const AStackFrame: Integer; const ADisplayFormat: TWatchDisplayFormat): TWatchValue; + function GetEntryByIdx(AnIndex: integer): TWatchValue; protected function CreateEntry(const AThreadId: Integer; const AStackFrame: Integer; const ADisplayFormat: TWatchDisplayFormat): TWatchValue; virtual; @@ -833,7 +876,10 @@ type procedure Assign(AnOther: TWatchValueList); constructor Create(AOwnerWatch: TWatch); destructor Destroy; override; + procedure Add(AnEntry: TWatchValue); procedure Clear; + function Count: Integer; + property EntriesByIdx[AnIndex: integer]: TWatchValue read GetEntryByIdx; property Entries[const AThreadId: Integer; const AStackFrame: Integer; const ADisplayFormat: TWatchDisplayFormat]: TWatchValue read GetEntry; default; @@ -883,9 +929,28 @@ type end; TBaseWatchClass = class of TWatch; + { TWatches } + + TWatches = class(TCollection) + private + function GetItem(const AnIndex: Integer): TWatch; + procedure SetItem(const AnIndex: Integer; const AValue: TWatch); + protected + public + constructor Create; + constructor Create(const AWatchClass: TBaseWatchClass); + function Add(const AExpression: String): TWatch; + function Find(const AExpression: String): TWatch; + property Items[const AnIndex: Integer]: TWatch read GetItem write SetItem; default; + procedure ClearValues; + end; + { TCurrentWatchValue } TCurrentWatchValue = class(TWatchValue) + private + FSnapShot: TWatchValue; + procedure SetSnapShot(const AValue: TWatchValue); protected FFreeNotificationList: TMethodList; procedure RequestData; override; @@ -895,6 +960,7 @@ type destructor Destroy; override; procedure AddFreeeNotification(ANotification: TNotifyEvent); procedure RemoveFreeeNotification(ANotification: TNotifyEvent); + property SnapShot: TWatchValue read FSnapShot write SetSnapShot; public procedure SetTypeInfo(const AValue: TDBGType); procedure SetValue(const AValue: String); @@ -903,18 +969,26 @@ type { TCurrentWatchValueList } TCurrentWatchValueList = class(TWatchValueList) + private + FSnapShot: TWatchValueList; + procedure SetSnapShot(const AValue: TWatchValueList); protected function CreateEntry(const AThreadId: Integer; const AStackFrame: Integer; const ADisplayFormat: TWatchDisplayFormat): TWatchValue; override; + property SnapShot: TWatchValueList read FSnapShot write SetSnapShot; end; { TCurrentWatch } TCurrentWatch = class(TWatch) + private + FSnapShot: TWatch; + procedure SetSnapShot(const AValue: TWatch); protected function CreateValueList: TWatchValueList; override; procedure DoChanged; override; procedure RequestData(AWatchValue: TCurrentWatchValue); + property SnapShot: TWatch read FSnapShot write SetSnapShot; public constructor Create(ACollection: TCollection); override; destructor Destroy; override; @@ -925,24 +999,13 @@ type end; TIDEWatchClass = class of TCurrentWatch; - { TWatches } - - TWatches = class(TCollection) - private - protected - public - constructor Create(const AWatchClass: TBaseWatchClass); - function Add(const AExpression: String): TWatch; - function Find(const AExpression: String): TWatch; - // no items property needed, it is "overridden" anyhow - procedure ClearValues; - end; - { TCurrentWatches } TCurrentWatches = class(TWatches) private FMonitor: TWatchesMonitor; + FSnapShot: TWatches; + procedure SetSnapShot(const AValue: TWatches); procedure WatchesChanged(Sender: TObject); protected function GetItem(const AnIndex: Integer): TCurrentWatch; @@ -952,6 +1015,7 @@ type procedure NotifyRemove(const AWatch: TCurrentWatch); virtual; // called by watch when destructed procedure Update(Item: TCollectionItem); override; procedure RequestData(AWatchValue: TCurrentWatchValue); + property SnapShot: TWatches read FSnapShot write SetSnapShot; public constructor Create(AMonitor: TWatchesMonitor); // Watch @@ -967,10 +1031,11 @@ type { TWatchesMonitor } - TWatchesMonitor = class(TDebuggerDataMonitor) + TWatchesMonitor = class(TDebuggerDataMonitorEx) private FNotificationList: TWatchesNotificationList; FCurrentWatches: TCurrentWatches; + function GetSnapshot(AnID: Pointer): TWatches; function GetSupplier: TWatchesSupplier; procedure SetSupplier(const AValue: TWatchesSupplier); protected @@ -979,12 +1044,14 @@ type procedure NotifyRemove(const AWatches: TCurrentWatches; const AWatch: TCurrentWatch); procedure NotifyUpdate(const AWatches: TCurrentWatches; const AWatch: TCurrentWatch); procedure RequestData(AWatchValue: TCurrentWatchValue); + function CreateSnapshot: TObject; override; public constructor Create; destructor Destroy; override; procedure AddNotification(const ANotification: TWatchesNotification); procedure RemoveNotification(const ANotification: TWatchesNotification); property CurrentWatches: TCurrentWatches read FCurrentWatches; + property Snapshots[AnID: Pointer]: TWatches read GetSnapshot; property Supplier: TWatchesSupplier read GetSupplier write SetSupplier; public procedure Clear; @@ -1005,6 +1072,7 @@ type procedure InternalRequestData(AWatchValue: TCurrentWatchValue); virtual; procedure DoStateChange(const AOldState: TDBGState); virtual; public + constructor Create(const ADebugger: TDebugger); property Monitor: TWatchesMonitor read GetMonitor write SetMonitor; property CurrentWatches: TCurrentWatches read GetCurrentWatches; end; @@ -1035,7 +1103,10 @@ type FStackFrame: Integer; FThreadId: Integer; public + procedure Assign(AnOther: TLocals); constructor Create; + constructor Create(AThreadId, AStackFrame: Integer); + constructor CreateCopy(const ASource: TLocals); destructor Destroy; override; function Count: Integer; virtual; public @@ -1051,13 +1122,17 @@ type private FList: TList; function GetEntry(const AThreadId: Integer; const AStackFrame: Integer): TLocals; + function GetEntryByIdx(const AnIndex: Integer): TLocals; protected function CreateEntry(const AThreadId: Integer; const AStackFrame: Integer): TLocals; virtual; + procedure Add(AnEntry: TLocals); public - //procedure Assign(AnOther: TWatchValueList); constructor Create; destructor Destroy; override; + procedure Assign(AnOther: TLocalsList); procedure Clear; + function Count: Integer; + property EntriesByIdx[const AnIndex: Integer]: TLocals read GetEntryByIdx; property Entries[const AThreadId: Integer; const AStackFrame: Integer]: TLocals read GetEntry; default; end; @@ -1068,6 +1143,10 @@ type private FMonitor: TLocalsMonitor; FDataValidity: TDebuggerDataState; + FSnapShot: TLocals; + procedure SetSnapShot(const AValue: TLocals); + protected + property SnapShot: TLocals read FSnapShot write SetSnapShot; public constructor Create(AMonitor: TLocalsMonitor; AThreadId, AStackFrame: Integer); function Count: Integer; override; @@ -1081,25 +1160,29 @@ type TCurrentLocalsList = class(TLocalsList) private FMonitor: TLocalsMonitor; + FSnapShot: TLocalsList; + procedure SetSnapShot(const AValue: TLocalsList); protected - function CreateEntry(const AThreadId: Integer; const AStackFrame: Integer): TLocals; - override; + function CreateEntry(const AThreadId: Integer; const AStackFrame: Integer): TLocals; override; + property SnapShot: TLocalsList read FSnapShot write SetSnapShot; public constructor Create(AMonitor: TLocalsMonitor); end; { TLocalsMonitor } - TLocalsMonitor = class(TDebuggerDataMonitor) + TLocalsMonitor = class(TDebuggerDataMonitorEx) private FCurrentLocalsList: TCurrentLocalsList; FNotificationList: TDebuggerChangeNotificationList; + function GetSnapshot(AnID: Pointer): TLocalsList; function GetSupplier: TLocalsSupplier; procedure SetSupplier(const AValue: TLocalsSupplier); protected procedure NotifyChange(ALocals: TCurrentLocals); procedure DoNewSupplier; override; procedure RequestData(ALocals: TCurrentLocals); + function CreateSnapshot: TObject; override; public constructor Create; destructor Destroy; override; @@ -1107,6 +1190,7 @@ type procedure AddNotification(const ANotification: TLocalsNotification); procedure RemoveNotification(const ANotification: TLocalsNotification); property CurrentLocalsList: TCurrentLocalsList read FCurrentLocalsList; + property Snapshots[AnID: Pointer]: TLocalsList read GetSnapshot; property Supplier: TLocalsSupplier read GetSupplier write SetSupplier; end; @@ -1363,25 +1447,26 @@ type TCallStack = class(TObject) private - FCount: Integer; - FLowestUnknown, FHighestUnknown: Integer; FThreadId: Integer; FCurrent: Integer; - function IndexError(AIndex: Integer): TCallStackEntry; - function GetEntry(AIndex: Integer): TCallStackEntry; + FList: TList; protected - FEntries: TMap; // list of created entries - procedure Clear; virtual; - function GetCount: Integer; virtual; + function IndexError(AIndex: Integer): TCallStackEntry; + function GetCurrent: Integer; virtual; procedure SetCurrent(AValue: Integer); virtual; + + procedure Clear; virtual; + function GetCount: Integer; virtual; procedure SetCount(ACount: Integer); virtual; - procedure DoEntriesCreated; virtual; - property LowestUnknown: Integer read FLowestUnknown; - property HighestUnknown: Integer read FHighestUnknown; + function GetEntry(AIndex: Integer): TCallStackEntry; virtual; + procedure AddEntry(AnEntry: TCallStackEntry); virtual; // must be added in correct order + procedure AssignEntriesTo(AnOther: TCallStack); virtual; public constructor Create; + constructor CreateCopy(const ASource: TCallStack); destructor Destroy; override; + procedure Assign(AnOther: TCallStack); procedure PrepareRange(AIndex, ACount: Integer); virtual; procedure ChangeCurrentIndex(ANewIndex: Integer); virtual; property Count: Integer read GetCount write SetCount; @@ -1402,6 +1487,7 @@ type public constructor Create; destructor Destroy; override; + procedure Assign(AnOther: TCallStackList); procedure Clear; function Count: Integer; // Count of already requested CallStacks (via ThreadId) property Entries[const AIndex: Integer]: TCallStack read GetEntry; default; @@ -1417,20 +1503,34 @@ type FCurrentValidity: TDebuggerDataState; FNewCurrentIndex: Integer; FPreparing: Boolean; + FSnapShot: TCallStack; + FEntries: TMap; // list of created entries + FCount: Integer; + FLowestUnknown, FHighestUnknown: Integer; + procedure SetSnapShot(const AValue: TCallStack); protected - function GetCount: Integer; override; + function GetCurrent: Integer; override; procedure SetCurrent(AValue: Integer); override; - function GetCurrent: Integer; override; + + procedure Clear; override; + function GetCount: Integer; override; + procedure SetCount(ACount: Integer); override; + function GetEntry(AIndex: Integer): TCallStackEntry; override; + procedure AddEntry(AnEntry: TCallStackEntry); override; + procedure AssignEntriesTo(AnOther: TCallStack); override; public constructor Create(AMonitor: TCallStackMonitor); + destructor Destroy; override; + procedure Assign(AnOther: TCallStack); procedure PrepareRange(AIndex, ACount: Integer); override; procedure ChangeCurrentIndex(ANewIndex: Integer); override; - procedure DoEntriesCreated; override; + procedure DoEntriesCreated; procedure DoEntriesUpdated; - property LowestUnknown; - property HighestUnknown; + property LowestUnknown: Integer read FLowestUnknown; + property HighestUnknown: Integer read FHighestUnknown; property RawEntries: TMap read FEntries; property NewCurrentIndex: Integer read FNewCurrentIndex; + property SnapShot: TCallStack read FSnapShot write SetSnapShot; public procedure SetCountValidity(AValidity: TDebuggerDataState); procedure SetCurrentValidity(AValidity: TDebuggerDataState); @@ -1441,19 +1541,23 @@ type TCurrentCallStackList = class(TCallStackList) private FMonitor: TCallStackMonitor; + FSnapShot: TCallStackList; + procedure SetSnapShot(const AValue: TCallStackList); protected function GetEntryForThread(const AThreadId: Integer): TCallStack; override; + property SnapShot: TCallStackList read FSnapShot write SetSnapShot; public constructor Create(AMonitor: TCallStackMonitor); end; { TCallStackMonitor } - TCallStackMonitor = class(TDebuggerDataMonitor) + TCallStackMonitor = class(TDebuggerDataMonitorEx) private FCurrentCallStackList: TCurrentCallStackList; FNotificationList: TDebuggerChangeNotificationList; procedure CallStackClear(Sender: TObject); + function GetSnapshot(AnID: Pointer): TCallStackList; function GetSupplier: TCallStackSupplier; procedure SetSupplier(const AValue: TCallStackSupplier); protected @@ -1462,14 +1566,16 @@ type procedure RequestEntries(ACallstack: TCallStack); procedure UpdateCurrentIndex; procedure DoNewSupplier; override; - procedure NotifyChange; // (sender) - procedure NotifyCurrent; + function CreateSnapshot: TObject; override; public constructor Create; destructor Destroy; override; procedure AddNotification(const ANotification: TCallStackNotification); procedure RemoveNotification(const ANotification: TCallStackNotification); + procedure NotifyChange; // (sender) + procedure NotifyCurrent; property CurrentCallStackList: TCurrentCallStackList read FCurrentCallStackList; + property Snapshots[AnID: Pointer]: TCallStackList read GetSnapshot; property Supplier: TCallStackSupplier read GetSupplier write SetSupplier; end; @@ -1739,7 +1845,7 @@ type constructor Create; destructor Destroy; override; function Count: Integer; virtual; - procedure Clear; + procedure Clear; virtual; procedure Add(AThread: TThreadEntry); property Entries[const AnIndex: Integer]: TThreadEntry read GetEntry; default; property CurrentThreadId: Integer read FCurrentThreadId write SetCurrentThreadId; @@ -1751,26 +1857,32 @@ type private FMonitor: TThreadsMonitor; FDataValidity: TDebuggerDataState; + FSnapShot: TThreads; procedure SetCurrentThreadId(const AValue: Integer); override; + procedure SetSnapShot(const AValue: TThreads); + protected + property SnapShot: TThreads read FSnapShot write SetSnapShot; public constructor Create(AMonitor: TThreadsMonitor); function Count: Integer; override; + procedure Clear; override; procedure SetValidity(AValidity: TDebuggerDataState); end; { TThreadsMonitor } - TThreadsMonitor = class(TDebuggerDataMonitor) + TThreadsMonitor = class(TDebuggerDataMonitorEx) private FCurrentThreads: TCurrentThreads; FNotificationList: TDebuggerChangeNotificationList; + function GetSnapshot(AnID: Pointer): TThreads; function GetSupplier: TThreadsSupplier; procedure SetSupplier(const AValue: TThreadsSupplier); protected procedure DoNewSupplier; override; procedure Changed; - procedure CurrentChanged; procedure RequestData; + function CreateSnapshot: TObject; override; public constructor Create; destructor Destroy; override; @@ -1778,7 +1890,9 @@ type procedure AddNotification(const ANotification: TThreadsNotification); procedure RemoveNotification(const ANotification: TThreadsNotification); procedure ChangeCurrentThread(ANewId: Integer); + procedure CurrentChanged; property CurrentThreads: TCurrentThreads read FCurrentThreads; + property Snapshots[AnID: Pointer]: TThreads read GetSnapshot; property Supplier: TThreadsSupplier read GetSupplier write SetSupplier; end; @@ -1792,7 +1906,6 @@ type protected procedure ChangeCurrentThread(ANewId: Integer); virtual; procedure RequestMasterData; virtual; - procedure Changed; public procedure DoStateChange(const AOldState: TDBGState); virtual; property CurrentThreads: TCurrentThreads read GetCurrentThreads; @@ -1801,7 +1914,82 @@ type {%endregion ^^^^^ Threads ^^^^^ } -(******************************************************************************) +{%region ***** Snapshots ***** } + + TSnapshotNotification = class(TDebuggerChangeNotification) + public + property OnChange; // fires for all changes (incl OnCurrent) + property OnCurrent; + end; + + { TSnapshot } + + TSnapshot = class + private + FLocation: TDBGLocationRec; + FTimeStamp: TDateTime; + function GetLocationAsText: String; + public + constructor Create; + property TimeStamp: TDateTime read FTimeStamp; + property Location: TDBGLocationRec read FLocation write FLocation; + property LocationAsText: String read GetLocationAsText; + end; + + { TSnapshotManager } + + TSnapshotManager = class + private + FDebugger: TDebugger; + FNotificationList: TDebuggerChangeNotificationList; + FLocals: TLocalsMonitor; + FWatches: TWatchesMonitor; + FCallStack: TCallStackMonitor; + FThreads: TThreadsMonitor; + FCurrentState: TDBGState; + FCurrentSnapshot: TSnapshot; // snapshot fo rcurrent pause. Not yet in list + private + FActive: Boolean; + FHistoryCapacity: Integer; + FHistoryIndex: Integer; + FHistoryList: TList; + FHistorySelected: Boolean; + function GetHistoryEntry(AIndex: Integer): TSnapshot; + procedure SetActive(const AValue: Boolean); + procedure SetHistoryIndex(const AValue: Integer); + procedure SetHistorySelected(AValue: Boolean); + protected + procedure ClearHistory; + procedure CreateHistoryEntry; + procedure RemoveHistoryEntry(AIndex: Integer); + procedure RemoveHistoryEntryFromMonitors(AnEntry: TSnapshot); + public + constructor Create; + destructor Destroy; override; + procedure AddNotification(const ANotification: TSnapshotNotification); + procedure RemoveNotification(const ANotification: TSnapshotNotification); + procedure DoStateChange(const AOldState: TDBGState); + property Active: Boolean read FActive write SetActive; + public + function SelectedId: Pointer; + function SelectedEntry: TSnapshot; + procedure Clear; + public + function HistoryCount: Integer; + property HistoryIndex: Integer read FHistoryIndex write SetHistoryIndex; + property HistoryEntries[AIndex: Integer]: TSnapshot read GetHistoryEntry; + property HistoryCapacity: Integer read FHistoryCapacity write FHistoryCapacity; + property HistorySelected: Boolean read FHistorySelected write SetHistorySelected; + public + property Locals: TLocalsMonitor read FLocals write FLocals; + property Watches: TWatchesMonitor read FWatches write FWatches; + property CallStack: TCallStackMonitor read FCallStack write FCallStack; + property Threads: TThreadsMonitor read FThreads write FThreads; + property Debugger: TDebugger read FDebugger write FDebugger; + end; +{%endregion ^^^^^ Snapshots ^^^^^ } + +{%region Signals / Exceptions *************************************************} (******************************************************************************) (** **) (** S I G N A L S and E X C E P T I O N S **) @@ -2018,6 +2206,7 @@ type property Items[const AIndex: Integer]: TIDEException read GetItem write SetItem; default; end; +{%endregion ^^^^^ Signals / Exceptions ^^^^^ } (******************************************************************************) (******************************************************************************) @@ -2214,6 +2403,7 @@ type function Modify(const AExpression, AValue: String): Boolean; // Modifies the given expression, returns true if valid function Disassemble(AAddr: TDbgPtr; ABackward: Boolean; out ANextAddr: TDbgPtr; out ADump, AStatement, AFile: String; out ALine: Integer): Boolean; deprecated; + function GetLocation: TDBGLocationRec; virtual; procedure LockCommandProcessing; virtual; procedure UnLockCommandProcessing; virtual; procedure AddNotifyEvent(AReason: TDebuggerNotifyReason; AnEvent: TNotifyEvent); @@ -2385,12 +2575,337 @@ begin Result:=bpaStop; end; +{ TDebuggerDataSnapShot } + +destructor TDebuggerDataSnapShot.Destroy; +begin + inherited Destroy; + DataObject.Free; +end; + +function TSnapshot.GetLocationAsText: String; +begin + if FLocation.SrcFile <> '' + then Result := FLocation.SrcFile + ' ' + IntToStr(FLocation.SrcLine) + else Result := ':' + IntToHex(FLocation.Address, 8); + if FLocation.FuncName <> '' + then Result := FLocation.FuncName + ' (' + Result + ')'; +end; + +constructor TSnapshot.Create; +begin + FTimeStamp := Now; +end; + +{ TSnapshotManager } + +function TSnapshotManager.GetHistoryEntry(AIndex: Integer): TSnapshot; +begin + Result := TSnapshot(FHistoryList[AIndex]); +end; + +procedure TSnapshotManager.SetActive(const AValue: Boolean); +begin + if FActive = AValue then exit; + FActive := AValue; + + if Active then begin + if FCurrentState = dsPause + then CreateHistoryEntry; + end + else begin + FLocals.CurrentLocalsList.SnapShot := nil; + FWatches.CurrentWatches.SnapShot := nil; + FCallStack.CurrentCallStackList.SnapShot := nil; + FThreads.CurrentThreads.SnapShot := nil; + if FCurrentSnapshot <> nil + then RemoveHistoryEntryFromMonitors(FCurrentSnapshot); + FreeAndNil(FCurrentSnapshot); + end; +end; + +procedure TSnapshotManager.SetHistoryindex(const AValue: Integer); +begin + if FHistoryindex = AValue then exit; + FHistoryindex := AValue; + FNotificationList.NotifyCurrent(Self); +end; + +procedure TSnapshotManager.SetHistorySelected(AValue: Boolean); +begin + if HistoryCount = 0 then AValue := False; + if FHistorySelected = AValue then exit; + FHistorySelected := AValue; + FNotificationList.NotifyCurrent(Self); +end; + +procedure TSnapshotManager.ClearHistory; +begin + while FHistoryList.Count > 0 do RemoveHistoryEntry(0); + HistorySelected := False; +end; + +procedure TSnapshotManager.CreateHistoryEntry; +var + t: LongInt; +begin + FreeAndNil(FCurrentSnapshot); // should be nil already + FCurrentSnapshot := TSnapshot.Create; + FCurrentSnapshot.Location := Debugger.GetLocation; + + FThreads.NewSnapshot(FCurrentSnapshot); + FCallStack.NewSnapshot(FCurrentSnapshot); + FLocals.NewSnapshot(FCurrentSnapshot); + FWatches.NewSnapshot(FCurrentSnapshot); + + // acces them , so they will be present + t := FThreads.CurrentThreads.CurrentThreadId; + FCallStack.CurrentCallStackList.EntriesForThreads[t]; +end; + +procedure TSnapshotManager.RemoveHistoryEntry(AIndex: Integer); +var + Snap: TSnapshot; +begin + Snap := HistoryEntries[AIndex]; + FHistoryList.Delete(AIndex); + RemoveHistoryEntryFromMonitors(Snap); + Snap.Free; + if HistoryCount = 0 + then HistorySelected := False; +end; + +procedure TSnapshotManager.RemoveHistoryEntryFromMonitors(AnEntry: TSnapshot); +begin + FThreads.RemoveSnapshot(AnEntry); + FCallStack.RemoveSnapshot(AnEntry); + FLocals.RemoveSnapshot(AnEntry); + FWatches.RemoveSnapshot(AnEntry); +end; + +constructor TSnapshotManager.Create; +begin + FNotificationList := TDebuggerChangeNotificationList.Create; + FActive := True; + FHistorySelected := False; + FHistoryList := TList.Create; + FHistoryCapacity := 25; + inherited Create; +end; + +destructor TSnapshotManager.Destroy; +begin + FNotificationList.Clear; + ClearHistory; + inherited Destroy; + FreeAndNil(FHistoryList); + FreeAndNil(FNotificationList); + FreeAndNil(FCurrentSnapshot); +end; + +procedure TSnapshotManager.AddNotification(const ANotification: TSnapshotNotification); +begin + FNotificationList.Add(ANotification); +end; + +procedure TSnapshotManager.RemoveNotification(const ANotification: TSnapshotNotification); +begin + FNotificationList.Remove(ANotification); +end; + +procedure TSnapshotManager.DoStateChange(const AOldState: TDBGState); +begin + if FDebugger = nil then exit; + FCurrentState := Debugger.State; + + if FDebugger.State = dsPause then begin + if FActive then CreateHistoryEntry; + HistorySelected := False; + end + else begin + if FCurrentSnapshot <> nil then begin + FHistoryIndex := FHistoryList.Add(FCurrentSnapshot); + FCurrentSnapshot := nil;; + while HistoryCount > HistoryCapacity do RemoveHistoryEntry(0); + FNotificationList.NotifyChange(Self); + if HistorySelected + then FNotificationList.NotifyCurrent(Self); + end; + end; + if (FDebugger.State = dsInit) then begin + Clear; + end; +end; + +function TSnapshotManager.SelectedId: Pointer; +begin + if (HistoryIndex < 0) or (HistoryIndex >= HistoryCount) or (not FHistorySelected) + then Result := nil + else Result := HistoryEntries[HistoryIndex]; +end; + +function TSnapshotManager.SelectedEntry: TSnapshot; +begin + if (HistoryIndex < 0) or (HistoryIndex >= HistoryCount) or (not FHistorySelected) + then Result := nil + else Result := HistoryEntries[HistoryIndex]; +end; + +procedure TSnapshotManager.Clear; +begin + if HistoryCount = 0 then exit; + ClearHistory; + FNotificationList.NotifyChange(Self); + FNotificationList.NotifyCurrent(Self); +end; + +function TSnapshotManager.HistoryCount: Integer; +begin + Result := FHistoryList.Count; +end; + +{ TDebuggerDataMonitorEx } + +function TDebuggerDataMonitorEx.CreateSnapshot: TObject; +begin + Result := nil; +end; + +function TDebuggerDataMonitorEx.GetSnapshotObj(AnID: Pointer): TObject; +begin + Result := FSnapshots.SnapShot[AnID]; +end; + +constructor TDebuggerDataMonitorEx.Create; +begin + FSnapshots := TDebuggerDataSnapShotList.Create; + inherited Create; +end; + +destructor TDebuggerDataMonitorEx.Destroy; +begin + FSnapshots.Clear; + inherited Destroy; + FreeAndNil(FSnapshots); +end; + +procedure TDebuggerDataMonitorEx.NewSnapshot(AnID: Pointer); +var + S: TObject; +begin + S := CreateSnapshot; + FSnapshots.AddSnapShot(AnID, S); +end; + +procedure TDebuggerDataMonitorEx.RemoveSnapshot(AnID: Pointer); +begin + FSnapshots.RemoveSnapShot(AnID); +end; + +{ TDebuggerDataSnapShotList } + +function TDebuggerDataSnapShotList.GetSnapShot(AnID: Pointer): TObject; +var + i: Integer; +begin + i := FList.Count - 1; + while i >= 0 do begin + Result := TObject(FList[i]); + if TDebuggerDataSnapShot(Result).SnapShotId = AnID + then exit(TDebuggerDataSnapShot(Result).DataObject); + dec(i); + end; + Result := nil; +end; + +constructor TDebuggerDataSnapShotList.Create; +begin + inherited Create; + FList := TList.Create; +end; + +destructor TDebuggerDataSnapShotList.Destroy; +begin + Clear; + inherited Destroy; + FreeAndNil(FList); +end; + +procedure TDebuggerDataSnapShotList.Clear; +begin + while FList.Count > 0 do begin + TDebuggerDataSnapShot(FList[0]).Free; + FList.Delete(0); + end; +end; + +procedure TDebuggerDataSnapShotList.AddSnapShot(AnID: Pointer; AnObject: TObject); +var + NewSn: TDebuggerDataSnapShot; +begin + NewSn := TDebuggerDataSnapShot.Create; + NewSn.SnapShotId := AnID; + NewSn.DataObject := AnObject; + FList.Add(NewSn); +end; + +procedure TDebuggerDataSnapShotList.RemoveSnapShot(AnID: Pointer); +var + R: TDebuggerDataSnapShot; + i: Integer; +begin + i := FList.Count - 1; + while i >= 0 do begin + R := TDebuggerDataSnapShot(FList[i]); + if TDebuggerDataSnapShot(R).SnapShotId = AnID + then break; + dec(i); + end; + if i >= 0 then begin + FList.Delete(i); + R.Free; + end; +end; + { TCurrentLocalsList } +procedure TCurrentLocalsList.SetSnapShot(const AValue: TLocalsList); +var + i: Integer; + R: TLocals; +begin + assert((FSnapShot=nil) or (AValue=nil), 'TCurrentLocalsList already have snapshot'); + if FSnapShot = AValue then exit; + FSnapShot := AValue; + + if FSnapShot = nil then begin + for i := 0 to Count-1 do + TCurrentLocals(EntriesByIdx[i]).SnapShot := nil; + end else begin + //FSnapShot.Assign(Self); + FSnapShot.Clear; + for i := 0 to Count-1 do begin + R := TLocals.Create; + FSnapShot.Add(R); + TCurrentLocals(EntriesByIdx[i]).SnapShot := R; + end; + + end; +end; + function TCurrentLocalsList.CreateEntry(const AThreadId: Integer; const AStackFrame: Integer): TLocals; +var + R: TLocals; begin Result := TCurrentLocals.Create(FMonitor, AThreadId, AStackFrame); + Add(Result); + if FSnapShot <> nil + then begin + R := TLocals.Create(AThreadId, AStackFrame); + FSnapShot.Add(R); + TCurrentLocals(Result).SnapShot := R; + end; end; constructor TCurrentLocalsList.Create(AMonitor: TLocalsMonitor); @@ -2413,8 +2928,11 @@ begin dec(i); end; Result := CreateEntry(AThreadId, AStackFrame); - if Result = nil then exit; - FList.Add(Result); +end; + +function TLocalsList.GetEntryByIdx(const AnIndex: Integer): TLocals; +begin + Result := TLocals(FList[AnIndex]); end; function TLocalsList.CreateEntry(const AThreadId: Integer; @@ -2423,6 +2941,22 @@ begin Result := nil; end; +procedure TLocalsList.Add(AnEntry: TLocals); +begin + assert(((Self is TCurrentLocalsList) and (AnEntry is TCurrentLocals)) or ((not(Self is TCurrentLocalsList)) and not(AnEntry is TCurrentLocals)), + 'TLocalsList.Add: entry and list differ (current and none current)'); + FList.add(AnEntry); +end; + +procedure TLocalsList.Assign(AnOther: TLocalsList); +var + i: Integer; +begin + Clear; + for i := 0 to AnOther.FList.Count-1 do + FList.Add(TLocals.CreateCopy(TLocals(AnOther.FList[i]))); +end; + constructor TLocalsList.Create; begin FList := TList.Create; @@ -2444,6 +2978,11 @@ begin end; end; +function TLocalsList.Count: Integer; +begin + Result := FList.Count; +end; + { TLocalsSupplier } function TLocalsSupplier.GetCurrentLocalsList: TCurrentLocalsList; @@ -2470,12 +3009,16 @@ end; procedure TLocalsSupplier.DoStateChange(const AOldState: TDBGState); begin + if (Debugger = nil) or (CurrentLocalsList = nil) then Exit; + if FDebugger.State = dsPause then begin if Monitor<> nil then Monitor.Clear; end else begin + CurrentLocalsList.SnapShot := nil; + if (AOldState = dsPause) or (AOldState = dsNone) { Force clear on initialisation } then begin if Monitor<> nil @@ -2491,6 +3034,11 @@ begin Result := TLocalsSupplier(inherited Supplier); end; +function TLocalsMonitor.GetSnapshot(AnID: Pointer): TLocalsList; +begin + Result := TLocalsList(GetSnapshotObj(AnID)); +end; + procedure TLocalsMonitor.SetSupplier(const AValue: TLocalsSupplier); begin inherited Supplier := AValue; @@ -2514,6 +3062,12 @@ begin else ALocals.SetDataValidity(ddsInvalid); end; +function TLocalsMonitor.CreateSnapshot: TObject; +begin + Result := TLocalsList.Create; + CurrentLocalsList.SnapShot := TLocalsList(Result); +end; + constructor TLocalsMonitor.Create; begin inherited; @@ -2549,7 +3103,6 @@ end; procedure TCurrentWatchValue.SetTypeInfo(const AValue: TDBGType); begin -if FTypeInfo<> nil then FreeAndNil(FTypeInfo); FTypeInfo := AValue; end; @@ -2559,6 +3112,15 @@ begin FValue := AValue; end; +procedure TCurrentWatchValue.SetSnapShot(const AValue: TWatchValue); +begin + assert((FSnapShot=nil) or (AValue=nil), 'TCurrentWatchValue already have snapshot'); + if FSnapShot = AValue then exit; + FSnapShot := AValue; + if FSnapShot <> nil + then FSnapShot.Assign(self); +end; + procedure TCurrentWatchValue.RequestData; begin TCurrentWatch(FWatch).RequestData(self); @@ -2568,6 +3130,8 @@ procedure TCurrentWatchValue.ValidityChanged; begin inherited; TCurrentWatches(TCurrentWatch(FWatch).Collection).Update(FWatch); + if FSnapShot <> nil + then FSnapShot.Assign(self); end; constructor TCurrentWatchValue.Create; @@ -2595,10 +3159,44 @@ end; { TCurrentWatchValueList } +procedure TCurrentWatchValueList.SetSnapShot(const AValue: TWatchValueList); +var + R: TWatchValue; + i: Integer; +begin + assert((FSnapShot=nil) or (AValue=nil), 'TCurrentWatchValueList already have snapshot'); + if FSnapShot = AValue then exit; + FSnapShot := AValue; + + if FSnapShot = nil then begin + for i := 0 to Count - 1 do + TCurrentWatchValue(EntriesByIdx[i]).SnapShot := nil; + end + else begin + // Assign + FSnapShot.Clear; + for i := 0 to Count - 1 do begin + R := TWatchValue.Create(FSnapShot.FWatch); + R.Assign(EntriesByIdx[i]); + FSnapShot.Add(R); + TCurrentWatchValue(EntriesByIdx[i]).SnapShot := R; + end; + end; + +end; + function TCurrentWatchValueList.CreateEntry(const AThreadId: Integer; const AStackFrame: Integer; const ADisplayFormat: TWatchDisplayFormat): TWatchValue; +var + R: TWatchValue; begin Result := TCurrentWatchValue.Create(FWatch, AThreadId, AStackFrame, ADisplayFormat); + Add(Result); + if FSnapShot <> nil then begin + R := TWatchValue.Create(FSnapShot.FWatch); + FSnapShot.Add(R); + TCurrentWatchValue(Result).SnapShot := R; + end; end; { TWatchValueList } @@ -2618,8 +3216,11 @@ begin dec(i); end; Result := CreateEntry(AThreadId, AStackFrame, ADisplayFormat); - if Result = nil then exit; - FList.Add(Result); +end; + +function TWatchValueList.GetEntryByIdx(AnIndex: integer): TWatchValue; +begin + Result := TWatchValue(FList[AnIndex]); end; function TWatchValueList.CreateEntry(const AThreadId: Integer; const AStackFrame: Integer; @@ -2643,6 +3244,9 @@ end; constructor TWatchValueList.Create(AOwnerWatch: TWatch); begin + assert(AOwnerWatch <> nil, 'TWatchValueList.Create without owner'); + assert(((Self is TCurrentWatchValueList) and (AOwnerWatch is TCurrentWatch)) or ((not(Self is TCurrentWatchValueList)) and not(AOwnerWatch is TCurrentWatch)), + 'TWatchValueList.Create: Watch and list differ (current and none current)'); FList := TList.Create; FWatch := AOwnerWatch; inherited Create; @@ -2655,6 +3259,11 @@ begin FreeAndNil(FList); end; +procedure TWatchValueList.Add(AnEntry: TWatchValue); +begin + Flist.Add(AnEntry); +end; + procedure TWatchValueList.Clear; begin while FList.Count > 0 do begin @@ -2663,6 +3272,11 @@ begin end;; end; +function TWatchValueList.Count: Integer; +begin + Result := FList.Count; +end; + { TWatchValue } function TWatchValue.GetValue: String; @@ -2677,7 +3291,7 @@ begin FValidity := ddsRequested; RequestData; if FValidity in [ddsValid, ddsInvalid, ddsError] - then Result := GetValue; + then Result := GetValue(); end; ddsRequested, ddsEvaluating: Result := ''; ddsValid: Result := FValue; @@ -2699,7 +3313,7 @@ begin FValidity := ddsRequested; RequestData; if FValidity in [ddsValid, ddsInvalid, ddsError] - then Result := GetTypeInfo; + then Result := GetTypeInfo(); end; ddsRequested, ddsEvaluating: Result := nil; @@ -2728,14 +3342,17 @@ end; constructor TWatchValue.Create; begin + assert(FWatch <> nil, 'TwatchValue without owner'); + assert(((Self is TCurrentWatchValue) and (FWatch is TCurrentWatch)) or ((not(Self is TCurrentWatchValue)) and not(FWatch is TCurrentWatch)), + 'TWatchValue.Create: Watch and self differ (current and none current)'); inherited Create; end; constructor TWatchValue.Create(AOwnerWatch: TWatch); begin - Create; FValidity := ddsUnknown; FWatch := AOwnerWatch; + Create; end; constructor TWatchValue.Create(AOwnerWatch: TWatch; const AThreadId: Integer; @@ -2799,13 +3416,29 @@ procedure TWatchesSupplier.DoStateChange(const AOldState: TDBGState); begin if (Debugger = nil) or (CurrentWatches = nil) then Exit; FNotifiedState := Debugger.State; - if (Debugger.State in [dsPause, dsStop, dsInit]) + + if FDebugger.State = dsPause then begin CurrentWatches.ClearValues; Monitor.NotifyUpdate(CurrentWatches, nil); + end + else begin + CurrentWatches.SnapShot := nil; + + if (AOldState = dsPause) or (AOldState = dsNone) { Force clear on initialisation } + then begin + CurrentWatches.ClearValues; + Monitor.NotifyUpdate(CurrentWatches, nil); + end; end; end; +constructor TWatchesSupplier.Create(const ADebugger: TDebugger); +begin + inherited Create(ADebugger); + FNotifiedState := dsNone; +end; + { TWatchesMonitor } function TWatchesMonitor.GetSupplier: TWatchesSupplier; @@ -2813,6 +3446,11 @@ begin Result := TWatchesSupplier(inherited Supplier); end; +function TWatchesMonitor.GetSnapshot(AnID: Pointer): TWatches; +begin + Result := TWatches(GetSnapshotObj(AnID)); +end; + procedure TWatchesMonitor.SetSupplier(const AValue: TWatchesSupplier); begin inherited Supplier := AValue; @@ -2840,6 +3478,12 @@ begin else AWatchValue.SetValidity(ddsInvalid); end; +function TWatchesMonitor.CreateSnapshot: TObject; +begin + Result := TWatches.Create; + CurrentWatches.SnapShot := TWatches(Result); +end; + constructor TWatchesMonitor.Create; begin FNotificationList := TWatchesNotificationList.Create; @@ -2930,27 +3574,71 @@ function TCurrentCallStack.GetCurrent: Integer; begin case FCurrentValidity of ddsUnknown: begin - Result := -1; + Result := 0; FCurrentValidity := ddsRequested; FMonitor.RequestCurrent(self); if FCurrentValidity = ddsValid then - Result := inherited GetCurrent; + Result := inherited GetCurrent(); end; - ddsRequested, ddsEvaluating: Result := -1; + ddsRequested, ddsEvaluating: Result := 0; ddsValid: Result := inherited GetCurrent; - ddsInvalid, ddsError: Result := -1; + ddsInvalid, ddsError: Result := 0; end; end; +procedure TCurrentCallStack.Clear; +var + Iterator: TMapIterator; +begin + Iterator:= TMapIterator.Create(FEntries); + while not Iterator.EOM do + begin + TObject(Iterator.DataPtr^).Free; + Iterator.Next; + end; + Iterator.Free; + FEntries.Clear; + + FCount := -1; +end; + constructor TCurrentCallStack.Create(AMonitor: TCallStackMonitor); begin + FCount := 0; + FEntries:= TMap.Create(its4, SizeOf(TCallStackEntry)); FMonitor := AMonitor; FPreparing := False; FCountValidity := ddsUnknown; FCurrentValidity := ddsUnknown; + FLowestUnknown := -1; + FHighestUnknown := -1; inherited Create; end; +destructor TCurrentCallStack.Destroy; +begin + Clear; + inherited Destroy; + FreeAndNil(FEntries); +end; + +procedure TCurrentCallStack.Assign(AnOther: TCallStack); +begin + inherited Assign(AnOther); + FCount := AnOther.Count; +end; + +procedure TCurrentCallStack.SetSnapShot(const AValue: TCallStack); +begin + assert((FSnapShot=nil) or (AValue=nil), 'TCurrentCallStack already have snapshot'); + if FSnapShot = AValue then exit; + + if (FSnapShot <> nil) and (AValue = nil) + then FSnapShot.Assign(Self); + + FSnapShot := AValue; +end; + function TCurrentCallStack.GetCount: Integer; begin case FCountValidity of @@ -2959,14 +3647,62 @@ begin FCountValidity := ddsRequested; FMonitor.RequestCount(self); if FCountValidity = ddsValid then - Result := inherited GetCount; + Result := FCount; end; ddsRequested, ddsEvaluating: Result := 0; - ddsValid: Result := inherited GetCount; + ddsValid: Result := FCount; ddsInvalid, ddsError: Result := 0; end; end; +procedure TCurrentCallStack.SetCount(ACount: Integer); +begin + if FCount = ACount then exit; + FCount := ACount; + FMonitor.NotifyChange; +end; + +function TCurrentCallStack.GetEntry(AIndex: Integer): TCallStackEntry; +begin + if (AIndex < 0) + or (AIndex >= Count) then IndexError(Aindex); + + Result := nil; + if FEntries.GetData(AIndex, Result) then Exit; + + Result := TCallStackEntry.Create(AIndex, 0, nil, '', '', '', 0, ddsRequested); + if Result = nil then Exit; + FEntries.Add(AIndex, Result); + Result.FOwner := Self; + + if (FLowestUnknown < 0) or (FLowestUnknown > AIndex) + then FLowestUnknown := AIndex; + if (FHighestUnknown < AIndex) + then FHighestUnknown := AIndex; + + DoEntriesCreated; +end; + +procedure TCurrentCallStack.AddEntry(AnEntry: TCallStackEntry); +begin + FEntries.Add(AnEntry.Index, AnEntry); + AnEntry.FOwner := Self; +end; + +procedure TCurrentCallStack.AssignEntriesTo(AnOther: TCallStack); +var + It: TMapIterator; +begin + It := TMapIterator.Create(FEntries); + It.First; + while (not IT.EOM) + do begin + AnOther.AddEntry(TCallStackEntry.CreateCopy(TCallStackEntry(It.DataPtr^))); + It.Next; + end; + It.Free; +end; + procedure TCurrentCallStack.PrepareRange(AIndex, ACount: Integer); var It: TMapIterator; @@ -3046,13 +3782,46 @@ begin inherited Create; end; +procedure TCurrentCallStackList.SetSnapShot(const AValue: TCallStackList); +var + R: TCallStack; + i: Integer; +begin + assert((FSnapShot=nil) or (AValue=nil), 'Callstack already have snapshot'); + if FSnapShot = AValue then exit; + FSnapShot := AValue; + + if FSnapShot = nil then begin + for i := 0 to Count - 1 do + TCurrentCallStack(Entries[i]).SnapShot := nil; + end + else begin + // Assign + FSnapShot.Clear; + for i := 0 to Count - 1 do begin + R := TCallStack.Create; + R.ThreadId := Entries[i].ThreadId; + FSnapShot.Add(R); + TCurrentCallStack(Entries[i]).SnapShot := R; + end; + end; +end; + function TCurrentCallStackList.GetEntryForThread(const AThreadId: Integer): TCallStack; +var + R: TCallStack; begin Result := inherited GetEntryForThread(AThreadId); if Result = nil then begin Result := TCurrentCallStack.Create(FMonitor); Result.ThreadId := AThreadId; Add(Result); + if FSnapShot <> nil then begin + R := TCallStack.Create; + R.ThreadId := AThreadId; + FSnapShot.Add(R); + TCurrentCallStack(Result).SnapShot := R; + end; end; end; @@ -3076,9 +3845,20 @@ end; procedure TCallStackList.Add(ACallStack: TCallStack); begin + assert(((Self is TCurrentCallStackList) and (ACallStack is TCurrentCallStack)) or ((not(Self is TCurrentCallStackList)) and not(ACallStack is TCurrentCallStack)), + 'TCallStackList.Add: entry and list differ (current and none current)'); FList.Add(ACallStack); end; +procedure TCallStackList.Assign(AnOther: TCallStackList); +var + i: Integer; +begin + Clear; + for i := 0 to AnOther.FList.Count-1 do + FList.Add(TCallStack.CreateCopy(TCallStack(AnOther.FList[i]))); +end; + constructor TCallStackList.Create; begin FList := TList.Create; @@ -3154,7 +3934,13 @@ end; procedure TCurrentThreads.SetValidity(AValidity: TDebuggerDataState); begin if FDataValidity = AValidity then exit; + + // Assign snapshot, if old data wasn't final + if (FDataValidity in [ddsUnknown, ddsEvaluating, ddsRequested]) and (FSnapShot <> nil) + then FSnapShot.Assign(self); + FDataValidity := AValidity; + if FDataValidity = ddsUnknown then Clear; FMonitor.Changed; end; @@ -3165,6 +3951,15 @@ begin FMonitor.CurrentChanged; // TODO ChangedSelection end; +procedure TCurrentThreads.SetSnapShot(const AValue: TThreads); +begin + assert((FSnapShot=nil) or (AValue=nil), 'Threads already have snapshot'); + if FSnapShot = AValue then exit; + FSnapShot := AValue; + if FSnapShot <> nil + then FSnapShot.Assign(self); +end; + constructor TCurrentThreads.Create(AMonitor: TThreadsMonitor); begin FMonitor := AMonitor; @@ -3179,6 +3974,7 @@ begin Result := 0; FDataValidity := ddsRequested; FMonitor.RequestData; + if FDataValidity = ddsValid then Result := inherited Count(); end; ddsRequested, ddsEvaluating: Result := 0; ddsValid: Result := inherited Count; @@ -3186,6 +3982,12 @@ begin end; end; +procedure TCurrentThreads.Clear; +begin + FDataValidity := ddsUnknown; + inherited Clear; +end; + { TThreadsSupplier } function TThreadsSupplier.GetCurrentThreads: TCurrentThreads; @@ -3215,14 +4017,23 @@ begin // end; -procedure TThreadsSupplier.Changed; -begin - If Monitor <> nil then CurrentThreads.SetValidity(ddsUnknown); -end; - procedure TThreadsSupplier.DoStateChange(const AOldState: TDBGState); begin - // + if (Debugger = nil) or (CurrentThreads = nil) then Exit; + + if Debugger.State in [dsPause] + then begin + CurrentThreads.SetValidity(ddsUnknown); + end + else begin + CurrentThreads.SnapShot := nil; + + if (AOldState = dsPause) or (AOldState = dsNone) { Force clear on initialisation } + then begin + if Monitor <> nil + then Monitor.Clear; + end; + end; end; { TThreadsMonitor } @@ -3232,6 +4043,11 @@ begin Result := TThreadsSupplier(inherited Supplier); end; +function TThreadsMonitor.GetSnapshot(AnID: Pointer): TThreads; +begin + Result := TThreads(GetSnapshotObj(AnID)); +end; + procedure TThreadsMonitor.SetSupplier(const AValue: TThreadsSupplier); begin inherited Supplier := AValue; @@ -3250,6 +4066,12 @@ begin then Supplier.RequestMasterData; end; +function TThreadsMonitor.CreateSnapshot: TObject; +begin + Result := TThreads.Create; + CurrentThreads.SnapShot := TThreads(Result); +end; + procedure TThreadsMonitor.Changed; begin FNotificationList.NotifyChange(Self); @@ -3279,6 +4101,7 @@ end; procedure TThreadsMonitor.Clear; begin FCurrentThreads.Clear; + Changed; end; procedure TThreadsMonitor.AddNotification(const ANotification: TThreadsNotification); @@ -3416,6 +4239,7 @@ var i: Integer; begin Clear; + FCurrentThreadId := AOther.FCurrentThreadId; for i := 0 to AOther.FList.Count-1 do FList.Add(TThreadEntry.CreateCopy(TThreadEntry(AOther.FList[i]))); end; @@ -3660,6 +4484,12 @@ begin Result := ReqCmd(dcDisassemble, [AAddr, ABackward, @ANextAddr, @ADump, @AStatement, @AFile, @ALine]); end; +function TDebugger.GetLocation: TDBGLocationRec; +begin + Result.Address := 0; + Result.SrcLine := 0; +end; + procedure TDebugger.LockCommandProcessing; begin // nothing @@ -5479,9 +6309,10 @@ procedure TWatch.AssignTo(Dest: TPersistent); begin if Dest is TWatch then begin - TWatch(Dest).SetExpression(FExpression); - TWatch(Dest).SetEnabled(FEnabled); - TWatch(Dest).SetDisplayFormat(FDisplayFormat); + TWatch(Dest).FExpression := FExpression; + TWatch(Dest).FEnabled := FEnabled; + TWatch(Dest).FDisplayFormat := FDisplayFormat; + TWatch(Dest).FValueList.Assign(FValueList); end else inherited; end; @@ -5493,6 +6324,8 @@ end; constructor TWatch.Create(ACollection: TCollection); begin + assert(((Self is TCurrentWatch) and (ACollection is TCurrentWatches)) or ((not(Self is TCurrentWatch)) and not(ACollection is TCurrentWatches)), + 'Twatch.Create: Watch and collection differ (current and none current)'); FEnabled := False; FValueList := CreateValueList; inherited Create(ACollection); @@ -5583,6 +6416,19 @@ end; { TCurrentWatch } { =========================================================================== } +procedure TCurrentWatch.SetSnapShot(const AValue: TWatch); +begin + assert((FSnapShot=nil) or (AValue=nil), 'TCurrentWatch already have snapshot'); + if FSnapShot = AValue then exit; + FSnapShot := AValue; + if FSnapShot = nil then begin + TCurrentWatchValueList(FValueList).SnapShot := nil; + end else begin + FSnapShot.Assign(self); + TCurrentWatchValueList(FValueList).SnapShot := FSnapShot.FValueList; + end; +end; + function TCurrentWatch.CreateValueList: TWatchValueList; begin Result := TCurrentWatchValueList.Create(Self); @@ -5648,6 +6494,21 @@ begin EndUpdate; end; +function TWatches.GetItem(const AnIndex: Integer): TWatch; +begin + Result := TWatch(inherited Items[AnIndex]); +end; + +procedure TWatches.SetItem(const AnIndex: Integer; const AValue: TWatch); +begin + inherited Items[AnIndex] := AValue; +end; + +constructor TWatches.Create; +begin + Create(TWatch); +end; + constructor TWatches.Create(const AWatchClass: TBaseWatchClass); begin inherited Create(AWatchClass); @@ -5681,9 +6542,15 @@ end; { =========================================================================== } function TCurrentWatches.Add(const AExpression: String): TCurrentWatch; +var + R: TWatch; begin // if this is modified, then also update LoadFromXMLConfig Result := TCurrentWatch(inherited Add(AExpression)); + if FSnapShot <> nil then begin + R := FSnapShot.Add(AExpression); + Result.SnapShot := R; + end; NotifyAdd(Result); end; @@ -5703,6 +6570,30 @@ begin Changed; end; +procedure TCurrentWatches.SetSnapShot(const AValue: TWatches); +var + R: TWatch; + i: Integer; +begin + assert((FSnapShot=nil) or (AValue=nil), 'TCurrentWatches already have snapshot'); + if FSnapShot = AValue then exit; + FSnapShot := AValue; + + if FSnapShot = nil then begin + for i := 0 to Count - 1 do + Items[i].SnapShot := nil; + end + else begin + // FSnapShot.Assign(Self); + FSnapShot.Clear; + for i := 0 to Count - 1 do begin + R := FSnapShot.Add(''); + R.Assign(Items[i]); + Items[i].SnapShot := R; + end; + end; +end; + function TCurrentWatches.GetItem(const AnIndex: Integer): TCurrentWatch; begin Result := TCurrentWatch(inherited GetItem(AnIndex)); @@ -5804,6 +6695,19 @@ begin inherited Create; end; +constructor TLocals.Create(AThreadId, AStackFrame: Integer); +begin + Create; + FThreadId := AThreadId; + FStackFrame := AStackFrame; +end; + +constructor TLocals.CreateCopy(const ASource: TLocals); +begin + Create; + Assign(ASource); +end; + destructor TLocals.Destroy; begin inherited Destroy; @@ -5821,10 +6725,26 @@ begin Result := GetPart('=', '', Result); end; +procedure TLocals.Assign(AnOther: TLocals); +begin + FThreadId := AnOther.FThreadId; + FStackFrame := AnOther.FStackFrame; + FLocals.Assign(AnOther.FLocals); +end; + { =========================================================================== } { TCurrentLocals } { =========================================================================== } +procedure TCurrentLocals.SetSnapShot(const AValue: TLocals); +begin + assert((FSnapShot=nil) or (AValue=nil), 'TCurrentLocals already have snapshot'); + if FSnapShot = AValue then exit; + FSnapShot := AValue; + if FSnapShot <> nil + then FSnapShot.Assign(Self); +end; + constructor TCurrentLocals.Create(AMonitor: TLocalsMonitor; AThreadId, AStackFrame: Integer); begin FMonitor := AMonitor; @@ -5841,7 +6761,7 @@ begin Result := 0; FDataValidity := ddsRequested; FMonitor.RequestData(Self); - if FDataValidity = ddsValid then Result := inherited Count; + if FDataValidity = ddsValid then Result := inherited Count(); end; ddsRequested, ddsEvaluating: Result := 0; ddsValid: Result := inherited Count; @@ -5862,6 +6782,10 @@ end; procedure TCurrentLocals.SetDataValidity(AValidity: TDebuggerDataState); begin if FDataValidity = AValidity then exit; + + if (FDataValidity in [ddsUnknown, ddsEvaluating, ddsRequested]) and (FSnapShot <> nil) + then FSnapShot.Assign(Self); + FDataValidity := AValidity; FMonitor.NotifyChange(Self); end; @@ -6246,30 +7170,23 @@ end; procedure TCallStack.Clear; var - Iterator: TMapIterator; + i: Integer; begin - Iterator:= TMapIterator.Create(FEntries); - while not Iterator.EOM do - begin - TObject(Iterator.DataPtr^).Free; - Iterator.Next; - end; - Iterator.Free; - FEntries.Clear; - - FCount := -1; + for i := 0 to FList.Count - 1 do + TObject(FList[i]).Free; + FList.Clear; end; function TCallStack.GetCount: Integer; begin - Result := FCount; + Result := FList.Count; end; destructor TCallStack.Destroy; begin Clear; inherited Destroy; - FreeAndNil(FEntries); + FreeAndNil(FList); end; function TCallStack.GetCurrent: Integer; @@ -6282,20 +7199,23 @@ begin if (AIndex < 0) or (AIndex >= Count) then IndexError(Aindex); - Result := nil; - if FEntries.GetData(AIndex, Result) then Exit; + Result := TCallStackEntry(FList[AIndex]); +end; - Result := TCallStackEntry.Create(AIndex, 0, nil, '', '', '', 0, ddsRequested); - if Result = nil then Exit; - FEntries.Add(AIndex, Result); - Result.FOwner := Self; +procedure TCallStack.AddEntry(AnEntry: TCallStackEntry); +begin + // must be added in correct order + Flist.Add(AnEntry); + AnEntry.FOwner := Self; +end; - if (FLowestUnknown < 0) or (FLowestUnknown > AIndex) - then FLowestUnknown := AIndex; - if (FHighestUnknown < AIndex) - then FHighestUnknown := AIndex; - - DoEntriesCreated; +procedure TCallStack.AssignEntriesTo(AnOther: TCallStack); +var + i: Integer; +begin + for i := 0 to FList.Count-1 do begin + AnOther.AddEntry(TCallStackEntry.CreateCopy(TCallStackEntry(FList[i]))); + end; end; function TCallStack.IndexError(AIndex: Integer): TCallStackEntry; @@ -6310,31 +7230,37 @@ end; procedure TCallStack.ChangeCurrentIndex(ANewIndex: Integer); begin - // + CurrentIndex := ANewIndex; end; procedure TCallStack.SetCount(ACount: Integer); begin - if FCount = ACount then exit; - FCount := ACount; + // can not set count + assert(False, 'TCallStack.SetCount should not be called') end; -procedure TCallStack.DoEntriesCreated; +procedure TCallStack.Assign(AnOther: TCallStack); begin - // + Clear; + ThreadId := AnOther.ThreadId; + FCurrent := AnOther.FCurrent; + AnOther.AssignEntriesTo(Self); end; constructor TCallStack.Create; begin - FCount := -1; FThreadId := -1; FCurrent := -1; - FLowestUnknown := -1; - FHighestUnknown := -1; - FEntries:= TMap.Create(its4, SizeOf(TCallStackEntry)); + FList := TList.Create; inherited; end; +constructor TCallStack.CreateCopy(const ASource: TCallStack); +begin + Create; + Assign(ASource); +end; + procedure TCallStack.SetCurrent(AValue: Integer); begin FCurrent := AValue; @@ -6407,6 +7333,11 @@ begin NotifyChange; end; +function TCallStackMonitor.GetSnapshot(AnID: Pointer): TCallStackList; +begin + Result := TCallStackList(GetSnapshotObj(AnID)); +end; + function TCallStackMonitor.GetSupplier: TCallStackSupplier; begin Result := TCallStackSupplier(inherited Supplier); @@ -6422,6 +7353,12 @@ begin FNotificationList.NotifyCurrent(Self); end; +function TCallStackMonitor.CreateSnapshot: TObject; +begin + Result := TCallStackList.Create; + CurrentCallStackList.SnapShot := TCallStackList(Result); +end; + procedure TCallStackMonitor.RemoveNotification(const ANotification: TCallStackNotification); begin FNotificationList.Remove(ANotification); @@ -6495,19 +7432,20 @@ end; procedure TCallStackSupplier.DoStateChange(const AOldState: TDBGState); begin + if (Debugger = nil) or (CurrentCallStackList = nil) then Exit; + if FDebugger.State = dsPause then begin - if CurrentCallStackList <> nil - then CurrentCallStackList.Clear; + CurrentCallStackList.Clear; Changed; end else begin + CurrentCallStackList.SnapShot := nil; + if (AOldState = dsPause) or (AOldState = dsNone) { Force clear on initialisation } then begin - if CurrentCallStackList <> nil - then CurrentCallStackList.Clear; - if Monitor <> nil - then Monitor.CallStackClear(Self); + CurrentCallStackList.Clear; + Monitor.CallStackClear(Self); end; end; end; diff --git a/debugger/gdbmidebugger.pp b/debugger/gdbmidebugger.pp index fb863bc472..972186d129 100644 --- a/debugger/gdbmidebugger.pp +++ b/debugger/gdbmidebugger.pp @@ -302,6 +302,7 @@ type // Internal Current values FCurrentStackFrame, FCurrentThreadId: Integer; + FCurrentLocation: TDBGLocationRec; // GDB info (move to ?) FGDBVersion: String; @@ -412,6 +413,7 @@ type procedure Init; override; // Initializes external debugger procedure Done; override; // Kills external debugger + function GetLocation: TDBGLocationRec; override; //LockCommandProcessing is more than just QueueExecuteLock //LockCommandProcessing also takes care to run the queue, if unlocked and not already running @@ -1190,8 +1192,6 @@ type TGDBMIThreads = class(TThreadsSupplier) private FGetThreadsCmdObj: TGDBMIDebuggerCommandThreads; - FThreadsReqState: TGDBMIEvaluationState; - FChangeThreadsCmdObj: TGDBMIDebuggerCommandChangeThread; function GetDebugger: TGDBMIDebugger; @@ -1208,7 +1208,6 @@ type public constructor Create(const ADebugger: TDebugger); destructor Destroy; override; - procedure DoStateChange(const AOldState: TDBGState); override; end; {%endregion ^^^^^ Threads ^^^^^ } @@ -1559,12 +1558,9 @@ begin if Monitor = nil then exit; Cmd := TGDBMIDebuggerCommandChangeThread(Sender); - if not Cmd.Success then begin - Changed; // invalidate Monitor - exit; - end; - Debugger.DoThreadChanged; + if not Cmd.Success + then exit; if CurrentThreads <> nil then CurrentThreads.CurrentThreadId := Cmd.NewId; end; @@ -1578,12 +1574,10 @@ procedure TGDBMIThreads.ThreadsNeeded; var ForceQueue: Boolean; begin - if FThreadsReqState in [esValid, esRequested] then Exit; if Debugger = nil then Exit; if (Debugger.State = dsPause) then begin - FThreadsReqState := esRequested; FGetThreadsCmdObj := TGDBMIDebuggerCommandThreads.Create(Debugger); FGetThreadsCmdObj.OnExecuted := @DoThreadsFinished; FGetThreadsCmdObj.OnDestroy := @DoThreadsDestroyed; @@ -1600,7 +1594,6 @@ end; procedure TGDBMIThreads.CancelEvaluation; begin - FThreadsReqState := esInvalid; if FGetThreadsCmdObj <> nil then begin FGetThreadsCmdObj.OnExecuted := nil; @@ -1613,7 +1606,6 @@ end; constructor TGDBMIThreads.Create(const ADebugger: TDebugger); begin inherited; - FThreadsReqState := esInvalid; end; destructor TGDBMIThreads.Destroy; @@ -1622,19 +1614,6 @@ begin inherited Destroy; end; -procedure TGDBMIThreads.DoStateChange(const AOldState: TDBGState); -begin - if (Debugger = nil) or (Monitor = nil) then Exit; - - if Debugger.State in [dsPause, dsStop] - then begin - CancelEvaluation; - FThreadsReqState := esInvalid; - if CurrentThreads <> nil then CurrentThreads.SetValidity(ddsUnknown); - Changed; - end; -end; - procedure TGDBMIThreads.RequestMasterData; begin ThreadsNeeded; @@ -3984,6 +3963,7 @@ function TGDBMIDebuggerCommandExecute.ProcessStopped(const AParams: String; if FTheDebugger.FCurrentStackFrame <> i then ExecuteCommand('-stack-select-frame %u', [FTheDebugger.FCurrentStackFrame], R); end; + FTheDebugger.FCurrentLocation := Result; end; function GetExceptionInfo: TGDBMIExceptionInfo; @@ -4120,6 +4100,7 @@ begin FTheDebugger.FCurrentStackFrame := 0; FTheDebugger.FCurrentThreadId := StrToIntDef(List.Values['thread-id'], -1); + FTheDebugger.FCurrentLocation := FrameToLocation(List.Values['frame']); FTheDebugger.Threads.CurrentThreads.CurrentThreadId := FTheDebugger.FCurrentThreadId; try @@ -4201,6 +4182,7 @@ begin then begin CanContinue := False; Location := FrameToLocation(List.Values['frame']); + FTheDebugger.FCurrentLocation := Location; FTheDebugger.DoDbgBreakpointEvent(BreakPoint, Location); BreakPoint.Hit(CanContinue); if CanContinue @@ -5327,6 +5309,11 @@ begin end; end; +function TGDBMIDebugger.GetLocation: TDBGLocationRec; +begin + Result := FCurrentLocation; +end; + procedure TGDBMIDebugger.LockCommandProcessing; begin // Keep a different counter than QueueExecuteLock @@ -9488,6 +9475,7 @@ end; procedure TGDBMIDebuggerCommand.ProcessFrame(const ALocation: TDBGLocationRec); begin FTheDebugger.DoCurrent(ALocation); + FTheDebugger.FCurrentLocation := ALocation; end; procedure TGDBMIDebuggerCommand.ProcessFrame(const AFrame: String); @@ -9579,6 +9567,9 @@ end; procedure TGDBMIDebuggerCommand.Cancel; begin + {$IFDEF DBGMI_QUEUE_DEBUG} + DebugLn(['Canceling: "', DebugText,'"']); + {$ENDIF} FTheDebugger.UnQueueCommand(Self); DoCancel; DoOnCanceled; diff --git a/debugger/historydlg.lfm b/debugger/historydlg.lfm new file mode 100644 index 0000000000..a4b1c9da23 --- /dev/null +++ b/debugger/historydlg.lfm @@ -0,0 +1,71 @@ +inherited HistoryDialog: THistoryDialog + Left = 1060 + Top = 216 + Width = 422 + BorderStyle = bsSizeToolWin + Caption = 'HistoryDialog' + ClientWidth = 422 + object lvHistory: TListView[0] + Left = 0 + Height = 214 + Top = 26 + Width = 422 + Align = alClient + Columns = < + item + Width = 25 + end + item + Width = 120 + end + item + Width = 250 + end> + ReadOnly = True + RowSelect = True + TabOrder = 0 + ViewStyle = vsReport + OnDblClick = lvHistoryDblClick + end + object ToolBar1: TToolBar[1] + Left = 0 + Height = 26 + Top = 0 + Width = 422 + Caption = 'ToolBar1' + ParentShowHint = False + ShowHint = True + TabOrder = 1 + Wrapable = False + object tbHistorySelected: TToolButton + Left = 24 + Top = 2 + AllowAllUp = True + Caption = 'tbHistorySelected' + OnClick = tbHistorySelectedClick + Style = tbsCheck + end + object tbPower: TToolButton + Left = 1 + Top = 2 + AllowAllUp = True + Caption = 'tbPower' + Down = True + OnClick = tbPowerClick + Style = tbsCheck + end + object tbClear: TToolButton + Left = 55 + Top = 2 + Caption = 'tbClear' + OnClick = tbClearClick + end + object ToolButton1: TToolButton + Left = 47 + Top = 2 + Width = 8 + Caption = 'ToolButton1' + Style = tbsSeparator + end + end +end diff --git a/debugger/historydlg.pp b/debugger/historydlg.pp new file mode 100644 index 0000000000..5c1aeefeaf --- /dev/null +++ b/debugger/historydlg.pp @@ -0,0 +1,192 @@ +unit HistoryDlg; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, ComCtrls, Debugger, DebuggerDlg, LazarusIDEStrConsts, + BaseDebugManager, MainBase, IDEImagesIntf; + +type + + { THistoryDialog } + + THistoryDialog = class(TDebuggerDlg) + lvHistory: TListView; + ToolBar1: TToolBar; + tbHistorySelected: TToolButton; + tbPower: TToolButton; + tbClear: TToolButton; + ToolButton1: TToolButton; + procedure lvHistoryDblClick(Sender: TObject); + procedure tbClearClick(Sender: TObject); + procedure tbHistorySelectedClick(Sender: TObject); + procedure tbPowerClick(Sender: TObject); + private + FSnapshotManager: TSnapshotManager; + FSnapshotNotification: TSnapshotNotification; + FInSnapshotChanged: Boolean; + imgCurrentLine: Integer; + FPowerImgIdx, FPowerImgIdxGrey: Integer; + FEnabledImgIdx, FDisabledIdx: Integer; + procedure SetSnapshotManager(const AValue: TSnapshotManager); + procedure SnapshotChanged(Sender: TObject); + public + { public declarations } + constructor Create(TheOwner: TComponent); override; + destructor Destroy; override; + property SnapshotManager: TSnapshotManager read FSnapshotManager write SetSnapshotManager; + end; + +implementation + +{$R *.lfm} + +{ THistoryDialog } + +procedure THistoryDialog.lvHistoryDblClick(Sender: TObject); +begin + if (FSnapshotManager.HistoryIndex = lvHistory.Selected.Index) and + (FSnapshotManager.HistorySelected) + then begin + FSnapshotManager.HistorySelected := False; + end + else begin + FSnapshotManager.HistoryIndex := lvHistory.Selected.Index; + FSnapshotManager.HistorySelected := True; + end; +end; + +procedure THistoryDialog.tbClearClick(Sender: TObject); +begin + if FSnapshotManager <> nil + then FSnapshotManager.Clear; +end; + +procedure THistoryDialog.tbHistorySelectedClick(Sender: TObject); +begin + if tbHistorySelected.Down + then tbHistorySelected.ImageIndex := FEnabledImgIdx + else tbHistorySelected.ImageIndex := FDisabledIdx; + if FSnapshotManager <> nil + then FSnapshotManager.HistorySelected := tbHistorySelected.Down; +end; + +procedure THistoryDialog.tbPowerClick(Sender: TObject); +begin + if tbPower.Down + then tbPower.ImageIndex := FPowerImgIdx + else tbPower.ImageIndex := FPowerImgIdxGrey; + if FSnapshotManager <> nil + then FSnapshotManager.Active := tbPower.Down; +end; + +procedure THistoryDialog.SnapshotChanged(Sender: TObject); +var + i, j: Integer; + Item: TListItem; +begin + if (FSnapshotManager = nil) or FInSnapshotChanged then exit; + + FInSnapshotChanged:= True; + try + tbHistorySelected.Enabled := FSnapshotManager.HistoryCount > 0; + if not tbHistorySelected.Enabled + then tbHistorySelected.Down := False + else tbHistorySelected.Down := FSnapshotManager.HistorySelected; + tbHistorySelected.Click; + + tbClear.Enabled := FSnapshotManager.HistoryCount > 0; + finally + FInSnapshotChanged := False; + end; + + j := -1; + lvHistory.BeginUpdate; + try + + i := SnapshotManager.HistoryCount; + while lvHistory.Items.Count > i do lvHistory.Items.Delete(i); + while lvHistory.Items.Count < i do begin + Item := lvHistory.Items.Add; + Item.SubItems.add(''); + Item.SubItems.add(''); + end; + + if FSnapshotManager.HistoryCount = 0 then exit; + + for i := 0 to FSnapshotManager.HistoryCount - 1 do begin + lvHistory.Items[i].Caption := ''; + if (i = FSnapshotManager.HistoryIndex) and FSnapshotManager.HistorySelected + then begin + lvHistory.Items[i].ImageIndex := imgCurrentLine; + j := i; + end + else lvHistory.Items[i].ImageIndex := -1; + + lvHistory.Items[i].SubItems[0] := TimeToStr(FSnapshotManager.HistoryEntries[i].TimeStamp); + lvHistory.Items[i].SubItems[1] := FSnapshotManager.HistoryEntries[i].LocationAsText; + lvHistory.Items[i].Data := FSnapshotManager.HistoryEntries[i]; + end; + + finally + lvHistory.EndUpdate; + end; + if j >= 0 + then lvHistory.Items[j].MakeVisible(False); +end; + +procedure THistoryDialog.SetSnapshotManager(const AValue: TSnapshotManager); +begin + if FSnapshotManager = AValue then exit; + if FSnapshotManager <> nil then FSnapshotManager.RemoveNotification(FSnapshotNotification); + FSnapshotManager := AValue; + if FSnapshotManager <> nil then FSnapshotManager.AddNotification(FSnapshotNotification); + SnapshotChanged(nil); +end; + +constructor THistoryDialog.Create(TheOwner: TComponent); +begin + inherited Create(TheOwner); + FInSnapshotChanged := False; + Caption:= histdlgFormName; + lvHistory.Column[0].Caption := histdlgColumnCur; + lvHistory.Column[1].Caption := histdlgColumnTime; + lvHistory.Column[2].Caption := histdlgColumnLoc; + + FSnapshotNotification := TSnapshotNotification.Create; + FSnapshotNotification.AddReference; + FSnapshotNotification.OnChange := @SnapshotChanged; + FSnapshotNotification.OnCurrent := @SnapshotChanged; + + imgCurrentLine := IDEImages.LoadImage(16, 'debugger_current_line'); + lvHistory.SmallImages := IDEImages.Images_16; + + ToolBar1.Images := IDEImages.Images_16; + + FPowerImgIdx := IDEImages.LoadImage(16, 'debugger_power'); + FPowerImgIdxGrey := IDEImages.LoadImage(16, 'debugger_power_grey'); + FEnabledImgIdx := IDEImages.LoadImage(16, 'debugger_enable'); + FDisabledIdx := IDEImages.LoadImage(16, 'debugger_disable'); + + tbClear.ImageIndex := IDEImages.LoadImage(16, 'menu_clean'); + tbPower.Hint := histdlgBtnPowerHint; + tbHistorySelected.Hint := histdlgBtnEnableHint; + tbClear.Hint := histdlgBtnClearHint; + + tbPowerClick(nil); + tbHistorySelectedClick(nil); +end; + +destructor THistoryDialog.Destroy; +begin + SetSnapshotManager(nil); + FSnapshotNotification.OnChange := nil; + FSnapshotNotification.OnCurrent := nil; + FSnapshotNotification.ReleaseReference; + inherited Destroy; +end; + +end. + diff --git a/debugger/localsdlg.pp b/debugger/localsdlg.pp index fb7e020c4f..d7eada3a23 100644 --- a/debugger/localsdlg.pp +++ b/debugger/localsdlg.pp @@ -49,16 +49,22 @@ type FCallStackMonitor: TCallStackMonitor; FLocalsMonitor: TLocalsMonitor; FLocalsNotification: TLocalsNotification; + FSnapshotManager: TSnapshotManager; FThreadsMonitor: TThreadsMonitor; FThreadsNotification: TThreadsNotification; FCallstackNotification: TCallStackNotification; + FSnapshotNotification: TSnapshotNotification; + procedure SetSnapshotManager(const AValue: TSnapshotManager); + procedure SnapshotChanged(Sender: TObject); procedure ContextChanged(Sender: TObject); procedure LocalsChanged(Sender: TObject); procedure SetCallStackMonitor(const AValue: TCallStackMonitor); procedure SetLocals(const AValue: TLocalsMonitor); procedure SetThreadsMonitor(const AValue: TThreadsMonitor); function GetThreadId: Integer; + function GetSelectedThreads(Snap: TSnapshot): TThreads; function GetStackframe: Integer; + function GetSelectedSnapshot: TSnapshot; protected procedure DoBeginUpdate; override; procedure DoEndUpdate; override; @@ -69,6 +75,7 @@ type property LocalsMonitor: TLocalsMonitor read FLocalsMonitor write SetLocals; property ThreadsMonitor: TThreadsMonitor read FThreadsMonitor write SetThreadsMonitor; property CallStackMonitor: TCallStackMonitor read FCallStackMonitor write SetCallStackMonitor; + property SnapshotManager: TSnapshotManager read FSnapshotManager write SetSnapshotManager; end; @@ -96,6 +103,11 @@ begin FCallstackNotification.AddReference; FCallstackNotification.OnCurrent := @ContextChanged; + FSnapshotNotification := TSnapshotNotification.Create; + FSnapshotNotification.AddReference; + FSnapshotNotification.OnChange := @SnapshotChanged; + FSnapshotNotification.OnCurrent := @SnapshotChanged; + Caption:= lisLocals; lvLocals.Columns[0].Caption:= lisLocalsDlgName; lvLocals.Columns[1].Caption:= lisLocalsDlgValue; @@ -110,9 +122,27 @@ begin FThreadsNotification.ReleaseReference; FCallstackNotification.OnCurrent := nil; FCallstackNotification.ReleaseReference; + SetSnapshotManager(nil); + FSnapshotNotification.OnChange := nil; + FSnapshotNotification.OnCurrent := nil; + FSnapshotNotification.ReleaseReference; inherited Destroy; end; +procedure TLocalsDlg.SnapshotChanged(Sender: TObject); +begin + LocalsChanged(nil); +end; + +procedure TLocalsDlg.SetSnapshotManager(const AValue: TSnapshotManager); +begin + if FSnapshotManager = AValue then exit; + if FSnapshotManager <> nil then FSnapshotManager.RemoveNotification(FSnapshotNotification); + FSnapshotManager := AValue; + if FSnapshotManager <> nil then FSnapshotManager.AddNotification(FSnapshotNotification); + LocalsChanged(nil); +end; + procedure TLocalsDlg.ContextChanged(Sender: TObject); begin LocalsChanged(nil); @@ -125,8 +155,9 @@ var Item: TListItem; S: String; Locals: TLocals; -begin - if (FThreadsMonitor = nil) or (FCallStackMonitor = nil) then begin + Snap: TSnapshot; +begin + if (FThreadsMonitor = nil) or (FCallStackMonitor = nil) or (FLocalsMonitor=nil) then begin lvLocals.Items.Clear; exit; end; @@ -135,13 +166,21 @@ begin exit; end; + Snap := GetSelectedSnapshot; + if (Snap <> nil) + then begin + Locals := FLocalsMonitor.Snapshots[Snap][GetThreadId, GetStackframe]; + Caption:= lisLocals + ' ('+ Snap.LocationAsText +')'; + end + else begin + Locals := LocalsMonitor.CurrentLocalsList[GetThreadId, GetStackframe]; + Caption:= lisLocals; + end; + List := TStringList.Create; try BeginUpdate; try - if FLocalsMonitor <> nil - then Locals := LocalsMonitor.CurrentLocalsList[GetThreadId, GetStackframe] - else Locals := nil; if Locals = nil then begin lvLocals.Items.Clear; @@ -251,17 +290,58 @@ begin end; function TLocalsDlg.GetThreadId: Integer; +var + Threads: TThreads; begin Result := -1; if (FThreadsMonitor = nil) then exit; - Result := FThreadsMonitor.CurrentThreads.CurrentThreadId; + Threads := GetSelectedThreads(GetSelectedSnapshot); + if Threads <> nil + then Result := Threads.CurrentThreadId + else Result := 1; +end; + +function TLocalsDlg.GetSelectedThreads(Snap: TSnapshot): TThreads; +begin + if FThreadsMonitor = nil then exit(nil); + if Snap = nil + then Result := FThreadsMonitor.CurrentThreads + else Result := FThreadsMonitor.Snapshots[Snap]; end; function TLocalsDlg.GetStackframe: Integer; +var + Snap: TSnapshot; + Threads: TThreads; + tid: LongInt; + Stack: TCallStack; begin - Result := -1; - if (FCallStackMonitor = nil) then exit; - Result := FCallStackMonitor.CurrentCallStackList.EntriesForThreads[GetThreadId].CurrentIndex; + if (CallStackMonitor = nil) or (ThreadsMonitor = nil) + then begin + Result := 0; + exit; + end; + + Snap := GetSelectedSnapshot; + Threads := GetSelectedThreads(Snap); + if Threads <> nil + then tid := Threads.CurrentThreadId + else tid := 1; + + if (Snap <> nil) + then Stack := CallStackMonitor.Snapshots[Snap].EntriesForThreads[tid] + else Stack := CallStackMonitor.CurrentCallStackList.EntriesForThreads[tid]; + + if Stack <> nil + then Result := Stack.CurrentIndex + else Result := 0; +end; + +function TLocalsDlg.GetSelectedSnapshot: TSnapshot; +begin + Result := nil; + if (SnapshotManager <> nil) and (SnapshotManager.HistorySelected) + then Result := SnapshotManager.SelectedEntry; end; procedure TLocalsDlg.DoBeginUpdate; diff --git a/debugger/threaddlg.lfm b/debugger/threaddlg.lfm index aea9c374ae..0842fc19e3 100644 --- a/debugger/threaddlg.lfm +++ b/debugger/threaddlg.lfm @@ -36,6 +36,7 @@ inherited ThreadsDlg: TThreadsDlg Caption = 'Function' Width = 300 end> + ReadOnly = True RowSelect = True TabOrder = 0 ViewStyle = vsReport diff --git a/debugger/threaddlg.pp b/debugger/threaddlg.pp index 2019b9ca48..21a57f9c5d 100644 --- a/debugger/threaddlg.pp +++ b/debugger/threaddlg.pp @@ -5,8 +5,8 @@ unit ThreadDlg; interface uses - Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls, - Debugger, DebuggerDlg, LazarusIDEStrConsts, BaseDebugManager, MainBase; + Classes, SysUtils, ComCtrls, Debugger, DebuggerDlg, LazarusIDEStrConsts, + BaseDebugManager, MainBase, IDEImagesIntf; type @@ -21,16 +21,23 @@ type procedure tbCurrentClick(Sender: TObject); procedure ThreadsChanged(Sender: TObject); private - { private declarations } + FSnapshotManager: TSnapshotManager; FThreadNotification: TThreadsNotification; + FSnapshotNotification: TSnapshotNotification; FThreadsMonitor: TThreadsMonitor; + imgCurrentLine: Integer; + procedure SetSnapshotManager(const AValue: TSnapshotManager); + procedure SnapshotChanged(Sender: TObject); procedure SetThreadsMonitor(const AValue: TThreadsMonitor); procedure JumpToSource; + function GetSelectedSnapshot: TSnapshot; + function GetSelectedThreads(Snap: TSnapshot): TThreads; public { public declarations } constructor Create(TheOwner: TComponent); override; destructor Destroy; override; property ThreadsMonitor: TThreadsMonitor read FThreadsMonitor write SetThreadsMonitor; + property SnapshotManager: TSnapshotManager read FSnapshotManager write SetSnapshotManager; end; implementation @@ -45,14 +52,28 @@ var s: String; Item: TListItem; Threads: TThreads; + Snap: TSnapshot; begin if FThreadsMonitor = nil then begin lvThreads.Clear; exit; end; - Threads := FThreadsMonitor.CurrentThreads; - lvThreads.Items.Count := Threads.Count; + Snap := GetSelectedSnapshot; + Threads := GetSelectedThreads(Snap); + if (Snap <> nil) + then begin + Caption:= lisThreads + ' ('+ Snap.LocationAsText +')'; + end + else begin + Caption:= lisThreads; + end; + + if Threads = nil then begin + lvThreads.Clear; + // Todo: display "no info available" + exit; + end; i := Threads.Count; while lvThreads.Items.Count > i do lvThreads.Items.Delete(i); @@ -67,9 +88,10 @@ begin end; for i := 0 to Threads.Count - 1 do begin + lvThreads.Items[i].Caption := ''; if Threads[i].ThreadId = Threads.CurrentThreadId - then lvThreads.Items[i].Caption := '*' - else lvThreads.Items[i].Caption := ''; + then lvThreads.Items[i].ImageIndex := imgCurrentLine + else lvThreads.Items[i].ImageIndex := -1; lvThreads.Items[i].SubItems[0] := IntToStr(Threads[i].ThreadId); lvThreads.Items[i].SubItems[1] := Threads[i].ThreadName; lvThreads.Items[i].SubItems[2] := Threads[i].ThreadState; @@ -86,12 +108,20 @@ procedure TThreadsDlg.tbCurrentClick(Sender: TObject); var Item: TListItem; id: LongInt; + Threads: TThreads; begin Item := lvThreads.Selected; if Item = nil then exit; id := StrToIntDef(Item.SubItems[0], -1); if id < 0 then exit; - FThreadsMonitor.ChangeCurrentThread(id); + if GetSelectedSnapshot = nil + then FThreadsMonitor.ChangeCurrentThread(id) + else begin + Threads := GetSelectedThreads(GetSelectedSnapshot); + if Threads <> nil + then Threads.CurrentThreadId := id; + FThreadsMonitor.CurrentChanged; + end; end; procedure TThreadsDlg.lvThreadsDblClick(Sender: TObject); @@ -99,6 +129,20 @@ begin JumpToSource; end; +procedure TThreadsDlg.SnapshotChanged(Sender: TObject); +begin + ThreadsChanged(nil); +end; + +procedure TThreadsDlg.SetSnapshotManager(const AValue: TSnapshotManager); +begin + if FSnapshotManager = AValue then exit; + if FSnapshotManager <> nil then FSnapshotManager.RemoveNotification(FSnapshotNotification); + FSnapshotManager := AValue; + if FSnapshotManager <> nil then FSnapshotManager.AddNotification(FSnapshotNotification); + ThreadsChanged(FSnapshotManager); +end; + procedure TThreadsDlg.SetThreadsMonitor(const AValue: TThreadsMonitor); begin if FThreadsMonitor = AValue then exit; @@ -136,6 +180,20 @@ begin DebugBoss.UnLockCommandProcessing; end;end; +function TThreadsDlg.GetSelectedSnapshot: TSnapshot; +begin + Result := nil; + if (SnapshotManager <> nil) and (SnapshotManager.HistorySelected) + then Result := SnapshotManager.SelectedEntry; +end; + +function TThreadsDlg.GetSelectedThreads(Snap: TSnapshot): TThreads; +begin + if Snap = nil + then Result := FThreadsMonitor.CurrentThreads + else Result := FThreadsMonitor.Snapshots[Snap]; +end; + constructor TThreadsDlg.Create(TheOwner: TComponent); begin inherited Create(TheOwner); @@ -152,6 +210,14 @@ begin FThreadNotification := TThreadsNotification.Create; FThreadNotification.AddReference; FThreadNotification.OnChange := @ThreadsChanged; + + FSnapshotNotification := TSnapshotNotification.Create; + FSnapshotNotification.AddReference; + FSnapshotNotification.OnChange := @SnapshotChanged; + FSnapshotNotification.OnCurrent := @SnapshotChanged; + + imgCurrentLine := IDEImages.LoadImage(16, 'debugger_current_line'); + lvThreads.SmallImages := IDEImages.Images_16; end; destructor TThreadsDlg.Destroy; @@ -159,6 +225,10 @@ begin SetThreadsMonitor(nil); FThreadNotification.OnChange := nil; FThreadNotification.ReleaseReference; + SetSnapshotManager(nil); + FSnapshotNotification.OnChange := nil; + FSnapshotNotification.OnCurrent := nil; + FSnapshotNotification.ReleaseReference; inherited Destroy; end; diff --git a/debugger/watchesdlg.pp b/debugger/watchesdlg.pp index fa0d260b7c..5cd4b4a01f 100644 --- a/debugger/watchesdlg.pp +++ b/debugger/watchesdlg.pp @@ -103,32 +103,39 @@ type procedure popEnableAllClick(Sender: TObject); procedure popDeleteAllClick(Sender: TObject); private - function GetWatches: TCurrentWatches; + function GetWatches: TWatches; procedure ContextChanged(Sender: TObject); + procedure SnapshotChanged(Sender: TObject); private + FWatchesInView: TWatches; FCallStackMonitor: TCallStackMonitor; + FSnapshotManager: TSnapshotManager; FThreadsMonitor: TThreadsMonitor; FWatchesMonitor: TWatchesMonitor; + FSnapshotNotification: TSnapshotNotification; FWatchesNotification: TWatchesNotification; FThreadsNotification: TThreadsNotification; FCallstackNotification: TCallStackNotification; FPowerImgIdx, FPowerImgIdxGrey: Integer; - FUpdateAllNeeded: Boolean; + FUpdateAllNeeded, FUpdatingAll: Boolean; FStateFlags: TWatchesDlgStateFlags; function GetSelected: TCurrentWatch; function GetThreadId: Integer; + function GetSelectedThreads(Snap: TSnapshot): TThreads; function GetStackframe: Integer; + procedure SetSnapshotManager(const AValue: TSnapshotManager); procedure SetCallStackMonitor(const AValue: TCallStackMonitor); procedure SetThreadsMonitor(const AValue: TThreadsMonitor); procedure SetWatchesMonitor(const AValue: TWatchesMonitor); - procedure WatchAdd(const ASender: TCurrentWatches; const AWatch: TCurrentWatch); - procedure WatchUpdate(const ASender: TCurrentWatches; const AWatch: TCurrentWatch); - procedure WatchRemove(const ASender: TCurrentWatches; const AWatch: TCurrentWatch); + procedure WatchAdd(const ASender: TWatches; const AWatch: TWatch); + procedure WatchUpdate(const ASender: TWatches; const AWatch: TWatch); + procedure WatchRemove(const ASender: TWatches; const AWatch: TWatch); - procedure UpdateItem(const AItem: TListItem; const AWatch: TCurrentWatch); + procedure UpdateItem(const AItem: TListItem; const AWatch: TWatch); procedure UpdateAll; procedure DisableAllActions; - property Watches: TCurrentWatches read GetWatches; + function GetSelectedSnapshot: TSnapshot; + property Watches: TWatches read GetWatches; protected procedure DoEndUpdate; override; public @@ -138,6 +145,7 @@ type property WatchesMonitor: TWatchesMonitor read FWatchesMonitor write SetWatchesMonitor; property ThreadsMonitor: TThreadsMonitor read FThreadsMonitor write SetThreadsMonitor; property CallStackMonitor: TCallStackMonitor read FCallStackMonitor write SetCallStackMonitor; + property SnapshotManager: TSnapshotManager read FSnapshotManager write SetSnapshotManager; end; @@ -150,6 +158,8 @@ implementation constructor TWatchesDlg.Create(AOwner: TComponent); begin inherited Create(AOwner); + FWatchesInView := nil; + FWatchesNotification := TWatchesNotification.Create; FWatchesNotification.AddReference; FWatchesNotification.OnAdd := @WatchAdd; @@ -165,6 +175,10 @@ begin FCallstackNotification.AddReference; FCallstackNotification.OnCurrent := @ContextChanged; + FSnapshotNotification := TSnapshotNotification.Create; + FSnapshotNotification.AddReference; + FSnapshotNotification.OnChange := @SnapshotChanged; + FSnapshotNotification.OnCurrent := @SnapshotChanged; ActionList1.Images := IDEImages.Images_16; ToolBar1.Images := IDEImages.Images_16; @@ -228,6 +242,10 @@ begin FThreadsNotification.ReleaseReference; FCallstackNotification.OnCurrent := nil; FCallstackNotification.ReleaseReference; + SetSnapshotManager(nil); + FSnapshotNotification.OnChange := nil; + FSnapshotNotification.OnCurrent := nil; + FSnapshotNotification.ReleaseReference; inherited Destroy; end; @@ -242,17 +260,60 @@ begin end; function TWatchesDlg.GetThreadId: Integer; +var + Threads: TThreads; begin Result := -1; if (FThreadsMonitor = nil) then exit; - Result := FThreadsMonitor.CurrentThreads.CurrentThreadId; + Threads := GetSelectedThreads(GetSelectedSnapshot); + if Threads <> nil + then Result := Threads.CurrentThreadId + else Result := 1; +end; + +function TWatchesDlg.GetSelectedThreads(Snap: TSnapshot): TThreads; +begin + if FThreadsMonitor = nil then exit(nil); + if Snap = nil + then Result := FThreadsMonitor.CurrentThreads + else Result := FThreadsMonitor.Snapshots[Snap]; end; function TWatchesDlg.GetStackframe: Integer; +var + Snap: TSnapshot; + Threads: TThreads; + tid: LongInt; + Stack: TCallStack; begin - Result := -1; - if (FCallStackMonitor = nil) then exit; - Result := FCallStackMonitor.CurrentCallStackList.EntriesForThreads[GetThreadId].CurrentIndex; + if (CallStackMonitor = nil) or (ThreadsMonitor = nil) + then begin + Result := 0; + exit; + end; + + Snap := GetSelectedSnapshot; + Threads := GetSelectedThreads(Snap); + if Threads <> nil + then tid := Threads.CurrentThreadId + else tid := 1; + + if (Snap <> nil) + then Stack := CallStackMonitor.Snapshots[Snap].EntriesForThreads[tid] + else Stack := CallStackMonitor.CurrentCallStackList.EntriesForThreads[tid]; + + if Stack <> nil + then Result := Stack.CurrentIndex + else Result := 0; +end; + +procedure TWatchesDlg.SetSnapshotManager(const AValue: TSnapshotManager); +begin + if FSnapshotManager = AValue then exit; + if FSnapshotManager <> nil then FSnapshotManager.RemoveNotification(FSnapshotNotification); + FSnapshotManager := AValue; + if FSnapshotManager <> nil then FSnapshotManager.AddNotification(FSnapshotNotification); + SnapshotChanged(nil); end; procedure TWatchesDlg.SetCallStackMonitor(const AValue: TCallStackMonitor); @@ -327,6 +388,22 @@ var AllCanEnable, AllCanDisable: Boolean; i: Integer; begin + if FUpdatingAll then exit; + if GetSelectedSnapshot <> nil then begin + actToggleCurrentEnable.Enabled := False; + actToggleCurrentEnable.Checked := False; + actEnableSelected.Enabled := False; + actDisableSelected.Enabled := False; + actDeleteSelected.Enabled := False; + actEnableAll.Enabled := False; + actDisableAll.Enabled := False; + actDeleteAll.Enabled := False; + actProperties.Enabled := False; + actAddWatch.Enabled := False; + actPower.Enabled := False; + exit; + end; + ItemSelected := lvWatches.Selected <> nil; if ItemSelected then Watch:=TCurrentWatch(lvWatches.Selected.Data) @@ -365,6 +442,7 @@ end; procedure TWatchesDlg.lvWatchesDblClick(Sender: TObject); begin + if GetSelectedSnapshot <> nil then exit; if lvWatches.SelCount >= 0 then popPropertiesClick(Sender) else @@ -449,6 +527,7 @@ end; procedure TWatchesDlg.lvWatchesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin + if GetSelectedSnapshot <> nil then exit; case Key of //delete key pressed: delete selected item VK_DELETE: popDeleteClick(Sender); @@ -486,11 +565,34 @@ begin end; end; -function TWatchesDlg.GetWatches: TCurrentWatches; +procedure TWatchesDlg.SnapshotChanged(Sender: TObject); +var + NewWatches: TWatches; begin - if FWatchesMonitor <> nil - then Result := FWatchesMonitor.CurrentWatches - else Result := nil; + lvWatches.BeginUpdate; + try + NewWatches := Watches; + if FWatchesInView <> NewWatches + then lvWatches.Items.Clear; + FWatchesInView := NewWatches; + UpdateAll; + finally + lvWatches.EndUpdate; + end; +end; + +function TWatchesDlg.GetWatches: TWatches; +var + Snap: TSnapshot; +begin + Result := nil; + if FWatchesMonitor = nil then exit; + + Snap := GetSelectedSnapshot; + + if Snap <> nil + then Result := FWatchesMonitor.Snapshots[Snap] + else Result := FWatchesMonitor.CurrentWatches; end; procedure TWatchesDlg.DoEndUpdate; @@ -582,7 +684,7 @@ begin end; end; -procedure TWatchesDlg.UpdateItem(const AItem: TListItem; const AWatch: TCurrentWatch); +procedure TWatchesDlg.UpdateItem(const AItem: TListItem; const AWatch: TWatch); function ClearMultiline(const AValue: ansistring): ansistring; var j: SizeInt; @@ -613,6 +715,8 @@ procedure TWatchesDlg.UpdateItem(const AItem: TListItem; const AWatch: TCurrentW SetLength(Result,ow); end; end; +var + WatchValue: TWatchValue; begin // Expression // Result @@ -622,7 +726,10 @@ begin include(FStateFlags, wdsfUpdating); AItem.Caption := AWatch.Expression; - AItem.SubItems[0] := ClearMultiline(AWatch.Values[GetThreadId, GetStackframe].Value); + WatchValue := AWatch.Values[GetThreadId, GetStackframe]; + if WatchValue <> nil + then AItem.SubItems[0] := ClearMultiline(WatchValue.Value) + else AItem.SubItems[0] := ''; exclude(FStateFlags, wdsfUpdating); if wdsfNeedDeleteCurrent in FStateFlags then popDeleteClick(nil); @@ -633,20 +740,36 @@ end; procedure TWatchesDlg.UpdateAll; var i, l: Integer; + Snap: TSnapshot; begin + Snap := GetSelectedSnapshot; + if Snap <> nil + then Caption:= liswlWatchList + ' (' + Snap.LocationAsText + ')' + else Caption:= liswlWatchList; + + if Watches = nil then exit; if UpdateCount > 0 then begin FUpdateAllNeeded := True; exit; end; - l := Watches.Count; - i := 0; - while i < l do begin - WatchUpdate(Watches, Watches.Items[i]); - if l <> Watches.Count then begin - i := Max(0, i - Max(0, Watches.Count - l)); - l := Watches.Count; + + FUpdatingAll := True; + lvWatches.BeginUpdate; + try + l := Watches.Count; + i := 0; + while i < l do begin + WatchUpdate(Watches, Watches.Items[i]); + if l <> Watches.Count then begin + i := Max(0, i - Max(0, Watches.Count - l)); + l := Watches.Count; + end; + inc(i); end; - inc(i); + finally + FUpdatingAll := False; + lvWatches.EndUpdate; + lvWatchesSelectItem(nil, nil, False); end; end; @@ -658,7 +781,14 @@ begin (ActionList1.Actions[i] as TAction).Enabled := False; end; -procedure TWatchesDlg.WatchAdd(const ASender: TCurrentWatches; const AWatch: TCurrentWatch); +function TWatchesDlg.GetSelectedSnapshot: TSnapshot; +begin + Result := nil; + if (SnapshotManager <> nil) and (SnapshotManager.HistorySelected) + then Result := SnapshotManager.SelectedEntry; +end; + +procedure TWatchesDlg.WatchAdd(const ASender: TWatches; const AWatch: TWatch); var Item: TListItem; Watch: TCurrentWatch; @@ -679,21 +809,23 @@ begin lvWatchesSelectItem(nil, nil, False); end; -procedure TWatchesDlg.WatchUpdate(const ASender: TCurrentWatches; const AWatch: TCurrentWatch); +procedure TWatchesDlg.WatchUpdate(const ASender: TWatches; const AWatch: TWatch); var Item: TListItem; begin if AWatch = nil then Exit; + if AWatch.Collection <> FWatchesInView then exit; Item := lvWatches.Items.FindData(AWatch); if Item = nil then WatchAdd(ASender, AWatch) else UpdateItem(Item, AWatch); - lvWatchesSelectItem(nil, nil, False); + if not FUpdatingAll + then lvWatchesSelectItem(nil, nil, False); end; -procedure TWatchesDlg.WatchRemove(const ASender: TCurrentWatches; const AWatch: TCurrentWatch); +procedure TWatchesDlg.WatchRemove(const ASender: TWatches; const AWatch: TWatch); begin lvWatches.Items.FindData(AWatch).Free; lvWatchesSelectItem(nil, nil, False); diff --git a/ide/basedebugmanager.pas b/ide/basedebugmanager.pas index ca29b54dc0..97e5ff182c 100644 --- a/ide/basedebugmanager.pas +++ b/ide/basedebugmanager.pas @@ -56,7 +56,8 @@ type ddtAssembler, ddtInspect, ddtPseudoTerminal, - ddtThreads + ddtThreads, + ddtHistory ); { TBaseDebugManager } @@ -94,6 +95,7 @@ type FWatches: TWatchesMonitor; FThreads: TThreadsMonitor; FRegisters: TIDERegisters; + FSnapshots: TSnapshotManager; FManagerStates: TDebugManagerStates; function FindDebuggerClass(const Astring: String): TDebuggerClass; function GetState: TDBGState; virtual; abstract; @@ -179,6 +181,7 @@ type property Signals: TIDESignals read FSignals; // A list of actions for signals we know of property Watches: TWatchesMonitor read FWatches; property Threads: TThreadsMonitor read FThreads; + property Snapshots: TSnapshotManager read FSnapshots; {$IFDEF DBG_WITH_DEBUGGER_DEBUG} property Debugger: TDebugger read GetDebugger; {$ENDIF} diff --git a/ide/debugmanager.pas b/ide/debugmanager.pas index 9bfdbff747..6e7c14e887 100644 --- a/ide/debugmanager.pas +++ b/ide/debugmanager.pas @@ -56,7 +56,7 @@ uses SourceMarks, DebuggerDlg, Watchesdlg, BreakPointsdlg, BreakPropertyDlg, LocalsDlg, WatchPropertyDlg, CallStackDlg, EvaluateDlg, RegistersDlg, AssemblerDlg, DebugOutputForm, ExceptionDlg, - InspectDlg, DebugEventsForm, PseudoTerminalDlg, FeedbackDlg, ThreadDlg, + InspectDlg, DebugEventsForm, PseudoTerminalDlg, FeedbackDlg, ThreadDlg, HistoryDlg, GDBMIDebugger, SSHGDBMIDebugger, ProcessDebugger, BaseDebugManager; @@ -135,6 +135,7 @@ type procedure InitRegistersDlg; procedure InitAssemblerDlg; procedure InitInspectDlg; + procedure InitHistoryDlg; procedure FreeDebugger; procedure ResetDebugger; @@ -218,7 +219,7 @@ const DebugDlgIDEWindow: array[TDebugDialogType] of TNonModalIDEWindow = ( nmiwDbgOutput, nmiwDbgEvents, nmiwBreakPoints, nmiwWatches, nmiwLocals, nmiwCallStack, nmiwEvaluate, nmiwRegisters, nmiwAssembler, nmiwInspect, - nmiwPseudoTerminal, nmiwThreads + nmiwPseudoTerminal, nmiwThreads, nmiHistory ); type @@ -657,6 +658,7 @@ begin ecInspect : ViewDebugDialog(ddtInspect); ecViewPseudoTerminal: ViewDebugDialog(ddtPseudoTerminal); ecViewThreads : ViewDebugDialog(ddtThreads); + ecViewHistory : ViewDebugDialog(ddtHistory); end; end; end; @@ -882,6 +884,8 @@ begin and (FDialogs[ddtInspect] <> nil) then TIDEInspectDlg(FDialogs[ddtInspect]).UpdateData; + FSnapshots.DoStateChange(OldState); + case FDebugger.State of dsError: begin {$ifdef VerboseDebugger} @@ -1073,7 +1077,7 @@ const DEBUGDIALOGCLASS: array[TDebugDialogType] of TDebuggerDlgClass = ( TDbgOutputForm, TDbgEventsForm, TBreakPointsDlg, TWatchesDlg, TLocalsDlg, TCallStackDlg, TEvaluateDlg, TRegistersDlg, TAssemblerDlg, TIDEInspectDlg, - TPseudoConsoleDlg, TThreadsDlg + TPseudoConsoleDlg, TThreadsDlg, THistoryDialog ); var CurDialog: TDebuggerDlg; @@ -1103,6 +1107,7 @@ begin ddtInspect: InitInspectDlg; ddtPseudoTerminal: InitPseudoTerminal; ddtThreads: InitThreadsDlg; + ddtHistory: InitHistoryDlg; end; end else begin @@ -1176,6 +1181,7 @@ begin TheDialog.WatchesMonitor := FWatches; TheDialog.ThreadsMonitor := FThreads; TheDialog.CallStackMonitor := FCallStack; + TheDialog.SnapshotManager := FSnapshots; end; procedure TDebugManager.InitThreadsDlg; @@ -1184,6 +1190,7 @@ var begin TheDialog := TThreadsDlg(FDialogs[ddtThreads]); TheDialog.ThreadsMonitor := FThreads; + TheDialog.SnapshotManager := FSnapshots; end; procedure TDebugManager.InitPseudoTerminal; @@ -1202,6 +1209,7 @@ begin TheDialog.LocalsMonitor := FLocals; TheDialog.ThreadsMonitor := FThreads; TheDialog.CallStackMonitor := FCallStack; + TheDialog.SnapshotManager := FSnapshots; end; procedure TDebugManager.InitRegistersDlg; @@ -1234,6 +1242,14 @@ begin TheDialog.Execute(SourceEditorManager.GetActiveSE.GetOperandAtCurrentCaret); end; +procedure TDebugManager.InitHistoryDlg; +var + TheDialog: THistoryDialog; +begin + TheDialog := THistoryDialog(FDialogs[ddtHistory]); + TheDialog.SnapshotManager := FSnapshots; +end; + procedure TDebugManager.InitCallStackDlg; var TheDialog: TCallStackDlg; @@ -1242,6 +1258,7 @@ begin TheDialog.CallStackMonitor := FCallStack; TheDialog.BreakPoints := FBreakPoints; TheDialog.ThreadsMonitor := FThreads; + TheDialog.SnapshotManager := FSnapshots; end; procedure TDebugManager.InitEvaluateDlg; @@ -1278,6 +1295,12 @@ begin FDisassembler := TIDEDisassembler.Create; FRegisters := TIDERegisters.Create; + FSnapshots := TSnapshotManager.Create; + FSnapshots.Threads := FThreads; + FSnapshots.CallStack := FCallStack; + FSnapshots.Watches := FWatches; + FSnapshots.Locals := FLocals; + FUserSourceFiles := TStringList.Create; FIgnoreSourceFiles := TStringList.Create; @@ -1306,6 +1329,7 @@ begin SetDebugger(nil); + FreeAndNil(FSnapshots); FreeAndNil(FWatches); FreeAndNil(FThreads); FreeAndNil(FBreakPoints); @@ -1365,6 +1389,8 @@ begin itmViewPseudoTerminal.OnClick := @mnuViewDebugDialogClick; itmViewPseudoTerminal.Tag := Ord(ddtPseudoTerminal); end; + itmViewDbgHistory.OnClick := @mnuViewDebugDialogClick; + itmViewDbgHistory.Tag := Ord(ddtHistory); itmRunMenuResetDebugger.OnClick := @mnuResetDebuggerClicked; @@ -1414,6 +1440,7 @@ begin itmViewThreads.Command:=GetCommand(ecViewThreads); if itmViewPseudoTerminal <> nil then itmViewPseudoTerminal.Command:=GetCommand(ecViewPseudoTerminal); + itmViewDbgHistory.Command:=GetCommand(ecViewHistory); itmRunMenuInspect.Command:=GetCommand(ecInspect); itmRunMenuEvaluate.Command:=GetCommand(ecEvaluate); @@ -2016,6 +2043,7 @@ begin ecToggleLocals: ViewDebugDialog(ddtLocals); ecViewPseudoTerminal: ViewDebugDialog(ddtPseudoTerminal); ecViewThreads: ViewDebugDialog(ddtThreads); + ecViewHistory: ViewDebugDialog(ddtHistory); else Handled := False; end; @@ -2290,6 +2318,7 @@ begin FExceptions.Master := nil; FSignals.Master := nil; FRegisters.Master := nil; + FSnapshots.Debugger := nil; end else begin TManagedBreakpoints(FBreakpoints).Master := FDebugger.BreakPoints; @@ -2302,6 +2331,7 @@ begin FExceptions.Master := FDebugger.Exceptions; FSignals.Master := FDebugger.Signals; FRegisters.Master := FDebugger.Registers; + FSnapshots.Debugger := FDebugger; end; end; diff --git a/ide/ideoptiondefs.pas b/ide/ideoptiondefs.pas index feb7b4d32f..b7da7780e5 100644 --- a/ide/ideoptiondefs.pas +++ b/ide/ideoptiondefs.pas @@ -95,6 +95,7 @@ type nmiwInspect, nmiwPseudoTerminal, nmiwThreads, + nmiHistory, // extra nmiwSearchResultsViewName, nmiwAnchorEditor, @@ -142,6 +143,7 @@ const 'Inspect', 'PseudoTerminal', 'Threads', + 'DbgHistory', // extra 'SearchResults', 'AnchorEditor', diff --git a/ide/keymapping.pp b/ide/keymapping.pp index 334a2ac5d0..8b707fa10c 100644 --- a/ide/keymapping.pp +++ b/ide/keymapping.pp @@ -519,6 +519,7 @@ begin ecToggleAssembler: SetResult(VK_D,[ssCtrl,ssAlt],VK_UNKNOWN,[]); ecToggleDebugEvents: SetResult(VK_V,[ssCtrl,ssAlt],VK_UNKNOWN,[]); ecToggleDebuggerOut: SetResult(VK_UNKNOWN,[],VK_UNKNOWN,[]); + ecViewHistory: SetResult(VK_H,[ssCtrl,ssAlt],VK_UNKNOWN,[]); ecViewUnitDependencies: SetResult(VK_UNKNOWN,[],VK_UNKNOWN,[]); ecViewUnitInfo: SetResult(VK_UNKNOWN,[],VK_UNKNOWN,[]); ecToggleFormUnit: SetResult(VK_F12,[],VK_UNKNOWN,[]); @@ -1580,6 +1581,7 @@ begin ecToggleAssembler: SetResult(VK_D,[ssCtrl,ssAlt],VK_UNKNOWN,[]); ecToggleDebugEvents: SetResult(VK_V,[ssCtrl,ssAlt],VK_UNKNOWN,[]); ecToggleDebuggerOut: SetResult(VK_UNKNOWN,[],VK_UNKNOWN,[]); + ecViewHistory: SetResult(VK_H,[ssCtrl,ssAlt],VK_UNKNOWN,[]); ecViewUnitDependencies: SetResult(VK_UNKNOWN,[],VK_UNKNOWN,[]); ecViewUnitInfo: SetResult(VK_UNKNOWN,[],VK_UNKNOWN,[]); ecToggleFormUnit: SetResult(VK_F,[ssMeta,ssAlt],VK_UNKNOWN,[]); @@ -2086,6 +2088,7 @@ begin ecToggleCallStack : Result:= srkmecToggleCallStack; ecToggleRegisters : Result:= srkmecToggleRegisters; ecToggleAssembler : Result:= srkmecToggleAssembler; + ecViewHistory : Result:= srkmecViewHistory; ecViewUnitDependencies : Result:= srkmecViewUnitDependencies; ecViewUnitInfo : Result:= srkmecViewUnitInfo; ecViewAnchorEditor : Result:= srkmecViewAnchorEditor; @@ -2758,6 +2761,7 @@ begin AddDefault(C, 'Toggle view Assembler', lisKMToggleViewAssembler, ecToggleAssembler); AddDefault(C, 'Toggle view Event Log', lisKMToggleViewDebugEvents, ecToggleDebugEvents); AddDefault(C, 'Toggle view Debugger Output', lisKMToggleViewDebuggerOutput, ecToggleDebuggerOut); + AddDefault(C, 'Toggle view Debug History', lisKMToggleViewHistory, ecViewHistory); AddDefault(C, 'View Unit Dependencies', lisMenuViewUnitDependencies, ecViewUnitDependencies); AddDefault(C, 'View Unit Info', lisKMViewUnitInfo, ecViewUnitInfo); AddDefault(C, 'Toggle between Unit and Form', lisKMToggleBetweenUnitAndForm, ecToggleFormUnit); diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index fcff185500..799ceeaecd 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -313,6 +313,7 @@ resourcestring lisMenuViewRegisters = 'Registers'; lisMenuViewCallStack = 'Call Stack'; lisMenuViewThreads = 'Threads'; + lisMenuViewHistory = 'History'; lisMenuViewAssembler = 'Assembler'; lisDbgAsmCopyToClipboard = 'Copy to clipboard'; lisMenuViewDebugOutput = 'Debug output'; @@ -2612,6 +2613,7 @@ resourcestring srkmecToggleDebuggerOut = 'View debugger output'; srkmecToggleLocals = 'View local variables'; srkmecViewThreads = 'View Threads'; + srkmecViewHistory = 'View History'; srkmecViewPseudoTerminal = 'View Terminal Output'; srkmecTogglecallStack = 'View call stack'; srkmecToggleRegisters = 'View registers'; @@ -2759,6 +2761,7 @@ resourcestring lisKMToggleViewBreakpoints = 'Toggle view Breakpoints'; lisKMToggleViewLocalVariables = 'Toggle view Local Variables'; lisKMToggleViewThreads = 'Toggle view Threads'; + lisKMToggleViewHistory = 'Toggle view History'; lisKMToggleViewPseudoTerminal = 'Toggle view Terminal Output'; lisKMToggleViewCallStack = 'Toggle view Call Stack'; lisKMToggleViewRegisters = 'Toggle view Registers'; @@ -4710,6 +4713,15 @@ resourcestring lisThreadsCurrent = 'Current'; lisThreadsGoto = 'Goto'; + // HistoryDlg + histdlgFormName = 'History'; + histdlgColumnCur = ''; + histdlgColumnTime = 'Time'; + histdlgColumnLoc = 'Location'; + histdlgBtnPowerHint = 'Switch on/off automatic snapshots'; + histdlgBtnEnableHint = 'Toggle view snapshot or current'; + histdlgBtnClearHint = 'Clear all snapshots'; + // Exception Dialog lisExceptionDialog = 'Debugger Exception Notification'; lisBtnBreak = 'Break'; diff --git a/ide/mainbar.pas b/ide/mainbar.pas index aa323dcb15..fa3f7e4b0a 100644 --- a/ide/mainbar.pas +++ b/ide/mainbar.pas @@ -193,6 +193,7 @@ type itmViewDebugOutput: TIDEMenuCommand; itmViewDebugEvents: TIDEMenuCommand; itmViewPseudoTerminal: TIDEMenuCommand; + itmViewDbgHistory: TIDEMenuCommand; //itmViewIDEInternalsWindows: TIDEMenuSection; itmViewPackageLinks: TIDEMenuCommand; itmViewFPCInfo: TIDEMenuCommand; diff --git a/ide/mainbase.pas b/ide/mainbase.pas index bf3c2d2263..24aad17417 100644 --- a/ide/mainbase.pas +++ b/ide/mainbase.pas @@ -537,6 +537,7 @@ begin CreateMenuItem(itmViewDebugWindows,itmViewAssembler,'itmViewAssembler',lisMenuViewAssembler); CreateMenuItem(itmViewDebugWindows,itmViewDebugEvents,'itmViewDebugEvents',lisMenuViewDebugEvents,'debugger_event_log'); CreateMenuItem(itmViewDebugWindows,itmViewDebugOutput,'itmViewDebugOutput',lisMenuViewDebugOutput,'debugger_output'); + CreateMenuItem(itmViewDebugWindows,itmViewDbgHistory,'itmViewDbgHistory',lisMenuViewHistory); end; CreateMenuSubSection(ParentMI, itmViewIDEInternalsWindows, 'itmViewIDEInternalsWindows', lisMenuIDEInternals); begin diff --git a/ideintf/idecommands.pas b/ideintf/idecommands.pas index e01af03fd4..8cf2a10713 100644 --- a/ideintf/idecommands.pas +++ b/ideintf/idecommands.pas @@ -187,6 +187,7 @@ const ecToggleDebugEvents = ecFirstLazarus + 327; ecViewPseudoTerminal = ecFirstLazarus + 328; ecViewThreads = ecFirstLazarus + 329; + ecViewHistory = ecFirstLazarus + 450; // sourcenotebook commands ecNextEditor = ecFirstLazarus + 330; @@ -255,6 +256,8 @@ const ecStepOverContext = ecFirstLazarus + 423; ecBuildAdvancedLazarus = ecFirstLazarus + 424; + // 450++ : used for ecViewHistory (debugger) + // project menu ecNewProject = ecFirstLazarus + 500; ecNewProjectFromFile = ecFirstLazarus + 501;