mirror of
				https://gitlab.com/freepascal.org/lazarus/lazarus.git
				synced 2025-10-31 07:21:32 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			375 lines
		
	
	
		
			11 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			375 lines
		
	
	
		
			11 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| { $Id$ }
 | |
| {               ----------------------------------------------  
 | |
|                  localsdlg.pp  -  Overview of local variables 
 | |
|                 ---------------------------------------------- 
 | |
|  
 | |
|  @created(Thu Mar 14st WET 2002)
 | |
|  @lastmod($Date$)
 | |
|  @author(Marc Weustink <marc@@dommelstein.net>)                       
 | |
| 
 | |
|  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 <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 | |
|  *   obtain it by writing to the Free Software Foundation,                 *
 | |
|  *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 | |
|  *                                                                         *
 | |
|  ***************************************************************************
 | |
| }
 | |
| unit LocalsDlg;
 | |
| 
 | |
| {$mode objfpc}{$H+}
 | |
| 
 | |
| interface
 | |
| 
 | |
| uses
 | |
|   SysUtils, Classes, Forms, ClipBrd, LCLProc, LazLoggerBase,
 | |
|   IDEWindowIntf, DebuggerStrConst,
 | |
|   ComCtrls, ActnList, Menus, BaseDebugManager, Debugger, DebuggerDlg;
 | |
| 
 | |
| type
 | |
| 
 | |
|   { TLocalsDlg }
 | |
| 
 | |
|   TLocalsDlg = class(TDebuggerDlg)
 | |
|     actInspect: TAction;
 | |
|     actEvaluate: TAction;
 | |
|     actCopyName: TAction;
 | |
|     actCopyValue: TAction;
 | |
|     actWath: TAction;
 | |
|     ActionList1: TActionList;
 | |
|     lvLocals: TListView;
 | |
|     MenuItem1: TMenuItem;
 | |
|     MenuItem2: TMenuItem;
 | |
|     MenuItem3: TMenuItem;
 | |
|     MenuItem4: TMenuItem;
 | |
|     MenuItem5: TMenuItem;
 | |
|     MenuItem6: TMenuItem;
 | |
|     PopupMenu1: TPopupMenu;
 | |
|     procedure actCopyNameExecute(Sender: TObject);
 | |
|     procedure actCopyValueExecute(Sender: TObject);
 | |
|     procedure actEvaluateExecute(Sender: TObject);
 | |
|     procedure actInspectExecute(Sender: TObject);
 | |
|     procedure actInspectUpdate(Sender: TObject);
 | |
|     procedure actWathExecute(Sender: TObject);
 | |
|   private
 | |
|     FUpdateFlags: set of (ufNeedUpdating);
 | |
|     procedure LocalsChanged(Sender: TObject);
 | |
|     function  GetThreadId: Integer;
 | |
|     function  GetSelectedThreads(Snap: TSnapshot): TThreads;
 | |
|     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;
 | |
| 
 | |
| 
 | |
| 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;
 | |
| 
 | |
| { 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;
 | |
| 
 | |
|   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.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.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: TLocals;
 | |
|   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: TThreads;
 | |
| 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): TThreads;
 | |
| 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: TThreads;
 | |
|   tid: LongInt;
 | |
|   Stack: TCallStack;
 | |
| 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.
 | |
| 
 | 
