fpsymbol.pas 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152
  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. unit FPSymbol;
  13. interface
  14. uses Objects,Drivers,Views,Dialogs,Outline,
  15. BrowCol,
  16. FPViews;
  17. const
  18. { Browser tab constants }
  19. btScope = 0;
  20. btReferences = 1;
  21. btInheritance = 2;
  22. btMemInfo = 3;
  23. btBreakWatch = 4;
  24. type
  25. PSymbolView = ^TSymbolView;
  26. TSymbolView = object(TListBox)
  27. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  28. procedure HandleEvent(var Event: TEvent); virtual;
  29. procedure GotoItem(Item: sw_integer); virtual;
  30. procedure TrackItem(Item: sw_integer); virtual;
  31. function GetPalette: PPalette; virtual;
  32. private
  33. function TrackReference(R: PReference): boolean; virtual;
  34. function GotoReference(R: PReference): boolean; virtual;
  35. end;
  36. PSymbolScopeView = ^TSymbolScopeView;
  37. TSymbolScopeView = object(TSymbolView)
  38. constructor Init(var Bounds: TRect; ASymbols: PSymbolCollection; AHScrollBar, AVScrollBar: PScrollBar);
  39. function GetText(Item,MaxLen: Sw_Integer): String; virtual;
  40. procedure HandleEvent(var Event: TEvent); virtual;
  41. procedure Draw; virtual;
  42. procedure LookUp(S: string); virtual;
  43. procedure GotoItem(Item: sw_integer); virtual;
  44. procedure TrackItem(Item: sw_integer); virtual;
  45. private
  46. Symbols: PSymbolCollection;
  47. LookupStr: string;
  48. end;
  49. PSymbolReferenceView = ^TSymbolReferenceView;
  50. TSymbolReferenceView = object(TSymbolView)
  51. constructor Init(var Bounds: TRect; AReferences: PReferenceCollection; AHScrollBar, AVScrollBar: PScrollBar);
  52. procedure HandleEvent(var Event: TEvent); virtual;
  53. function GetText(Item,MaxLen: Sw_Integer): String; virtual;
  54. procedure SelectItem(Item: Sw_Integer); virtual;
  55. procedure GotoItem(Item: sw_integer); virtual;
  56. procedure TrackItem(Item: sw_integer); virtual;
  57. private
  58. References: PReferenceCollection;
  59. end;
  60. PSymbolMemInfoView = ^TSymbolMemInfoView;
  61. TSymbolMemInfoView = object(TStaticText)
  62. constructor Init(var Bounds: TRect; AMemInfo: PSymbolMemInfo);
  63. procedure GetText(var S: String); virtual;
  64. function GetPalette: PPalette; virtual;
  65. private
  66. MemInfo: PSymbolMemInfo;
  67. end;
  68. PSymbolInheritanceView = ^TSymbolInheritanceView;
  69. TSymbolInheritanceView = object(TOutlineViewer)
  70. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar; ARoot: PObjectSymbol);
  71. function GetRoot: Pointer; virtual;
  72. function HasChildren(Node: Pointer): Boolean; virtual;
  73. function GetChild(Node: Pointer; I: Integer): Pointer; virtual;
  74. function GetNumChildren(Node: Pointer): Integer; virtual;
  75. function GetText(Node: Pointer): String; virtual;
  76. procedure Adjust(Node: Pointer; Expand: Boolean); virtual;
  77. function IsExpanded(Node: Pointer): Boolean; virtual;
  78. procedure Selected(I: Integer); virtual;
  79. function GetPalette: PPalette; virtual;
  80. private
  81. Root: PObjectSymbol;
  82. end;
  83. PBrowserTabItem = ^TBrowserTabItem;
  84. TBrowserTabItem = record
  85. Sign : char;
  86. Link : PView;
  87. Next : PBrowserTabItem;
  88. end;
  89. PBrowserTab = ^TBrowserTab;
  90. TBrowserTab = object(TView)
  91. Items: PBrowserTabItem;
  92. constructor Init(var Bounds: TRect; AItems: PBrowserTabItem);
  93. function GetItemCount: sw_integer; virtual;
  94. function GetItem(Index: sw_integer): PBrowserTabItem; virtual;
  95. procedure SetParams(AFlags: word; ACurrent: Sw_integer); virtual;
  96. procedure SelectItem(Index: Sw_integer); virtual;
  97. procedure Draw; virtual;
  98. function GetPalette: PPalette; virtual;
  99. procedure HandleEvent(var Event: TEvent); virtual;
  100. destructor Done; virtual;
  101. private
  102. Flags : word;
  103. Current : Sw_integer;
  104. end;
  105. PBrowserWindow = ^TBrowserWindow;
  106. TBrowserWindow = object(TFPWindow)
  107. constructor Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Sw_Integer;ASym : PSymbol;
  108. const AName: string; ASymbols: PSymbolCollection; AReferences: PReferenceCollection;
  109. AInheritance: PObjectSymbol; AMemInfo: PSymbolMemInfo);
  110. procedure HandleEvent(var Event: TEvent); virtual;
  111. procedure SetState(AState: Word; Enable: Boolean); virtual;
  112. procedure Close; virtual;
  113. procedure SelectTab(BrowserTab: Sw_integer); virtual;
  114. function GetPalette: PPalette; virtual;
  115. private
  116. PageTab : PBrowserTab;
  117. Sym : PSymbol;
  118. ScopeView : PSymbolScopeView;
  119. ReferenceView : PSymbolReferenceView;
  120. InheritanceView: PSymbolInheritanceView;
  121. MemInfoView : PSymbolMemInfoView;
  122. end;
  123. procedure OpenSymbolBrowser(X,Y: Sw_integer;const Name,Line: string;S : PSymbol;
  124. Symbols: PSymbolCollection; References: PReferenceCollection;
  125. Inheritance: PObjectSymbol; MemInfo: PSymbolMemInfo);
  126. function IsSymbolInfoAvailable: boolean;
  127. procedure OpenOneSymbolBrowser(Name : String);
  128. implementation
  129. uses Commands,App,
  130. WEditor,WViews,
  131. FPConst,FPUtils,FPVars,{$ifndef FPDEBUG}FPDebug{$endif};
  132. function NewBrowserTabItem(ASign: char; ALink: PView; ANext: PBrowserTabItem): PBrowserTabItem;
  133. var P: PBrowserTabItem;
  134. begin
  135. New(P); FillChar(P^,SizeOf(P^),0);
  136. with P^ do begin Sign:=ASign; Link:=ALink; Next:=ANext; end;
  137. NewBrowserTabItem:=P;
  138. end;
  139. procedure DisposeBrowserTabItem(P: PBrowserTabItem);
  140. begin
  141. if P<>nil then Dispose(P);
  142. end;
  143. procedure DisposeBrowserTabList(P: PBrowserTabItem);
  144. begin
  145. if P<>nil then
  146. begin
  147. if P^.Next<>nil then DisposeBrowserTabList(P^.Next);
  148. DisposeBrowserTabItem(P);
  149. end;
  150. end;
  151. function IsSymbolInfoAvailable: boolean;
  152. begin
  153. IsSymbolInfoAvailable:=BrowCol.Modules<>nil;
  154. end;
  155. procedure OpenOneSymbolBrowser(Name : String);
  156. var Index : sw_integer;
  157. PS : PSymbol;
  158. P : Pstring;
  159. function Search(P : PSymbol) : boolean;
  160. begin
  161. Search:=UpcaseStr(P^.Items^.LookUp(Name,Index))=Name;
  162. end;
  163. begin
  164. Name:=UpcaseStr(Name);
  165. If BrowCol.Modules<>nil then
  166. begin
  167. PS:=BrowCol.Modules^.FirstThat(@Search);
  168. If assigned(PS) then
  169. OpenSymbolBrowser(0,20,
  170. PS^.Items^.At(Index)^.GetName,'',PS^.Items^.At(Index),
  171. PS^.Items^.At(Index)^.Items,PS^.Items^.At(Index)^.References,nil,PS^.MemInfo)
  172. else
  173. begin
  174. P:=@Name;
  175. ErrorBox(#3'Symbol %s not found',@P);
  176. end;
  177. end
  178. else
  179. ErrorBox('No Browser info available',nil);
  180. end;
  181. (*procedure ReadBrowseLog(FileName: string);
  182. var f: text;
  183. IOOK,EndOfFile: boolean;
  184. Line: string;
  185. procedure NextLine;
  186. begin
  187. readln(f,Line);
  188. EndOfFile:=Eof(f);
  189. end;
  190. var Level: integer;
  191. procedure ProcessSymTable(Indent: integer; Owner: PSymbolCollection);
  192. var IndentS,S,Source: string;
  193. Sym: PSymbol;
  194. Ref: PSymbolReference;
  195. P: byte;
  196. PX: TPoint;
  197. PS: PString;
  198. PCount: integer;
  199. Params: array[0..30] of PString;
  200. Typ: tsymtyp;
  201. ExitBack: boolean;
  202. begin
  203. Inc(Level);
  204. IndentS:=CharStr(' ',Indent); ExitBack:=false;
  205. Sym:=nil;
  206. repeat
  207. if copy(Line,1,length(IndentS))<>IndentS then ExitBack:=true else
  208. if copy(Line,Indent+1,3)='***' then
  209. { new symbol }
  210. begin
  211. S:=copy(Line,Indent+1+3,255);
  212. P:=Pos('***',S); if P=0 then P:=length(S)+1;
  213. S:=Trim(copy(S,1,P-1));
  214. if (copy(S,1,1)='_') and (Pos('$$',S)>0) then
  215. begin
  216. repeat
  217. P:=Pos('$$',S);
  218. if P>0 then Delete(S,1,P+1);
  219. until P=0;
  220. P:=Pos('$',S);
  221. Delete(S,1,P);
  222. PCount:=0;
  223. repeat
  224. P:=Pos('$',S); if P=0 then P:=length(S)+1;
  225. Params[PCount]:=TypeNames^.Add(copy(S,1,P-1));
  226. Inc(PCount);
  227. Delete(S,1,P);
  228. until S='';
  229. Sym^.Typ:=procsym;
  230. Sym^.SetParams(PCount,@Params);
  231. end
  232. else
  233. New(Sym, Init(S, varsym, 0, nil));
  234. Owner^.Insert(Sym);
  235. NextLine;
  236. end else
  237. if copy(Line,Indent+1,3)='---' then
  238. { child symtable }
  239. begin
  240. S:=Trim(copy(Line,Indent+1+12,255));
  241. if Level=1 then Typ:=unitsym else
  242. Typ:=typesym;
  243. if (Sym<>nil) and (Sym^.GetName=S) then
  244. else
  245. begin
  246. New(Sym, Init(S, Typ, 0, nil));
  247. Owner^.Insert(Sym);
  248. end;
  249. Sym^.Typ:=Typ;
  250. NextLine;
  251. New(Sym^.Items, Init(0,50));
  252. ProcessSymTable(Indent+2,Sym^.Items);
  253. end else
  254. { if Sym<>nil then}
  255. if copy(Line,Indent+1,1)=' ' then
  256. { reference }
  257. begin
  258. S:=copy(Line,Indent+1+2,255);
  259. P:=Pos('(',S); if P=0 then P:=length(S)+1;
  260. Source:=Trim(copy(S,1,P-1)); Delete(S,1,P);
  261. P:=Pos(',',S); if P=0 then P:=length(S)+1;
  262. PX.Y:=StrToInt(copy(S,1,P-1)); Delete(S,1,P);
  263. P:=Pos(')',S); if P=0 then P:=length(S)+1;
  264. PX.X:=StrToInt(copy(S,1,P-1)); Delete(S,1,P);
  265. PS:=ModuleNames^.Add(Source);
  266. New(Ref, Init(PS, PX));
  267. if Sym^.References=nil then
  268. New(Sym^.References, Init(10,50));
  269. Sym^.References^.Insert(Ref);
  270. end;
  271. if ExitBack=false then
  272. NextLine;
  273. until EndOfFile or ExitBack;
  274. Dec(Level);
  275. end;
  276. begin
  277. DoneSymbolBrowser;
  278. InitSymbolBrowser;
  279. {$I-}
  280. Assign(f,FileName);
  281. Reset(f);
  282. Level:=0;
  283. NextLine;
  284. while (IOResult=0) and (EndOfFile=false) do
  285. ProcessSymTable(0,Modules);
  286. Close(f);
  287. EatIO;
  288. {$I+}
  289. end;*)
  290. {****************************************************************************
  291. TSymbolView
  292. ****************************************************************************}
  293. constructor TSymbolView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  294. begin
  295. inherited Init(Bounds,1,AVScrollBar);
  296. HScrollBar:=AHScrollBar;
  297. if assigned(HScrollBar) then
  298. HScrollBar^.SetRange(1,80);
  299. Options:=Options or (ofSelectable+ofTopSelect);
  300. end;
  301. procedure TSymbolView.HandleEvent(var Event: TEvent);
  302. var DontClear: boolean;
  303. begin
  304. case Event.What of
  305. evKeyDown :
  306. begin
  307. DontClear:=false;
  308. case Event.KeyCode of
  309. kbEnter :
  310. GotoItem(Focused);
  311. kbSpaceBar :
  312. TrackItem(Focused);
  313. kbRight,kbLeft :
  314. if HScrollBar<>nil then
  315. HScrollBar^.HandleEvent(Event);
  316. else DontClear:=true;
  317. end;
  318. if DontClear=false then ClearEvent(Event);
  319. end;
  320. evMouseDown :
  321. if Event.double then
  322. GotoItem(Focused);
  323. end;
  324. inherited HandleEvent(Event);
  325. end;
  326. function TSymbolView.GetPalette: PPalette;
  327. const
  328. P: string[length(CBrowserListBox)] = CBrowserListBox;
  329. begin
  330. GetPalette:=@P;
  331. end;
  332. procedure TSymbolView.GotoItem(Item: sw_integer);
  333. begin
  334. SelectItem(Item);
  335. end;
  336. procedure TSymbolView.TrackItem(Item: sw_integer);
  337. begin
  338. SelectItem(Item);
  339. end;
  340. function LastBrowserWindow: PBrowserWindow;
  341. var BW: PBrowserWindow;
  342. procedure IsBW(P: PView); {$ifndef FPC}far;{$endif}
  343. begin
  344. if (P^.HelpCtx=hcBrowserWindow) then
  345. BW:=pointer(P);
  346. end;
  347. begin
  348. BW:=nil;
  349. Desktop^.ForEach(@IsBW);
  350. LastBrowserWindow:=BW;
  351. end;
  352. function TSymbolView.TrackReference(R: PReference): boolean;
  353. var W: PSourceWindow;
  354. BW: PBrowserWindow;
  355. P: TPoint;
  356. begin
  357. Message(Desktop,evBroadcast,cmClearLineHighlights,nil);
  358. Desktop^.Lock;
  359. P.X:=R^.Position.X-1; P.Y:=R^.Position.Y-1;
  360. W:=TryToOpenFile(nil,R^.GetFileName,P.X,P.Y,true);
  361. if W<>nil then
  362. begin
  363. BW:=LastBrowserWindow;
  364. if BW=nil then
  365. W^.Select
  366. else
  367. begin
  368. Desktop^.Delete(W);
  369. Desktop^.InsertBefore(W,BW^.NextView);
  370. end;
  371. W^.Editor^.SetHighlightRow(P.Y);
  372. end;
  373. Desktop^.UnLock;
  374. TrackReference:=W<>nil;
  375. end;
  376. function TSymbolView.GotoReference(R: PReference): boolean;
  377. var W: PSourceWindow;
  378. begin
  379. Desktop^.Lock;
  380. W:=TryToOpenFile(nil,R^.GetFileName,R^.Position.X-1,R^.Position.Y-1,true);
  381. if W<>nil then W^.Select;
  382. Desktop^.UnLock;
  383. GotoReference:=W<>nil;
  384. end;
  385. {****************************************************************************
  386. TSymbolScopeView
  387. ****************************************************************************}
  388. constructor TSymbolScopeView.Init(var Bounds: TRect; ASymbols: PSymbolCollection; AHScrollBar, AVScrollBar: PScrollBar);
  389. begin
  390. inherited Init(Bounds,AHScrollBar, AVScrollBar);
  391. Symbols:=ASymbols;
  392. NewList(ASymbols);
  393. SetRange(Symbols^.Count);
  394. end;
  395. procedure TSymbolScopeView.HandleEvent(var Event: TEvent);
  396. var OldFocus: sw_integer;
  397. begin
  398. case Event.What of
  399. evKeyDown :
  400. case Event.KeyCode of
  401. kbBack :
  402. begin
  403. LookUp(copy(LookUpStr,1,length(LookUpStr)-1));
  404. ClearEvent(Event);
  405. end;
  406. else
  407. if Event.CharCode in[#33..#255] then
  408. begin
  409. LookUp(LookUpStr+Event.CharCode);
  410. ClearEvent(Event);
  411. end;
  412. end;
  413. end;
  414. OldFocus:=Focused;
  415. inherited HandleEvent(Event);
  416. if OldFocus<>Focused then
  417. Lookup('');
  418. end;
  419. procedure TSymbolScopeView.Draw;
  420. begin
  421. inherited Draw;
  422. SetCursor(2+SymbolTypLen+length(LookUpStr),Focused-TopItem);
  423. end;
  424. procedure TSymbolScopeView.LookUp(S: string);
  425. var Idx: Sw_integer;
  426. NS: string;
  427. begin
  428. NS:=LookUpStr;
  429. if (Symbols=nil) or (S='') then NS:='' else
  430. begin
  431. S:=Symbols^.LookUp(S,Idx);
  432. if Idx<>-1 then
  433. begin
  434. NS:=S;
  435. FocusItem(Idx);
  436. end;
  437. end;
  438. LookUpStr:=NS;
  439. SetState(sfCursorVis,LookUpStr<>'');
  440. DrawView;
  441. end;
  442. procedure TSymbolScopeView.GotoItem(Item: sw_integer);
  443. begin
  444. SelectItem(Item);
  445. end;
  446. procedure TSymbolScopeView.TrackItem(Item: sw_integer);
  447. var S: PSymbol;
  448. begin
  449. if Range=0 then Exit;
  450. S:=List^.At(Focused);
  451. if (S^.References<>nil) and (S^.References^.Count>0) then
  452. TrackReference(S^.References^.At(0));
  453. end;
  454. function TSymbolScopeView.GetText(Item,MaxLen: Sw_Integer): String;
  455. var S: string;
  456. begin
  457. S:=Symbols^.At(Item)^.GetText;
  458. GetText:=copy(S,1,MaxLen);
  459. end;
  460. {****************************************************************************
  461. TSymbolReferenceView
  462. ****************************************************************************}
  463. constructor TSymbolReferenceView.Init(var Bounds: TRect; AReferences: PReferenceCollection;
  464. AHScrollBar, AVScrollBar: PScrollBar);
  465. begin
  466. inherited Init(Bounds,AHScrollBar, AVScrollBar);
  467. References:=AReferences;
  468. NewList(AReferences);
  469. SetRange(References^.Count);
  470. end;
  471. procedure TSymbolReferenceView.HandleEvent(var Event: TEvent);
  472. var OldFocus: sw_integer;
  473. begin
  474. OldFocus:=Focused;
  475. inherited HandleEvent(Event);
  476. if OldFocus<>Focused then
  477. Message(Desktop,evBroadcast,cmClearLineHighlights,nil);
  478. end;
  479. function TSymbolReferenceView.GetText(Item,MaxLen: Sw_Integer): String;
  480. var S: string;
  481. P: PReference;
  482. begin
  483. P:=References^.At(Item);
  484. S:=P^.GetFileName+'('+IntToStr(P^.Position.Y)+','+IntToStr(P^.Position.X)+')';
  485. GetText:=copy(S,1,MaxLen);
  486. end;
  487. procedure TSymbolReferenceView.GotoItem(Item: sw_integer);
  488. begin
  489. if Range=0 then Exit;
  490. GotoReference(List^.At(Item));
  491. end;
  492. procedure TSymbolReferenceView.TrackItem(Item: sw_integer);
  493. begin
  494. if Range=0 then Exit;
  495. TrackReference(List^.At(Item));
  496. end;
  497. procedure TSymbolReferenceView.SelectItem(Item: Sw_Integer);
  498. begin
  499. GotoItem(Item);
  500. end;
  501. constructor TSymbolMemInfoView.Init(var Bounds: TRect; AMemInfo: PSymbolMemInfo);
  502. begin
  503. inherited Init(Bounds,'');
  504. Options:=Options or (ofSelectable+ofTopSelect);
  505. MemInfo:=AMemInfo;
  506. end;
  507. procedure TSymbolMemInfoView.GetText(var S: String);
  508. function SizeStr(Size: longint): string;
  509. var S: string[40];
  510. begin
  511. S:=IntToStrL(Size,7);
  512. S:=S+' byte';
  513. if Size>0 then S:=S+'s';
  514. SizeStr:=S;
  515. end;
  516. function AddrStr(Addr: longint): string;
  517. type TLongint = record LoW,HiW: word; end;
  518. begin
  519. with TLongint(Addr) do
  520. AddrStr:='$'+IntToHexL(HiW,4)+IntToHexL(HiW,4);
  521. end;
  522. begin
  523. S:=
  524. #13+
  525. { ' Memory location: '+AddrStr(MemInfo^.Addr)+#13+
  526. ' Local address: '+AddrStr(MemInfo^.LocalAddr)+#13+}
  527. { ??? internal linker ??? }
  528. ' Size in memory: '+SizeStr(MemInfo^.Size)+#13+
  529. ' Size on stack: '+SizeStr(MemInfo^.PushSize)+#13+
  530. ''
  531. ;
  532. end;
  533. function TSymbolMemInfoView.GetPalette: PPalette;
  534. begin
  535. GetPalette:=inherited GetPalette;
  536. end;
  537. {****************************************************************************
  538. TSymbolInheritanceView
  539. ****************************************************************************}
  540. constructor TSymbolInheritanceView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar; ARoot: PObjectSymbol);
  541. begin
  542. inherited Init(Bounds,AHScrollBar,AVScrollBar);
  543. Options:=Options or (ofSelectable+ofTopSelect);
  544. Root:=ARoot;
  545. ExpandAll(GetRoot); Update;
  546. end;
  547. function TSymbolInheritanceView.GetRoot: Pointer;
  548. begin
  549. GetRoot:=Root;
  550. end;
  551. function TSymbolInheritanceView.HasChildren(Node: Pointer): Boolean;
  552. begin
  553. HasChildren:=GetNumChildren(Node)>0;
  554. end;
  555. function TSymbolInheritanceView.GetChild(Node: Pointer; I: Integer): Pointer;
  556. begin
  557. GetChild:=PObjectSymbol(Node)^.GetDescendant(I);
  558. end;
  559. function TSymbolInheritanceView.GetNumChildren(Node: Pointer): Integer;
  560. begin
  561. GetNumChildren:=PObjectSymbol(Node)^.GetDescendantCount;
  562. end;
  563. function TSymbolInheritanceView.GetText(Node: Pointer): String;
  564. begin
  565. GetText:=PObjectSymbol(Node)^.GetName;
  566. end;
  567. procedure TSymbolInheritanceView.Adjust(Node: Pointer; Expand: Boolean);
  568. begin
  569. PObjectSymbol(Node)^.Expanded:=Expand;
  570. end;
  571. function TSymbolInheritanceView.IsExpanded(Node: Pointer): Boolean;
  572. begin
  573. IsExpanded:=PObjectSymbol(Node)^.Expanded;
  574. end;
  575. function TSymbolInheritanceView.GetPalette: PPalette;
  576. const P: string[length(CBrowserOutline)] = CBrowserOutline;
  577. begin
  578. GetPalette:=@P;
  579. end;
  580. procedure TSymbolInheritanceView.Selected(I: Integer);
  581. var P: pointer;
  582. S: PSymbol;
  583. Anc: PObjectSymbol;
  584. begin
  585. P:=GetNode(I);
  586. if P=nil then Exit;
  587. S:=PObjectSymbol(P)^.Symbol;
  588. if S^.Ancestor=nil then Anc:=nil else
  589. Anc:=SearchObjectForSymbol(S^.Ancestor);
  590. OpenSymbolBrowser(Origin.X-1,FOC-Delta.Y+1,
  591. S^.GetName,
  592. S^.GetText,S,
  593. S^.Items,S^.References,Anc,S^.MemInfo);
  594. end;
  595. {****************************************************************************
  596. TBrowserTab
  597. ****************************************************************************}
  598. constructor TBrowserTab.Init(var Bounds: TRect; AItems: PBrowserTabItem);
  599. begin
  600. inherited Init(Bounds);
  601. Options:=Options or ofPreProcess;
  602. Items:=AItems;
  603. SetParams(0,0);
  604. end;
  605. procedure TBrowserTab.SetParams(AFlags: word; ACurrent: Sw_integer);
  606. begin
  607. Flags:=AFlags;
  608. SelectItem(ACurrent);
  609. end;
  610. procedure TBrowserTab.SelectItem(Index: Sw_integer);
  611. var P: PBrowserTabItem;
  612. begin
  613. Current:=Index;
  614. P:=GetItem(Current);
  615. if (P<>nil) and (P^.Link<>nil) then
  616. P^.Link^.Focus;
  617. DrawView;
  618. end;
  619. function TBrowserTab.GetItemCount: sw_integer;
  620. var Count: integer;
  621. P: PBrowserTabItem;
  622. begin
  623. Count:=0; P:=Items;
  624. while (P<>nil) do
  625. begin
  626. Inc(Count);
  627. P:=P^.Next;
  628. end;
  629. GetItemCount:=Count;
  630. end;
  631. function TBrowserTab.GetItem(Index: sw_integer): PBrowserTabItem;
  632. var Counter: integer;
  633. P: PBrowserTabItem;
  634. begin
  635. P:=Items; Counter:=0;
  636. while (P<>nil) and (Counter<Index) do
  637. begin
  638. P:=P^.Next;
  639. Inc(Counter);
  640. end;
  641. GetItem:=P;
  642. end;
  643. procedure TBrowserTab.Draw;
  644. var B: TDrawBuffer;
  645. SelColor, NormColor, C: word;
  646. I,CurX,Count: Sw_integer;
  647. function Names(Idx: integer): char;
  648. begin
  649. Names:=GetItem(Idx)^.Sign;
  650. end;
  651. begin
  652. NormColor:=GetColor(1); SelColor:=GetColor(2);
  653. MoveChar(B,'Ä',SelColor,Size.X);
  654. CurX:=0; Count:=0;
  655. for I:=0 to GetItemCount-1 do
  656. if (Flags and (1 shl I))<>0 then
  657. begin
  658. Inc(Count);
  659. if Current=I then C:=SelColor
  660. else C:=NormColor;
  661. if Count=1 then MoveChar(B[CurX],'´',SelColor,1)
  662. else MoveChar(B[CurX],'³',SelColor,1);
  663. MoveCStr(B[CurX+1],' '+Names(I)+' ',C);
  664. Inc(CurX,4);
  665. end;
  666. if Count>0 then
  667. MoveChar(B[CurX],'Ã',SelColor,1);
  668. WriteLine(0,0,Size.X,Size.Y,B);
  669. end;
  670. procedure TBrowserTab.HandleEvent(var Event: TEvent);
  671. var I,Idx: integer;
  672. DontClear: boolean;
  673. P: TPoint;
  674. function GetItemForCoord(X: integer): integer;
  675. var I,CurX,Idx: integer;
  676. begin
  677. CurX:=0; Idx:=-1;
  678. for I:=0 to GetItemCount-1 do
  679. if (Flags and (1 shl I))<>0 then
  680. begin
  681. if (CurX+1<=X) and (X<=CurX+3) then
  682. begin Idx:=I; Break; end;
  683. Inc(CurX,4);
  684. end;
  685. GetItemForCoord:=Idx;
  686. end;
  687. begin
  688. case Event.What of
  689. evMouseDown :
  690. if MouseInView(Event.Where) then
  691. begin
  692. repeat
  693. MakeLocal(Event.Where,P);
  694. Idx:=GetItemForCoord(P.X);
  695. if Idx<>-1 then
  696. SelectItem(Idx);
  697. until not MouseEvent(Event, evMouseMove);
  698. ClearEvent(Event);
  699. end;
  700. evKeyDown :
  701. begin
  702. DontClear:=false; Idx:=-1;
  703. for I:=0 to GetItemCount-1 do
  704. if GetCtrlCode(GetItem(I)^.Sign)=Event.KeyCode then
  705. begin
  706. Idx:=I;
  707. Break;
  708. end;
  709. if Idx=-1 then
  710. DontClear:=true
  711. else
  712. SelectItem(Idx);
  713. if DontClear=false then ClearEvent(Event);
  714. end;
  715. end;
  716. inherited HandleEvent(Event);
  717. end;
  718. function TBrowserTab.GetPalette: PPalette;
  719. const P: string[length(CBrowserTab)] = CBrowserTab;
  720. begin
  721. GetPalette:=@P;
  722. end;
  723. destructor TBrowserTab.Done;
  724. begin
  725. inherited Done;
  726. if Items<>nil then DisposeBrowserTabList(Items);
  727. end;
  728. constructor TBrowserWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Sw_Integer;ASym : PSymbol;
  729. const AName: string; ASymbols: PSymbolCollection; AReferences: PReferenceCollection;
  730. AInheritance: PObjectSymbol; AMemInfo: PSymbolMemINfo);
  731. var R: TRect;
  732. ST: PStaticText;
  733. HSB,VSB: PScrollBar;
  734. function CreateVSB(R: TRect): PScrollBar;
  735. var R2: TRect;
  736. SB: PScrollBar;
  737. begin
  738. Sym:=ASym;
  739. R2.Copy(R); R2.Move(1,0); R2.A.X:=R2.B.X-1;
  740. New(SB, Init(R2)); SB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  741. CreateVSB:=SB;
  742. end;
  743. function CreateHSB(R: TRect): PScrollBar;
  744. var R2: TRect;
  745. SB: PScrollBar;
  746. begin
  747. R2.Copy(R); R2.Move(0,1); R2.A.Y:=R2.B.Y-1;
  748. New(SB, Init(R2)); SB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY;
  749. CreateHSB:=SB;
  750. end;
  751. begin
  752. inherited Init(Bounds, ATitle, ANumber);
  753. HelpCtx:=hcBrowserWindow;
  754. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
  755. New(ST, Init(R, ' '+AName)); ST^.GrowMode:=gfGrowHiX;
  756. Insert(ST);
  757. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);
  758. if assigned(ASymbols) and (ASymbols^.Count>0) then
  759. begin
  760. HSB:=CreateHSB(R); Insert(HSB);
  761. VSB:=CreateVSB(R); Insert(VSB);
  762. New(ScopeView, Init(R, ASymbols, HSB, VSB));
  763. ScopeView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  764. Insert(ScopeView);
  765. end;
  766. if assigned(AReferences) and (AReferences^.Count>0) then
  767. begin
  768. HSB:=CreateHSB(R); Insert(HSB);
  769. VSB:=CreateVSB(R); Insert(VSB);
  770. New(ReferenceView, Init(R, AReferences, HSB, VSB));
  771. ReferenceView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  772. Insert(ReferenceView);
  773. end;
  774. if assigned(AInheritance) then
  775. begin
  776. New(InheritanceView, Init(R, nil,nil, AInheritance));
  777. InheritanceView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  778. Insert(InheritanceView);
  779. end;
  780. if assigned(AMemInfo) then
  781. begin
  782. New(MemInfoView, Init(R, AMemInfo));
  783. MemInfoView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  784. Insert(MemInfoView);
  785. end;
  786. GetExtent(R); R.Grow(-1,-1); R.Move(0,1); R.B.Y:=R.A.Y+1;
  787. New(PageTab, Init(R,
  788. NewBrowserTabItem('S',ScopeView,
  789. NewBrowserTabItem('R',ReferenceView,
  790. NewBrowserTabItem('I',InheritanceView,
  791. NewBrowserTabItem('M',MemInfoView,
  792. nil))
  793. ))));
  794. PageTab^.GrowMode:=gfGrowHiX;
  795. Insert(PageTab);
  796. if assigned(ScopeView) then
  797. SelectTab(btScope)
  798. else
  799. if assigned(ReferenceView) then
  800. SelectTab(btReferences)
  801. else
  802. if assigned(InheritanceView) then
  803. SelectTab(btInheritance);
  804. end;
  805. procedure TBrowserWindow.HandleEvent(var Event: TEvent);
  806. var DontClear: boolean;
  807. S: PSymbol;
  808. Anc: PObjectSymbol;
  809. P: TPoint;
  810. begin
  811. case Event.What of
  812. evBroadcast :
  813. case Event.Command of
  814. cmSearchWindow :
  815. ClearEvent(Event);
  816. cmListItemSelected :
  817. if Event.InfoPtr=ScopeView then
  818. begin
  819. S:=ScopeView^.Symbols^.At(ScopeView^.Focused);
  820. MakeGlobal(ScopeView^.Origin,P);
  821. Desktop^.MakeLocal(P,P); Inc(P.Y,ScopeView^.Focused-ScopeView^.TopItem);
  822. Inc(P.Y);
  823. if S^.Ancestor=nil then Anc:=nil else
  824. Anc:=SearchObjectForSymbol(S^.Ancestor);
  825. if (S^.GetReferenceCount>0) or (S^.GetItemCount>0) or (Anc<>nil) then
  826. OpenSymbolBrowser(Origin.X-1,P.Y,
  827. S^.GetName,
  828. ScopeView^.GetText(ScopeView^.Focused,255),S,
  829. S^.Items,S^.References,Anc,S^.MemInfo);
  830. end;
  831. end;
  832. { evCommand :
  833. begin
  834. DontClear:=false;
  835. case Event.Command of
  836. cmGotoSymbol :
  837. if Event.InfoPtr=ScopeView then
  838. if ReferenceView<>nil then
  839. if ReferenceView^.Range>0 then
  840. ReferenceView^.GotoItem(0);
  841. cmTrackSymbol :
  842. if Event.InfoPtr=ScopeView then
  843. if (ScopeView<>nil) and (ScopeView^.Range>0) then
  844. begin
  845. S:=ScopeView^.At(ScopeView^.Focused);
  846. if (S^.References<>nil) and (S^.References^.Count>0) then
  847. TrackItem(S^.References^.At(0));
  848. else DontClear:=true;
  849. end;
  850. if DontClear=false then ClearEvent(Event);
  851. end;}
  852. evKeyDown :
  853. begin
  854. DontClear:=false;
  855. case Event.KeyCode of
  856. kbEsc :
  857. Close;
  858. else DontClear:=true;
  859. end;
  860. if DontClear=false then ClearEvent(Event);
  861. end;
  862. end;
  863. inherited HandleEvent(Event);
  864. end;
  865. procedure TBrowserWindow.SetState(AState: Word; Enable: Boolean);
  866. var OldState: word;
  867. begin
  868. OldState:=State;
  869. inherited SetState(AState,Enable);
  870. if ((State xor OldState) and sfActive)<>0 then
  871. if GetState(sfActive)=false then
  872. Message(Desktop,evBroadcast,cmClearLineHighlights,nil);
  873. end;
  874. procedure TBrowserWindow.Close;
  875. begin
  876. Message(Desktop,evBroadcast,cmClearLineHighlights,nil);
  877. inherited Close;
  878. end;
  879. procedure TBrowserWindow.SelectTab(BrowserTab: Sw_integer);
  880. var Tabs: Sw_integer;
  881. { PB : PBreakpoint;
  882. PS :PString;
  883. l : longint; }
  884. begin
  885. (* case BrowserTab of
  886. btScope :
  887. if assigned(ScopeView) then
  888. ScopeView^.Select;
  889. btReferences :
  890. if assigned(ReferenceView) then
  891. ReferenceView^.Select;
  892. btBreakWatch :
  893. begin
  894. if Assigned(Sym) then
  895. begin
  896. if Pos('proc',Sym^.GetText)>0 then
  897. { insert function breakpoint }
  898. begin
  899. { make it visible }
  900. PS:=Sym^.Name;
  901. l:=Length(PS^);
  902. If PS^[l]='*' then
  903. begin
  904. PB:=BreakpointCollection^.GetType(bt_function,copy(GetStr(PS),1,l-1));
  905. If Assigned(PB) then
  906. BreakpointCollection^.Delete(PB);
  907. Sym^.Name:=NewStr(copy(GetStr(PS),1,l-1));
  908. DrawView;
  909. DisposeStr(PS);
  910. end
  911. else
  912. begin
  913. Sym^.Name:=NewStr(GetStr(PS)+'*');
  914. DrawView;
  915. New(PB,init_function(GetStr(PS)));
  916. DisposeStr(PS);
  917. BreakpointCollection^.Insert(PB);
  918. BreakpointCollection^.Update;
  919. end;
  920. end
  921. else if pos('var',Sym^.GetText)>0 then
  922. { insert watch point }
  923. begin
  924. { make it visible }
  925. PS:=Sym^.Name;
  926. l:=Length(PS^);
  927. If PS^[l]='*' then
  928. begin
  929. PB:=BreakpointCollection^.GetType(bt_awatch,copy(PS^,1,l-1));
  930. If Assigned(PB) then
  931. BreakpointCollection^.Delete(PB);
  932. Sym^.Name:=NewStr(copy(PS^,1,l-1));
  933. DrawView;
  934. DisposeStr(PS);
  935. end
  936. else
  937. begin
  938. Sym^.Name:=NewStr(GetStr(PS)+'*');
  939. DrawView;
  940. New(PB,init_type(bt_awatch,GetStr(PS)));
  941. DisposeStr(PS);
  942. BreakpointCollection^.Insert(PB);
  943. BreakpointCollection^.Update;
  944. end;
  945. end;
  946. end;
  947. end;
  948. end;*)
  949. Tabs:=0;
  950. if assigned(ScopeView) then
  951. Tabs:=Tabs or (1 shl btScope);
  952. if assigned(ReferenceView) then
  953. Tabs:=Tabs or (1 shl btReferences);
  954. if assigned(InheritanceView) then
  955. Tabs:=Tabs or (1 shl btInheritance);
  956. if assigned(MemInfoView) then
  957. Tabs:=Tabs or (1 shl btMemInfo);
  958. if Assigned(Sym) then
  959. if (Pos('proc',Sym^.GetText)>0) or (Pos('var',Sym^.GetText)>0) then
  960. Tabs:=Tabs or (1 shl btBreakWatch);
  961. if PageTab<>nil then PageTab^.SetParams(Tabs,BrowserTab);
  962. end;
  963. function TBrowserWindow.GetPalette: PPalette;
  964. const S: string[length(CBrowserWindow)] = CBrowserWindow;
  965. begin
  966. GetPalette:=@S;
  967. end;
  968. procedure OpenSymbolBrowser(X,Y: Sw_integer;const Name,Line: string;S : PSymbol;
  969. Symbols: PSymbolCollection; References: PReferenceCollection;
  970. Inheritance: PObjectSymbol; MemInfo: PSymbolMemInfo);
  971. var R: TRect;
  972. begin
  973. if X=0 then X:=Desktop^.Size.X-35;
  974. R.A.X:=X; R.A.Y:=Y;
  975. R.B.X:=R.A.X+35; R.B.Y:=R.A.Y+15;
  976. while (R.B.Y>Desktop^.Size.Y) do R.Move(0,-1);
  977. Desktop^.Insert(New(PBrowserWindow, Init(R,
  978. 'Browse: '+Name,SearchFreeWindowNo,S,Line,Symbols,References,Inheritance,MemInfo)));
  979. end;
  980. END.
  981. {
  982. $Log$
  983. Revision 1.15 1999-04-15 08:58:06 peter
  984. * syntax highlight fixes
  985. * browser updates
  986. Revision 1.14 1999/04/07 21:55:53 peter
  987. + object support for browser
  988. * html help fixes
  989. * more desktop saving things
  990. * NODEBUG directive to exclude debugger
  991. Revision 1.13 1999/03/16 00:44:44 peter
  992. * forgotten in last commit :(
  993. Revision 1.12 1999/03/01 15:42:02 peter
  994. + Added dummy entries for functions not yet implemented
  995. * MenuBar didn't update itself automatically on command-set changes
  996. * Fixed Debugging/Profiling options dialog
  997. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
  998. set
  999. * efBackSpaceUnindents works correctly
  1000. + 'Messages' window implemented
  1001. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  1002. + Added TP message-filter support (for ex. you can call GREP thru
  1003. GREP2MSG and view the result in the messages window - just like in TP)
  1004. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  1005. so topic search didn't work...
  1006. * In FPHELP.PAS there were still context-variables defined as word instead
  1007. of THelpCtx
  1008. * StdStatusKeys() was missing from the statusdef for help windows
  1009. + Topic-title for index-table can be specified when adding a HTML-files
  1010. Revision 1.11 1999/02/22 11:51:38 peter
  1011. * browser updates from gabor
  1012. Revision 1.9 1999/02/18 13:44:34 peter
  1013. * search fixed
  1014. + backward search
  1015. * help fixes
  1016. * browser updates
  1017. Revision 1.7 1999/02/16 12:44:20 pierre
  1018. * DoubleClick works now
  1019. Revision 1.6 1999/02/10 09:44:59 pierre
  1020. + added B tab for functions and vars for break/watch
  1021. TBrowserWindow also stores the symbol itself for break/watchpoints
  1022. Revision 1.5 1999/02/04 17:53:47 pierre
  1023. + OpenOneSymbolBrowser
  1024. Revision 1.4 1999/02/04 13:16:14 pierre
  1025. + column info added
  1026. Revision 1.3 1999/01/21 11:54:23 peter
  1027. + tools menu
  1028. + speedsearch in symbolbrowser
  1029. * working run command
  1030. Revision 1.2 1999/01/14 21:42:24 peter
  1031. * source tracking from Gabor
  1032. Revision 1.1 1999/01/12 14:29:40 peter
  1033. + Implemented still missing 'switch' entries in Options menu
  1034. + Pressing Ctrl-B sets ASCII mode in editor, after which keypresses (even
  1035. ones with ASCII < 32 ; entered with Alt+<###>) are interpreted always as
  1036. ASCII chars and inserted directly in the text.
  1037. + Added symbol browser
  1038. * splitted fp.pas to fpide.pas
  1039. Revision 1.0 1999/01/09 11:49:41 gabor
  1040. Original implementation
  1041. }