1unit ThreadDlg;
2
3{$mode objfpc}{$H+}
4
5interface
6
7uses
8  Classes, SysUtils, ComCtrls, LCLProc, LazLoggerBase,
9  Debugger, DebuggerDlg, Forms, LazarusIDEStrConsts, IDEWindowIntf, DebuggerStrConst,
10  BaseDebugManager, IDEImagesIntf;
11
12type
13
14  { TThreadsDlg }
15
16  TThreadsDlg = class(TDebuggerDlg)
17    lvThreads: TListView;
18    ToolBar1: TToolBar;
19    tbCurrent: TToolButton;
20    tbGoto: TToolButton;
21    procedure lvThreadsDblClick(Sender: TObject);
22    procedure tbCurrentClick(Sender: TObject);
23  private
24    imgCurrentLine: Integer;
25    FUpdateFlags: set of (ufThreadChanged);
26    procedure JumpToSource;
27    function  GetSelectedSnapshot: TSnapshot;
28    function GetSelectedThreads(Snap: TSnapshot): TIdeThreads;
29  protected
30    procedure DoEndUpdate; override;
31    procedure ThreadsChanged(Sender: TObject);
32    function  ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;
33    procedure ColSizeSetter(AColId: Integer; ASize: Integer);
34  public
35    { public declarations }
36    constructor Create(TheOwner: TComponent); override;
37    property ThreadsMonitor;
38    property SnapshotManager;
39  end;
40
41implementation
42
43{$R *.lfm}
44
45var
46  DBG_DATA_MONITORS: PLazLoggerLogGroup;
47  ThreadDlgWindowCreator: TIDEWindowCreator;
48
49const
50  COL_THREAD_BRKPOINT = 1;
51  COL_THREAD_INDEX    = 2;
52  COL_THREAD_NAME     = 3;
53  COL_THREAD_STATE    = 4;
54  COL_THREAD_SOURCE   = 5;
55  COL_THREAD_LINE     = 6;
56  COL_THREAD_FUNC     = 7;
57  COL_WIDTHS: Array[0..6] of integer = ( 20, 50, 100, 50,  150, 50, 300);
58
59function ThreadsDlgColSizeGetter(AForm: TCustomForm; AColId: Integer; var ASize: Integer): Boolean;
60begin
61  Result := AForm is TThreadsDlg;
62  if Result then
63    Result := TThreadsDlg(AForm).ColSizeGetter(AColId, ASize);
64end;
65
66procedure ThreadsDlgColSizeSetter(AForm: TCustomForm; AColId: Integer; ASize: Integer);
67begin
68  if AForm is TThreadsDlg then
69    TThreadsDlg(AForm).ColSizeSetter(AColId, ASize);
70end;
71
72{ TThreadsDlg }
73
74procedure TThreadsDlg.ThreadsChanged(Sender: TObject);
75var
76  i: Integer;
77  s: String;
78  Item: TListItem;
79  Threads: TIdeThreads;
80  Snap: TSnapshot;
81begin
82  if IsUpdating then begin
83    DebugLn(DBG_DATA_MONITORS, ['DebugDataWindow: TThreadsDlg.ThreadsChanged from ',  DbgSName(Sender), ' in IsUpdating']);
84
85    Include(FUpdateFlags, ufThreadChanged);
86    exit;
87  end;
88  try DebugLnEnter(DBG_DATA_MONITORS, ['DebugDataMonitor: >>ENTER: TThreadsDlg.ThreadsChanged from ',  DbgSName(Sender)]);
89  Exclude(FUpdateFlags, ufThreadChanged);
90
91  BeginUpdate;
92  lvThreads.BeginUpdate;
93  try
94    if ThreadsMonitor = nil then begin
95      lvThreads.Clear;
96      exit;
97    end;
98
99    Snap := GetSelectedSnapshot;
100    Threads := GetSelectedThreads(Snap);
101    if (Snap <> nil)
102    then begin
103      Caption:= lisThreads + ' ('+ Snap.LocationAsText +')';
104    end
105    else begin
106      Caption:= lisThreads;
107    end;
108
109    if (Threads = nil) or ((Snap <> nil) and (Threads.Count=0)) then begin
110      lvThreads.Clear;
111      Item := lvThreads.Items.Add;
112      Item.SubItems.add('');
113      Item.SubItems.add('');
114      Item.SubItems.add('');
115      Item.SubItems.add(lisThreadsNotEvaluated);
116      Item.SubItems.add('');
117      Item.SubItems.add('');
118      exit;
119    end;
120
121    i := Threads.Count;
122    while lvThreads.Items.Count > i do lvThreads.Items.Delete(i);
123    while lvThreads.Items.Count < i do begin
124      Item := lvThreads.Items.Add;
125      Item.SubItems.add('');
126      Item.SubItems.add('');
127      Item.SubItems.add('');
128      Item.SubItems.add('');
129      Item.SubItems.add('');
130      Item.SubItems.add('');
131    end;
132
133    for i := 0 to Threads.Count - 1 do begin
134      lvThreads.Items[i].Caption := '';
135      if Threads[i].ThreadId = Threads.CurrentThreadId
136      then lvThreads.Items[i].ImageIndex := imgCurrentLine
137      else lvThreads.Items[i].ImageIndex := -1;
138      lvThreads.Items[i].SubItems[0] := IntToStr(Threads[i].ThreadId);
139      lvThreads.Items[i].SubItems[1] := Threads[i].ThreadName;
140      lvThreads.Items[i].SubItems[2] := Threads[i].ThreadState;
141      s := Threads[i].TopFrame.Source;
142      if s = '' then s := ':' + IntToHex(Threads[i].TopFrame.Address, 8);
143      lvThreads.Items[i].SubItems[3] := s;
144      lvThreads.Items[i].SubItems[4] := IntToStr(Threads[i].TopFrame.Line);
145      lvThreads.Items[i].SubItems[5] := Threads[i].TopFrame.GetFunctionWithArg;
146      lvThreads.Items[i].Data := Threads[i];
147    end;
148  finally
149    lvThreads.EndUpdate;
150    EndUpdate;
151  end;
152  finally DebugLnExit(DBG_DATA_MONITORS, ['DebugDataMonitor: <<EXIT: TThreadsDlg.ThreadsChanged']); end;
153end;
154
155function TThreadsDlg.ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;
156begin
157  if (AColId - 1 >= 0) and (AColId - 1 < lvThreads.ColumnCount) then begin
158    ASize := lvThreads.Column[AColId - 1].Width;
159    Result := ASize <> COL_WIDTHS[AColId - 1];
160  end
161  else
162    Result := False;
163end;
164
165procedure TThreadsDlg.ColSizeSetter(AColId: Integer; ASize: Integer);
166begin
167  case AColId of
168    COL_THREAD_BRKPOINT: lvThreads.Column[0].Width := ASize;
169    COL_THREAD_INDEX:    lvThreads.Column[1].Width := ASize;
170    COL_THREAD_NAME:     lvThreads.Column[2].Width := ASize;
171    COL_THREAD_STATE:    lvThreads.Column[3].Width := ASize;
172    COL_THREAD_SOURCE:   lvThreads.Column[4].Width := ASize;
173    COL_THREAD_LINE:     lvThreads.Column[5].Width := ASize;
174    COL_THREAD_FUNC:     lvThreads.Column[6].Width := ASize;
175  end;
176end;
177
178procedure TThreadsDlg.tbCurrentClick(Sender: TObject);
179var
180  Item: TListItem;
181  id: LongInt;
182  Threads: TIdeThreads;
183begin
184  Item := lvThreads.Selected;
185  if Item = nil then exit;
186  id := StrToIntDef(Item.SubItems[0], -1);
187  if id < 0 then exit;
188  if GetSelectedSnapshot = nil
189  then ThreadsMonitor.ChangeCurrentThread(id)
190  else begin
191    Threads := GetSelectedThreads(GetSelectedSnapshot);
192    if Threads <> nil
193    then Threads.CurrentThreadId := id;
194    ThreadsMonitor.CurrentChanged;
195  end;
196end;
197
198procedure TThreadsDlg.lvThreadsDblClick(Sender: TObject);
199begin
200  JumpToSource;
201end;
202
203procedure TThreadsDlg.JumpToSource;
204var
205  Entry: TIdeThreadEntry;
206  Item: TListItem;
207begin
208  Item := lvThreads.Selected;
209  if Item = nil then exit;
210  Entry := TIdeThreadEntry(Item.Data);
211  if Entry = nil then Exit;
212
213  JumpToUnitSource(Entry.TopFrame.UnitInfo, Entry.TopFrame.Line);
214end;
215
216function TThreadsDlg.GetSelectedSnapshot: TSnapshot;
217begin
218  Result := nil;
219  if (SnapshotManager <> nil) and (SnapshotManager.SelectedEntry <> nil)
220  then Result := SnapshotManager.SelectedEntry;
221end;
222
223function TThreadsDlg.GetSelectedThreads(Snap: TSnapshot): TIdeThreads;
224begin
225  if Snap = nil
226  then Result := ThreadsMonitor.CurrentThreads
227  else Result := ThreadsMonitor.Snapshots[Snap];
228end;
229
230procedure TThreadsDlg.DoEndUpdate;
231begin
232  if ufThreadChanged in FUpdateFlags then ThreadsChanged(nil);
233end;
234
235constructor TThreadsDlg.Create(TheOwner: TComponent);
236var
237  i: Integer;
238begin
239  inherited Create(TheOwner);
240  Caption:= lisThreads;
241  lvThreads.Column[1].Caption := lisId;
242  lvThreads.Column[2].Caption := lisName;
243  lvThreads.Column[3].Caption := lisThreadsState;
244  lvThreads.Column[4].Caption := lisThreadsSrc;
245  lvThreads.Column[5].Caption := lisThreadsLine;
246  lvThreads.Column[6].Caption := lisThreadsFunc;
247  tbCurrent.Caption := lisThreadsCurrent;
248  tbGoto.Caption := lisThreadsGoto;
249
250  SnapshotNotification.OnCurrent := @ThreadsChanged;
251  ThreadsNotification.OnChange   := @ThreadsChanged;
252
253  imgCurrentLine := IDEImages.LoadImage('debugger_current_line');
254  lvThreads.SmallImages := IDEImages.Images_16;
255
256  for i := low(COL_WIDTHS) to high(COL_WIDTHS) do
257    lvThreads.Column[i].Width := COL_WIDTHS[i];
258end;
259
260initialization
261
262  ThreadDlgWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtThreads]);
263  ThreadDlgWindowCreator.OnCreateFormProc := @CreateDebugDialog;
264  ThreadDlgWindowCreator.OnSetDividerSize := @ThreadsDlgColSizeSetter;
265  ThreadDlgWindowCreator.OnGetDividerSize := @ThreadsDlgColSizeGetter;
266  ThreadDlgWindowCreator.DividerTemplate.Add('ColumnThreadBrkPoint', COL_THREAD_BRKPOINT,  @drsColWidthBrkPointImg);
267  ThreadDlgWindowCreator.DividerTemplate.Add('ColumnThreadIndex',    COL_THREAD_INDEX,     @drsColWidthIndex);
268  ThreadDlgWindowCreator.DividerTemplate.Add('ColumnThreadName',     COL_THREAD_NAME,      @drsColWidthName);
269  ThreadDlgWindowCreator.DividerTemplate.Add('ColumnThreadState',    COL_THREAD_STATE,     @drsColWidthState);
270  ThreadDlgWindowCreator.DividerTemplate.Add('ColumnThreadSource',   COL_THREAD_SOURCE,    @drsColWidthSource);
271  ThreadDlgWindowCreator.DividerTemplate.Add('ColumnThreadLine',     COL_THREAD_LINE,      @drsColWidthLine);
272  ThreadDlgWindowCreator.DividerTemplate.Add('ColumnThreadFunc',     COL_THREAD_FUNC,      @drsColWidthFunc);
273  ThreadDlgWindowCreator.CreateSimpleLayout;
274
275  DBG_DATA_MONITORS := DebugLogger.FindOrRegisterLogGroup('DBG_DATA_MONITORS' {$IFDEF DBG_DATA_MONITORS} , True {$ENDIF} );
276
277end.
278
279