← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/ide/fpsymbol.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/ide/fpsymbol.pas
 
1
{
 
2
    This file is part of the Free Pascal Integrated Development Environment
 
3
    Copyright (c) 1998 by Berczi Gabor
 
4
 
 
5
    Symbol browse support routines for the IDE
 
6
 
 
7
    See the file COPYING.FPC, included in this distribution,
 
8
    for details about the copyright.
 
9
 
 
10
    This program is distributed in the hope that it will be useful,
 
11
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
13
 
 
14
 **********************************************************************}
 
15
{$i globdir.inc}
 
16
unit FPSymbol;
 
17
 
 
18
interface
 
19
 
 
20
uses Objects,Drivers,Views,Menus,Dialogs,
 
21
{$ifdef HASOUTLINE}
 
22
     Outline,
 
23
{$endif HASOUTLINE}
 
24
     BrowCol,
 
25
     WViews,
 
26
     FPViews;
 
27
 
 
28
const
 
29
      { Browser tab constants }
 
30
      btScope       = 0;
 
31
      btReferences  = 1;
 
32
      btInheritance = 2;
 
33
      btMemInfo     = 3;
 
34
      btUnitInfo    = 4;
 
35
      btBreakWatch  = 7;
 
36
 
 
37
type
 
38
    PBrowserWindow = ^TBrowserWindow;
 
39
 
 
40
    PGDBValueCollection = ^TGDBValueCollection;
 
41
 
 
42
    PGDBValue = ^TGDBValue;
 
43
    TGDBValue = Object(TObject)
 
44
      constructor Init(Const AExpr : String;ASym : PSymbol);
 
45
      procedure GetValue;
 
46
      function  GetText : String;
 
47
      destructor Done;virtual;
 
48
    private
 
49
      expr : Pstring;
 
50
      St   : Pstring;
 
51
      S    : PSymbol;
 
52
      GDBI : longint;
 
53
      end;
 
54
 
 
55
    TGDBValueCollection = Object(TCollection)
 
56
      function  At(Index: sw_Integer): PGDBValue;
 
57
      end;
 
58
 
 
59
 
 
60
    PSymbolView = ^TSymbolView;
 
61
    TSymbolView = object(TLocalMenuListBox)
 
62
      constructor  Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
 
63
      destructor   Done;virtual;
 
64
      procedure    HandleEvent(var Event: TEvent); virtual;
 
65
      procedure    SetState(AState: Word; Enable: Boolean); virtual;
 
66
      function     GotoItem(Item: sw_integer): boolean; virtual;
 
67
      function     TrackItem(Item: sw_integer; AutoTrack: boolean): boolean; virtual;
 
68
      function     GetPalette: PPalette; virtual;
 
69
      function     GetLocalMenu: PMenu; virtual;
 
70
      procedure    ClearHighlights;
 
71
      procedure    AutoTrackSource; virtual;
 
72
      procedure    Browse; virtual;
 
73
      procedure    GotoSource; virtual;
 
74
      procedure    TrackSource; virtual;
 
75
      procedure    OptionsDlg; virtual;
 
76
    private
 
77
      MyBW         : PBrowserWindow;
 
78
      function     TrackReference(R: PReference; AutoTrack: boolean): boolean; virtual;
 
79
      function     GotoReference(R: PReference): boolean; virtual;
 
80
    end;
 
81
 
 
82
    PSymbolScopeView = ^TSymbolScopeView;
 
83
    TSymbolScopeView = object(TSymbolView)
 
84
      constructor Init(var Bounds: TRect; ASymbols: PSymbolCollection; AHScrollBar, AVScrollBar: PScrollBar);
 
85
      destructor  Done; virtual;
 
86
      procedure   SetGDBCol;
 
87
      function    GetText(Item,MaxLen: Sw_Integer): String; virtual;
 
88
      procedure   HandleEvent(var Event: TEvent); virtual;
 
89
      procedure   Draw; virtual;
 
90
      procedure   LookUp(S: string); virtual;
 
91
      function    GotoItem(Item: sw_integer): boolean; virtual;
 
92
      function    TrackItem(Item: sw_integer; AutoTrack: boolean): boolean; virtual;
 
93
    private
 
94
      Symbols: PSymbolCollection;
 
95
      SymbolsValue : PGDBValueCollection;
 
96
      LookupStr: string;
 
97
    end;
 
98
 
 
99
    PSymbolReferenceView = ^TSymbolReferenceView;
 
100
    TSymbolReferenceView = object(TSymbolView)
 
101
      constructor Init(var Bounds: TRect; AReferences: PReferenceCollection; AHScrollBar, AVScrollBar: PScrollBar);
 
102
      destructor  Done; virtual;
 
103
      procedure   HandleEvent(var Event: TEvent); virtual;
 
104
      function    GetText(Item,MaxLen: Sw_Integer): String; virtual;
 
105
      procedure   SelectItem(Item: Sw_Integer); virtual;
 
106
      function    GotoItem(Item: sw_integer): boolean; virtual;
 
107
      function    TrackItem(Item: sw_integer; AutoTrack: boolean): boolean; virtual;
 
108
      procedure   Browse; virtual;
 
109
    private
 
110
      References: PReferenceCollection;
 
111
    end;
 
112
 
 
113
    PSymbolMemInfoView = ^TSymbolMemInfoView;
 
114
    TSymbolMemInfoView = object(TStaticText)
 
115
      constructor  Init(var Bounds: TRect; AMemInfo: PSymbolMemInfo);
 
116
      destructor  Done; virtual;
 
117
      procedure    GetText(var S: String); virtual;
 
118
      function     GetPalette: PPalette; virtual;
 
119
    private
 
120
      MemInfo: PSymbolMemInfo;
 
121
      MyBW   : PBrowserWindow;
 
122
    end;
 
123
 
 
124
    PSymbolMemoView = ^TSymbolMemoView;
 
125
    TSymbolMemoView = object(TFPMemo)
 
126
      function    GetPalette: PPalette; virtual;
 
127
    end;
 
128
 
 
129
    PSymbolInheritanceView = ^TSymbolInheritanceView;
 
130
{$ifdef HASOUTLINE}
 
131
    TSymbolInheritanceView = object(TOutlineViewer)
 
132
{$else notHASOUTLINE}
 
133
    TSymbolInheritanceView = object(TLocalMenuListBox)
 
134
{$endif HASOUTLINE}
 
135
      constructor  Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar; ARoot: PObjectSymbol);
 
136
      destructor   Done; virtual;
 
137
      function     GetRoot: Pointer; virtual;
 
138
      function     HasChildren(Node: Pointer): Boolean; virtual;
 
139
      function     GetChild(Node: Pointer; I: sw_Integer): Pointer; virtual;
 
140
      function     GetNumChildren(Node: Pointer): sw_Integer; virtual;
 
141
      function     GetNumChildrenExposed(Node: Pointer) : sw_Integer; virtual;
 
142
      procedure    Adjust(Node: Pointer; Expand: Boolean); virtual;
 
143
      function     IsExpanded(Node: Pointer): Boolean; virtual;
 
144
{$ifdef HASOUTLINE}
 
145
      function     GetText(Node: Pointer): String; virtual;
 
146
{$else not HASOUTLINE}
 
147
      procedure    ExpandAll(Node: Pointer);
 
148
      function     GetNode(I : sw_Integer) : Pointer; virtual;
 
149
      function     GetLineNode(Item : sw_Integer) : Pointer; virtual;
 
150
      function     GetText(Item,MaxLen: Sw_Integer): String; virtual;
 
151
{$endif HASOUTLINE}
 
152
      procedure    NodeSelected(P: pointer); virtual;
 
153
      procedure    Selected(I: sw_Integer); virtual;
 
154
      procedure    HandleEvent(var Event: TEvent); virtual;
 
155
      function     GetPalette: PPalette; virtual;
 
156
    private
 
157
      Root         : PObjectSymbol;
 
158
      MyBW         : PBrowserWindow;
 
159
    end;
 
160
 
 
161
    PBrowserTabItem = ^TBrowserTabItem;
 
162
    TBrowserTabItem = record
 
163
      Sign  : char;
 
164
      Link  : PView;
 
165
      Next  : PBrowserTabItem;
 
166
    end;
 
167
 
 
168
    PBrowserTab = ^TBrowserTab;
 
169
    TBrowserTab = object(TView)
 
170
      Items: PBrowserTabItem;
 
171
      constructor Init(var Bounds: TRect; AItems: PBrowserTabItem);
 
172
      function    GetItemCount: sw_integer; virtual;
 
173
      function    GetItem(Index: sw_integer): PBrowserTabItem; virtual;
 
174
      procedure   SetParams(AFlags: word; ACurrent: Sw_integer); virtual;
 
175
      procedure   SelectItem(Index: Sw_integer); virtual;
 
176
      procedure   Draw; virtual;
 
177
      function    GetPalette: PPalette; virtual;
 
178
      procedure   HandleEvent(var Event: TEvent); virtual;
 
179
      destructor  Done; virtual;
 
180
    private
 
181
      Flags   : word;
 
182
      Current : Sw_integer;
 
183
    end;
 
184
 
 
185
    PUnitInfoPanel = ^TUnitInfoPanel;
 
186
    TUnitInfoPanel = object(TPanel)
 
187
      InOwnerCall: boolean;
 
188
      procedure HandleEvent(var Event: TEvent); virtual;
 
189
    end;
 
190
 
 
191
    TBrowserWindow = object(TFPWindow)
 
192
      constructor Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Sw_Integer;ASym : PSymbol;
 
193
                    const AName,APrefix: string; ASymbols: PSymbolCollection; AReferences: PReferenceCollection;
 
194
                    AInheritance: PObjectSymbol; AMemInfo: PSymbolMemInfo);
 
195
      procedure   HandleEvent(var Event: TEvent); virtual;
 
196
      procedure   SetState(AState: Word; Enable: Boolean); virtual;
 
197
      procedure   Close; virtual;
 
198
      procedure   SelectTab(BrowserTab: Sw_integer); virtual;
 
199
      function    GetPalette: PPalette; virtual;
 
200
      function    Disassemble : boolean;
 
201
      destructor  Done;virtual;
 
202
    private
 
203
      PageTab       : PBrowserTab;
 
204
      ST            : PStaticText;
 
205
      Sym           : PSymbol;
 
206
      ScopeView     : PSymbolScopeView;
 
207
      ReferenceView : PSymbolReferenceView;
 
208
      InheritanceView: PSymbolInheritanceView;
 
209
      MemInfoView   : PSymbolMemInfoView;
 
210
      UnitInfoText  : PSymbolMemoView;
 
211
      UnitInfoUsed  : PSymbolScopeView;
 
212
      UnitInfoDependent : PSymbolScopeView;
 
213
      UnitInfo      : PUnitInfoPanel;
 
214
      Prefix        : PString;
 
215
      IsValid       : boolean;
 
216
      DebuggerValue : PGDBValue;
 
217
    end;
 
218
 
 
219
procedure OpenSymbolBrowser(X,Y: Sw_integer;const Name,Line: string;S : PSymbol;
 
220
            ParentBrowser : PBrowserWindow;
 
221
            Symbols: PSymbolCollection; References: PReferenceCollection;
 
222
            Inheritance: PObjectSymbol; MemInfo: PSymbolMemInfo);
 
223
 
 
224
function IsSymbolInfoAvailable: boolean;
 
225
 
 
226
procedure OpenOneSymbolBrowser(Name : String);
 
227
 
 
228
procedure CloseAllBrowsers;
 
229
 
 
230
procedure RemoveBrowsersCollection;
 
231
 
 
232
const
 
233
   GlobalsCollection : PSortedCollection = nil;
 
234
   ProcedureCollection : PSortedCollection = nil;
 
235
   ModulesCollection : PSortedCollection = nil;
 
236
 
 
237
implementation
 
238
 
 
239
uses App,Strings,
 
240
     FVConsts,
 
241
{$ifdef BROWSERCOL}
 
242
     symconst,
 
243
{$endif BROWSERCOL}
 
244
     WUtils,WEditor,
 
245
     FPConst,FPUtils,FPVars,{$ifndef FPDEBUG}FPDebug{$endif},FPIDE;
 
246
 
 
247
{$ifdef USERESSTRINGS}
 
248
resourcestring
 
249
{$else}
 
250
const
 
251
{$endif}
 
252
                msg_symbolnotfound = #3'Symbol %s not found';
 
253
                msg_nobrowserinfoavailable = 'No Browser info available';
 
254
                msg_cantfindfile = 'Can''t find %s';
 
255
 
 
256
                menu_local_gotosource = '~G~oto source';
 
257
                menu_local_tracksource = '~T~rack source';
 
258
                menu_local_options = '~O~ptions...';
 
259
                menu_local_clear = '~C~lear';
 
260
                menu_local_saveas = 'Save ~a~s';
 
261
 
 
262
                { Symbol view local menu items }
 
263
                menu_symlocal_browse = '~B~rowse';
 
264
                menu_symlocal_gotosource = '~G~oto source';
 
265
                menu_symlocal_tracksource = '~T~rack source';
 
266
                menu_symlocal_options = '~O~ptions...';
 
267
 
 
268
                { Symbol browser meminfo page }
 
269
                msg_sizeinmemory = 'Size in memory';
 
270
                msg_sizeonstack = 'Size on stack';
 
271
 
 
272
                msg_usedfirstin = 'Used first in';
 
273
                msg_mainsource = 'Main source';
 
274
                msg_sourcefiles = 'Source files';
 
275
 
 
276
                dialog_browse = 'Browse: %s';
 
277
 
 
278
const           { Symbol browser tabs }
 
279
                { must be char constants (so cannot be resourcestring)}
 
280
                label_browsertab_scope = 'S';
 
281
                label_browsertab_reference = 'R';
 
282
                label_browsertab_inheritance = 'I';
 
283
                label_browsertab_memory = 'M';
 
284
                label_browsertab_unit = 'U';
 
285
 
 
286
procedure CloseAllBrowsers;
 
287
  procedure SendCloseIfBrowser(P: PView); {$ifndef FPC}far;{$endif}
 
288
  begin
 
289
    if assigned(P) and
 
290
       ((TypeOf(P^)=TypeOf(TBrowserWindow)) or
 
291
       (TypeOf(P^)=TypeOf(TSymbolView)) or
 
292
       (TypeOf(P^)=TypeOf(TSymbolScopeView)) or
 
293
       (TypeOf(P^)=TypeOf(TSymbolReferenceView)) or
 
294
       (TypeOf(P^)=TypeOf(TSymbolMemInfoView)) or
 
295
       (TypeOf(P^)=TypeOf(TSymbolInheritanceView)) or
 
296
       (TypeOf(P^)=TypeOf(TSymbolMemoView))) then
 
297
      Message(P,evCommand,cmClose,nil);
 
298
  end;
 
299
 
 
300
begin
 
301
  Desktop^.ForEach(@SendCloseIfBrowser);
 
302
end;
 
303
 
 
304
procedure RemoveBrowsersCollection;
 
305
begin
 
306
  if assigned(GlobalsCollection) then
 
307
    begin
 
308
      GlobalsCollection^.deleteAll;
 
309
      Dispose(GlobalsCollection,done);
 
310
      GlobalsCollection:=nil;
 
311
    end;
 
312
  if assigned(ProcedureCollection) then
 
313
    begin
 
314
      ProcedureCollection^.deleteAll;
 
315
      Dispose(ProcedureCollection,done);
 
316
      ProcedureCollection:=nil;
 
317
    end;
 
318
  if assigned(ModulesCollection) then
 
319
    begin
 
320
      ModulesCollection^.deleteAll;
 
321
      Dispose(ModulesCollection,done);
 
322
      ModulesCollection:=nil;
 
323
    end;
 
324
end;
 
325
 
 
326
function NewBrowserTabItem(ASign: char; ALink: PView; ANext: PBrowserTabItem): PBrowserTabItem;
 
327
var P: PBrowserTabItem;
 
328
begin
 
329
  New(P); FillChar(P^,SizeOf(P^),0);
 
330
  with P^ do begin Sign:=ASign; Link:=ALink; Next:=ANext; end;
 
331
  NewBrowserTabItem:=P;
 
332
end;
 
333
 
 
334
procedure DisposeBrowserTabItem(P: PBrowserTabItem);
 
335
begin
 
336
  if P<>nil then Dispose(P);
 
337
end;
 
338
 
 
339
procedure DisposeBrowserTabList(P: PBrowserTabItem);
 
340
begin
 
341
  if P<>nil then
 
342
  begin
 
343
    if P^.Next<>nil then DisposeBrowserTabList(P^.Next);
 
344
    DisposeBrowserTabItem(P);
 
345
  end;
 
346
end;
 
347
 
 
348
function IsSymbolInfoAvailable: boolean;
 
349
begin
 
350
  IsSymbolInfoAvailable:=BrowCol.Modules<>nil;
 
351
end;
 
352
 
 
353
procedure OpenOneSymbolBrowser(Name : String);
 
354
 
 
355
var Index : sw_integer;
 
356
    PS,S : PSymbol;
 
357
    Anc : PObjectSymbol;
 
358
    P : Pstring;
 
359
    Symbols: PSymbolCollection;
 
360
 
 
361
  function Search(P : PSymbol) : boolean;
 
362
  begin
 
363
    Search:=UpcaseStr(P^.Items^.LookUp(Name,Index))=Name;
 
364
  end;
 
365
 
 
366
begin
 
367
   Name:=UpcaseStr(Name);
 
368
   If BrowCol.Modules<>nil then
 
369
     begin
 
370
       PS:=BrowCol.Modules^.FirstThat(@Search);
 
371
       If assigned(PS) then
 
372
         begin
 
373
           S:=PS^.Items^.At(Index);
 
374
           Symbols:=S^.Items;
 
375
           if (not assigned(symbols) or (symbols^.count=0)) and
 
376
              assigned(S^.Ancestor) then
 
377
             Symbols:=S^.Ancestor^.Items;
 
378
           if (S^.Flags and (sfObject or sfClass))=0 then
 
379
             Anc:=nil
 
380
           else if S^.Ancestor=nil then
 
381
             Anc:=ObjectTree
 
382
           else
 
383
             Anc:=SearchObjectForSymbol(S^.Ancestor);
 
384
           OpenSymbolBrowser(0,20,
 
385
                PS^.Items^.At(Index)^.GetName,
 
386
                PS^.Items^.At(Index)^.GetText,
 
387
                PS^.Items^.At(Index),nil,
 
388
                Symbols,PS^.Items^.At(Index)^.References,Anc,PS^.MemInfo);
 
389
         end
 
390
       else
 
391
         begin
 
392
           P:=@Name;
 
393
           ErrorBox(msg_symbolnotfound,@P);
 
394
         end;
 
395
     end
 
396
   else
 
397
     ErrorBox(msg_nobrowserinfoavailable,nil);
 
398
end;
 
399
 
 
400
(*procedure ReadBrowseLog(FileName: string);
 
401
var f: text;
 
402
    IOOK,EndOfFile: boolean;
 
403
    Line: string;
 
404
procedure NextLine;
 
405
begin
 
406
  readln(f,Line);
 
407
  EndOfFile:=Eof(f);
 
408
end;
 
409
var Level: integer;
 
410
procedure ProcessSymTable(Indent: integer; Owner: PSymbolCollection);
 
411
var IndentS,S,Source: string;
 
412
    Sym: PSymbol;
 
413
    Ref: PSymbolReference;
 
414
    P: byte;
 
415
    PX: TPoint;
 
416
    PS: PString;
 
417
    PCount: integer;
 
418
    Params: array[0..30] of PString;
 
419
    Typ: tsymtyp;
 
420
    ExitBack: boolean;
 
421
begin
 
422
  Inc(Level);
 
423
  IndentS:=CharStr(' ',Indent); ExitBack:=false;
 
424
  Sym:=nil;
 
425
  repeat
 
426
    if copy(Line,1,length(IndentS))<>IndentS then ExitBack:=true else
 
427
    if copy(Line,Indent+1,3)='***' then
 
428
      { new symbol }
 
429
      begin
 
430
        S:=copy(Line,Indent+1+3,255);
 
431
        P:=Pos('***',S); if P=0 then P:=length(S)+1;
 
432
        S:=Trim(copy(S,1,P-1));
 
433
        if (copy(S,1,1)='_') and (Pos('$$',S)>0) then
 
434
          begin
 
435
            repeat
 
436
              P:=Pos('$$',S);
 
437
              if P>0 then Delete(S,1,P+1);
 
438
            until P=0;
 
439
            P:=Pos('$',S);
 
440
            Delete(S,1,P);
 
441
            PCount:=0;
 
442
            repeat
 
443
              P:=Pos('$',S); if P=0 then P:=length(S)+1;
 
444
              Params[PCount]:=TypeNames^.Add(copy(S,1,P-1));
 
445
              Inc(PCount);
 
446
              Delete(S,1,P);
 
447
            until S='';
 
448
            Sym^.Typ:=procsym;
 
449
            Sym^.SetParams(PCount,@Params);
 
450
          end
 
451
        else
 
452
          New(Sym, Init(S, varsym, 0, nil));
 
453
        Owner^.Insert(Sym);
 
454
        NextLine;
 
455
      end else
 
456
    if copy(Line,Indent+1,3)='---' then
 
457
      { child symtable }
 
458
      begin
 
459
        S:=Trim(copy(Line,Indent+1+12,255));
 
460
        if Level=1 then Typ:=unitsym else
 
461
          Typ:=typesym;
 
462
        if (Sym<>nil) and (Sym^.GetName=S) then
 
463
        else
 
464
          begin
 
465
            New(Sym, Init(S, Typ, 0, nil));
 
466
            Owner^.Insert(Sym);
 
467
          end;
 
468
        Sym^.Typ:=Typ;
 
469
        NextLine;
 
470
        New(Sym^.Items, Init(0,50));
 
471
        ProcessSymTable(Indent+2,Sym^.Items);
 
472
      end else
 
473
{    if Sym<>nil then}
 
474
    if copy(Line,Indent+1,1)=' ' then
 
475
      { reference }
 
476
      begin
 
477
        S:=copy(Line,Indent+1+2,255);
 
478
        P:=Pos('(',S); if P=0 then P:=length(S)+1;
 
479
        Source:=Trim(copy(S,1,P-1)); Delete(S,1,P);
 
480
        P:=Pos(',',S); if P=0 then P:=length(S)+1;
 
481
        PX.Y:=StrToInt(copy(S,1,P-1)); Delete(S,1,P);
 
482
        P:=Pos(')',S); if P=0 then P:=length(S)+1;
 
483
        PX.X:=StrToInt(copy(S,1,P-1)); Delete(S,1,P);
 
484
        PS:=ModuleNames^.Add(Source);
 
485
        New(Ref, Init(PS, PX));
 
486
        if Sym^.References=nil then
 
487
          New(Sym^.References, Init(10,50));
 
488
        Sym^.References^.Insert(Ref);
 
489
      end;
 
490
    if ExitBack=false then
 
491
      NextLine;
 
492
  until EndOfFile or ExitBack;
 
493
  Dec(Level);
 
494
end;
 
495
begin
 
496
  DoneSymbolBrowser;
 
497
  InitSymbolBrowser;
 
498
 
 
499
{$I-}
 
500
  Assign(f,FileName);
 
501
  Reset(f);
 
502
  Level:=0;
 
503
  NextLine;
 
504
  while (IOResult=0) and (EndOfFile=false) do
 
505
    ProcessSymTable(0,Modules);
 
506
  Close(f);
 
507
  EatIO;
 
508
{$I+}
 
509
end;*)
 
510
 
 
511
 
 
512
{****************************************************************************
 
513
                               TGDBValue
 
514
****************************************************************************}
 
515
 
 
516
constructor TGDBValue.Init(Const AExpr : String;ASym : PSymbol);
 
517
begin
 
518
  St := nil;
 
519
  S := ASym;
 
520
  Expr:=NewStr(AExpr);
 
521
  GDBI:=-1;
 
522
end;
 
523
 
 
524
destructor TGDBValue.Done;
 
525
begin
 
526
  If Assigned(St) then
 
527
    begin
 
528
      DisposeStr(St);
 
529
      st:=nil;
 
530
    end;
 
531
  If Assigned(Expr) then
 
532
    begin
 
533
      DisposeStr(Expr);
 
534
      Expr:=nil;
 
535
    end;
 
536
end;
 
537
 
 
538
procedure TGDBValue.GetValue;
 
539
var
 
540
  p : pchar;
 
541
begin
 
542
{$ifdef BROWSERCOL}
 
543
{$ifndef NODEBUG}
 
544
  if not assigned(Debugger) then
 
545
    exit;
 
546
  if not Debugger^.IsRunning then
 
547
    exit;
 
548
  if (S^.typ in [fieldvarsym,staticvarsym,localvarsym,paravarsym]) or (GDBI=Debugger^.RunCount) then
 
549
    exit;
 
550
  If Assigned(St) then
 
551
    DisposeStr(St);
 
552
  if assigned(Expr) then
 
553
    begin
 
554
      p:=Debugger^.GetValue(Expr^);
 
555
      St:=NewStr(GetPChar(p));
 
556
      if assigned(p) then
 
557
        StrDispose(p);
 
558
      GDBI:=Debugger^.RunCount;
 
559
    end;
 
560
{$endif ndef NODEBUG}
 
561
{$endif BROWSERCOL}
 
562
end;
 
563
 
 
564
function TGDBValue.GetText : String;
 
565
begin
 
566
  GetValue;
 
567
  if assigned(St) then
 
568
    GetText:=S^.GetText+' = '+GetStr(St)
 
569
  else
 
570
    GetText:=S^.GetText;
 
571
end;
 
572
 
 
573
{****************************************************************************
 
574
                               TGDBValueCollection
 
575
****************************************************************************}
 
576
function  TGDBValueCollection.At(Index: sw_Integer): PGDBValue;
 
577
begin
 
578
  At:= Inherited At(Index);
 
579
end;
 
580
{****************************************************************************
 
581
                               TSymbolView
 
582
****************************************************************************}
 
583
 
 
584
constructor TSymbolView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
 
585
begin
 
586
  inherited Init(Bounds,1,AVScrollBar);
 
587
  HScrollBar:=AHScrollBar;
 
588
  MyBW:=nil;
 
589
  if assigned(HScrollBar) then
 
590
    begin
 
591
      HScrollBar^.SetRange(1,80);
 
592
    end;
 
593
  Options:=Options or (ofSelectable+ofTopSelect);
 
594
  EventMask:=EventMask or evBroadcast;
 
595
end;
 
596
 
 
597
procedure TSymbolView.ClearHighlights;
 
598
begin
 
599
  Message(Desktop,evBroadcast,cmClearLineHighlights,nil);
 
600
end;
 
601
 
 
602
procedure TSymbolView.AutoTrackSource;
 
603
begin
 
604
  if Range>0 then
 
605
    TrackSource;
 
606
end;
 
607
 
 
608
procedure TSymbolView.OptionsDlg;
 
609
begin
 
610
  { Abstract }
 
611
end;
 
612
 
 
613
destructor TSymbolView.Done;
 
614
begin
 
615
  EventMask:=EventMask and not evBroadcast;
 
616
  Inherited Done;
 
617
end;
 
618
 
 
619
procedure TSymbolView.SetState(AState: Word; Enable: Boolean);
 
620
var OState: longint;
 
621
begin
 
622
  OState:=State;
 
623
  inherited SetState(AState,Enable);
 
624
  if ((OState xor State) and sfFocused)<>0 then
 
625
    if GetState(sfFocused) then
 
626
      begin
 
627
        if (MiscOptions and moAutoTrackSource)<>0 then
 
628
          AutoTrackSource;
 
629
      end
 
630
    else
 
631
      Message(Desktop,evBroadcast,cmClearLineHighlights,nil);
 
632
end;
 
633
 
 
634
procedure TSymbolView.Browse;
 
635
begin
 
636
  SelectItem(Focused);
 
637
end;
 
638
 
 
639
procedure TSymbolView.GotoSource;
 
640
begin
 
641
  if GotoItem(Focused) then
 
642
    PutCommand(Owner,evCommand,cmClose,nil);
 
643
end;
 
644
 
 
645
procedure TSymbolView.TrackSource;
 
646
begin
 
647
  TrackItem(Focused,false);
 
648
end;
 
649
 
 
650
procedure TSymbolView.HandleEvent(var Event: TEvent);
 
651
var DontClear: boolean;
 
652
begin
 
653
  case Event.What of
 
654
    evKeyDown :
 
655
      begin
 
656
        DontClear:=false;
 
657
        case Event.KeyCode of
 
658
          kbEnter :
 
659
            Browse;
 
660
          kbCtrlEnter :
 
661
            GotoSource;
 
662
          kbSpaceBar :
 
663
            TrackSource;
 
664
          kbRight,kbLeft :
 
665
            if HScrollBar<>nil then
 
666
              HScrollBar^.HandleEvent(Event);
 
667
        else DontClear:=true;
 
668
        end;
 
669
        if DontClear=false then ClearEvent(Event);
 
670
      end;
 
671
    evMouseDown :
 
672
      begin
 
673
        if Event.double then
 
674
          begin
 
675
            Browse;
 
676
            ClearEvent(Event);
 
677
          end;
 
678
      end;
 
679
    evCommand :
 
680
      begin
 
681
        DontClear:=false;
 
682
        case Event.Command of
 
683
          cmSymBrowse :
 
684
            Browse;
 
685
          cmSymGotoSource :
 
686
            GotoSource;
 
687
          cmSymTrackSource :
 
688
            TrackSource;
 
689
          cmSymOptions :
 
690
            OptionsDlg;
 
691
        else DontClear:=true;
 
692
        end;
 
693
        if DontClear=false then ClearEvent(Event);
 
694
      end;
 
695
    evBroadcast :
 
696
      case Event.Command of
 
697
        cmListFocusChanged :
 
698
         if Event.InfoPtr=@Self then
 
699
          if (MiscOptions and moAutoTrackSource)<>0 then
 
700
            if GetState(sfFocused) then
 
701
              AutoTrackSource;
 
702
      end;
 
703
  end;
 
704
  inherited HandleEvent(Event);
 
705
end;
 
706
 
 
707
function TSymbolView.GetPalette: PPalette;
 
708
const
 
709
  P: string[length(CBrowserListBox)] = CBrowserListBox;
 
710
begin
 
711
  GetPalette:=@P;
 
712
end;
 
713
 
 
714
function TSymbolView.GetLocalMenu: PMenu;
 
715
begin
 
716
  GetLocalMenu:=NewMenu(
 
717
    NewItem(menu_symlocal_browse,'',kbNoKey,cmSymBrowse,hcSymBrowse,
 
718
    NewItem(menu_symlocal_gotosource,'',kbNoKey,cmSymGotoSource,hcSymGotoSource,
 
719
    NewItem(menu_symlocal_tracksource,'',kbNoKey,cmSymTrackSource,hcSymTrackSource,
 
720
    NewLine(
 
721
    NewItem(menu_symlocal_options,'',kbNoKey,cmSymOptions,hcSymOptions,
 
722
    nil))))));
 
723
end;
 
724
 
 
725
function TSymbolView.GotoItem(Item: sw_integer): boolean;
 
726
begin
 
727
  SelectItem(Item);
 
728
  GotoItem:=true;
 
729
end;
 
730
 
 
731
function TSymbolView.TrackItem(Item: sw_integer; AutoTrack: boolean): boolean;
 
732
begin
 
733
  SelectItem(Item);
 
734
  TrackItem:=true;
 
735
end;
 
736
 
 
737
function LastBrowserWindow: PBrowserWindow;
 
738
var BW: PBrowserWindow;
 
739
procedure IsBW(P: PView); {$ifndef FPC}far;{$endif}
 
740
begin
 
741
  if (P^.HelpCtx=hcBrowserWindow) then
 
742
    BW:=pointer(P);
 
743
end;
 
744
begin
 
745
  BW:=nil;
 
746
  Desktop^.ForEach(@IsBW);
 
747
  LastBrowserWindow:=BW;
 
748
end;
 
749
 
 
750
function TSymbolView.TrackReference(R: PReference; AutoTrack: boolean): boolean;
 
751
var W: PSourceWindow;
 
752
    BW: PBrowserWindow;
 
753
    P: TPoint;
 
754
begin
 
755
  ClearHighlights;
 
756
  Desktop^.Lock;
 
757
  P.X:=R^.Position.X-1; P.Y:=R^.Position.Y-1;
 
758
  if AutoTrack then
 
759
    W:=SearchOnDesktop(R^.GetFileName,false)
 
760
  else
 
761
    W:=TryToOpenFile(nil,R^.GetFileName,P.X,P.Y,true);
 
762
  if not assigned(W) then
 
763
    begin
 
764
      Desktop^.Unlock;
 
765
      if IDEApp.OpenSearch(R^.GetFileName+'*') then
 
766
        begin
 
767
          W:=TryToOpenFile(nil,R^.GetFileName,R^.Position.X-1,R^.Position.Y-1,true);
 
768
          if Assigned(W) then
 
769
            W^.Select;
 
770
        end;
 
771
      Desktop^.Lock;
 
772
    end;
 
773
  if W<>nil then
 
774
  begin
 
775
    BW:=LastBrowserWindow;
 
776
    if BW=nil then
 
777
      W^.Select
 
778
    else
 
779
      begin
 
780
        Desktop^.Delete(W);
 
781
        Desktop^.InsertBefore(W,BW^.NextView);
 
782
      end;
 
783
    W^.Editor^.SetLineFlagExclusive(lfHighlightRow,P.Y);
 
784
  end;
 
785
  Desktop^.UnLock;
 
786
  if Assigned(W)=false then
 
787
    ErrorBox(FormatStrStr(msg_cantfindfile,R^.GetFileName),nil);
 
788
 
 
789
  TrackReference:=W<>nil;
 
790
end;
 
791
 
 
792
function TSymbolView.GotoReference(R: PReference): boolean;
 
793
var W: PSourceWindow;
 
794
begin
 
795
  Desktop^.Lock;
 
796
  W:=TryToOpenFile(nil,R^.GetFileName,R^.Position.X-1,R^.Position.Y-1,true);
 
797
  if Assigned(W) then
 
798
    W^.Select
 
799
  else
 
800
    begin
 
801
      Desktop^.Unlock;
 
802
      if IDEApp.OpenSearch(R^.GetFileName+'*') then
 
803
        begin
 
804
          W:=TryToOpenFile(nil,R^.GetFileName,R^.Position.X-1,R^.Position.Y-1,true);
 
805
          if Assigned(W) then
 
806
            W^.Select;
 
807
        end;
 
808
      Desktop^.Lock;
 
809
    end;
 
810
  Desktop^.UnLock;
 
811
  if Assigned(W)=false then
 
812
    ErrorBox(FormatStrStr(msg_cantfindfile,R^.GetFileName),nil);
 
813
  GotoReference:=W<>nil;
 
814
end;
 
815
 
 
816
{****************************************************************************
 
817
                               TSymbolScopeView
 
818
****************************************************************************}
 
819
 
 
820
constructor TSymbolScopeView.Init(var Bounds: TRect; ASymbols: PSymbolCollection; AHScrollBar, AVScrollBar: PScrollBar);
 
821
begin
 
822
  inherited Init(Bounds,AHScrollBar, AVScrollBar);
 
823
  Symbols:=ASymbols;
 
824
  NewList(ASymbols);
 
825
  New(SymbolsValue,Init(50,50));
 
826
  SetRange(Symbols^.Count);
 
827
end;
 
828
 
 
829
destructor TSymbolScopeView.Done;
 
830
begin
 
831
  {if assigned(Symbols) then
 
832
    begin
 
833
       the elements belong to other lists
 
834
       Symbols^.DeleteAll;
 
835
       dispose(Symbols,done);
 
836
    end;}
 
837
  if Assigned(SymbolsValue) then
 
838
    begin
 
839
      Dispose(SymbolsValue,Done);
 
840
      SymbolsValue:=nil;
 
841
    end;
 
842
  Inherited Done;
 
843
end;
 
844
 
 
845
procedure TSymbolScopeView.HandleEvent(var Event: TEvent);
 
846
var OldFocus: sw_integer;
 
847
begin
 
848
  case Event.What of
 
849
    evKeyDown :
 
850
      case Event.KeyCode of
 
851
        kbBack :
 
852
          begin
 
853
            LookUp(copy(LookUpStr,1,length(LookUpStr)-1));
 
854
            ClearEvent(Event);
 
855
          end;
 
856
      else
 
857
        if Event.CharCode in[#33..#255] then
 
858
          begin
 
859
            LookUp(LookUpStr+Event.CharCode);
 
860
            ClearEvent(Event);
 
861
          end;
 
862
      end;
 
863
  end;
 
864
  OldFocus:=Focused;
 
865
  inherited HandleEvent(Event);
 
866
  if OldFocus<>Focused then
 
867
    Lookup('');
 
868
end;
 
869
 
 
870
procedure TSymbolScopeView.Draw;
 
871
var DeltaX: sw_integer;
 
872
begin
 
873
  inherited Draw;
 
874
  if Assigned(HScrollBar)=false then DeltaX:=0 else
 
875
    DeltaX:=HScrollBar^.Value-HScrollBar^.Min;
 
876
  SetCursor(2+SymbolTypLen+length(LookUpStr)-DeltaX,Focused-TopItem);
 
877
end;
 
878
 
 
879
procedure TSymbolScopeView.LookUp(S: string);
 
880
var Idx,Slength: Sw_integer;
 
881
    NS: string;
 
882
begin
 
883
  NS:=LookUpStr;
 
884
  Slength:=Length(S);
 
885
  if (Symbols=nil) or (S='') then NS:='' else
 
886
    begin
 
887
      S:=Symbols^.LookUp(S,Idx);
 
888
      if Idx<>-1 then
 
889
        begin
 
890
          NS:=S;
 
891
          FocusItem(Idx);
 
892
        end;
 
893
    end;
 
894
  LookUpStr:=Copy(NS,1,Slength);
 
895
  SetState(sfCursorVis,LookUpStr<>'');
 
896
  DrawView;
 
897
end;
 
898
 
 
899
function TSymbolScopeView.GotoItem(Item: sw_integer): boolean;
 
900
var S: PSymbol;
 
901
    OK: boolean;
 
902
begin
 
903
  OK:=Range>0;
 
904
  if OK then
 
905
  begin
 
906
    S:=List^.At(Item);
 
907
    OK:=(S^.References<>nil) and (S^.References^.Count>0);
 
908
    if OK then
 
909
      OK:=GotoReference(S^.References^.At(0));
 
910
  end;
 
911
  GotoItem:=OK;
 
912
end;
 
913
 
 
914
function TSymbolScopeView.TrackItem(Item: sw_integer; AutoTrack: boolean): boolean;
 
915
var S: PSymbol;
 
916
    OK: boolean;
 
917
begin
 
918
  OK:=Range>0;
 
919
  if OK then
 
920
  begin
 
921
    S:=List^.At(Item);
 
922
    OK:=(S^.References<>nil) and (S^.References^.Count>0);
 
923
    if OK then
 
924
      OK:=TrackReference(S^.References^.At(0),AutoTrack);
 
925
  end;
 
926
  TrackItem:=OK;
 
927
end;
 
928
 
 
929
procedure TSymbolScopeView.SetGDBCol;
 
930
var S : PSymbol;
 
931
    I : sw_integer;
 
932
begin
 
933
  if assigned(MyBW) and (SymbolsValue^.Count=0) then
 
934
    begin
 
935
      For i:=0 to Symbols^.Count-1 do
 
936
        begin
 
937
          S:=Symbols^.At(I);
 
938
          SymbolsValue^.Insert(New(PGDBValue,Init(GetStr(MyBW^.Prefix)+S^.GetName,S)));
 
939
        end;
 
940
    end;
 
941
end;
 
942
 
 
943
function TSymbolScopeView.GetText(Item,MaxLen: Sw_Integer): String;
 
944
var S1: string;
 
945
    S : PSymbol;
 
946
    SG : PGDBValue;
 
947
begin
 
948
  S:=Symbols^.At(Item);
 
949
  if Assigned(SymbolsValue) and (SymbolsValue^.Count>Item) then
 
950
    SG:=SymbolsValue^.At(Item)
 
951
  else
 
952
    SG:=nil;
 
953
  if assigned(SG) then
 
954
    S1:=SG^.getText
 
955
  else
 
956
    S1:=S^.GetText;
 
957
  GetText:=copy(S1,1,MaxLen);
 
958
end;
 
959
 
 
960
 
 
961
{****************************************************************************
 
962
                             TSymbolReferenceView
 
963
****************************************************************************}
 
964
 
 
965
constructor TSymbolReferenceView.Init(var Bounds: TRect; AReferences: PReferenceCollection;
 
966
              AHScrollBar, AVScrollBar: PScrollBar);
 
967
begin
 
968
  inherited Init(Bounds,AHScrollBar, AVScrollBar);
 
969
  References:=AReferences;
 
970
  NewList(AReferences);
 
971
  SetRange(References^.Count);
 
972
end;
 
973
 
 
974
destructor TSymbolReferenceView.Done;
 
975
begin
 
976
  Inherited Done;
 
977
end;
 
978
 
 
979
procedure TSymbolReferenceView.HandleEvent(var Event: TEvent);
 
980
var OldFocus: sw_integer;
 
981
    DontClear: boolean;
 
982
begin
 
983
  OldFocus:=Focused;
 
984
  case Event.What of
 
985
    evKeyDown :
 
986
      begin
 
987
        DontClear:=false;
 
988
        case Event.KeyCode of
 
989
          kbEnter :
 
990
            TrackItem(Focused,false);
 
991
          kbCtrlEnter :
 
992
            GotoItem(Focused);
 
993
        else DontClear:=true;
 
994
        end;
 
995
        if DontClear=false then ClearEvent(Event);
 
996
      end;
 
997
  end;
 
998
  inherited HandleEvent(Event);
 
999
  if OldFocus<>Focused then
 
1000
   if (MiscOptions and moAutoTrackSource)=0 then
 
1001
    ClearHighlights;
 
1002
end;
 
1003
 
 
1004
procedure TSymbolReferenceView.Browse;
 
1005
begin
 
1006
  { do nothing here }
 
1007
end;
 
1008
 
 
1009
function TSymbolReferenceView.GetText(Item,MaxLen: Sw_Integer): String;
 
1010
var S: string;
 
1011
    P: PReference;
 
1012
begin
 
1013
  P:=References^.At(Item);
 
1014
  S:=P^.GetFileName+'('+IntToStr(P^.Position.Y)+','+IntToStr(P^.Position.X)+')';
 
1015
  GetText:=copy(S,1,MaxLen);
 
1016
end;
 
1017
 
 
1018
function TSymbolReferenceView.GotoItem(Item: sw_integer): boolean;
 
1019
var OK: boolean;
 
1020
begin
 
1021
  OK:=Range>0;
 
1022
  if OK then
 
1023
    OK:=GotoReference(List^.At(Item));
 
1024
  GotoItem:=OK;
 
1025
end;
 
1026
 
 
1027
function TSymbolReferenceView.TrackItem(Item: sw_integer; AutoTrack: boolean): boolean;
 
1028
var OK: boolean;
 
1029
begin
 
1030
  OK:=Range>0;
 
1031
  if OK then
 
1032
    OK:=TrackReference(List^.At(Item),AutoTrack);
 
1033
  TrackItem:=OK;
 
1034
end;
 
1035
 
 
1036
procedure TSymbolReferenceView.SelectItem(Item: Sw_Integer);
 
1037
begin
 
1038
  GotoItem(Item);
 
1039
end;
 
1040
 
 
1041
 
 
1042
constructor TSymbolMemInfoView.Init(var Bounds: TRect; AMemInfo: PSymbolMemInfo);
 
1043
begin
 
1044
  inherited Init(Bounds,'');
 
1045
  Options:=Options or (ofSelectable+ofTopSelect);
 
1046
  MemInfo:=AMemInfo;
 
1047
  MyBW:=nil;
 
1048
end;
 
1049
 
 
1050
destructor TSymbolMemInfoView.Done;
 
1051
begin
 
1052
{  if assigned(MemInfo) then
 
1053
    dispose(MemInfo);}
 
1054
  Inherited Done;
 
1055
end;
 
1056
 
 
1057
procedure TSymbolMemInfoView.GetText(var S: String);
 
1058
function SizeStr(Size: longint): string;
 
1059
var S: string[40];
 
1060
begin
 
1061
  S:=IntToStrL(Size,7);
 
1062
  S:=S+' byte';
 
1063
  if Size>1 then S:=S+'s';
 
1064
  if Size=-1 then
 
1065
    SizeStr:='variable'
 
1066
  else
 
1067
    SizeStr:=S;
 
1068
end;
 
1069
function AddrStr(Addr: longint): string;
 
1070
{ Warning this is endian specific code !! (PM) }
 
1071
type TLongint = record LoW,HiW: word; end;
 
1072
begin
 
1073
  with TLongint(Addr) do
 
1074
  AddrStr:='$'+hexstr(HiW,4)+hexstr(LoW,4);
 
1075
end;
 
1076
begin
 
1077
  ClearFormatParams;
 
1078
  AddFormatParamStr(msg_sizeinmemory);
 
1079
  AddFormatParamStr(msg_sizeonstack);
 
1080
  S:=
 
1081
  FormatStrF(
 
1082
   #13+
 
1083
{  ' Memory location: '+AddrStr(MemInfo^.Addr)+#13+
 
1084
  '   Local address: '+AddrStr(MemInfo^.LocalAddr)+#13+}
 
1085
 
 
1086
  { ??? internal linker ??? }
 
1087
 
 
1088
  '%18s: '+SizeStr(MemInfo^.Size)+#13+
 
1089
  '%18s: '+SizeStr(MemInfo^.PushSize)+#13+
 
1090
  '',
 
1091
  FormatParams);
 
1092
end;
 
1093
 
 
1094
function TSymbolMemInfoView.GetPalette: PPalette;
 
1095
begin
 
1096
  GetPalette:=inherited GetPalette;
 
1097
end;
 
1098
 
 
1099
function TSymbolMemoView.GetPalette: PPalette;
 
1100
const P: string[length(CFPSymbolMemo)] = CFPSymbolMemo;
 
1101
begin
 
1102
  GetPalette:=@P;
 
1103
end;
 
1104
 
 
1105
{****************************************************************************
 
1106
                          TSymbolInheritanceView
 
1107
****************************************************************************}
 
1108
 
 
1109
constructor TSymbolInheritanceView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar; ARoot: PObjectSymbol);
 
1110
begin
 
1111
{$ifdef HASOUTLINE}
 
1112
  inherited Init(Bounds,AHScrollBar,AVScrollBar);
 
1113
{$else not HASOUTLINE}
 
1114
  inherited Init(Bounds,1,AVScrollBar);
 
1115
  HScrollBar:=AHScrollBar;
 
1116
{$endif not HASOUTLINE}
 
1117
  Options:=Options or (ofSelectable+ofTopSelect);
 
1118
  Root:=ARoot;
 
1119
  MyBW:=nil;
 
1120
  ExpandAll(Root);
 
1121
{$ifdef HASOUTLINE}
 
1122
  Update;
 
1123
{$else not HASOUTLINE}
 
1124
  SetRange(GetNumChildrenExposed(Root));
 
1125
{$endif not HASOUTLINE}
 
1126
end;
 
1127
 
 
1128
destructor TSymbolInheritanceView.Done;
 
1129
begin
 
1130
  { do not dispose,
 
1131
    belongs to a symbolcollection (PM)
 
1132
  if assigned(Root) then
 
1133
    dispose(Root,done); }
 
1134
  Inherited Done;
 
1135
end;
 
1136
 
 
1137
function TSymbolInheritanceView.GetRoot: Pointer;
 
1138
begin
 
1139
  GetRoot:=Root;
 
1140
end;
 
1141
 
 
1142
function TSymbolInheritanceView.HasChildren(Node: Pointer): Boolean;
 
1143
begin
 
1144
  HasChildren:=GetNumChildren(Node)>0;
 
1145
end;
 
1146
 
 
1147
function TSymbolInheritanceView.GetChild(Node: Pointer; I: sw_Integer): Pointer;
 
1148
begin
 
1149
  GetChild:=PObjectSymbol(Node)^.GetDescendant(I);
 
1150
end;
 
1151
 
 
1152
function TSymbolInheritanceView.GetNumChildren(Node: Pointer): sw_Integer;
 
1153
begin
 
1154
  GetNumChildren:=PObjectSymbol(Node)^.GetDescendantCount;
 
1155
end;
 
1156
 
 
1157
function TSymbolInheritanceView.GetNumChildrenExposed(Node: Pointer) : sw_Integer;
 
1158
var
 
1159
  Nb : integer;
 
1160
  P : PObjectSymbol;
 
1161
    Procedure AddCount(P : PObjectSymbol);
 
1162
    var
 
1163
      i,count : integer;
 
1164
      D : PObjectSymbol;
 
1165
    begin
 
1166
      if not assigned(P) then
 
1167
        exit;
 
1168
      Count:=P^.GetDescendantCount;
 
1169
      Inc(Nb,Count);
 
1170
      for I:=0 to Count-1 do
 
1171
        begin
 
1172
          D:=P^.GetDescendant(I);
 
1173
          AddCount(D);
 
1174
        end;
 
1175
    end;
 
1176
begin
 
1177
  Nb:=0;
 
1178
  AddCount(Node);
 
1179
  GetNumChildrenExposed:=Nb;
 
1180
end;
 
1181
 
 
1182
 
 
1183
procedure TSymbolInheritanceView.Adjust(Node: Pointer; Expand: Boolean);
 
1184
begin
 
1185
  PObjectSymbol(Node)^.Expanded:=Expand;
 
1186
end;
 
1187
 
 
1188
function TSymbolInheritanceView.IsExpanded(Node: Pointer): Boolean;
 
1189
begin
 
1190
  IsExpanded:=PObjectSymbol(Node)^.Expanded;
 
1191
end;
 
1192
 
 
1193
procedure TSymbolInheritanceView.HandleEvent(var Event: TEvent);
 
1194
var DontClear: boolean;
 
1195
{$ifndef HASOUTLINE}
 
1196
        P: TPoint;
 
1197
{$endif HASOUTLINE}
 
1198
begin
 
1199
  case Event.What of
 
1200
    evKeyDown :
 
1201
      begin
 
1202
        DontClear:=false;
 
1203
        case Event.KeyCode of
 
1204
{$ifndef HASOUTLINE}
 
1205
          kbEnter:
 
1206
            NodeSelected(GetLineNode(Cursor.Y-Origin.Y));
 
1207
{$endif HASOUTLINE}
 
1208
          kbLeft,kbRight,
 
1209
          kbCtrlLeft,kbCtrlRight :
 
1210
            if Assigned(HScrollBar) then
 
1211
              HScrollBar^.HandleEvent(Event)
 
1212
            else
 
1213
              DontClear:=true;
 
1214
        else DontClear:=true;
 
1215
        end;
 
1216
        if DontClear=false then ClearEvent(Event);
 
1217
      end;
 
1218
    evMouseDown :
 
1219
      begin
 
1220
{$ifndef HASOUTLINE}
 
1221
        MakeLocal(Event.Where,P);
 
1222
        SetCursor(P.X,P.Y);
 
1223
{$endif HASOUTLINE}
 
1224
        if Event.double then
 
1225
          begin
 
1226
            Message(@Self,evKeyDown,kbEnter,nil);
 
1227
            ClearEvent(Event);
 
1228
          end;
 
1229
      end;
 
1230
  end;
 
1231
  inherited HandleEvent(Event);
 
1232
end;
 
1233
 
 
1234
function TSymbolInheritanceView.GetPalette: PPalette;
 
1235
const P: string[length(CBrowserOutline)] = CBrowserOutline;
 
1236
begin
 
1237
  GetPalette:=@P;
 
1238
end;
 
1239
 
 
1240
{$ifdef HASOUTLINE}
 
1241
function TSymbolInheritanceView.GetText(Node: Pointer): String;
 
1242
begin
 
1243
  GetText:=PObjectSymbol(Node)^.GetName;
 
1244
end;
 
1245
 
 
1246
{$else not HASOUTLINE}
 
1247
function TSymbolInheritanceView.GetNode(I : sw_Integer) : Pointer;
 
1248
var
 
1249
  P : PObjectSymbol;
 
1250
begin
 
1251
  P:=Root;
 
1252
  If Assigned(P) then
 
1253
    P:=P^.GetDescendant(I);
 
1254
  GetNode:=Pointer(P);
 
1255
end;
 
1256
 
 
1257
procedure TSymbolInheritanceView.ExpandAll(Node: Pointer);
 
1258
var
 
1259
  i : integer;
 
1260
  P : Pointer;
 
1261
begin
 
1262
  Adjust(Node,true);
 
1263
  For i:=0 to GetNumChildren(Node)-1 do
 
1264
    begin
 
1265
      P:=GetChild(Node,I);
 
1266
      if Assigned(P) then
 
1267
        ExpandAll(P);
 
1268
    end;
 
1269
end;
 
1270
 
 
1271
function TSymbolInheritanceView.GetLineNode(Item : sw_Integer) : Pointer;
 
1272
var
 
1273
  P : PObjectSymbol;
 
1274
  NT: Integer;
 
1275
    procedure FindSymbol(var P:PObjectSymbol);
 
1276
    var
 
1277
      Q : PObjectSymbol;
 
1278
      Nc,Des : integer;
 
1279
    begin
 
1280
      if not assigned(P) then
 
1281
         exit;
 
1282
      Des:=0;
 
1283
      While (NT<Item) and (Des<GetNumChildren(P)) do
 
1284
        begin
 
1285
          Q:=P^.GetDescendant(Des);
 
1286
          Inc(NT);
 
1287
          if NT=Item then
 
1288
            begin
 
1289
              P:=Q;
 
1290
              exit;
 
1291
            end;
 
1292
          Nc:=GetNumChildrenExposed(Q);
 
1293
          If NT+Nc<Item then
 
1294
            Inc(NT,Nc)
 
1295
          else
 
1296
            begin
 
1297
              FindSymbol(Q);
 
1298
              P:=Q;
 
1299
              exit;
 
1300
            end;
 
1301
          Inc(Des);
 
1302
        end;
 
1303
    end;
 
1304
 
 
1305
begin
 
1306
  P:=Root;
 
1307
  NT:=0;
 
1308
  FindSymbol(P);
 
1309
  GetLineNode:=P;
 
1310
end;
 
1311
 
 
1312
function TSymbolInheritanceView.GetText(Item,MaxLen: Sw_Integer): String;
 
1313
var
 
1314
  P,Ans : PObjectSymbol;
 
1315
  NC,NT,NumParents : Integer;
 
1316
  S : String;
 
1317
    procedure FindSymbol(var P:PObjectSymbol);
 
1318
    var
 
1319
      Q : PObjectSymbol;
 
1320
      Des : integer;
 
1321
    begin
 
1322
      if not assigned(P) then
 
1323
         exit;
 
1324
      Des:=0;
 
1325
      While (NT<Item) and (Des<GetNumChildren(P)) do
 
1326
        begin
 
1327
          Q:=P^.GetDescendant(Des);
 
1328
          Inc(NT);
 
1329
          if NT=Item then
 
1330
            begin
 
1331
              P:=Q;
 
1332
              exit;
 
1333
            end;
 
1334
          Nc:=GetNumChildrenExposed(Q);
 
1335
          If NT+Nc<Item then
 
1336
            Inc(NT,Nc)
 
1337
          else
 
1338
            begin
 
1339
              FindSymbol(Q);
 
1340
              P:=Q;
 
1341
              exit;
 
1342
            end;
 
1343
          Inc(Des);
 
1344
        end;
 
1345
    end;
 
1346
 
 
1347
begin
 
1348
  P:=Root;
 
1349
  NT:=0;
 
1350
  FindSymbol(P);
 
1351
 
 
1352
  if assigned(P) then
 
1353
    begin
 
1354
      S:=P^.GetName;
 
1355
      Ans:=P^.Parent;
 
1356
      NumParents:=0;
 
1357
      While Assigned(Ans) do
 
1358
        begin
 
1359
          Inc(NumParents);
 
1360
          Ans:=Ans^.Parent;
 
1361
        end;
 
1362
      S:=CharStr('-',NumParents)+S;
 
1363
      GetText:=Copy(S,1,MaxLen);
 
1364
    end
 
1365
  else
 
1366
    GetText:='';
 
1367
end;
 
1368
 
 
1369
{$endif HASOUTLINE}
 
1370
 
 
1371
 
 
1372
procedure TSymbolInheritanceView.Selected(I: sw_Integer);
 
1373
var P: pointer;
 
1374
begin
 
1375
  P:=GetNode(I);
 
1376
  NodeSelected(P);
 
1377
end;
 
1378
 
 
1379
procedure TSymbolInheritanceView.NodeSelected(P: pointer);
 
1380
var
 
1381
    S: PSymbol;
 
1382
    St : String;
 
1383
    Anc: PObjectSymbol;
 
1384
begin
 
1385
  if P=nil then Exit;
 
1386
 
 
1387
  S:=PObjectSymbol(P)^.Symbol;
 
1388
 
 
1389
  { this happens for the top objects view (PM) }
 
1390
  if S=nil then exit;
 
1391
 
 
1392
  st:=S^.GetName;
 
1393
  if S^.Ancestor=nil then
 
1394
    Anc:=ObjectTree
 
1395
  else
 
1396
    Anc:=SearchObjectForSymbol(S^.Ancestor);
 
1397
  OpenSymbolBrowser(Origin.X-1,
 
1398
{$ifdef HASOUTLINE}
 
1399
    FOC-Delta.Y+1,
 
1400
{$else not HASOUTLINE}
 
1401
    Origin.Y+1,
 
1402
{$endif not HASOUTLINE}
 
1403
    st,
 
1404
    S^.GetText,S,nil,
 
1405
    S^.Items,S^.References,Anc,S^.MemInfo);
 
1406
end;
 
1407
 
 
1408
 
 
1409
{****************************************************************************
 
1410
                               TBrowserTab
 
1411
****************************************************************************}
 
1412
 
 
1413
constructor TBrowserTab.Init(var Bounds: TRect; AItems: PBrowserTabItem);
 
1414
begin
 
1415
  inherited Init(Bounds);
 
1416
  Options:=Options or ofPreProcess;
 
1417
  Items:=AItems;
 
1418
  SetParams(0,0);
 
1419
end;
 
1420
 
 
1421
procedure TBrowserTab.SetParams(AFlags: word; ACurrent: Sw_integer);
 
1422
begin
 
1423
  Flags:=AFlags;
 
1424
  SelectItem(ACurrent);
 
1425
end;
 
1426
 
 
1427
procedure TBrowserTab.SelectItem(Index: Sw_integer);
 
1428
var P: PBrowserTabItem;
 
1429
begin
 
1430
  Current:=Index;
 
1431
  P:=GetItem(Current);
 
1432
  if (P<>nil) and (P^.Link<>nil) then
 
1433
    P^.Link^.Focus;
 
1434
  DrawView;
 
1435
end;
 
1436
 
 
1437
function TBrowserTab.GetItemCount: sw_integer;
 
1438
var Count: integer;
 
1439
    P: PBrowserTabItem;
 
1440
begin
 
1441
  Count:=0; P:=Items;
 
1442
  while (P<>nil) do
 
1443
    begin
 
1444
      Inc(Count);
 
1445
      P:=P^.Next;
 
1446
    end;
 
1447
  GetItemCount:=Count;
 
1448
end;
 
1449
 
 
1450
function TBrowserTab.GetItem(Index: sw_integer): PBrowserTabItem;
 
1451
var Counter: integer;
 
1452
    P: PBrowserTabItem;
 
1453
begin
 
1454
  P:=Items;
 
1455
  Counter:=0;
 
1456
  while (P<>nil) and (Counter<Index) do
 
1457
    begin
 
1458
      P:=P^.Next;
 
1459
      Inc(Counter);
 
1460
    end;
 
1461
  GetItem:=P;
 
1462
end;
 
1463
 
 
1464
procedure TBrowserTab.Draw;
 
1465
var B: TDrawBuffer;
 
1466
    SelColor, NormColor, C: word;
 
1467
    I,CurX,Count: Sw_integer;
 
1468
function Names(Idx: integer): char;
 
1469
begin
 
1470
  Names:=GetItem(Idx)^.Sign;
 
1471
end;
 
1472
begin
 
1473
  NormColor:=GetColor(1); SelColor:=GetColor(2);
 
1474
  MoveChar(B,'�',SelColor,Size.X);
 
1475
  CurX:=0; Count:=0;
 
1476
  for I:=0 to GetItemCount-1 do
 
1477
    if (Flags and (1 shl I))<>0 then
 
1478
    begin
 
1479
      Inc(Count);
 
1480
      if Current=I then C:=SelColor
 
1481
                   else C:=NormColor;
 
1482
      if Count=1 then MoveChar(B[CurX],'�',SelColor,1)
 
1483
                 else MoveChar(B[CurX],'�',SelColor,1);
 
1484
      MoveCStr(B[CurX+1],' '+Names(I)+' ',C);
 
1485
      Inc(CurX,4);
 
1486
    end;
 
1487
  if Count>0 then
 
1488
    MoveChar(B[CurX],'�',SelColor,1);
 
1489
  WriteLine(0,0,Size.X,Size.Y,B);
 
1490
end;
 
1491
 
 
1492
procedure TBrowserTab.HandleEvent(var Event: TEvent);
 
1493
var I,Idx: integer;
 
1494
    DontClear: boolean;
 
1495
    P: TPoint;
 
1496
function GetItemForCoord(X: integer): integer;
 
1497
var I,CurX,Idx: integer;
 
1498
begin
 
1499
  CurX:=0; Idx:=-1;
 
1500
  for I:=0 to GetItemCount-1 do
 
1501
    if (Flags and (1 shl I))<>0 then
 
1502
    begin
 
1503
      if (CurX+1<=X) and (X<=CurX+3) then
 
1504
        begin Idx:=I; Break; end;
 
1505
      Inc(CurX,4);
 
1506
    end;
 
1507
  GetItemForCoord:=Idx;
 
1508
end;
 
1509
begin
 
1510
  case Event.What of
 
1511
    evMouseDown :
 
1512
      if MouseInView(Event.Where) then
 
1513
        begin
 
1514
          repeat
 
1515
            MakeLocal(Event.Where,P);
 
1516
            Idx:=GetItemForCoord(P.X);
 
1517
            if Idx<>-1 then
 
1518
              SelectItem(Idx);
 
1519
          until not MouseEvent(Event, evMouseMove);
 
1520
          ClearEvent(Event);
 
1521
        end;
 
1522
    evKeyDown :
 
1523
      begin
 
1524
        DontClear:=false; Idx:=-1;
 
1525
        for I:=0 to GetItemCount-1 do
 
1526
          if (GetCtrlCode(GetItem(I)^.Sign)=Event.KeyCode){ or
 
1527
             (GetItem(I)^.Sign=UpCase(Event.CharCode))}  then
 
1528
           if (Flags and (1 shl I))<>0 then
 
1529
            begin
 
1530
              Idx:=I;
 
1531
              Break;
 
1532
            end;
 
1533
        if Idx=-1 then
 
1534
          DontClear:=true
 
1535
        else
 
1536
          SelectItem(Idx);
 
1537
        if DontClear=false then ClearEvent(Event);
 
1538
      end;
 
1539
  end;
 
1540
  inherited HandleEvent(Event);
 
1541
end;
 
1542
 
 
1543
function TBrowserTab.GetPalette: PPalette;
 
1544
const P: string[length(CBrowserTab)] = CBrowserTab;
 
1545
begin
 
1546
  GetPalette:=@P;
 
1547
end;
 
1548
 
 
1549
destructor TBrowserTab.Done;
 
1550
begin
 
1551
  if Items<>nil then DisposeBrowserTabList(Items);
 
1552
  inherited Done;
 
1553
end;
 
1554
 
 
1555
procedure TUnitInfoPanel.HandleEvent(var Event: TEvent);
 
1556
begin
 
1557
  if (Event.What=evBroadcast) and (Event.Command=cmListItemSelected) and
 
1558
     (InOwnerCall=false) then
 
1559
    begin
 
1560
      InOwnerCall:=true;
 
1561
      if Assigned(Owner) then
 
1562
        Owner^.HandleEvent(Event);
 
1563
      InOwnerCall:=false;
 
1564
    end;
 
1565
  inherited HandleEvent(Event);
 
1566
end;
 
1567
 
 
1568
constructor TBrowserWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Sw_Integer;ASym : PSymbol;
 
1569
             const AName,APrefix: string; ASymbols: PSymbolCollection; AReferences: PReferenceCollection;
 
1570
             AInheritance: PObjectSymbol; AMemInfo: PSymbolMemINfo);
 
1571
var R,R2,R3: TRect;
 
1572
    HSB,VSB: PScrollBar;
 
1573
    CST: PColorStaticText;
 
1574
    I: sw_integer;
 
1575
function CreateVSB(R: TRect): PScrollBar;
 
1576
var R2: TRect;
 
1577
    SB: PScrollBar;
 
1578
begin
 
1579
  R2.Copy(R); R2.Move(1,0); R2.A.X:=R2.B.X-1;
 
1580
  New(SB, Init(R2)); SB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
 
1581
  CreateVSB:=SB;
 
1582
end;
 
1583
function CreateHSB(R: TRect): PScrollBar;
 
1584
var R2: TRect;
 
1585
    SB: PScrollBar;
 
1586
begin
 
1587
  R2.Copy(R); R2.Move(0,1); R2.A.Y:=R2.B.Y-1;
 
1588
  New(SB, Init(R2)); SB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY;
 
1589
  CreateHSB:=SB;
 
1590
end;
 
1591
begin
 
1592
  inherited Init(Bounds, FormatStrStr(dialog_browse,ATitle), ANumber);
 
1593
  HelpCtx:=hcBrowserWindow;
 
1594
  Sym:=ASym;
 
1595
  Prefix:=NewStr(APrefix);
 
1596
 
 
1597
  GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
 
1598
{$ifndef NODEBUG}
 
1599
  if {assigned(Debugger) and Debugger^.IsRunning and}
 
1600
     assigned(Sym) and (Sym^.typ in [fieldvarsym,staticvarsym,localvarsym,paravarsym]) then
 
1601
    begin
 
1602
      New(DebuggerValue,Init(ATitle,Sym));
 
1603
      New(ST, Init(R, ' '+DebuggerValue^.GetText));
 
1604
    end
 
1605
  else
 
1606
{$endif NODEBUG}
 
1607
    begin
 
1608
      New(ST, Init(R, ' '+AName));
 
1609
      DebuggerValue:=nil;
 
1610
    end;
 
1611
  ST^.GrowMode:=gfGrowHiX;
 
1612
  Insert(ST);
 
1613
 
 
1614
  GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);
 
1615
  if assigned(ASymbols) and (ASymbols^.Count>0) then
 
1616
    begin
 
1617
      HSB:=CreateHSB(R);
 
1618
      Insert(HSB);
 
1619
      VSB:=CreateVSB(R);
 
1620
      Insert(VSB);
 
1621
      New(ScopeView, Init(R, ASymbols, HSB, VSB));
 
1622
      ScopeView^.GrowMode:=gfGrowHiX+gfGrowHiY;
 
1623
      Insert(ScopeView);
 
1624
      ScopeView^.MyBW:=@Self;
 
1625
      ScopeView^.SetGDBCol;
 
1626
    end;
 
1627
  if assigned(AReferences) and (AReferences^.Count>0) then
 
1628
    begin
 
1629
      HSB:=CreateHSB(R);
 
1630
      Insert(HSB);
 
1631
      VSB:=CreateVSB(R);
 
1632
      Insert(VSB);
 
1633
      New(ReferenceView, Init(R, AReferences, HSB, VSB));
 
1634
      ReferenceView^.GrowMode:=gfGrowHiX+gfGrowHiY;
 
1635
      Insert(ReferenceView);
 
1636
      ReferenceView^.MyBW:=@Self;
 
1637
    end;
 
1638
  if assigned(AInheritance) then
 
1639
    begin
 
1640
      HSB:=CreateHSB(R);
 
1641
      Insert(HSB);
 
1642
      VSB:=CreateVSB(R);
 
1643
      Insert(VSB);
 
1644
      New(InheritanceView, Init(R, HSB,VSB, AInheritance));
 
1645
      InheritanceView^.GrowMode:=gfGrowHiX+gfGrowHiY;
 
1646
      Insert(InheritanceView);
 
1647
      InheritanceView^.MyBW:=@Self;
 
1648
    end;
 
1649
  if assigned(AMemInfo) then
 
1650
    begin
 
1651
      New(MemInfoView, Init(R, AMemInfo));
 
1652
      MemInfoView^.GrowMode:=gfGrowHiX+gfGrowHiY;
 
1653
      Insert(MemInfoView);
 
1654
      MemInfoView^.MyBW:=@Self;
 
1655
    end;
 
1656
  if Assigned(Asym) and (TypeOf(ASym^)=TypeOf(TModuleSymbol)) then
 
1657
  with PModuleSymbol(Sym)^ do
 
1658
    begin
 
1659
      New(UnitInfo, Init(R));
 
1660
      UnitInfo^.GetExtent(R3);
 
1661
 
 
1662
      R2.Copy(R3);
 
1663
      R2.B.Y:=R2.A.Y+3;
 
1664
      if (Assigned(UsedUnits) or Assigned(DependentUnits))=false then
 
1665
        R2.B.Y:=R3.B.Y;
 
1666
      HSB:=CreateHSB(R2); {UnitInfo^.Insert(HSB); HSB:=nil;}
 
1667
      VSB:=CreateVSB(R2);
 
1668
      {UnitInfo^.Insert(VSB);
 
1669
       VSB will be owned by UnitInfoText PM }
 
1670
      New(UnitInfoText, Init(R2,HSB,VSB, nil));
 
1671
      with UnitInfoText^ do
 
1672
      begin
 
1673
        GrowMode:=gfGrowHiX;
 
1674
        if Assigned(LoadedFrom) then
 
1675
        begin
 
1676
          AddLine(FormatStrStr2('%s : %s',msg_usedfirstin,GetStr(LoadedFrom)));
 
1677
          AddLine(FormatStrStr('%s : ',msg_mainsource));
 
1678
          AddLine(FormatStrStr('  %s',GetStr(MainSource)));
 
1679
          if Assigned(SourceFiles) and (SourceFiles^.Count>1) then
 
1680
          begin
 
1681
            AddLine(FormatStrStr('%s : ',msg_sourcefiles));
 
1682
            for I:=0 to SourceFiles^.Count-1 do
 
1683
              AddLine(FormatStrStr('  %s',GetStr(SourceFiles^.At(I))));
 
1684
          end;
 
1685
        end;
 
1686
      end;
 
1687
      UnitInfo^.Insert(UnitInfoText);
 
1688
 
 
1689
      if Assigned(UsedUnits) then
 
1690
      begin
 
1691
        Inc(R2.A.Y,R2.B.Y-R2.A.Y); R2.B.Y:=R2.A.Y+1;
 
1692
        New(CST, Init(R2,'� Used units �'+CharStr('�',255),ColorIndex(12),false));
 
1693
        CST^.GrowMode:=gfGrowHiX;
 
1694
        UnitInfo^.Insert(CST);
 
1695
 
 
1696
        Inc(R2.A.Y,R2.B.Y-R2.A.Y); R2.B.Y:=R2.A.Y+4;
 
1697
        if Assigned(DependentUnits)=false then R2.B.Y:=R3.B.Y;
 
1698
        {HSB:=CreateHSB(R2); UnitInfo^.Insert(HSB); }
 
1699
        HSB:=nil;
 
1700
        VSB:=CreateVSB(R2);
 
1701
        {UnitInfo^.Insert(VSB);  this created crashes,
 
1702
        that were difficult to findout PM }
 
1703
        New(UnitInfoUsed, Init(R2,UsedUnits,HSB,VSB));
 
1704
        UnitInfoUsed^.GrowMode:=gfGrowHiY+gfGrowHiX;
 
1705
        UnitInfoUsed^.MyBW:=@Self;
 
1706
        UnitInfo^.Insert(UnitInfoUsed);
 
1707
      end;
 
1708
 
 
1709
      if Assigned(DependentUnits) then
 
1710
      begin
 
1711
        Inc(R2.A.Y,R2.B.Y-R2.A.Y); R2.B.Y:=R2.A.Y+1;
 
1712
        New(CST, Init(R2,'� Dependent units �'+CharStr('�',255),ColorIndex(12),false));
 
1713
        CST^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY;
 
1714
        UnitInfo^.Insert(CST);
 
1715
 
 
1716
        Inc(R2.A.Y,R2.B.Y-R2.A.Y); R2.B.Y:=R3.B.Y;
 
1717
        {HSB:=CreateHSB(R2); UnitInfo^.Insert(HSB); }
 
1718
        HSB:=nil;
 
1719
        VSB:=CreateVSB(R2);
 
1720
        { UnitInfo^.Insert(VSB);  this created crashes,
 
1721
        that were difficult to findout PM }
 
1722
        New(UnitInfoDependent, Init(R2,DependentUnits,HSB,VSB));
 
1723
        UnitInfoDependent^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY;
 
1724
        UnitInfoDependent^.MyBW:=@Self;
 
1725
        UnitInfo^.Insert(UnitInfoDependent);
 
1726
      end;
 
1727
 
 
1728
      if Assigned(UnitInfoText) then
 
1729
        UnitInfoText^.Select;
 
1730
 
 
1731
      Insert(UnitInfo);
 
1732
    end;
 
1733
 
 
1734
  GetExtent(R); R.Grow(-1,-1); R.Move(0,1); R.B.Y:=R.A.Y+1;
 
1735
  New(PageTab, Init(R,
 
1736
    NewBrowserTabItem(label_browsertab_scope,ScopeView,
 
1737
    NewBrowserTabItem(label_browsertab_reference,ReferenceView,
 
1738
    NewBrowserTabItem(label_browsertab_inheritance,InheritanceView,
 
1739
    NewBrowserTabItem(label_browsertab_memory,MemInfoView,
 
1740
    NewBrowserTabItem(label_browsertab_unit,UnitInfo,
 
1741
    nil)))))));
 
1742
  PageTab^.GrowMode:=gfGrowHiX;
 
1743
  Insert(PageTab);
 
1744
 
 
1745
  if assigned(ScopeView) then
 
1746
   SelectTab(btScope)
 
1747
  else if assigned(ReferenceView) then
 
1748
    SelectTab(btReferences)
 
1749
  else if assigned(MemInfoView) then
 
1750
    SelectTab(btMemInfo)
 
1751
  else
 
1752
   if assigned(InheritanceView) then
 
1753
    SelectTab(btInheritance);
 
1754
end;
 
1755
 
 
1756
destructor  TBrowserWindow.Done;
 
1757
begin
 
1758
  { UnitInfoText needs to be removed first
 
1759
    to avoid crashes within the UnitInfo destructor PM }
 
1760
  if Assigned(UnitInfoText) then
 
1761
    begin
 
1762
      UnitInfo^.Delete(UnitInfoText);
 
1763
      Dispose(UnitInfoText,Done);
 
1764
      UnitInfoText:=nil;
 
1765
    end;
 
1766
  if assigned(DebuggerValue) then
 
1767
    begin
 
1768
      Dispose(DebuggerValue,Done);
 
1769
      DebuggerValue:=nil;
 
1770
    end;
 
1771
  if assigned(Prefix) then
 
1772
    begin
 
1773
      DisposeStr(Prefix);
 
1774
      Prefix:=nil;
 
1775
    end;
 
1776
  inherited Done;
 
1777
end;
 
1778
 
 
1779
procedure TBrowserWindow.HandleEvent(var Event: TEvent);
 
1780
var DontClear: boolean;
 
1781
    S: PSymbol;
 
1782
    Symbols: PSymbolCollection;
 
1783
    Anc: PObjectSymbol;
 
1784
    P: TPoint;
 
1785
begin
 
1786
  case Event.What of
 
1787
    evBroadcast :
 
1788
      case Event.Command of
 
1789
        cmDebuggerStopped :
 
1790
          begin
 
1791
            if Assigned(DebuggerValue) and
 
1792
               (DebuggerValue^.GDBI<>Event.InfoLong) then
 
1793
              begin
 
1794
                If Assigned(ST^.Text) then
 
1795
                  DisposeStr(ST^.Text);
 
1796
                ST^.Text:=NewStr(DebuggerValue^.GetText);
 
1797
                ST^.DrawView;
 
1798
              end;
 
1799
          end;
 
1800
        cmSearchWindow :
 
1801
          ClearEvent(Event);
 
1802
        cmListItemSelected :
 
1803
          begin
 
1804
            S:=nil;
 
1805
            if (Event.InfoPtr=ScopeView) then
 
1806
              begin
 
1807
                S:=ScopeView^.Symbols^.At(ScopeView^.Focused);
 
1808
                MakeGlobal(ScopeView^.Origin,P);
 
1809
                Desktop^.MakeLocal(P,P); Inc(P.Y,ScopeView^.Focused-ScopeView^.TopItem);
 
1810
                Inc(P.Y);
 
1811
              end;
 
1812
            if (Event.InfoPtr=UnitInfoUsed) then
 
1813
              begin
 
1814
                S:=UnitInfoUsed^.Symbols^.At(UnitInfoUsed^.Focused);
 
1815
                MakeGlobal(UnitInfoUsed^.Origin,P);
 
1816
                Desktop^.MakeLocal(P,P); Inc(P.Y,UnitInfoUsed^.Focused-UnitInfoUsed^.TopItem);
 
1817
                Inc(P.Y);
 
1818
              end;
 
1819
            if (Event.InfoPtr=UnitInfoDependent) then
 
1820
              begin
 
1821
                S:=UnitInfoDependent^.Symbols^.At(UnitInfoDependent^.Focused);
 
1822
                MakeGlobal(UnitInfoDependent^.Origin,P);
 
1823
                Desktop^.MakeLocal(P,P); Inc(P.Y,UnitInfoDependent^.Focused-UnitInfoDependent^.TopItem);
 
1824
                Inc(P.Y);
 
1825
              end;
 
1826
            if Assigned(S) then
 
1827
              begin
 
1828
                if S^.Ancestor=nil then Anc:=nil else
 
1829
                  Anc:=SearchObjectForSymbol(S^.Ancestor);
 
1830
                Symbols:=S^.Items;
 
1831
                if (not assigned(Symbols)  or (symbols^.count=0)) then
 
1832
                  if assigned(S^.Ancestor) then
 
1833
                    Symbols:=S^.Ancestor^.Items;
 
1834
                if (S^.GetReferenceCount>0) or (assigned(Symbols) and (Symbols^.Count>0)) or (Anc<>nil) then
 
1835
                 OpenSymbolBrowser(Origin.X-1,P.Y,
 
1836
                   S^.GetName,
 
1837
                   ScopeView^.GetText(ScopeView^.Focused,255),
 
1838
                   S,@self,
 
1839
                   Symbols,S^.References,Anc,S^.MemInfo);
 
1840
              end;
 
1841
            end;
 
1842
      end;
 
1843
{    evCommand :
 
1844
      begin
 
1845
        DontClear:=false;
 
1846
        case Event.Command of
 
1847
        cmGotoSymbol :
 
1848
          if Event.InfoPtr=ScopeView then
 
1849
           if ReferenceView<>nil then
 
1850
            if ReferenceView^.Range>0 then
 
1851
              ReferenceView^.GotoItem(0);
 
1852
        cmTrackSymbol :
 
1853
          if Event.InfoPtr=ScopeView then
 
1854
            if (ScopeView<>nil) and (ScopeView^.Range>0) then
 
1855
              begin
 
1856
                S:=ScopeView^.At(ScopeView^.Focused);
 
1857
                if (S^.References<>nil) and (S^.References^.Count>0) then
 
1858
                  TrackItem(S^.References^.At(0));
 
1859
        else DontClear:=true;
 
1860
        end;
 
1861
        if DontClear=false then ClearEvent(Event);
 
1862
      end;}
 
1863
    evKeyDown :
 
1864
      begin
 
1865
        DontClear:=false;
 
1866
        case Event.KeyCode of
 
1867
          kbEsc :
 
1868
            Close;
 
1869
          kbAltI :
 
1870
            If not Disassemble then
 
1871
              DontClear:=true;
 
1872
        else DontClear:=true;
 
1873
        end;
 
1874
        if DontClear=false then ClearEvent(Event);
 
1875
      end;
 
1876
  end;
 
1877
  inherited HandleEvent(Event);
 
1878
end;
 
1879
 
 
1880
function TBrowserWindow.Disassemble : boolean;
 
1881
begin
 
1882
  Disassemble:=false;
 
1883
  if not assigned(sym) or (sym^.typ<>procsym) then
 
1884
    exit;
 
1885
  { We need to load exefile }
 
1886
{$ifndef NODEBUG}
 
1887
  InitGDBWindow;
 
1888
  if not assigned(Debugger) then
 
1889
    begin
 
1890
      new(Debugger,Init);
 
1891
      if assigned(Debugger) then
 
1892
        Debugger^.SetExe(ExeFile);
 
1893
    end;
 
1894
  if not assigned(Debugger) or not Debugger^.HasExe then
 
1895
    exit;
 
1896
  { goto source/assembly mixture }
 
1897
  InitDisassemblyWindow;
 
1898
  DisassemblyWindow^.LoadFunction(Sym^.GetName);
 
1899
  DisassemblyWindow^.SelectInDebugSession;
 
1900
  Disassemble:=true;
 
1901
{$else NODEBUG}
 
1902
  NoDebugger;
 
1903
{$endif NODEBUG}
 
1904
end;
 
1905
 
 
1906
procedure TBrowserWindow.SetState(AState: Word; Enable: Boolean);
 
1907
{var OldState: word;}
 
1908
begin
 
1909
{  OldState:=State;}
 
1910
  inherited SetState(AState,Enable);
 
1911
{  if ((State xor OldState) and sfActive)<>0 then
 
1912
    if GetState(sfActive)=false then
 
1913
      Message(Desktop,evBroadcast,cmClearLineHighlights,nil);}
 
1914
end;
 
1915
 
 
1916
procedure TBrowserWindow.Close;
 
1917
begin
 
1918
  inherited Close;
 
1919
end;
 
1920
 
 
1921
procedure TBrowserWindow.SelectTab(BrowserTab: Sw_integer);
 
1922
var Tabs: Sw_integer;
 
1923
{$ifndef NODEBUG}
 
1924
    PB : PBreakpoint;
 
1925
{$endif}
 
1926
    PS :PString;
 
1927
    l : longint;
 
1928
begin
 
1929
  case BrowserTab of
 
1930
    btScope :
 
1931
      if assigned(ScopeView) then
 
1932
        ScopeView^.Select;
 
1933
    btReferences :
 
1934
      if assigned(ReferenceView) then
 
1935
        ReferenceView^.Select;
 
1936
    btMemInfo:
 
1937
      if assigned(MemInfoView) then
 
1938
        MemInfoView^.Select;
 
1939
{$ifndef NODEBUG}
 
1940
    btBreakWatch :
 
1941
      begin
 
1942
        if Assigned(Sym) then
 
1943
          begin
 
1944
            if Pos('proc',Sym^.GetText)>0 then
 
1945
          { insert function breakpoint }
 
1946
            begin
 
1947
               { make it visible }
 
1948
               PS:=Sym^.Name;
 
1949
               l:=Length(PS^);
 
1950
               If PS^[l]='*' then
 
1951
                 begin
 
1952
                   PB:=BreakpointsCollection^.GetType(bt_function,copy(GetStr(PS),1,l-1));
 
1953
                   If Assigned(PB) then
 
1954
                     BreakpointsCollection^.Delete(PB);
 
1955
                   Sym^.Name:=NewStr(copy(GetStr(PS),1,l-1));
 
1956
                   DrawView;
 
1957
                   DisposeStr(PS);
 
1958
                 end
 
1959
               else
 
1960
                 begin
 
1961
                   Sym^.Name:=NewStr(GetStr(PS)+'*');
 
1962
                   DrawView;
 
1963
                   New(PB,init_function(GetStr(PS)));
 
1964
                   DisposeStr(PS);
 
1965
                   BreakpointsCollection^.Insert(PB);
 
1966
                   BreakpointsCollection^.Update;
 
1967
                 end;
 
1968
            end
 
1969
          else if pos('var',Sym^.GetText)>0 then
 
1970
            { insert watch point }
 
1971
            begin
 
1972
               { make it visible }
 
1973
               PS:=Sym^.Name;
 
1974
               l:=Length(PS^);
 
1975
               If PS^[l]='*' then
 
1976
                 begin
 
1977
                   PB:=BreakpointsCollection^.GetType(bt_awatch,copy(PS^,1,l-1));
 
1978
                   If Assigned(PB) then
 
1979
                     BreakpointsCollection^.Delete(PB);
 
1980
                   Sym^.Name:=NewStr(copy(PS^,1,l-1));
 
1981
                   DrawView;
 
1982
                   DisposeStr(PS);
 
1983
                 end
 
1984
               else
 
1985
                 begin
 
1986
                   Sym^.Name:=NewStr(GetStr(PS)+'*');
 
1987
                   DrawView;
 
1988
                   New(PB,init_type(bt_awatch,GetStr(PS)));
 
1989
                   DisposeStr(PS);
 
1990
                   BreakpointsCollection^.Insert(PB);
 
1991
                   BreakpointsCollection^.Update;
 
1992
                 end;
 
1993
            end;
 
1994
        end;
 
1995
      end;
 
1996
{$endif NODEBUG}
 
1997
  end;
 
1998
  Tabs:=0;
 
1999
  if assigned(ScopeView) then
 
2000
    Tabs:=Tabs or (1 shl btScope);
 
2001
  if assigned(ReferenceView) then
 
2002
    Tabs:=Tabs or (1 shl btReferences);
 
2003
  if assigned(InheritanceView) then
 
2004
    Tabs:=Tabs or (1 shl btInheritance);
 
2005
  if assigned(MemInfoView) then
 
2006
    Tabs:=Tabs or (1 shl btMemInfo);
 
2007
{$ifndef NODEBUG}
 
2008
  if Assigned(Sym) then
 
2009
    if (Pos('proc',Sym^.GetText)>0) or (Pos('var',Sym^.GetText)>0) then
 
2010
      Tabs:=Tabs or (1 shl btBreakWatch);
 
2011
{$endif NODEBUG}
 
2012
  if assigned(UnitInfo) then
 
2013
    Tabs:=Tabs or (1 shl btUnitInfo);
 
2014
  if PageTab<>nil then PageTab^.SetParams(Tabs,BrowserTab);
 
2015
end;
 
2016
 
 
2017
function TBrowserWindow.GetPalette: PPalette;
 
2018
const S: string[length(CBrowserWindow)] = CBrowserWindow;
 
2019
begin
 
2020
  GetPalette:=@S;
 
2021
end;
 
2022
 
 
2023
procedure OpenSymbolBrowser(X,Y: Sw_integer;const Name,Line: string;S : PSymbol;
 
2024
            ParentBrowser : PBrowserWindow;
 
2025
            Symbols: PSymbolCollection; References: PReferenceCollection;
 
2026
            Inheritance: PObjectSymbol; MemInfo: PSymbolMemInfo);
 
2027
var R: TRect;
 
2028
    PB : PBrowserWindow;
 
2029
    St,st2 : string;
 
2030
begin
 
2031
  if X=0 then X:=Desktop^.Size.X-35;
 
2032
  R.A.X:=X; R.A.Y:=Y;
 
2033
  R.B.X:=R.A.X+35; R.B.Y:=R.A.Y+15;
 
2034
  while (R.B.Y>Desktop^.Size.Y) do R.Move(0,-1);
 
2035
  if assigned(ParentBrowser) and assigned(ParentBrowser^.Prefix) and
 
2036
     assigned(ParentBrowser^.sym) and
 
2037
     (ParentBrowser^.sym^.typ<>unitsym)
 
2038
     then
 
2039
    begin
 
2040
      st:=GetStr(ParentBrowser^.Prefix)+' '+Name;
 
2041
    end
 
2042
  else
 
2043
    st:=Name;
 
2044
  st2:=st;
 
2045
  if assigned(S) and ((S^.Flags and sfPointer)<>0) then
 
2046
    begin
 
2047
      st:=st+'^';
 
2048
      if assigned(S^.Ancestor) and
 
2049
         ((S^.Ancestor^.Flags and sfRecord)<>0) then
 
2050
        st:=st+'.';
 
2051
    end
 
2052
  else if assigned(S) and ((S^.Flags and sfRecord)<>0) then
 
2053
    st:=st+'.';
 
2054
 
 
2055
  PB:=New(PBrowserWindow, Init(R,
 
2056
    st2,SearchFreeWindowNo,S,Line,st,
 
2057
    Symbols,References,Inheritance,MemInfo));
 
2058
  if (assigned(S) and (S^.typ in [fieldvarsym,staticvarsym,localvarsym,paravarsym])) or
 
2059
     (assigned(ParentBrowser) and ParentBrowser^.IsValid) then
 
2060
    PB^.IsValid:=true;
 
2061
 
 
2062
  Desktop^.Insert(PB);
 
2063
end;
 
2064
 
 
2065
END.