{ $Id$ } { ---------------------------------------------- localsdlg.pp - Overview of local variables ---------------------------------------------- @created(Thu Mar 14st WET 2002) @lastmod($Date$) @author(Marc Weustink ) This unit contains the Locals debugger dialog. *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code is distributed in the hope that it will be useful, but * * WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * * * *************************************************************************** } unit LocalsDlg; {$mode objfpc}{$H+} interface uses SysUtils, Classes, Forms, ClipBrd, LCLProc, LazLoggerBase, strutils, IDEWindowIntf, DebuggerStrConst, ComCtrls, ActnList, Menus, BaseDebugManager, Debugger, DebuggerDlg; type { TLocalsDlg } TLocalsDlg = class(TDebuggerDlg) actInspect: TAction; actEvaluate: TAction; actCopyName: TAction; actCopyValue: TAction; actCopyAll: TAction; actCopyRAWValue: TAction; actWath: TAction; ActionList1: TActionList; lvLocals: TListView; MenuItem1: TMenuItem; MenuItem2: TMenuItem; MenuItem3: TMenuItem; MenuItem4: TMenuItem; MenuItem5: TMenuItem; MenuItem6: TMenuItem; MenuItem7: TMenuItem; MenuItem8: TMenuItem; PopupMenu1: TPopupMenu; procedure actCopyAllExecute(Sender: TObject); procedure actCopyAllUpdate(Sender: TObject); procedure actCopyNameExecute(Sender: TObject); procedure actCopyValueExecute(Sender: TObject); procedure actEvaluateExecute(Sender: TObject); procedure actInspectExecute(Sender: TObject); procedure actInspectUpdate(Sender: TObject); procedure actCopyRAWValueExecute(Sender: TObject); procedure actWathExecute(Sender: TObject); private FUpdateFlags: set of (ufNeedUpdating); procedure LocalsChanged(Sender: TObject); function GetThreadId: Integer; function GetSelectedThreads(Snap: TSnapshot): TIdeThreads; function GetStackframe: Integer; function GetSelectedSnapshot: TSnapshot; protected procedure DoBeginUpdate; override; procedure DoEndUpdate; override; function ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean; procedure ColSizeSetter(AColId: Integer; ASize: Integer); public constructor Create(AOwner: TComponent); override; property LocalsMonitor; property ThreadsMonitor; property CallStackMonitor; property SnapshotManager; end; function ValueToRAW(const AValue: string): string; implementation {$R *.lfm} uses LazarusIDEStrConsts; var DBG_DATA_MONITORS: PLazLoggerLogGroup; LocalsDlgWindowCreator: TIDEWindowCreator; const COL_LOCALS_NAME = 1; COL_LOCALS_VALUE = 2; COL_WIDTHS: Array[0..1] of integer = ( 50, 150); function LocalsDlgColSizeGetter(AForm: TCustomForm; AColId: Integer; var ASize: Integer): Boolean; begin Result := AForm is TLocalsDlg; if Result then Result := TLocalsDlg(AForm).ColSizeGetter(AColId, ASize); end; procedure LocalsDlgColSizeSetter(AForm: TCustomForm; AColId: Integer; ASize: Integer); begin if AForm is TLocalsDlg then TLocalsDlg(AForm).ColSizeSetter(AColId, ASize); end; function ValueToRAW(const AValue: string): string; var I: Integer; //current char in AValue M: Integer; //max char in AValue L: Integer; //current char in Result procedure ProcessCharConsts; var xNum: string; xCharOrd: Integer; begin while (I <= M) and (AValue[I] = '#') do begin Inc(I); xNum := ''; while (I <= M) and (AValue[I] in ['0'..'9']) do begin xNum := xNum + AValue[I]; // not really fast, but OK for this purpose Inc(I); end; if TryStrToInt(xNum, xCharOrd) then begin Result[L] := Char(xCharOrd); Inc(L); end; end; end; procedure ProcessQuote; begin Inc(I); if AValue[I] = '''' then // "''" => "'" begin Result[L] := AValue[I]; Inc(L); end else if AValue[I] = '#' then // "'#13#10'" => [CRLF] ProcessCharConsts; end; procedure ProcessString; begin I := 2; L := 1; M := Length(AValue); if AValue[M] = '''' then Dec(M); SetLength(Result, Length(AValue)-2); while I <= M do begin if AValue[I] = '''' then begin ProcessQuote; end else begin Result[L] := AValue[I]; Inc(L); end; Inc(I); end; SetLength(Result, L-1); end; procedure ProcessOther; begin I := Pos('(', AValue); if I > 0 then begin // Invalid enum value: "true (85)" => "85" L := PosEx(')', AValue, I+1); Result := Copy(AValue, I+1, L-I-1); end else begin //no formatting Result := AValue; end; end; begin // try to guess and format value back to raw data, e.g. // "'value'" => "value" // "true (85)" => "85" Result := ''; if AValue='' then Exit; if AValue[1] = '''' then //string "'val''ue'" => "val'ue" ProcessString else ProcessOther; end; { TLocalsDlg } constructor TLocalsDlg.Create(AOwner: TComponent); var i: Integer; begin inherited Create(AOwner); LocalsNotification.OnChange := @LocalsChanged; ThreadsNotification.OnCurrent := @LocalsChanged; CallstackNotification.OnCurrent := @LocalsChanged; SnapshotNotification.OnCurrent := @LocalsChanged; Caption:= lisLocals; lvLocals.Columns[0].Caption:= lisName; lvLocals.Columns[1].Caption:= lisValue; actInspect.Caption := lisInspect; actWath.Caption := lisWatch; actEvaluate.Caption := lisEvaluateModify; actCopyName.Caption := lisLocalsDlgCopyName; actCopyValue.Caption := lisLocalsDlgCopyValue; actCopyRAWValue.Caption := lisLocalsDlgCopyRAWValue; actCopyAll.Caption := lisCopyAll; for i := low(COL_WIDTHS) to high(COL_WIDTHS) do lvLocals.Column[i].Width := COL_WIDTHS[i]; end; procedure TLocalsDlg.actInspectUpdate(Sender: TObject); begin (Sender as TAction).Enabled := Assigned(lvLocals.Selected); end; procedure TLocalsDlg.actCopyRAWValueExecute(Sender: TObject); begin Clipboard.Open; Clipboard.AsText := ValueToRAW(lvLocals.Selected.SubItems[0]); Clipboard.Close; end; procedure TLocalsDlg.actWathExecute(Sender: TObject); var S: String; Watch: TCurrentWatch; begin S := lvLocals.Selected.Caption; if DebugBoss.Watches.CurrentWatches.Find(S) = nil then begin Watch := DebugBoss.Watches.CurrentWatches.Add(S); Watch.Enabled := True; end; DebugBoss.ViewDebugDialog(ddtWatches); end; procedure TLocalsDlg.actInspectExecute(Sender: TObject); begin DebugBoss.Inspect(lvLocals.Selected.Caption); end; procedure TLocalsDlg.actEvaluateExecute(Sender: TObject); begin DebugBoss.EvaluateModify(lvLocals.Selected.Caption); end; procedure TLocalsDlg.actCopyNameExecute(Sender: TObject); begin Clipboard.Open; Clipboard.AsText := lvLocals.Selected.Caption; Clipboard.Close; end; procedure TLocalsDlg.actCopyAllExecute(Sender: TObject); Var AStringList : TStringList; I : Integer; begin if lvLocals.Items.Count > 0 then begin AStringList := TStringList.Create; for I := 0 to lvLocals.Items.Count - 1 do AStringList.Values[lvLocals.Items[I].Caption] := lvLocals.Items[I].SubItems[0]; Clipboard.Open; Clipboard.AsText := AStringList.Text; Clipboard.Close; FreeAndNil(AStringList); end; end; procedure TLocalsDlg.actCopyAllUpdate(Sender: TObject); begin (Sender as TAction).Enabled := lvLocals.Items.Count > 0; end; procedure TLocalsDlg.actCopyValueExecute(Sender: TObject); begin Clipboard.Open; Clipboard.AsText := lvLocals.Selected.SubItems[0]; Clipboard.Close; end; procedure TLocalsDlg.LocalsChanged(Sender: TObject); var n, idx: Integer; List: TStringList; Item: TListItem; S: String; Locals: TIDELocals; Snap: TSnapshot; begin if (ThreadsMonitor = nil) or (CallStackMonitor = nil) or (LocalsMonitor=nil) then begin lvLocals.Items.Clear; exit; end; if IsUpdating then begin DebugLn(DBG_DATA_MONITORS, ['DebugDataWindow: TLocalsDlg.LocalsChanged in IsUpdating']); Include(FUpdateFlags, ufNeedUpdating); exit; end; Exclude(FUpdateFlags, ufNeedUpdating); DebugLn(DBG_DATA_MONITORS, ['DebugDataMonitor: TLocalsDlg.LocalsChanged']); if GetStackframe < 0 then begin // TODO need dedicated validity property lvLocals.Items.Clear; exit; end; Snap := GetSelectedSnapshot; if (Snap <> nil) then begin Locals := LocalsMonitor.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 Locals = nil then begin lvLocals.Items.Clear; Item := lvLocals.Items.Add; Item.Caption := ''; Item.SubItems.add(lisLocalsNotEvaluated); Exit; end; //Get existing items for n := 0 to lvLocals.Items.Count - 1 do begin Item := lvLocals.Items[n]; S := Item.Caption; S := UpperCase(S); List.AddObject(S, Item); end; // add/update entries for n := 0 to Locals.Count - 1 do begin idx := List.IndexOf(Uppercase(Locals.Names[n])); if idx = -1 then begin // New entry Item := lvLocals.Items.Add; Item.Caption := Locals.Names[n]; Item.SubItems.Add(Locals.Values[n]); end else begin // Existing entry Item := TListItem(List.Objects[idx]); Item.SubItems[0] := Locals.Values[n]; List.Delete(idx); end; end; // remove obsolete entries for n := 0 to List.Count - 1 do lvLocals.Items.Delete(TListItem(List.Objects[n]).Index); finally EndUpdate; end; finally List.Free; end; end; function TLocalsDlg.GetThreadId: Integer; var Threads: TIdeThreads; begin Result := -1; if (ThreadsMonitor = nil) then exit; Threads := GetSelectedThreads(GetSelectedSnapshot); if Threads <> nil then Result := Threads.CurrentThreadId else Result := 1; end; function TLocalsDlg.GetSelectedThreads(Snap: TSnapshot): TIdeThreads; begin if ThreadsMonitor = nil then exit(nil); if Snap = nil then Result := ThreadsMonitor.CurrentThreads else Result := ThreadsMonitor.Snapshots[Snap]; end; function TLocalsDlg.GetStackframe: Integer; var Snap: TSnapshot; Threads: TIdeThreads; tid: LongInt; Stack: TIdeCallStack; begin 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.SelectedEntry <> nil) then Result := SnapshotManager.SelectedEntry; end; procedure TLocalsDlg.DoBeginUpdate; begin lvLocals.BeginUpdate; end; procedure TLocalsDlg.DoEndUpdate; begin if ufNeedUpdating in FUpdateFlags then LocalsChanged(nil); lvLocals.EndUpdate; end; function TLocalsDlg.ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean; begin if (AColId - 1 >= 0) and (AColId - 1 < lvLocals.ColumnCount) then begin ASize := lvLocals.Column[AColId - 1].Width; Result := (ASize <> COL_WIDTHS[AColId - 1]) and (not lvLocals.Column[AColId - 1].AutoSize); end else Result := False; end; procedure TLocalsDlg.ColSizeSetter(AColId: Integer; ASize: Integer); begin case AColId of COL_LOCALS_NAME: lvLocals.Column[0].Width := ASize; COL_LOCALS_VALUE: lvLocals.Column[1].Width := ASize; end; end; initialization LocalsDlgWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtLocals]); LocalsDlgWindowCreator.OnCreateFormProc := @CreateDebugDialog; LocalsDlgWindowCreator.OnSetDividerSize := @LocalsDlgColSizeSetter; LocalsDlgWindowCreator.OnGetDividerSize := @LocalsDlgColSizeGetter; LocalsDlgWindowCreator.DividerTemplate.Add('LocalsName', COL_LOCALS_NAME, @drsColWidthName); LocalsDlgWindowCreator.DividerTemplate.Add('LocalsValue', COL_LOCALS_VALUE, @drsColWidthValue); LocalsDlgWindowCreator.CreateSimpleLayout; DBG_DATA_MONITORS := DebugLogger.FindOrRegisterLogGroup('DBG_DATA_MONITORS' {$IFDEF DBG_DATA_MONITORS} , True {$ENDIF} ); end.