← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to debugger/localsdlg.pp

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
debugger/localsdlg.pp
1
 
{ $Id: localsdlg.pp 23459 2010-01-15 02:41:46Z paul $ }
 
1
{ $Id: localsdlg.pp 36579 2012-04-05 14:20:15Z vincents $ }
2
2
{               ----------------------------------------------  
3
3
                 localsdlg.pp  -  Overview of local variables 
4
4
                ---------------------------------------------- 
5
5
 
6
6
 @created(Thu Mar 14st WET 2002)
7
 
 @lastmod($Date: 2010-01-15 02:41:46 +0000 (Fri, 15 Jan 2010) $)
 
7
 @lastmod($Date: 2012-04-05 16:20:15 +0200 (Thu, 05 Apr 2012) $)
8
8
 @author(Marc Weustink <marc@@dommelstein.net>)                       
9
9
 
10
10
 This unit contains the Locals debugger dialog.
36
36
interface
37
37
 
38
38
uses
39
 
  SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
40
 
  ComCtrls, Debugger, DebuggerDlg;
 
39
  SysUtils, Classes, Forms, ClipBrd, LCLProc, LazLoggerBase,
 
40
  IDEWindowIntf, DebuggerStrConst,
 
41
  ComCtrls, ActnList, Menus, BaseDebugManager, Debugger, DebuggerDlg;
41
42
 
42
43
type
 
44
 
 
45
  { TLocalsDlg }
 
46
 
43
47
  TLocalsDlg = class(TDebuggerDlg)
 
48
    actInspect: TAction;
 
49
    actEvaluate: TAction;
 
50
    actCopyName: TAction;
 
51
    actCopyValue: TAction;
 
52
    actWath: TAction;
 
53
    ActionList1: TActionList;
44
54
    lvLocals: TListView;
 
55
    MenuItem1: TMenuItem;
 
56
    MenuItem2: TMenuItem;
 
57
    MenuItem3: TMenuItem;
 
58
    MenuItem4: TMenuItem;
 
59
    MenuItem5: TMenuItem;
 
60
    MenuItem6: TMenuItem;
 
61
    PopupMenu1: TPopupMenu;
 
62
    procedure actCopyNameExecute(Sender: TObject);
 
63
    procedure actCopyValueExecute(Sender: TObject);
 
64
    procedure actEvaluateExecute(Sender: TObject);
 
65
    procedure actInspectExecute(Sender: TObject);
 
66
    procedure actInspectUpdate(Sender: TObject);
 
67
    procedure actWathExecute(Sender: TObject);
45
68
  private
46
 
    FLocals: TIDELocals;
47
 
    FLocalsNotification: TIDELocalsNotification;
 
69
    FUpdateFlags: set of (ufNeedUpdating);
48
70
    procedure LocalsChanged(Sender: TObject);
49
 
    procedure SetLocals(const AValue: TIDELocals);
 
71
    function  GetThreadId: Integer;
 
72
    function  GetSelectedThreads(Snap: TSnapshot): TThreads;
 
73
    function GetStackframe: Integer;
 
74
    function  GetSelectedSnapshot: TSnapshot;
50
75
  protected
51
76
    procedure DoBeginUpdate; override;
52
77
    procedure DoEndUpdate; override;
 
78
    function  ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;
 
79
    procedure ColSizeSetter(AColId: Integer; ASize: Integer);
53
80
  public
54
81
    constructor Create(AOwner: TComponent); override;
55
 
    destructor Destroy; override;
56
 
 
57
 
    property Locals: TIDELocals read FLocals write SetLocals;
 
82
    property LocalsMonitor;
 
83
    property ThreadsMonitor;
 
84
    property CallStackMonitor;
 
85
    property SnapshotManager;
58
86
  end;
59
87
 
60
88
 
64
92
 
65
93
uses
66
94
  LazarusIDEStrConsts;
67
 
  
 
95
 
 
96
var
 
97
  DBG_DATA_MONITORS: PLazLoggerLogGroup;
 
98
  LocalsDlgWindowCreator: TIDEWindowCreator;
 
99
 
 
100
const
 
101
  COL_LOCALS_NAME   = 1;
 
102
  COL_LOCALS_VALUE  = 2;
 
103
  COL_WIDTHS: Array[0..1] of integer = ( 50,   150);
 
104
 
 
105
function LocalsDlgColSizeGetter(AForm: TCustomForm; AColId: Integer; var ASize: Integer): Boolean;
 
106
begin
 
107
  Result := AForm is TLocalsDlg;
 
108
  if Result then
 
109
    Result := TLocalsDlg(AForm).ColSizeGetter(AColId, ASize);
 
110
end;
 
111
 
 
112
procedure LocalsDlgColSizeSetter(AForm: TCustomForm; AColId: Integer; ASize: Integer);
 
113
begin
 
114
  if AForm is TLocalsDlg then
 
115
    TLocalsDlg(AForm).ColSizeSetter(AColId, ASize);
 
116
end;
 
117
 
68
118
{ TLocalsDlg }
69
119
 
70
120
constructor TLocalsDlg.Create(AOwner: TComponent);
 
121
var
 
122
  i: Integer;
71
123
begin
72
124
  inherited Create(AOwner);
73
 
  FLocalsNotification := TIDELocalsNotification.Create;
74
 
  FLocalsNotification.AddReference;
75
 
  FLocalsNotification.OnChange := @LocalsChanged;
 
125
  LocalsNotification.OnChange     := @LocalsChanged;
 
126
  ThreadsNotification.OnCurrent   := @LocalsChanged;
 
127
  CallstackNotification.OnCurrent := @LocalsChanged;
 
128
  SnapshotNotification.OnCurrent  := @LocalsChanged;
 
129
 
76
130
  Caption:= lisLocals;
77
 
  lvLocals.Columns[0].Caption:= lisLocalsDlgName;
78
 
  lvLocals.Columns[1].Caption:= lisLocalsDlgValue;
79
 
end;
80
 
 
81
 
destructor TLocalsDlg.Destroy;
82
 
begin
83
 
  SetLocals(nil);
84
 
  FLocalsNotification.OnChange := nil;
85
 
  FLocalsNotification.ReleaseReference;
86
 
  inherited Destroy;
 
131
  lvLocals.Columns[0].Caption:= lisName;
 
132
  lvLocals.Columns[1].Caption:= lisValue;
 
133
  actInspect.Caption := lisInspect;
 
134
  actWath.Caption := lisWatch;
 
135
  actEvaluate.Caption := lisEvaluateModify;
 
136
  actCopyName.Caption := lisLocalsDlgCopyName;
 
137
  actCopyValue.Caption := lisLocalsDlgCopyValue;
 
138
 
 
139
  for i := low(COL_WIDTHS) to high(COL_WIDTHS) do
 
140
    lvLocals.Column[i].Width := COL_WIDTHS[i];
 
141
end;
 
142
 
 
143
procedure TLocalsDlg.actInspectUpdate(Sender: TObject);
 
144
begin
 
145
  (Sender as TAction).Enabled := Assigned(lvLocals.Selected);
 
146
end;
 
147
 
 
148
procedure TLocalsDlg.actWathExecute(Sender: TObject);
 
149
var
 
150
  S: String;
 
151
  Watch: TCurrentWatch;
 
152
begin
 
153
  S := lvLocals.Selected.Caption;
 
154
  if DebugBoss.Watches.CurrentWatches.Find(S) = nil then
 
155
  begin
 
156
    Watch := DebugBoss.Watches.CurrentWatches.Add(S);
 
157
    Watch.Enabled := True;
 
158
  end;
 
159
  DebugBoss.ViewDebugDialog(ddtWatches);
 
160
end;
 
161
 
 
162
procedure TLocalsDlg.actInspectExecute(Sender: TObject);
 
163
begin
 
164
  DebugBoss.Inspect(lvLocals.Selected.Caption);
 
165
end;
 
166
 
 
167
procedure TLocalsDlg.actEvaluateExecute(Sender: TObject);
 
168
begin
 
169
  DebugBoss.EvaluateModify(lvLocals.Selected.Caption);
 
170
end;
 
171
 
 
172
procedure TLocalsDlg.actCopyNameExecute(Sender: TObject);
 
173
begin
 
174
  Clipboard.Open;
 
175
  Clipboard.AsText := lvLocals.Selected.Caption;
 
176
  Clipboard.Close;
 
177
end;
 
178
 
 
179
procedure TLocalsDlg.actCopyValueExecute(Sender: TObject);
 
180
begin
 
181
  Clipboard.Open;
 
182
  Clipboard.AsText := lvLocals.Selected.SubItems[0];
 
183
  Clipboard.Close;
87
184
end;
88
185
 
89
186
procedure TLocalsDlg.LocalsChanged(Sender: TObject);
92
189
  List: TStringList;
93
190
  Item: TListItem;
94
191
  S: String;
95
 
begin                                        
 
192
  Locals: TLocals;
 
193
  Snap: TSnapshot;
 
194
begin
 
195
  if (ThreadsMonitor = nil) or (CallStackMonitor = nil) or (LocalsMonitor=nil) then begin
 
196
    lvLocals.Items.Clear;
 
197
    exit;
 
198
  end;
 
199
 
 
200
  if IsUpdating then begin
 
201
    DebugLn(DBG_DATA_MONITORS, ['DebugDataWindow: TLocalsDlg.LocalsChanged  in IsUpdating']);
 
202
    Include(FUpdateFlags, ufNeedUpdating);
 
203
    exit;
 
204
  end;
 
205
  Exclude(FUpdateFlags, ufNeedUpdating);
 
206
  DebugLn(DBG_DATA_MONITORS, ['DebugDataMonitor: TLocalsDlg.LocalsChanged']);
 
207
 
 
208
  if GetStackframe < 0 then begin // TODO need dedicated validity property
 
209
    lvLocals.Items.Clear;
 
210
    exit;
 
211
  end;
 
212
 
 
213
  Snap := GetSelectedSnapshot;
 
214
  if (Snap <> nil)
 
215
  then begin
 
216
    Locals := LocalsMonitor.Snapshots[Snap][GetThreadId, GetStackframe];
 
217
    Caption:= lisLocals + ' ('+ Snap.LocationAsText +')';
 
218
  end
 
219
  else begin
 
220
    Locals := LocalsMonitor.CurrentLocalsList[GetThreadId, GetStackframe];
 
221
    Caption:= lisLocals;
 
222
  end;
 
223
 
96
224
  List := TStringList.Create;
97
225
  try
98
226
    BeginUpdate;
99
227
    try
100
 
      if FLocals = nil
 
228
      if Locals = nil
101
229
      then begin
102
230
        lvLocals.Items.Clear;
 
231
        Item := lvLocals.Items.Add;
 
232
        Item.Caption := '';
 
233
        Item.SubItems.add(lisLocalsNotEvaluated);
103
234
        Exit;
104
235
      end;
105
 
    
 
236
 
106
237
      //Get existing items
107
238
      for n := 0 to lvLocals.Items.Count - 1 do
108
239
      begin
113
244
      end;
114
245
 
115
246
      // add/update entries
116
 
      for n := 0 to FLocals.Count - 1 do
 
247
      for n := 0 to Locals.Count - 1 do
117
248
      begin
118
 
        idx := List.IndexOf(Uppercase(FLocals.Names[n]));
 
249
        idx := List.IndexOf(Uppercase(Locals.Names[n]));
119
250
        if idx = -1
120
251
        then begin
121
252
          // New entry
122
253
          Item := lvLocals.Items.Add;
123
 
          Item.Caption := FLocals.Names[n];
124
 
          Item.SubItems.Add(FLocals.Values[n]);
 
254
          Item.Caption := Locals.Names[n];
 
255
          Item.SubItems.Add(Locals.Values[n]);
125
256
        end
126
257
        else begin
127
258
          // Existing entry
128
259
          Item := TListItem(List.Objects[idx]);
129
 
          Item.SubItems[0] := FLocals.Values[n];
 
260
          Item.SubItems[0] := Locals.Values[n];
130
261
          List.Delete(idx);
131
262
        end;
132
263
      end;
143
274
  end;
144
275
end;
145
276
 
146
 
procedure TLocalsDlg.SetLocals(const AValue: TIDELocals);
147
 
begin
148
 
  if FLocals = AValue then Exit;
149
 
 
150
 
  BeginUpdate;
151
 
  try
152
 
    if FLocals <> nil
153
 
    then begin
154
 
      FLocals.RemoveNotification(FLocalsNotification);
155
 
    end;
156
 
 
157
 
    FLocals := AValue;
158
 
 
159
 
    if FLocals <> nil
160
 
    then begin
161
 
      FLocals.AddNotification(FLocalsNotification);
162
 
    end;
163
 
    
164
 
    LocalsChanged(FLocals);
165
 
  finally
166
 
    EndUpdate;
 
277
function TLocalsDlg.GetThreadId: Integer;
 
278
var
 
279
  Threads: TThreads;
 
280
begin
 
281
  Result := -1;
 
282
  if (ThreadsMonitor = nil) then exit;
 
283
  Threads := GetSelectedThreads(GetSelectedSnapshot);
 
284
  if Threads <> nil
 
285
  then Result := Threads.CurrentThreadId
 
286
  else Result := 1;
 
287
end;
 
288
 
 
289
function TLocalsDlg.GetSelectedThreads(Snap: TSnapshot): TThreads;
 
290
begin
 
291
  if ThreadsMonitor = nil then exit(nil);
 
292
  if Snap = nil
 
293
  then Result := ThreadsMonitor.CurrentThreads
 
294
  else Result := ThreadsMonitor.Snapshots[Snap];
 
295
end;
 
296
 
 
297
function TLocalsDlg.GetStackframe: Integer;
 
298
var
 
299
  Snap: TSnapshot;
 
300
  Threads: TThreads;
 
301
  tid: LongInt;
 
302
  Stack: TCallStack;
 
303
begin
 
304
  if (CallStackMonitor = nil) or (ThreadsMonitor = nil)
 
305
  then begin
 
306
    Result := 0;
 
307
    exit;
167
308
  end;
 
309
 
 
310
  Snap := GetSelectedSnapshot;
 
311
  Threads := GetSelectedThreads(Snap);
 
312
  if Threads <> nil
 
313
  then tid := Threads.CurrentThreadId
 
314
  else tid := 1;
 
315
 
 
316
  if (Snap <> nil)
 
317
  then Stack := CallStackMonitor.Snapshots[Snap].EntriesForThreads[tid]
 
318
  else Stack := CallStackMonitor.CurrentCallStackList.EntriesForThreads[tid];
 
319
 
 
320
  if Stack <> nil
 
321
  then Result := Stack.CurrentIndex
 
322
  else Result := 0;
 
323
end;
 
324
 
 
325
function TLocalsDlg.GetSelectedSnapshot: TSnapshot;
 
326
begin
 
327
  Result := nil;
 
328
  if (SnapshotManager <> nil) and (SnapshotManager.SelectedEntry <> nil)
 
329
  then Result := SnapshotManager.SelectedEntry;
168
330
end;
169
331
 
170
332
procedure TLocalsDlg.DoBeginUpdate;
174
336
 
175
337
procedure TLocalsDlg.DoEndUpdate;
176
338
begin
 
339
  if ufNeedUpdating in FUpdateFlags then LocalsChanged(nil);
177
340
  lvLocals.EndUpdate;
178
341
end;
179
342
 
 
343
function TLocalsDlg.ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;
 
344
begin
 
345
  if (AColId - 1 >= 0) and (AColId - 1 < lvLocals.ColumnCount) then begin
 
346
    ASize := lvLocals.Column[AColId - 1].Width;
 
347
    Result := (ASize <> COL_WIDTHS[AColId - 1]) and (not lvLocals.Column[AColId - 1].AutoSize);
 
348
  end
 
349
  else
 
350
    Result := False;
 
351
end;
 
352
 
 
353
procedure TLocalsDlg.ColSizeSetter(AColId: Integer; ASize: Integer);
 
354
begin
 
355
  case AColId of
 
356
    COL_LOCALS_NAME:   lvLocals.Column[0].Width := ASize;
 
357
    COL_LOCALS_VALUE:  lvLocals.Column[1].Width := ASize;
 
358
  end;
 
359
end;
 
360
 
 
361
initialization
 
362
 
 
363
  LocalsDlgWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtLocals]);
 
364
  LocalsDlgWindowCreator.OnCreateFormProc := @CreateDebugDialog;
 
365
  LocalsDlgWindowCreator.OnSetDividerSize := @LocalsDlgColSizeSetter;
 
366
  LocalsDlgWindowCreator.OnGetDividerSize := @LocalsDlgColSizeGetter;
 
367
  LocalsDlgWindowCreator.DividerTemplate.Add('LocalsName',  COL_LOCALS_NAME,  @drsColWidthName);
 
368
  LocalsDlgWindowCreator.DividerTemplate.Add('LocalsValue', COL_LOCALS_VALUE, @drsColWidthValue);
 
369
  LocalsDlgWindowCreator.CreateSimpleLayout;
 
370
 
 
371
  DBG_DATA_MONITORS := DebugLogger.FindOrRegisterLogGroup('DBG_DATA_MONITORS' {$IFDEF DBG_DATA_MONITORS} , True {$ENDIF} );
 
372
 
180
373
end.
181
374