fpsymbol.pas 45 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 1998 by Berczi Gabor
  5. Symbol browse support routines for the IDE
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$i globdir.inc}
  13. unit FPSymbol;
  14. interface
  15. uses Objects,Drivers,Views,Menus,Dialogs,Outline,
  16. BrowCol,
  17. WViews,
  18. FPViews;
  19. const
  20. { Browser tab constants }
  21. btScope = 0;
  22. btReferences = 1;
  23. btInheritance = 2;
  24. btMemInfo = 3;
  25. btBreakWatch = 4;
  26. type
  27. PBrowserWindow = ^TBrowserWindow;
  28. PGDBValueCollection = ^TGDBValueCollection;
  29. PGDBValue = ^TGDBValue;
  30. TGDBValue = Object(TObject)
  31. constructor Init(Const AExpr : String;ASym : PSymbol);
  32. procedure GetValue;
  33. function GetText : String;
  34. destructor Done;virtual;
  35. private
  36. expr : Pstring;
  37. St : Pstring;
  38. S : PSymbol;
  39. GDBI : longint;
  40. end;
  41. TGDBValueCollection = Object(TCollection)
  42. function At(Index: sw_Integer): PGDBValue;
  43. end;
  44. PSymbolView = ^TSymbolView;
  45. TSymbolView = object(TLocalMenuListBox)
  46. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  47. procedure HandleEvent(var Event: TEvent); virtual;
  48. procedure SetState(AState: Word; Enable: Boolean); virtual;
  49. function GotoItem(Item: sw_integer): boolean; virtual;
  50. function TrackItem(Item: sw_integer; AutoTrack: boolean): boolean; virtual;
  51. function GetPalette: PPalette; virtual;
  52. function GetLocalMenu: PMenu; virtual;
  53. procedure ClearHighlights;
  54. procedure AutoTrackSource; virtual;
  55. procedure Browse; virtual;
  56. procedure GotoSource; virtual;
  57. procedure TrackSource; virtual;
  58. procedure OptionsDlg; virtual;
  59. private
  60. MyBW : PBrowserWindow;
  61. function TrackReference(R: PReference; AutoTrack: boolean): boolean; virtual;
  62. function GotoReference(R: PReference): boolean; virtual;
  63. end;
  64. PSymbolScopeView = ^TSymbolScopeView;
  65. TSymbolScopeView = object(TSymbolView)
  66. constructor Init(var Bounds: TRect; ASymbols: PSymbolCollection; AHScrollBar, AVScrollBar: PScrollBar);
  67. destructor Done; virtual;
  68. procedure SetGDBCol;
  69. function GetText(Item,MaxLen: Sw_Integer): String; virtual;
  70. procedure HandleEvent(var Event: TEvent); virtual;
  71. procedure Draw; virtual;
  72. procedure LookUp(S: string); virtual;
  73. function GotoItem(Item: sw_integer): boolean; virtual;
  74. function TrackItem(Item: sw_integer; AutoTrack: boolean): boolean; virtual;
  75. private
  76. Symbols: PSymbolCollection;
  77. SymbolsValue : PGDBValueCollection;
  78. LookupStr: string;
  79. end;
  80. PSymbolReferenceView = ^TSymbolReferenceView;
  81. TSymbolReferenceView = object(TSymbolView)
  82. constructor Init(var Bounds: TRect; AReferences: PReferenceCollection; AHScrollBar, AVScrollBar: PScrollBar);
  83. destructor Done; virtual;
  84. procedure HandleEvent(var Event: TEvent); virtual;
  85. function GetText(Item,MaxLen: Sw_Integer): String; virtual;
  86. procedure SelectItem(Item: Sw_Integer); virtual;
  87. function GotoItem(Item: sw_integer): boolean; virtual;
  88. function TrackItem(Item: sw_integer; AutoTrack: boolean): boolean; virtual;
  89. procedure Browse; virtual;
  90. private
  91. References: PReferenceCollection;
  92. end;
  93. PSymbolMemInfoView = ^TSymbolMemInfoView;
  94. TSymbolMemInfoView = object(TStaticText)
  95. constructor Init(var Bounds: TRect; AMemInfo: PSymbolMemInfo);
  96. destructor Done; virtual;
  97. procedure GetText(var S: String); virtual;
  98. function GetPalette: PPalette; virtual;
  99. private
  100. MemInfo: PSymbolMemInfo;
  101. MyBW : PBrowserWindow;
  102. end;
  103. PSymbolInheritanceView = ^TSymbolInheritanceView;
  104. TSymbolInheritanceView = object(TOutlineViewer)
  105. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar; ARoot: PObjectSymbol);
  106. destructor Done; virtual;
  107. function GetRoot: Pointer; virtual;
  108. function HasChildren(Node: Pointer): Boolean; virtual;
  109. function GetChild(Node: Pointer; I: Integer): Pointer; virtual;
  110. function GetNumChildren(Node: Pointer): Integer; virtual;
  111. function GetText(Node: Pointer): String; virtual;
  112. procedure Adjust(Node: Pointer; Expand: Boolean); virtual;
  113. function IsExpanded(Node: Pointer): Boolean; virtual;
  114. procedure Selected(I: Integer); virtual;
  115. procedure HandleEvent(var Event: TEvent); virtual;
  116. function GetPalette: PPalette; virtual;
  117. private
  118. Root : PObjectSymbol;
  119. MyBW : PBrowserWindow;
  120. end;
  121. PBrowserTabItem = ^TBrowserTabItem;
  122. TBrowserTabItem = record
  123. Sign : char;
  124. Link : PView;
  125. Next : PBrowserTabItem;
  126. end;
  127. PBrowserTab = ^TBrowserTab;
  128. TBrowserTab = object(TView)
  129. Items: PBrowserTabItem;
  130. constructor Init(var Bounds: TRect; AItems: PBrowserTabItem);
  131. function GetItemCount: sw_integer; virtual;
  132. function GetItem(Index: sw_integer): PBrowserTabItem; virtual;
  133. procedure SetParams(AFlags: word; ACurrent: Sw_integer); virtual;
  134. procedure SelectItem(Index: Sw_integer); virtual;
  135. procedure Draw; virtual;
  136. function GetPalette: PPalette; virtual;
  137. procedure HandleEvent(var Event: TEvent); virtual;
  138. destructor Done; virtual;
  139. private
  140. Flags : word;
  141. Current : Sw_integer;
  142. end;
  143. TBrowserWindow = object(TFPWindow)
  144. constructor Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Sw_Integer;ASym : PSymbol;
  145. const AName,APrefix: string; ASymbols: PSymbolCollection; AReferences: PReferenceCollection;
  146. AInheritance: PObjectSymbol; AMemInfo: PSymbolMemInfo);
  147. procedure HandleEvent(var Event: TEvent); virtual;
  148. procedure SetState(AState: Word; Enable: Boolean); virtual;
  149. procedure Close; virtual;
  150. procedure SelectTab(BrowserTab: Sw_integer); virtual;
  151. function GetPalette: PPalette; virtual;
  152. destructor Done;virtual;
  153. private
  154. PageTab : PBrowserTab;
  155. ST : PStaticText;
  156. Sym : PSymbol;
  157. ScopeView : PSymbolScopeView;
  158. ReferenceView : PSymbolReferenceView;
  159. InheritanceView: PSymbolInheritanceView;
  160. MemInfoView : PSymbolMemInfoView;
  161. Prefix : PString;
  162. IsValid : boolean;
  163. DebuggerValue : PGDBValue;
  164. end;
  165. procedure OpenSymbolBrowser(X,Y: Sw_integer;const Name,Line: string;S : PSymbol;
  166. ParentBrowser : PBrowserWindow;
  167. Symbols: PSymbolCollection; References: PReferenceCollection;
  168. Inheritance: PObjectSymbol; MemInfo: PSymbolMemInfo);
  169. function IsSymbolInfoAvailable: boolean;
  170. procedure OpenOneSymbolBrowser(Name : String);
  171. procedure CloseAllBrowsers;
  172. procedure RemoveBrowsersCollection;
  173. const
  174. GlobalsCollection : PSortedCollection = nil;
  175. ModulesCollection : PSortedCollection = nil;
  176. implementation
  177. uses Commands,App,
  178. {$ifdef BROWSERCOL}
  179. symconst,
  180. {$endif BROWSERCOL}
  181. WUtils,WEditor,
  182. FPConst,FPString,FPUtils,FPVars,{$ifndef FPDEBUG}FPDebug{$endif},FPIDE;
  183. procedure CloseAllBrowsers;
  184. procedure SendCloseIfBrowser(P: PView); {$ifndef FPC}far;{$endif}
  185. begin
  186. if assigned(P) and
  187. ((TypeOf(P^)=TypeOf(TBrowserWindow)) or
  188. (TypeOf(P^)=TypeOf(TSymbolView)) or
  189. (TypeOf(P^)=TypeOf(TSymbolScopeView)) or
  190. (TypeOf(P^)=TypeOf(TSymbolReferenceView)) or
  191. (TypeOf(P^)=TypeOf(TSymbolMemInfoView)) or
  192. (TypeOf(P^)=TypeOf(TSymbolInheritanceView))) then
  193. Message(P,evCommand,cmClose,nil);
  194. end;
  195. begin
  196. Desktop^.ForEach(@SendCloseIfBrowser);
  197. end;
  198. procedure RemoveBrowsersCollection;
  199. begin
  200. if assigned(GlobalsCollection) then
  201. begin
  202. GlobalsCollection^.deleteAll;
  203. Dispose(GlobalsCollection,done);
  204. GlobalsCollection:=nil;
  205. end;
  206. if assigned(ModulesCollection) then
  207. begin
  208. ModulesCollection^.deleteAll;
  209. Dispose(ModulesCollection,done);
  210. ModulesCollection:=nil;
  211. end;
  212. end;
  213. function NewBrowserTabItem(ASign: char; ALink: PView; ANext: PBrowserTabItem): PBrowserTabItem;
  214. var P: PBrowserTabItem;
  215. begin
  216. New(P); FillChar(P^,SizeOf(P^),0);
  217. with P^ do begin Sign:=ASign; Link:=ALink; Next:=ANext; end;
  218. NewBrowserTabItem:=P;
  219. end;
  220. procedure DisposeBrowserTabItem(P: PBrowserTabItem);
  221. begin
  222. if P<>nil then Dispose(P);
  223. end;
  224. procedure DisposeBrowserTabList(P: PBrowserTabItem);
  225. begin
  226. if P<>nil then
  227. begin
  228. if P^.Next<>nil then DisposeBrowserTabList(P^.Next);
  229. DisposeBrowserTabItem(P);
  230. end;
  231. end;
  232. function IsSymbolInfoAvailable: boolean;
  233. begin
  234. IsSymbolInfoAvailable:=BrowCol.Modules<>nil;
  235. end;
  236. procedure OpenOneSymbolBrowser(Name : String);
  237. var Index : sw_integer;
  238. PS,S : PSymbol;
  239. Anc : PObjectSymbol;
  240. P : Pstring;
  241. Symbols: PSymbolCollection;
  242. function Search(P : PSymbol) : boolean;
  243. begin
  244. Search:=UpcaseStr(P^.Items^.LookUp(Name,Index))=Name;
  245. end;
  246. begin
  247. Name:=UpcaseStr(Name);
  248. If BrowCol.Modules<>nil then
  249. begin
  250. PS:=BrowCol.Modules^.FirstThat(@Search);
  251. If assigned(PS) then
  252. begin
  253. S:=PS^.Items^.At(Index);
  254. Symbols:=S^.Items;
  255. if (not assigned(symbols) or (symbols^.count=0)) and
  256. assigned(S^.Ancestor) then
  257. Symbols:=S^.Ancestor^.Items;
  258. if (S^.Flags and sfObject)=0 then
  259. Anc:=nil
  260. else if S^.Ancestor=nil then
  261. Anc:=ObjectTree
  262. else
  263. Anc:=SearchObjectForSymbol(S^.Ancestor);
  264. OpenSymbolBrowser(0,20,
  265. PS^.Items^.At(Index)^.GetName,
  266. PS^.Items^.At(Index)^.GetText,
  267. PS^.Items^.At(Index),nil,
  268. Symbols,PS^.Items^.At(Index)^.References,Anc,PS^.MemInfo);
  269. end
  270. else
  271. begin
  272. P:=@Name;
  273. ErrorBox(msg_symbolnotfound,@P);
  274. end;
  275. end
  276. else
  277. ErrorBox(msg_nobrowserinfoavailable,nil);
  278. end;
  279. (*procedure ReadBrowseLog(FileName: string);
  280. var f: text;
  281. IOOK,EndOfFile: boolean;
  282. Line: string;
  283. procedure NextLine;
  284. begin
  285. readln(f,Line);
  286. EndOfFile:=Eof(f);
  287. end;
  288. var Level: integer;
  289. procedure ProcessSymTable(Indent: integer; Owner: PSymbolCollection);
  290. var IndentS,S,Source: string;
  291. Sym: PSymbol;
  292. Ref: PSymbolReference;
  293. P: byte;
  294. PX: TPoint;
  295. PS: PString;
  296. PCount: integer;
  297. Params: array[0..30] of PString;
  298. Typ: tsymtyp;
  299. ExitBack: boolean;
  300. begin
  301. Inc(Level);
  302. IndentS:=CharStr(' ',Indent); ExitBack:=false;
  303. Sym:=nil;
  304. repeat
  305. if copy(Line,1,length(IndentS))<>IndentS then ExitBack:=true else
  306. if copy(Line,Indent+1,3)='***' then
  307. { new symbol }
  308. begin
  309. S:=copy(Line,Indent+1+3,255);
  310. P:=Pos('***',S); if P=0 then P:=length(S)+1;
  311. S:=Trim(copy(S,1,P-1));
  312. if (copy(S,1,1)='_') and (Pos('$$',S)>0) then
  313. begin
  314. repeat
  315. P:=Pos('$$',S);
  316. if P>0 then Delete(S,1,P+1);
  317. until P=0;
  318. P:=Pos('$',S);
  319. Delete(S,1,P);
  320. PCount:=0;
  321. repeat
  322. P:=Pos('$',S); if P=0 then P:=length(S)+1;
  323. Params[PCount]:=TypeNames^.Add(copy(S,1,P-1));
  324. Inc(PCount);
  325. Delete(S,1,P);
  326. until S='';
  327. Sym^.Typ:=procsym;
  328. Sym^.SetParams(PCount,@Params);
  329. end
  330. else
  331. New(Sym, Init(S, varsym, 0, nil));
  332. Owner^.Insert(Sym);
  333. NextLine;
  334. end else
  335. if copy(Line,Indent+1,3)='---' then
  336. { child symtable }
  337. begin
  338. S:=Trim(copy(Line,Indent+1+12,255));
  339. if Level=1 then Typ:=unitsym else
  340. Typ:=typesym;
  341. if (Sym<>nil) and (Sym^.GetName=S) then
  342. else
  343. begin
  344. New(Sym, Init(S, Typ, 0, nil));
  345. Owner^.Insert(Sym);
  346. end;
  347. Sym^.Typ:=Typ;
  348. NextLine;
  349. New(Sym^.Items, Init(0,50));
  350. ProcessSymTable(Indent+2,Sym^.Items);
  351. end else
  352. { if Sym<>nil then}
  353. if copy(Line,Indent+1,1)=' ' then
  354. { reference }
  355. begin
  356. S:=copy(Line,Indent+1+2,255);
  357. P:=Pos('(',S); if P=0 then P:=length(S)+1;
  358. Source:=Trim(copy(S,1,P-1)); Delete(S,1,P);
  359. P:=Pos(',',S); if P=0 then P:=length(S)+1;
  360. PX.Y:=StrToInt(copy(S,1,P-1)); Delete(S,1,P);
  361. P:=Pos(')',S); if P=0 then P:=length(S)+1;
  362. PX.X:=StrToInt(copy(S,1,P-1)); Delete(S,1,P);
  363. PS:=ModuleNames^.Add(Source);
  364. New(Ref, Init(PS, PX));
  365. if Sym^.References=nil then
  366. New(Sym^.References, Init(10,50));
  367. Sym^.References^.Insert(Ref);
  368. end;
  369. if ExitBack=false then
  370. NextLine;
  371. until EndOfFile or ExitBack;
  372. Dec(Level);
  373. end;
  374. begin
  375. DoneSymbolBrowser;
  376. InitSymbolBrowser;
  377. {$I-}
  378. Assign(f,FileName);
  379. Reset(f);
  380. Level:=0;
  381. NextLine;
  382. while (IOResult=0) and (EndOfFile=false) do
  383. ProcessSymTable(0,Modules);
  384. Close(f);
  385. EatIO;
  386. {$I+}
  387. end;*)
  388. {****************************************************************************
  389. TGDBValue
  390. ****************************************************************************}
  391. constructor TGDBValue.Init(Const AExpr : String;ASym : PSymbol);
  392. begin
  393. St := nil;
  394. S := ASym;
  395. Expr:=NewStr(AExpr);
  396. GDBI:=-1;
  397. end;
  398. destructor TGDBValue.Done;
  399. begin
  400. If Assigned(St) then
  401. DisposeStr(St);
  402. If Assigned(Expr) then
  403. DisposeStr(Expr);
  404. end;
  405. procedure TGDBValue.GetValue;
  406. begin
  407. {$ifdef BROWSERCOL}
  408. {$ifndef NODEBUG}
  409. if not assigned(Debugger) then
  410. exit;
  411. if not Debugger^.IsRunning then
  412. exit;
  413. if (S^.typ<>varsym) or (GDBI=Debugger^.RunCount) then
  414. exit;
  415. If Assigned(St) then
  416. DisposeStr(St);
  417. if assigned(Expr) then
  418. begin
  419. St:=NewStr(GetPChar(Debugger^.GetValue(Expr^)));
  420. GDBI:=Debugger^.RunCount;
  421. end;
  422. {$endif ndef NODEBUG}
  423. {$endif BROWSERCOL}
  424. end;
  425. function TGDBValue.GetText : String;
  426. begin
  427. GetValue;
  428. if assigned(St) then
  429. GetText:=S^.GetText+' = '+GetStr(St)
  430. else
  431. GetText:=S^.GetText;
  432. end;
  433. {****************************************************************************
  434. TGDBValueCollection
  435. ****************************************************************************}
  436. function TGDBValueCollection.At(Index: sw_Integer): PGDBValue;
  437. begin
  438. At:= Inherited At(Index);
  439. end;
  440. {****************************************************************************
  441. TSymbolView
  442. ****************************************************************************}
  443. constructor TSymbolView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  444. begin
  445. inherited Init(Bounds,1,AVScrollBar);
  446. HScrollBar:=AHScrollBar;
  447. MyBW:=nil;
  448. if assigned(HScrollBar) then
  449. HScrollBar^.SetRange(1,80);
  450. Options:=Options or (ofSelectable+ofTopSelect);
  451. EventMask:=EventMask or evBroadcast;
  452. end;
  453. procedure TSymbolView.ClearHighlights;
  454. begin
  455. Message(Desktop,evBroadcast,cmClearLineHighlights,nil);
  456. end;
  457. procedure TSymbolView.AutoTrackSource;
  458. begin
  459. if Range>0 then
  460. TrackSource;
  461. end;
  462. procedure TSymbolView.OptionsDlg;
  463. begin
  464. { Abstract }
  465. end;
  466. procedure TSymbolView.SetState(AState: Word; Enable: Boolean);
  467. var OState: longint;
  468. begin
  469. OState:=State;
  470. inherited SetState(AState,Enable);
  471. if ((OState xor State) and sfFocused)<>0 then
  472. if GetState(sfFocused) then
  473. begin
  474. if (MiscOptions and moAutoTrackSource)<>0 then
  475. AutoTrackSource;
  476. end
  477. else
  478. Message(Desktop,evBroadcast,cmClearLineHighlights,nil);
  479. end;
  480. procedure TSymbolView.Browse;
  481. begin
  482. SelectItem(Focused);
  483. end;
  484. procedure TSymbolView.GotoSource;
  485. begin
  486. if GotoItem(Focused) then
  487. PutCommand(Owner,evCommand,cmClose,nil);
  488. end;
  489. procedure TSymbolView.TrackSource;
  490. begin
  491. TrackItem(Focused,false);
  492. end;
  493. procedure TSymbolView.HandleEvent(var Event: TEvent);
  494. var DontClear: boolean;
  495. begin
  496. case Event.What of
  497. evKeyDown :
  498. begin
  499. DontClear:=false;
  500. case Event.KeyCode of
  501. kbEnter :
  502. Browse;
  503. kbCtrlEnter :
  504. GotoSource;
  505. kbSpaceBar :
  506. TrackSource;
  507. kbRight,kbLeft :
  508. if HScrollBar<>nil then
  509. HScrollBar^.HandleEvent(Event);
  510. else DontClear:=true;
  511. end;
  512. if DontClear=false then ClearEvent(Event);
  513. end;
  514. evMouseDown :
  515. begin
  516. if Event.double then
  517. begin
  518. Browse;
  519. ClearEvent(Event);
  520. end;
  521. end;
  522. evCommand :
  523. begin
  524. DontClear:=false;
  525. case Event.Command of
  526. cmSymBrowse :
  527. Browse;
  528. cmSymGotoSource :
  529. GotoSource;
  530. cmSymTrackSource :
  531. TrackSource;
  532. cmSymOptions :
  533. OptionsDlg;
  534. else DontClear:=true;
  535. end;
  536. if DontClear=false then ClearEvent(Event);
  537. end;
  538. evBroadcast :
  539. case Event.Command of
  540. cmListFocusChanged :
  541. if Event.InfoPtr=@Self then
  542. if (MiscOptions and moAutoTrackSource)<>0 then
  543. if GetState(sfFocused) then
  544. AutoTrackSource;
  545. end;
  546. end;
  547. inherited HandleEvent(Event);
  548. end;
  549. function TSymbolView.GetPalette: PPalette;
  550. const
  551. P: string[length(CBrowserListBox)] = CBrowserListBox;
  552. begin
  553. GetPalette:=@P;
  554. end;
  555. function TSymbolView.GetLocalMenu: PMenu;
  556. begin
  557. GetLocalMenu:=NewMenu(
  558. NewItem(menu_symlocal_browse,'',kbNoKey,cmSymBrowse,hcSymBrowse,
  559. NewItem(menu_symlocal_gotosource,'',kbNoKey,cmSymGotoSource,hcSymGotoSource,
  560. NewItem(menu_symlocal_tracksource,'',kbNoKey,cmSymTrackSource,hcSymTrackSource,
  561. NewLine(
  562. NewItem(menu_symlocal_options,'',kbNoKey,cmSymOptions,hcSymOptions,
  563. nil))))));
  564. end;
  565. function TSymbolView.GotoItem(Item: sw_integer): boolean;
  566. begin
  567. SelectItem(Item);
  568. GotoItem:=true;
  569. end;
  570. function TSymbolView.TrackItem(Item: sw_integer; AutoTrack: boolean): boolean;
  571. begin
  572. SelectItem(Item);
  573. TrackItem:=true;
  574. end;
  575. function LastBrowserWindow: PBrowserWindow;
  576. var BW: PBrowserWindow;
  577. procedure IsBW(P: PView); {$ifndef FPC}far;{$endif}
  578. begin
  579. if (P^.HelpCtx=hcBrowserWindow) then
  580. BW:=pointer(P);
  581. end;
  582. begin
  583. BW:=nil;
  584. Desktop^.ForEach(@IsBW);
  585. LastBrowserWindow:=BW;
  586. end;
  587. function TSymbolView.TrackReference(R: PReference; AutoTrack: boolean): boolean;
  588. var W: PSourceWindow;
  589. BW: PBrowserWindow;
  590. P: TPoint;
  591. begin
  592. ClearHighlights;
  593. Desktop^.Lock;
  594. P.X:=R^.Position.X-1; P.Y:=R^.Position.Y-1;
  595. if AutoTrack then
  596. W:=SearchOnDesktop(R^.GetFileName,false)
  597. else
  598. W:=TryToOpenFile(nil,R^.GetFileName,P.X,P.Y,true);
  599. if W<>nil then
  600. begin
  601. BW:=LastBrowserWindow;
  602. if BW=nil then
  603. W^.Select
  604. else
  605. begin
  606. Desktop^.Delete(W);
  607. Desktop^.InsertBefore(W,BW^.NextView);
  608. end;
  609. W^.Editor^.SetLineFlagExclusive(lfHighlightRow,P.Y);
  610. end;
  611. Desktop^.UnLock;
  612. if Assigned(W)=false then
  613. ErrorBox(FormatStrStr(msg_cantfindfile,R^.GetFileName),nil);
  614. TrackReference:=W<>nil;
  615. end;
  616. function TSymbolView.GotoReference(R: PReference): boolean;
  617. var W: PSourceWindow;
  618. begin
  619. Desktop^.Lock;
  620. W:=TryToOpenFile(nil,R^.GetFileName,R^.Position.X-1,R^.Position.Y-1,true);
  621. if Assigned(W) then
  622. W^.Select;
  623. Desktop^.UnLock;
  624. if Assigned(W)=false then
  625. ErrorBox(FormatStrStr(msg_cantfindfile,R^.GetFileName),nil);
  626. GotoReference:=W<>nil;
  627. end;
  628. {****************************************************************************
  629. TSymbolScopeView
  630. ****************************************************************************}
  631. constructor TSymbolScopeView.Init(var Bounds: TRect; ASymbols: PSymbolCollection; AHScrollBar, AVScrollBar: PScrollBar);
  632. begin
  633. inherited Init(Bounds,AHScrollBar, AVScrollBar);
  634. Symbols:=ASymbols;
  635. NewList(ASymbols);
  636. New(SymbolsValue,Init(50,50));
  637. SetRange(Symbols^.Count);
  638. end;
  639. destructor TSymbolScopeView.Done;
  640. begin
  641. {if assigned(Symbols) then
  642. begin
  643. the elements belong to other lists
  644. Symbols^.DeleteAll;
  645. dispose(Symbols,done);
  646. end;}
  647. Inherited Done;
  648. end;
  649. procedure TSymbolScopeView.HandleEvent(var Event: TEvent);
  650. var OldFocus: sw_integer;
  651. begin
  652. case Event.What of
  653. evKeyDown :
  654. case Event.KeyCode of
  655. kbBack :
  656. begin
  657. LookUp(copy(LookUpStr,1,length(LookUpStr)-1));
  658. ClearEvent(Event);
  659. end;
  660. else
  661. if Event.CharCode in[#33..#255] then
  662. begin
  663. LookUp(LookUpStr+Event.CharCode);
  664. ClearEvent(Event);
  665. end;
  666. end;
  667. end;
  668. OldFocus:=Focused;
  669. inherited HandleEvent(Event);
  670. if OldFocus<>Focused then
  671. Lookup('');
  672. end;
  673. procedure TSymbolScopeView.Draw;
  674. begin
  675. inherited Draw;
  676. SetCursor(2+SymbolTypLen+length(LookUpStr),Focused-TopItem);
  677. end;
  678. procedure TSymbolScopeView.LookUp(S: string);
  679. var Idx,Slength: Sw_integer;
  680. NS: string;
  681. begin
  682. NS:=LookUpStr;
  683. Slength:=Length(S);
  684. if (Symbols=nil) or (S='') then NS:='' else
  685. begin
  686. S:=Symbols^.LookUp(S,Idx);
  687. if Idx<>-1 then
  688. begin
  689. NS:=S;
  690. FocusItem(Idx);
  691. end;
  692. end;
  693. LookUpStr:=Copy(NS,1,Slength);
  694. SetState(sfCursorVis,LookUpStr<>'');
  695. DrawView;
  696. end;
  697. function TSymbolScopeView.GotoItem(Item: sw_integer): boolean;
  698. var S: PSymbol;
  699. OK: boolean;
  700. begin
  701. OK:=Range>0;
  702. if OK then
  703. begin
  704. S:=List^.At(Item);
  705. OK:=(S^.References<>nil) and (S^.References^.Count>0);
  706. if OK then
  707. OK:=GotoReference(S^.References^.At(0));
  708. end;
  709. GotoItem:=OK;
  710. end;
  711. function TSymbolScopeView.TrackItem(Item: sw_integer; AutoTrack: boolean): boolean;
  712. var S: PSymbol;
  713. OK: boolean;
  714. begin
  715. OK:=Range>0;
  716. if OK then
  717. begin
  718. S:=List^.At(Item);
  719. OK:=(S^.References<>nil) and (S^.References^.Count>0);
  720. if OK then
  721. OK:=TrackReference(S^.References^.At(0),AutoTrack);
  722. end;
  723. TrackItem:=OK;
  724. end;
  725. procedure TSymbolScopeView.SetGDBCol;
  726. var S : PSymbol;
  727. I : sw_integer;
  728. begin
  729. if assigned(MyBW) and (SymbolsValue^.Count=0) then
  730. begin
  731. For i:=0 to Symbols^.Count-1 do
  732. begin
  733. S:=Symbols^.At(I);
  734. SymbolsValue^.Insert(New(PGDBValue,Init(GetStr(MyBW^.Prefix)+S^.GetName,S)));
  735. end;
  736. end;
  737. end;
  738. function TSymbolScopeView.GetText(Item,MaxLen: Sw_Integer): String;
  739. var S1: string;
  740. S : PSymbol;
  741. SG : PGDBValue;
  742. begin
  743. S:=Symbols^.At(Item);
  744. SG:=SymbolsValue^.At(Item);
  745. if assigned(SG) then
  746. S1:=SG^.getText
  747. else
  748. S1:=S^.GetText;
  749. GetText:=copy(S1,1,MaxLen);
  750. end;
  751. {****************************************************************************
  752. TSymbolReferenceView
  753. ****************************************************************************}
  754. constructor TSymbolReferenceView.Init(var Bounds: TRect; AReferences: PReferenceCollection;
  755. AHScrollBar, AVScrollBar: PScrollBar);
  756. begin
  757. inherited Init(Bounds,AHScrollBar, AVScrollBar);
  758. References:=AReferences;
  759. NewList(AReferences);
  760. SetRange(References^.Count);
  761. end;
  762. destructor TSymbolReferenceView.Done;
  763. begin
  764. Inherited Done;
  765. end;
  766. procedure TSymbolReferenceView.HandleEvent(var Event: TEvent);
  767. var OldFocus: sw_integer;
  768. DontClear: boolean;
  769. begin
  770. OldFocus:=Focused;
  771. { case Event.What of
  772. evKeyDown :
  773. begin
  774. DontClear:=false;
  775. case Event.KeyCode of
  776. kbEnter :
  777. TrackItem(Focused,false);
  778. kbCtrlEnter :
  779. GotoItem(Focused);
  780. else DontClear:=true;
  781. end;
  782. if DontClear=false then ClearEvent(Event);
  783. end;
  784. end;}
  785. inherited HandleEvent(Event);
  786. if OldFocus<>Focused then
  787. if (MiscOptions and moAutoTrackSource)=0 then
  788. ClearHighlights;
  789. end;
  790. procedure TSymbolReferenceView.Browse;
  791. begin
  792. { do nothing here }
  793. end;
  794. function TSymbolReferenceView.GetText(Item,MaxLen: Sw_Integer): String;
  795. var S: string;
  796. P: PReference;
  797. begin
  798. P:=References^.At(Item);
  799. S:=P^.GetFileName+'('+IntToStr(P^.Position.Y)+','+IntToStr(P^.Position.X)+')';
  800. GetText:=copy(S,1,MaxLen);
  801. end;
  802. function TSymbolReferenceView.GotoItem(Item: sw_integer): boolean;
  803. var OK: boolean;
  804. begin
  805. OK:=Range>0;
  806. if OK then
  807. OK:=GotoReference(List^.At(Item));
  808. GotoItem:=OK;
  809. end;
  810. function TSymbolReferenceView.TrackItem(Item: sw_integer; AutoTrack: boolean): boolean;
  811. var OK: boolean;
  812. begin
  813. OK:=Range>0;
  814. if OK then
  815. OK:=TrackReference(List^.At(Item),AutoTrack);
  816. TrackItem:=OK;
  817. end;
  818. procedure TSymbolReferenceView.SelectItem(Item: Sw_Integer);
  819. begin
  820. GotoItem(Item);
  821. end;
  822. constructor TSymbolMemInfoView.Init(var Bounds: TRect; AMemInfo: PSymbolMemInfo);
  823. begin
  824. inherited Init(Bounds,'');
  825. Options:=Options or (ofSelectable+ofTopSelect);
  826. MemInfo:=AMemInfo;
  827. MyBW:=nil;
  828. end;
  829. destructor TSymbolMemInfoView.Done;
  830. begin
  831. { if assigned(MemInfo) then
  832. dispose(MemInfo);}
  833. Inherited Done;
  834. end;
  835. procedure TSymbolMemInfoView.GetText(var S: String);
  836. function SizeStr(Size: longint): string;
  837. var S: string[40];
  838. begin
  839. S:=IntToStrL(Size,7);
  840. S:=S+' byte';
  841. if Size>1 then S:=S+'s';
  842. SizeStr:=S;
  843. end;
  844. function AddrStr(Addr: longint): string;
  845. { Warning this is endian specific code !! (PM) }
  846. type TLongint = record LoW,HiW: word; end;
  847. begin
  848. with TLongint(Addr) do
  849. AddrStr:='$'+IntToHexL(HiW,4)+IntToHexL(HiW,4);
  850. end;
  851. begin
  852. ClearFormatParams;
  853. AddFormatParamStr(msg_sizeinmemory);
  854. AddFormatParamStr(msg_sizeonstack);
  855. S:=
  856. #13+
  857. { ' Memory location: '+AddrStr(MemInfo^.Addr)+#13+
  858. ' Local address: '+AddrStr(MemInfo^.LocalAddr)+#13+}
  859. { ??? internal linker ??? }
  860. '%18s: '+SizeStr(MemInfo^.Size)+#13+
  861. '%18s: '+SizeStr(MemInfo^.PushSize)+#13+
  862. ''
  863. ;
  864. end;
  865. function TSymbolMemInfoView.GetPalette: PPalette;
  866. begin
  867. GetPalette:=inherited GetPalette;
  868. end;
  869. {****************************************************************************
  870. TSymbolInheritanceView
  871. ****************************************************************************}
  872. constructor TSymbolInheritanceView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar; ARoot: PObjectSymbol);
  873. begin
  874. inherited Init(Bounds,AHScrollBar,AVScrollBar);
  875. Options:=Options or (ofSelectable+ofTopSelect);
  876. Root:=ARoot;
  877. MyBW:=nil;
  878. ExpandAll(GetRoot);
  879. Update;
  880. end;
  881. destructor TSymbolInheritanceView.Done;
  882. begin
  883. { do not dispose,
  884. belongs to a symbolcollection (PM)
  885. if assigned(Root) then
  886. dispose(Root,done); }
  887. Inherited Done;
  888. end;
  889. function TSymbolInheritanceView.GetRoot: Pointer;
  890. begin
  891. GetRoot:=Root;
  892. end;
  893. function TSymbolInheritanceView.HasChildren(Node: Pointer): Boolean;
  894. begin
  895. HasChildren:=GetNumChildren(Node)>0;
  896. end;
  897. function TSymbolInheritanceView.GetChild(Node: Pointer; I: Integer): Pointer;
  898. begin
  899. GetChild:=PObjectSymbol(Node)^.GetDescendant(I);
  900. end;
  901. function TSymbolInheritanceView.GetNumChildren(Node: Pointer): Integer;
  902. begin
  903. GetNumChildren:=PObjectSymbol(Node)^.GetDescendantCount;
  904. end;
  905. function TSymbolInheritanceView.GetText(Node: Pointer): String;
  906. begin
  907. GetText:=PObjectSymbol(Node)^.GetName;
  908. end;
  909. procedure TSymbolInheritanceView.Adjust(Node: Pointer; Expand: Boolean);
  910. begin
  911. PObjectSymbol(Node)^.Expanded:=Expand;
  912. end;
  913. function TSymbolInheritanceView.IsExpanded(Node: Pointer): Boolean;
  914. begin
  915. IsExpanded:=PObjectSymbol(Node)^.Expanded;
  916. end;
  917. procedure TSymbolInheritanceView.HandleEvent(var Event: TEvent);
  918. var DontClear: boolean;
  919. begin
  920. case Event.What of
  921. evKeyDown :
  922. begin
  923. DontClear:=false;
  924. case Event.KeyCode of
  925. kbLeft,kbRight,
  926. kbCtrlLeft,kbCtrlRight :
  927. if Assigned(HScrollBar) then
  928. HScrollBar^.HandleEvent(Event)
  929. else
  930. DontClear:=true;
  931. else DontClear:=true;
  932. end;
  933. if DontClear=false then ClearEvent(Event);
  934. end;
  935. end;
  936. inherited HandleEvent(Event);
  937. end;
  938. function TSymbolInheritanceView.GetPalette: PPalette;
  939. const P: string[length(CBrowserOutline)] = CBrowserOutline;
  940. begin
  941. GetPalette:=@P;
  942. end;
  943. procedure TSymbolInheritanceView.Selected(I: Integer);
  944. var P: pointer;
  945. S: PSymbol;
  946. St : String;
  947. Anc: PObjectSymbol;
  948. begin
  949. P:=GetNode(I);
  950. if P=nil then Exit;
  951. S:=PObjectSymbol(P)^.Symbol;
  952. { this happens for the top objects view (PM) }
  953. if S=nil then exit;
  954. st:=S^.GetName;
  955. if S^.Ancestor=nil then
  956. Anc:=ObjectTree
  957. else
  958. Anc:=SearchObjectForSymbol(S^.Ancestor);
  959. OpenSymbolBrowser(Origin.X-1,FOC-Delta.Y+1,
  960. st,
  961. S^.GetText,S,nil,
  962. S^.Items,S^.References,Anc,S^.MemInfo);
  963. end;
  964. {****************************************************************************
  965. TBrowserTab
  966. ****************************************************************************}
  967. constructor TBrowserTab.Init(var Bounds: TRect; AItems: PBrowserTabItem);
  968. begin
  969. inherited Init(Bounds);
  970. Options:=Options or ofPreProcess;
  971. Items:=AItems;
  972. SetParams(0,0);
  973. end;
  974. procedure TBrowserTab.SetParams(AFlags: word; ACurrent: Sw_integer);
  975. begin
  976. Flags:=AFlags;
  977. SelectItem(ACurrent);
  978. end;
  979. procedure TBrowserTab.SelectItem(Index: Sw_integer);
  980. var P: PBrowserTabItem;
  981. begin
  982. Current:=Index;
  983. P:=GetItem(Current);
  984. if (P<>nil) and (P^.Link<>nil) then
  985. P^.Link^.Focus;
  986. DrawView;
  987. end;
  988. function TBrowserTab.GetItemCount: sw_integer;
  989. var Count: integer;
  990. P: PBrowserTabItem;
  991. begin
  992. Count:=0; P:=Items;
  993. while (P<>nil) do
  994. begin
  995. Inc(Count);
  996. P:=P^.Next;
  997. end;
  998. GetItemCount:=Count;
  999. end;
  1000. function TBrowserTab.GetItem(Index: sw_integer): PBrowserTabItem;
  1001. var Counter: integer;
  1002. P: PBrowserTabItem;
  1003. begin
  1004. P:=Items; Counter:=0;
  1005. while (P<>nil) and (Counter<Index) do
  1006. begin
  1007. P:=P^.Next;
  1008. Inc(Counter);
  1009. end;
  1010. GetItem:=P;
  1011. end;
  1012. procedure TBrowserTab.Draw;
  1013. var B: TDrawBuffer;
  1014. SelColor, NormColor, C: word;
  1015. I,CurX,Count: Sw_integer;
  1016. function Names(Idx: integer): char;
  1017. begin
  1018. Names:=GetItem(Idx)^.Sign;
  1019. end;
  1020. begin
  1021. NormColor:=GetColor(1); SelColor:=GetColor(2);
  1022. MoveChar(B,'Ä',SelColor,Size.X);
  1023. CurX:=0; Count:=0;
  1024. for I:=0 to GetItemCount-1 do
  1025. if (Flags and (1 shl I))<>0 then
  1026. begin
  1027. Inc(Count);
  1028. if Current=I then C:=SelColor
  1029. else C:=NormColor;
  1030. if Count=1 then MoveChar(B[CurX],'´',SelColor,1)
  1031. else MoveChar(B[CurX],'³',SelColor,1);
  1032. MoveCStr(B[CurX+1],' '+Names(I)+' ',C);
  1033. Inc(CurX,4);
  1034. end;
  1035. if Count>0 then
  1036. MoveChar(B[CurX],'Ã',SelColor,1);
  1037. WriteLine(0,0,Size.X,Size.Y,B);
  1038. end;
  1039. procedure TBrowserTab.HandleEvent(var Event: TEvent);
  1040. var I,Idx: integer;
  1041. DontClear: boolean;
  1042. P: TPoint;
  1043. function GetItemForCoord(X: integer): integer;
  1044. var I,CurX,Idx: integer;
  1045. begin
  1046. CurX:=0; Idx:=-1;
  1047. for I:=0 to GetItemCount-1 do
  1048. if (Flags and (1 shl I))<>0 then
  1049. begin
  1050. if (CurX+1<=X) and (X<=CurX+3) then
  1051. begin Idx:=I; Break; end;
  1052. Inc(CurX,4);
  1053. end;
  1054. GetItemForCoord:=Idx;
  1055. end;
  1056. begin
  1057. case Event.What of
  1058. evMouseDown :
  1059. if MouseInView(Event.Where) then
  1060. begin
  1061. repeat
  1062. MakeLocal(Event.Where,P);
  1063. Idx:=GetItemForCoord(P.X);
  1064. if Idx<>-1 then
  1065. SelectItem(Idx);
  1066. until not MouseEvent(Event, evMouseMove);
  1067. ClearEvent(Event);
  1068. end;
  1069. evKeyDown :
  1070. begin
  1071. DontClear:=false; Idx:=-1;
  1072. for I:=0 to GetItemCount-1 do
  1073. if GetCtrlCode(GetItem(I)^.Sign)=Event.KeyCode then
  1074. if (Flags and (1 shl I))<>0 then
  1075. begin
  1076. Idx:=I;
  1077. Break;
  1078. end;
  1079. if Idx=-1 then
  1080. DontClear:=true
  1081. else
  1082. SelectItem(Idx);
  1083. if DontClear=false then ClearEvent(Event);
  1084. end;
  1085. end;
  1086. inherited HandleEvent(Event);
  1087. end;
  1088. function TBrowserTab.GetPalette: PPalette;
  1089. const P: string[length(CBrowserTab)] = CBrowserTab;
  1090. begin
  1091. GetPalette:=@P;
  1092. end;
  1093. destructor TBrowserTab.Done;
  1094. begin
  1095. if Items<>nil then DisposeBrowserTabList(Items);
  1096. inherited Done;
  1097. end;
  1098. constructor TBrowserWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Sw_Integer;ASym : PSymbol;
  1099. const AName,APrefix: string; ASymbols: PSymbolCollection; AReferences: PReferenceCollection;
  1100. AInheritance: PObjectSymbol; AMemInfo: PSymbolMemINfo);
  1101. var R: TRect;
  1102. HSB,VSB: PScrollBar;
  1103. function CreateVSB(R: TRect): PScrollBar;
  1104. var R2: TRect;
  1105. SB: PScrollBar;
  1106. begin
  1107. R2.Copy(R); R2.Move(1,0); R2.A.X:=R2.B.X-1;
  1108. New(SB, Init(R2)); SB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  1109. CreateVSB:=SB;
  1110. end;
  1111. function CreateHSB(R: TRect): PScrollBar;
  1112. var R2: TRect;
  1113. SB: PScrollBar;
  1114. begin
  1115. R2.Copy(R); R2.Move(0,1); R2.A.Y:=R2.B.Y-1;
  1116. New(SB, Init(R2)); SB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY;
  1117. CreateHSB:=SB;
  1118. end;
  1119. begin
  1120. inherited Init(Bounds, FormatStrStr(dialog_browse,ATitle), ANumber);
  1121. HelpCtx:=hcBrowserWindow;
  1122. Sym:=ASym;
  1123. Prefix:=NewStr(APrefix);
  1124. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
  1125. {$ifndef NODEBUG}
  1126. if {assigned(Debugger) and Debugger^.IsRunning and}
  1127. assigned(Sym) and (Sym^.typ=varsym) then
  1128. begin
  1129. New(DebuggerValue,Init(ATitle,Sym));
  1130. New(ST, Init(R, ' '+DebuggerValue^.GetText));
  1131. end
  1132. else
  1133. {$endif NODEBUG}
  1134. begin
  1135. New(ST, Init(R, ' '+AName));
  1136. DebuggerValue:=nil;
  1137. end;
  1138. ST^.GrowMode:=gfGrowHiX;
  1139. Insert(ST);
  1140. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);
  1141. if assigned(ASymbols) and (ASymbols^.Count>0) then
  1142. begin
  1143. HSB:=CreateHSB(R); Insert(HSB);
  1144. VSB:=CreateVSB(R); Insert(VSB);
  1145. New(ScopeView, Init(R, ASymbols, HSB, VSB));
  1146. ScopeView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1147. Insert(ScopeView);
  1148. ScopeView^.MyBW:=@Self;
  1149. ScopeView^.SetGDBCol;
  1150. end;
  1151. if assigned(AReferences) and (AReferences^.Count>0) then
  1152. begin
  1153. HSB:=CreateHSB(R); Insert(HSB);
  1154. VSB:=CreateVSB(R); Insert(VSB);
  1155. New(ReferenceView, Init(R, AReferences, HSB, VSB));
  1156. ReferenceView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1157. Insert(ReferenceView);
  1158. ReferenceView^.MyBW:=@Self;
  1159. end;
  1160. if assigned(AInheritance) then
  1161. begin
  1162. HSB:=CreateHSB(R); Insert(HSB);
  1163. VSB:=CreateVSB(R); Insert(VSB);
  1164. New(InheritanceView, Init(R, HSB,VSB, AInheritance));
  1165. InheritanceView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1166. Insert(InheritanceView);
  1167. InheritanceView^.MyBW:=@Self;
  1168. end;
  1169. if assigned(AMemInfo) then
  1170. begin
  1171. New(MemInfoView, Init(R, AMemInfo));
  1172. MemInfoView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1173. Insert(MemInfoView);
  1174. MemInfoView^.MyBW:=@Self;
  1175. end;
  1176. GetExtent(R); R.Grow(-1,-1); R.Move(0,1); R.B.Y:=R.A.Y+1;
  1177. New(PageTab, Init(R,
  1178. NewBrowserTabItem(label_browsertab_scope,ScopeView,
  1179. NewBrowserTabItem(label_browsertab_reference,ReferenceView,
  1180. NewBrowserTabItem(label_browsertab_inheritance,InheritanceView,
  1181. NewBrowserTabItem(label_browsertab_memory,MemInfoView,
  1182. nil))
  1183. ))));
  1184. PageTab^.GrowMode:=gfGrowHiX;
  1185. Insert(PageTab);
  1186. if assigned(ScopeView) then
  1187. SelectTab(btScope)
  1188. else
  1189. if assigned(ReferenceView) then
  1190. SelectTab(btReferences)
  1191. else
  1192. if assigned(InheritanceView) then
  1193. SelectTab(btInheritance);
  1194. end;
  1195. destructor TBrowserWindow.Done;
  1196. begin
  1197. if assigned(DebuggerValue) then
  1198. begin
  1199. Dispose(DebuggerValue,Done);
  1200. DebuggerValue:=nil;
  1201. end;
  1202. inherited Done;
  1203. end;
  1204. procedure TBrowserWindow.HandleEvent(var Event: TEvent);
  1205. var DontClear: boolean;
  1206. S: PSymbol;
  1207. Symbols: PSymbolCollection;
  1208. Anc: PObjectSymbol;
  1209. P: TPoint;
  1210. begin
  1211. case Event.What of
  1212. evBroadcast :
  1213. case Event.Command of
  1214. cmDebuggerStopped :
  1215. begin
  1216. if Assigned(DebuggerValue) and
  1217. (DebuggerValue^.GDBI<>Event.InfoLong) then
  1218. begin
  1219. If Assigned(ST^.Text) then
  1220. DisposeStr(ST^.Text);
  1221. ST^.Text:=NewStr(DebuggerValue^.GetText);
  1222. ST^.DrawView;
  1223. end;
  1224. end;
  1225. cmSearchWindow :
  1226. ClearEvent(Event);
  1227. cmListItemSelected :
  1228. if Event.InfoPtr=ScopeView then
  1229. begin
  1230. S:=ScopeView^.Symbols^.At(ScopeView^.Focused);
  1231. MakeGlobal(ScopeView^.Origin,P);
  1232. Desktop^.MakeLocal(P,P); Inc(P.Y,ScopeView^.Focused-ScopeView^.TopItem);
  1233. Inc(P.Y);
  1234. if S^.Ancestor=nil then Anc:=nil else
  1235. Anc:=SearchObjectForSymbol(S^.Ancestor);
  1236. Symbols:=S^.Items;
  1237. if (not assigned(Symbols) or (symbols^.count=0)) then
  1238. if assigned(S^.Ancestor) then
  1239. Symbols:=S^.Ancestor^.Items;
  1240. if (S^.GetReferenceCount>0) or (assigned(Symbols) and (Symbols^.Count>0)) or (Anc<>nil) then
  1241. OpenSymbolBrowser(Origin.X-1,P.Y,
  1242. S^.GetName,
  1243. ScopeView^.GetText(ScopeView^.Focused,255),
  1244. S,@self,
  1245. Symbols,S^.References,Anc,S^.MemInfo);
  1246. end;
  1247. end;
  1248. { evCommand :
  1249. begin
  1250. DontClear:=false;
  1251. case Event.Command of
  1252. cmGotoSymbol :
  1253. if Event.InfoPtr=ScopeView then
  1254. if ReferenceView<>nil then
  1255. if ReferenceView^.Range>0 then
  1256. ReferenceView^.GotoItem(0);
  1257. cmTrackSymbol :
  1258. if Event.InfoPtr=ScopeView then
  1259. if (ScopeView<>nil) and (ScopeView^.Range>0) then
  1260. begin
  1261. S:=ScopeView^.At(ScopeView^.Focused);
  1262. if (S^.References<>nil) and (S^.References^.Count>0) then
  1263. TrackItem(S^.References^.At(0));
  1264. else DontClear:=true;
  1265. end;
  1266. if DontClear=false then ClearEvent(Event);
  1267. end;}
  1268. evKeyDown :
  1269. begin
  1270. DontClear:=false;
  1271. case Event.KeyCode of
  1272. kbEsc :
  1273. Close;
  1274. else DontClear:=true;
  1275. end;
  1276. if DontClear=false then ClearEvent(Event);
  1277. end;
  1278. end;
  1279. inherited HandleEvent(Event);
  1280. end;
  1281. procedure TBrowserWindow.SetState(AState: Word; Enable: Boolean);
  1282. {var OldState: word;}
  1283. begin
  1284. { OldState:=State;}
  1285. inherited SetState(AState,Enable);
  1286. { if ((State xor OldState) and sfActive)<>0 then
  1287. if GetState(sfActive)=false then
  1288. Message(Desktop,evBroadcast,cmClearLineHighlights,nil);}
  1289. end;
  1290. procedure TBrowserWindow.Close;
  1291. begin
  1292. inherited Close;
  1293. end;
  1294. procedure TBrowserWindow.SelectTab(BrowserTab: Sw_integer);
  1295. var Tabs: Sw_integer;
  1296. { PB : PBreakpoint;
  1297. PS :PString;
  1298. l : longint; }
  1299. begin
  1300. (* case BrowserTab of
  1301. btScope :
  1302. if assigned(ScopeView) then
  1303. ScopeView^.Select;
  1304. btReferences :
  1305. if assigned(ReferenceView) then
  1306. ReferenceView^.Select;
  1307. btBreakWatch :
  1308. begin
  1309. if Assigned(Sym) then
  1310. begin
  1311. if Pos('proc',Sym^.GetText)>0 then
  1312. { insert function breakpoint }
  1313. begin
  1314. { make it visible }
  1315. PS:=Sym^.Name;
  1316. l:=Length(PS^);
  1317. If PS^[l]='*' then
  1318. begin
  1319. PB:=BreakpointsCollection^.GetType(bt_function,copy(GetStr(PS),1,l-1));
  1320. If Assigned(PB) then
  1321. BreakpointsCollection^.Delete(PB);
  1322. Sym^.Name:=NewStr(copy(GetStr(PS),1,l-1));
  1323. DrawView;
  1324. DisposeStr(PS);
  1325. end
  1326. else
  1327. begin
  1328. Sym^.Name:=NewStr(GetStr(PS)+'*');
  1329. DrawView;
  1330. New(PB,init_function(GetStr(PS)));
  1331. DisposeStr(PS);
  1332. BreakpointsCollection^.Insert(PB);
  1333. BreakpointsCollection^.Update;
  1334. end;
  1335. end
  1336. else if pos('var',Sym^.GetText)>0 then
  1337. { insert watch point }
  1338. begin
  1339. { make it visible }
  1340. PS:=Sym^.Name;
  1341. l:=Length(PS^);
  1342. If PS^[l]='*' then
  1343. begin
  1344. PB:=BreakpointsCollection^.GetType(bt_awatch,copy(PS^,1,l-1));
  1345. If Assigned(PB) then
  1346. BreakpointsCollection^.Delete(PB);
  1347. Sym^.Name:=NewStr(copy(PS^,1,l-1));
  1348. DrawView;
  1349. DisposeStr(PS);
  1350. end
  1351. else
  1352. begin
  1353. Sym^.Name:=NewStr(GetStr(PS)+'*');
  1354. DrawView;
  1355. New(PB,init_type(bt_awatch,GetStr(PS)));
  1356. DisposeStr(PS);
  1357. BreakpointsCollection^.Insert(PB);
  1358. BreakpointsCollection^.Update;
  1359. end;
  1360. end;
  1361. end;
  1362. end;
  1363. end;*)
  1364. Tabs:=0;
  1365. if assigned(ScopeView) then
  1366. Tabs:=Tabs or (1 shl btScope);
  1367. if assigned(ReferenceView) then
  1368. Tabs:=Tabs or (1 shl btReferences);
  1369. if assigned(InheritanceView) then
  1370. Tabs:=Tabs or (1 shl btInheritance);
  1371. if assigned(MemInfoView) then
  1372. Tabs:=Tabs or (1 shl btMemInfo);
  1373. if Assigned(Sym) then
  1374. if (Pos('proc',Sym^.GetText)>0) or (Pos('var',Sym^.GetText)>0) then
  1375. Tabs:=Tabs or (1 shl btBreakWatch);
  1376. if PageTab<>nil then PageTab^.SetParams(Tabs,BrowserTab);
  1377. end;
  1378. function TBrowserWindow.GetPalette: PPalette;
  1379. const S: string[length(CBrowserWindow)] = CBrowserWindow;
  1380. begin
  1381. GetPalette:=@S;
  1382. end;
  1383. procedure OpenSymbolBrowser(X,Y: Sw_integer;const Name,Line: string;S : PSymbol;
  1384. ParentBrowser : PBrowserWindow;
  1385. Symbols: PSymbolCollection; References: PReferenceCollection;
  1386. Inheritance: PObjectSymbol; MemInfo: PSymbolMemInfo);
  1387. var R: TRect;
  1388. PB : PBrowserWindow;
  1389. St,st2 : string;
  1390. begin
  1391. if X=0 then X:=Desktop^.Size.X-35;
  1392. R.A.X:=X; R.A.Y:=Y;
  1393. R.B.X:=R.A.X+35; R.B.Y:=R.A.Y+15;
  1394. while (R.B.Y>Desktop^.Size.Y) do R.Move(0,-1);
  1395. if assigned(ParentBrowser) then
  1396. begin
  1397. st:=GetStr(ParentBrowser^.Prefix)+Name;
  1398. end
  1399. else
  1400. st:=Name;
  1401. st2:=st;
  1402. if assigned(S) and ((S^.Flags and sfPointer)<>0) then
  1403. begin
  1404. st:=st+'^';
  1405. if assigned(S^.Ancestor) and
  1406. ((S^.Ancestor^.Flags and sfRecord)<>0) then
  1407. st:=st+'.';
  1408. end
  1409. else if assigned(S) and ((S^.Flags and sfRecord)<>0) then
  1410. st:=st+'.';
  1411. PB:=New(PBrowserWindow, Init(R,
  1412. st2,SearchFreeWindowNo,S,Line,st,
  1413. Symbols,References,Inheritance,MemInfo));
  1414. {$ifndef GABOR}
  1415. if (S^.typ=varsym) or (assigned(ParentBrowser) and ParentBrowser^.IsValid) then
  1416. PB^.IsValid:=true;
  1417. {$endif}
  1418. Desktop^.Insert(PB);
  1419. end;
  1420. END.
  1421. {
  1422. $Log$
  1423. Revision 1.26 2000-05-02 08:42:28 pierre
  1424. * new set of Gabor changes: see fixes.txt
  1425. Revision 1.25 2000/04/18 11:42:37 pierre
  1426. lot of Gabor changes : see fixes.txt
  1427. Revision 1.24 2000/03/21 23:26:55 pierre
  1428. adapted to wcedit addition
  1429. Revision 1.23 2000/03/15 10:29:03 pierre
  1430. * TGDBValue object
  1431. Revision 1.22 2000/03/08 16:53:21 pierre
  1432. * Value of vars in browsers cleaned up
  1433. Revision 1.21 2000/03/07 21:55:16 pierre
  1434. + Add current value to browser
  1435. Revision 1.20 1999/11/10 00:42:42 pierre
  1436. * LookUp function now returns the complete name in browcol
  1437. and fpsymbol only yakes a part of LoopUpStr
  1438. Revision 1.19 1999/09/16 14:34:59 pierre
  1439. + TBreakpoint and TWatch registering
  1440. + WatchesCollection and BreakpointsCollection stored in desk file
  1441. * Syntax highlighting was broken
  1442. Revision 1.18 1999/07/28 23:11:22 peter
  1443. * fixes from gabor
  1444. Revision 1.17 1999/06/28 12:35:05 pierre
  1445. + CloseAllBrowsers needed before compilation to avoid problems
  1446. + ModulesCollection and GlobalsCollection to avoid memory leaks
  1447. Revision 1.16 1999/06/17 23:44:01 pierre
  1448. * problem with Inheritance list
  1449. Revision 1.15 1999/04/15 08:58:06 peter
  1450. * syntax highlight fixes
  1451. * browser updates
  1452. Revision 1.14 1999/04/07 21:55:53 peter
  1453. + object support for browser
  1454. * html help fixes
  1455. * more desktop saving things
  1456. * NODEBUG directive to exclude debugger
  1457. Revision 1.13 1999/03/16 00:44:44 peter
  1458. * forgotten in last commit :(
  1459. Revision 1.12 1999/03/01 15:42:02 peter
  1460. + Added dummy entries for functions not yet implemented
  1461. * MenuBar didn't update itself automatically on command-set changes
  1462. * Fixed Debugging/Profiling options dialog
  1463. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
  1464. set
  1465. * efBackSpaceUnindents works correctly
  1466. + 'Messages' window implemented
  1467. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  1468. + Added TP message-filter support (for ex. you can call GREP thru
  1469. GREP2MSG and view the result in the messages window - just like in TP)
  1470. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  1471. so topic search didn't work...
  1472. * In FPHELP.PAS there were still context-variables defined as word instead
  1473. of THelpCtx
  1474. * StdStatusKeys() was missing from the statusdef for help windows
  1475. + Topic-title for index-table can be specified when adding a HTML-files
  1476. Revision 1.11 1999/02/22 11:51:38 peter
  1477. * browser updates from gabor
  1478. Revision 1.9 1999/02/18 13:44:34 peter
  1479. * search fixed
  1480. + backward search
  1481. * help fixes
  1482. * browser updates
  1483. Revision 1.7 1999/02/16 12:44:20 pierre
  1484. * DoubleClick works now
  1485. Revision 1.6 1999/02/10 09:44:59 pierre
  1486. + added B tab for functions and vars for break/watch
  1487. TBrowserWindow also stores the symbol itself for break/watchpoints
  1488. Revision 1.5 1999/02/04 17:53:47 pierre
  1489. + OpenOneSymbolBrowser
  1490. Revision 1.4 1999/02/04 13:16:14 pierre
  1491. + column info added
  1492. Revision 1.3 1999/01/21 11:54:23 peter
  1493. + tools menu
  1494. + speedsearch in symbolbrowser
  1495. * working run command
  1496. Revision 1.2 1999/01/14 21:42:24 peter
  1497. * source tracking from Gabor
  1498. Revision 1.1 1999/01/12 14:29:40 peter
  1499. + Implemented still missing 'switch' entries in Options menu
  1500. + Pressing Ctrl-B sets ASCII mode in editor, after which keypresses (even
  1501. ones with ASCII < 32 ; entered with Alt+<###>) are interpreted always as
  1502. ASCII chars and inserted directly in the text.
  1503. + Added symbol browser
  1504. * splitted fp.pas to fpide.pas
  1505. Revision 1.0 1999/01/09 11:49:41 gabor
  1506. Original implementation
  1507. }