lazarus/debugger/threaddlg.pp

unit ThreadDlg;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, ComCtrls, LCLProc, LazLoggerBase,
  Debugger, DebuggerDlg, Forms, LazarusIDEStrConsts, IDEWindowIntf, DebuggerStrConst,
  BaseDebugManager, IDEImagesIntf;

type

  { TThreadsDlg }

  TThreadsDlg = class(TDebuggerDlg)
    lvThreads: TListView;
    ToolBar1: TToolBar;
    tbCurrent: TToolButton;
    tbGoto: TToolButton;
    procedure lvThreadsDblClick(Sender: TObject);
    procedure tbCurrentClick(Sender: TObject);
  private
    imgCurrentLine: Integer;
    FUpdateFlags: set of (ufThreadChanged);
    procedure JumpToSource;
    function  GetSelectedSnapshot: TSnapshot;
    function GetSelectedThreads(Snap: TSnapshot): TIdeThreads;
  protected
    procedure DoEndUpdate; override;
    procedure ThreadsChanged(Sender: TObject);
    function  ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;
    procedure ColSizeSetter(AColId: Integer; ASize: Integer);
  public
    { public declarations }
    constructor Create(TheOwner: TComponent); override;
    property ThreadsMonitor;
    property SnapshotManager;
  end;

implementation

{$R *.lfm}

var
  DBG_DATA_MONITORS: PLazLoggerLogGroup;
  ThreadDlgWindowCreator: TIDEWindowCreator;

const
  COL_THREAD_BRKPOINT = 1;
  COL_THREAD_INDEX    = 2;
  COL_THREAD_NAME     = 3;
  COL_THREAD_STATE    = 4;
  COL_THREAD_SOURCE   = 5;
  COL_THREAD_LINE     = 6;
  COL_THREAD_FUNC     = 7;
  COL_WIDTHS: Array[0..6] of integer = ( 20, 50, 100, 50,  150, 50, 300);

function ThreadsDlgColSizeGetter(AForm: TCustomForm; AColId: Integer; var ASize: Integer): Boolean;
begin
  Result := AForm is TThreadsDlg;
  if Result then
    Result := TThreadsDlg(AForm).ColSizeGetter(AColId, ASize);
end;

procedure ThreadsDlgColSizeSetter(AForm: TCustomForm; AColId: Integer; ASize: Integer);
begin
  if AForm is TThreadsDlg then
    TThreadsDlg(AForm).ColSizeSetter(AColId, ASize);
end;

{ TThreadsDlg }

procedure TThreadsDlg.ThreadsChanged(Sender: TObject);
var
  i: Integer;
  s: String;
  Item: TListItem;
  Threads: TIdeThreads;
  Snap: TSnapshot;
begin
  if IsUpdating then begin
    DebugLn(DBG_DATA_MONITORS, ['DebugDataWindow: TThreadsDlg.ThreadsChanged from ',  DbgSName(Sender), ' in IsUpdating']);

    Include(FUpdateFlags, ufThreadChanged);
    exit;
  end;
  try DebugLnEnter(DBG_DATA_MONITORS, ['DebugDataMonitor: >>ENTER: TThreadsDlg.ThreadsChanged from ',  DbgSName(Sender)]);
  Exclude(FUpdateFlags, ufThreadChanged);

  BeginUpdate;
  lvThreads.BeginUpdate;
  try
    if ThreadsMonitor = nil then begin
      lvThreads.Clear;
      exit;
    end;

    Snap := GetSelectedSnapshot;
    Threads := GetSelectedThreads(Snap);
    if (Snap <> nil)
    then begin
      Caption:= lisThreads + ' ('+ Snap.LocationAsText +')';
    end
    else begin
      Caption:= lisThreads;
    end;

    if (Threads = nil) or ((Snap <> nil) and (Threads.Count=0)) then begin
      lvThreads.Clear;
      Item := lvThreads.Items.Add;
      Item.SubItems.add('');
      Item.SubItems.add('');
      Item.SubItems.add('');
      Item.SubItems.add(lisThreadsNotEvaluated);
      Item.SubItems.add('');
      Item.SubItems.add('');
      exit;
    end;

    i := Threads.Count;
    while lvThreads.Items.Count > i do lvThreads.Items.Delete(i);
    while lvThreads.Items.Count < i do begin
      Item := lvThreads.Items.Add;
      Item.SubItems.add('');
      Item.SubItems.add('');
      Item.SubItems.add('');
      Item.SubItems.add('');
      Item.SubItems.add('');
      Item.SubItems.add('');
    end;

    for i := 0 to Threads.Count - 1 do begin
      lvThreads.Items[i].Caption := '';
      if Threads[i].ThreadId = Threads.CurrentThreadId
      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;
      s := Threads[i].TopFrame.Source;
      if s = '' then s := ':' + IntToHex(Threads[i].TopFrame.Address, 8);
      lvThreads.Items[i].SubItems[3] := s;
      lvThreads.Items[i].SubItems[4] := IntToStr(Threads[i].TopFrame.Line);
      lvThreads.Items[i].SubItems[5] := Threads[i].TopFrame.GetFunctionWithArg;
      lvThreads.Items[i].Data := Threads[i];
    end;
  finally
    lvThreads.EndUpdate;
    EndUpdate;
  end;
  finally DebugLnExit(DBG_DATA_MONITORS, ['DebugDataMonitor: <<EXIT: TThreadsDlg.ThreadsChanged']); end;
end;

function TThreadsDlg.ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;
begin
  if (AColId - 1 >= 0) and (AColId - 1 < lvThreads.ColumnCount) then begin
    ASize := lvThreads.Column[AColId - 1].Width;
    Result := ASize <> COL_WIDTHS[AColId - 1];
  end
  else
    Result := False;
end;

procedure TThreadsDlg.ColSizeSetter(AColId: Integer; ASize: Integer);
begin
  case AColId of
    COL_THREAD_BRKPOINT: lvThreads.Column[0].Width := ASize;
    COL_THREAD_INDEX:    lvThreads.Column[1].Width := ASize;
    COL_THREAD_NAME:     lvThreads.Column[2].Width := ASize;
    COL_THREAD_STATE:    lvThreads.Column[3].Width := ASize;
    COL_THREAD_SOURCE:   lvThreads.Column[4].Width := ASize;
    COL_THREAD_LINE:     lvThreads.Column[5].Width := ASize;
    COL_THREAD_FUNC:     lvThreads.Column[6].Width := ASize;
  end;
end;

procedure TThreadsDlg.tbCurrentClick(Sender: TObject);
var
  Item: TListItem;
  id: LongInt;
  Threads: TIdeThreads;
begin
  Item := lvThreads.Selected;
  if Item = nil then exit;
  id := StrToIntDef(Item.SubItems[0], -1);
  if id < 0 then exit;
  if GetSelectedSnapshot = nil
  then ThreadsMonitor.ChangeCurrentThread(id)
  else begin
    Threads := GetSelectedThreads(GetSelectedSnapshot);
    if Threads <> nil
    then Threads.CurrentThreadId := id;
    ThreadsMonitor.CurrentChanged;
  end;
end;

procedure TThreadsDlg.lvThreadsDblClick(Sender: TObject);
begin
  JumpToSource;
end;

procedure TThreadsDlg.JumpToSource;
var
  Entry: TIdeThreadEntry;
  Item: TListItem;
begin
  Item := lvThreads.Selected;
  if Item = nil then exit;
  Entry := TIdeThreadEntry(Item.Data);
  if Entry = nil then Exit;

  JumpToUnitSource(Entry.TopFrame.UnitInfo, Entry.TopFrame.Line);
end;

function TThreadsDlg.GetSelectedSnapshot: TSnapshot;
begin
  Result := nil;
  if (SnapshotManager <> nil) and (SnapshotManager.SelectedEntry <> nil)
  then Result := SnapshotManager.SelectedEntry;
end;

function TThreadsDlg.GetSelectedThreads(Snap: TSnapshot): TIdeThreads;
begin
  if Snap = nil
  then Result := ThreadsMonitor.CurrentThreads
  else Result := ThreadsMonitor.Snapshots[Snap];
end;

procedure TThreadsDlg.DoEndUpdate;
begin
  if ufThreadChanged in FUpdateFlags then ThreadsChanged(nil);
end;

constructor TThreadsDlg.Create(TheOwner: TComponent);
var
  i: Integer;
begin
  inherited Create(TheOwner);
  Caption:= lisThreads;
  lvThreads.Column[1].Caption := lisId;
  lvThreads.Column[2].Caption := lisName;
  lvThreads.Column[3].Caption := lisThreadsState;
  lvThreads.Column[4].Caption := lisThreadsSrc;
  lvThreads.Column[5].Caption := lisThreadsLine;
  lvThreads.Column[6].Caption := lisThreadsFunc;
  tbCurrent.Caption := lisThreadsCurrent;
  tbGoto.Caption := lisThreadsGoto;

  SnapshotNotification.OnCurrent := @ThreadsChanged;
  ThreadsNotification.OnChange   := @ThreadsChanged;

  imgCurrentLine := IDEImages.LoadImage('debugger_current_line');
  lvThreads.SmallImages := IDEImages.Images_16;

  for i := low(COL_WIDTHS) to high(COL_WIDTHS) do
    lvThreads.Column[i].Width := COL_WIDTHS[i];
end;

initialization

  ThreadDlgWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtThreads]);
  ThreadDlgWindowCreator.OnCreateFormProc := @CreateDebugDialog;
  ThreadDlgWindowCreator.OnSetDividerSize := @ThreadsDlgColSizeSetter;
  ThreadDlgWindowCreator.OnGetDividerSize := @ThreadsDlgColSizeGetter;
  ThreadDlgWindowCreator.DividerTemplate.Add('ColumnThreadBrkPoint', COL_THREAD_BRKPOINT,  @drsColWidthBrkPointImg);
  ThreadDlgWindowCreator.DividerTemplate.Add('ColumnThreadIndex',    COL_THREAD_INDEX,     @drsColWidthIndex);
  ThreadDlgWindowCreator.DividerTemplate.Add('ColumnThreadName',     COL_THREAD_NAME,      @drsColWidthName);
  ThreadDlgWindowCreator.DividerTemplate.Add('ColumnThreadState',    COL_THREAD_STATE,     @drsColWidthState);
  ThreadDlgWindowCreator.DividerTemplate.Add('ColumnThreadSource',   COL_THREAD_SOURCE,    @drsColWidthSource);
  ThreadDlgWindowCreator.DividerTemplate.Add('ColumnThreadLine',     COL_THREAD_LINE,      @drsColWidthLine);
  ThreadDlgWindowCreator.DividerTemplate.Add('ColumnThreadFunc',     COL_THREAD_FUNC,      @drsColWidthFunc);
  ThreadDlgWindowCreator.CreateSimpleLayout;

  DBG_DATA_MONITORS := DebugLogger.FindOrRegisterLogGroup('DBG_DATA_MONITORS' {$IFDEF DBG_DATA_MONITORS} , True {$ENDIF} );

end.