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