browcol.pas 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by the FPC development team
  4. Support routines for getting browser info in collections
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. {$ifdef TP}
  19. {$N+,E+}
  20. {$endif}
  21. unit browcol;
  22. interface
  23. uses
  24. objects,symtable;
  25. const
  26. SymbolTypLen : integer = 6;
  27. RecordTypes : set of tsymtyp =
  28. ([typesym,unitsym,programsym]);
  29. type
  30. TStoreCollection = object(TStringCollection)
  31. function Add(const S: string): PString;
  32. end;
  33. PModuleNameCollection = ^TModuleNameCollection;
  34. TModuleNameCollection = object(TStoreCollection)
  35. end;
  36. PTypeNameCollection = ^TTypeNameCollection;
  37. TTypeNameCollection = object(TStoreCollection)
  38. end;
  39. PSymbolCollection = ^TSymbolCollection;
  40. PSortedSymbolCollection = ^TSortedSymbolCollection;
  41. PReferenceCollection = ^TReferenceCollection;
  42. PReference = ^TReference;
  43. TReference = object(TObject)
  44. FileName : PString;
  45. Position : TPoint;
  46. constructor Init(AFileName: PString; ALine, AColumn: Sw_integer);
  47. function GetFileName: string;
  48. destructor Done; virtual;
  49. end;
  50. PSymbol = ^TSymbol;
  51. TSymbol = object(TObject)
  52. Name : PString;
  53. Typ : tsymtyp;
  54. Params : PString;
  55. References : PReferenceCollection;
  56. Items : PSymbolCollection;
  57. DType : PString;
  58. VType : PString;
  59. Ancestor : PString;
  60. IsRecord : boolean;
  61. IsClass : boolean;
  62. constructor Init(const AName: string; ATyp: tsymtyp; AParams: string);
  63. function GetReferenceCount: Sw_integer;
  64. function GetReference(Index: Sw_integer): PReference;
  65. function GetItemCount: Sw_integer;
  66. function GetItem(Index: Sw_integer): PSymbol;
  67. function GetName: string;
  68. function GetText: string;
  69. function GetTypeName: string;
  70. destructor Done; virtual;
  71. end;
  72. TSymbolCollection = object(TSortedCollection)
  73. function At(Index: Sw_Integer): PSymbol;
  74. procedure Insert(Item: Pointer); virtual;
  75. function LookUp(const S: string; var Idx: sw_integer): string; virtual;
  76. end;
  77. TSortedSymbolCollection = object(TSymbolCollection)
  78. function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
  79. procedure Insert(Item: Pointer); virtual;
  80. function LookUp(const S: string; var Idx: sw_integer): string; virtual;
  81. end;
  82. TReferenceCollection = object(TCollection)
  83. function At(Index: Sw_Integer): PReference;
  84. end;
  85. const
  86. Modules : PSymbolCollection = nil;
  87. ModuleNames : PModuleNameCollection = nil;
  88. TypeNames : PTypeNameCollection = nil;
  89. procedure DisposeBrowserCol;
  90. procedure NewBrowserCol;
  91. procedure CreateBrowserCol;
  92. procedure InitBrowserCol;
  93. procedure DoneBrowserCol;
  94. implementation
  95. uses
  96. Drivers,Views,App,
  97. aasm,globtype,globals,files,comphook;
  98. {****************************************************************************
  99. Helpers
  100. ****************************************************************************}
  101. function GetStr(P: PString): string;
  102. begin
  103. if P=nil then
  104. GetStr:=''
  105. else
  106. GetStr:=P^;
  107. end;
  108. function IntToStr(L: longint): string;
  109. var S: string;
  110. begin
  111. Str(L,S);
  112. IntToStr:=S;
  113. end;
  114. function UpcaseStr(S: string): string;
  115. var I: integer;
  116. begin
  117. for I:=1 to length(S) do
  118. S[I]:=Upcase(S[I]);
  119. UpcaseStr:=S;
  120. end;
  121. function FloatToStr(E: extended): string;
  122. var S: string;
  123. begin
  124. Str(E:0:24,S);
  125. if Pos('.',S)>0 then
  126. begin
  127. while (length(S)>0) and (S[length(S)]='0') do
  128. Delete(S,length(S),1);
  129. if (length(S)>0) and (S[length(S)]='.') then
  130. Delete(S,length(S),1);
  131. end;
  132. if S='' then S:='0';
  133. FloatToStr:=S;
  134. end;
  135. {****************************************************************************
  136. TStoreCollection
  137. ****************************************************************************}
  138. function TStoreCollection.Add(const S: string): PString;
  139. var P: PString;
  140. Index: Sw_integer;
  141. begin
  142. if S='' then P:=nil else
  143. if Search(@S,Index) then P:=At(Index) else
  144. begin
  145. P:=NewStr(S);
  146. Insert(P);
  147. end;
  148. Add:=P;
  149. end;
  150. {****************************************************************************
  151. TSymbolCollection
  152. ****************************************************************************}
  153. function TSymbolCollection.At(Index: Sw_Integer): PSymbol;
  154. begin
  155. At:=inherited At(Index);
  156. end;
  157. procedure TSymbolCollection.Insert(Item: Pointer);
  158. begin
  159. TCollection.Insert(Item);
  160. end;
  161. function TSymbolCollection.LookUp(const S: string; var Idx: sw_integer): string;
  162. begin
  163. Idx:=-1;
  164. LookUp:='';
  165. end;
  166. {****************************************************************************
  167. TReferenceCollection
  168. ****************************************************************************}
  169. function TReferenceCollection.At(Index: Sw_Integer): PReference;
  170. begin
  171. At:=inherited At(Index);
  172. end;
  173. {****************************************************************************
  174. TSortedSymbolCollection
  175. ****************************************************************************}
  176. function TSortedSymbolCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
  177. var K1: PSymbol absolute Key1;
  178. K2: PSymbol absolute Key2;
  179. R: Sw_integer;
  180. S1,S2: string;
  181. begin
  182. S1:=Upper(K1^.GetName);
  183. S2:=Upper(K2^.GetName);
  184. if S1<S2 then R:=-1 else
  185. if S1>S2 then R:=1 else
  186. R:=0;
  187. Compare:=R;
  188. end;
  189. procedure TSortedSymbolCollection.Insert(Item: Pointer);
  190. begin
  191. TSortedCollection.Insert(Item);
  192. end;
  193. function TSortedSymbolCollection.LookUp(const S: string; var Idx: sw_integer): string;
  194. var OLI,ORI,Left,Right,Mid: integer;
  195. LeftP,RightP,MidP: PSymbol;
  196. RL: integer;
  197. LeftS,MidS,RightS: string;
  198. FoundS: string;
  199. UpS : string;
  200. begin
  201. Idx:=-1; FoundS:='';
  202. Left:=0; Right:=Count-1;
  203. UpS:=Upper(S);
  204. if Left<Right then
  205. begin
  206. while (Left<Right) do
  207. begin
  208. OLI:=Left; ORI:=Right;
  209. Mid:=Left+(Right-Left) div 2;
  210. LeftP:=At(Left); RightP:=At(Right); MidP:=At(Mid);
  211. LeftS:=Upper(LeftP^.GetName); MidS:=Upper(MidP^.GetName);
  212. RightS:=Upper(RightP^.GetName);
  213. if copy(MidS,1,length(UpS))=UpS then
  214. begin
  215. Idx:=Mid; FoundS:=copy(MidS,1,length(S));
  216. end;
  217. { else}
  218. if UpS<MidS then
  219. Right:=Mid
  220. else
  221. Left:=Mid;
  222. if (OLI=Left) and (ORI=Right) then
  223. Break;
  224. end;
  225. end;
  226. LookUp:=FoundS;
  227. end;
  228. {****************************************************************************
  229. TReference
  230. ****************************************************************************}
  231. constructor TReference.Init(AFileName: PString; ALine, AColumn: Sw_integer);
  232. begin
  233. inherited Init;
  234. FileName:=AFileName;
  235. Position.X:=AColumn;
  236. Position.Y:=ALine;
  237. end;
  238. function TReference.GetFileName: string;
  239. begin
  240. GetFileName:=GetStr(FileName);
  241. end;
  242. destructor TReference.Done;
  243. begin
  244. inherited Done;
  245. end;
  246. {****************************************************************************
  247. TSymbol
  248. ****************************************************************************}
  249. constructor TSymbol.Init(const AName: string; ATyp: tsymtyp; AParams: string);
  250. begin
  251. inherited Init;
  252. Name:=NewStr(AName); Typ:=ATyp;
  253. New(References, Init(20,50));
  254. if ATyp in RecordTypes then
  255. begin
  256. Items:=New(PSortedSymbolCollection, Init(50,100));
  257. end;
  258. end;
  259. function TSymbol.GetReferenceCount: Sw_integer;
  260. var Count: Sw_integer;
  261. begin
  262. if References=nil then Count:=0 else
  263. Count:=References^.Count;
  264. GetReferenceCount:=Count;
  265. end;
  266. function TSymbol.GetReference(Index: Sw_integer): PReference;
  267. begin
  268. GetReference:=References^.At(Index);
  269. end;
  270. function TSymbol.GetItemCount: Sw_integer;
  271. var Count: Sw_integer;
  272. begin
  273. if Items=nil then Count:=0 else
  274. Count:=Items^.Count;
  275. GetItemCount:=Count;
  276. end;
  277. function TSymbol.GetItem(Index: Sw_integer): PSymbol;
  278. begin
  279. GetItem:=Items^.At(Index);
  280. end;
  281. function TSymbol.GetName: string;
  282. begin
  283. GetName:=GetStr(Name);
  284. end;
  285. function TSymbol.GetText: string;
  286. var S: string;
  287. I: Sw_integer;
  288. begin
  289. S:=GetTypeName;
  290. if length(S)>SymbolTypLen then
  291. S:=Copy(S,1,SymbolTypLen)
  292. else
  293. begin
  294. while length(S)<SymbolTypLen do
  295. S:=S+' ';
  296. end;
  297. S:=S+' '+GetName;
  298. if IsRecord then
  299. S:=S+' = record'
  300. else
  301. if Ancestor<>nil then
  302. begin
  303. S:=S+' = ';
  304. if IsClass then
  305. S:=S+'class'
  306. else
  307. S:=S+'object';
  308. if Ancestor^<>'.' then
  309. S:=S+'('+Ancestor^+')';
  310. end
  311. else
  312. begin
  313. if Assigned(DType) then
  314. S:=S+' = '+DType^;
  315. if Assigned(Params) then
  316. S:=S+'('+Params^+')';
  317. if Assigned(VType) then
  318. S:=S+': '+VType^;
  319. end;
  320. GetText:=S;
  321. end;
  322. function TSymbol.GetTypeName: string;
  323. var S: string;
  324. begin
  325. case Typ of
  326. abstractsym : S:='abst';
  327. varsym : S:='var';
  328. typesym : S:='type';
  329. procsym : if VType=nil then
  330. S:='proc'
  331. else
  332. S:='func';
  333. unitsym : S:='unit';
  334. programsym : S:='prog';
  335. constsym : S:='const';
  336. enumsym : S:='enum';
  337. typedconstsym: S:='const';
  338. errorsym : S:='error';
  339. syssym : S:='sys';
  340. labelsym : S:='label';
  341. absolutesym : S:='abs';
  342. propertysym : S:='prop';
  343. funcretsym : S:='func';
  344. macrosym : S:='macro';
  345. else S:='';
  346. end;
  347. GetTypeName:=S;
  348. end;
  349. destructor TSymbol.Done;
  350. begin
  351. inherited Done;
  352. if assigned(References) then
  353. Dispose(References, Done);
  354. if assigned(Items) then
  355. Dispose(Items, Done);
  356. if assigned(Name) then
  357. DisposeStr(Name);
  358. { if assigned(Params) then
  359. DisposeStr(Params);
  360. if assigned(VType) then
  361. DisposeStr(VType);
  362. if assigned(DType) then
  363. DisposeStr(DType);
  364. if assigned(Ancestor) then
  365. DisposeStr(Ancestor);}
  366. end;
  367. {*****************************************************************************
  368. Main Routines
  369. *****************************************************************************}
  370. procedure DisposeBrowserCol;
  371. begin
  372. if assigned(Modules) then
  373. begin
  374. dispose(Modules,Done);
  375. Modules:=nil;
  376. end;
  377. if assigned(ModuleNames) then
  378. begin
  379. dispose(ModuleNames,Done);
  380. ModuleNames:=nil;
  381. end;
  382. if assigned(TypeNames) then
  383. begin
  384. dispose(TypeNames,Done);
  385. TypeNames:=nil;
  386. end;
  387. end;
  388. procedure NewBrowserCol;
  389. begin
  390. New(Modules, Init(50,50));
  391. New(ModuleNames, Init(50,50));
  392. New(TypeNames, Init(1000,5000));
  393. end;
  394. procedure CreateBrowserCol;
  395. procedure ProcessSymTable(OwnerSym: PSymbol; var Owner: PSymbolCollection; Table: PSymTable);
  396. var I,J,defcount,symcount: longint;
  397. Ref: PRef;
  398. Sym,ParSym: PSym;
  399. Symbol: PSymbol;
  400. Reference: PReference;
  401. ParamCount: Sw_integer;
  402. Params: array[0..20] of PString;
  403. inputfile : pinputfile;
  404. Idx: sw_integer;
  405. S: string;
  406. procedure SetVType(Symbol: PSymbol; VType: string);
  407. begin
  408. Symbol^.VType:=TypeNames^.Add(VType);
  409. end;
  410. procedure SetDType(Symbol: PSymbol; DType: string);
  411. begin
  412. Symbol^.DType:=TypeNames^.Add(DType);
  413. end;
  414. function GetDefinitionStr(def: pdef): string; forward;
  415. function GetEnumDefStr(def: penumdef): string;
  416. var Name: string;
  417. esym: penumsym;
  418. Count: integer;
  419. begin
  420. Name:='(';
  421. esym:=def^.First; Count:=0;
  422. while (esym<>nil) do
  423. begin
  424. if Count>0 then Name:=Name+', ';
  425. Name:=Name+esym^.name;
  426. esym:=esym^.next; Inc(Count);
  427. end;
  428. Name:=Name+')';
  429. GetEnumDefStr:=Name;
  430. end;
  431. function GetArrayDefStr(def: parraydef): string;
  432. var Name: string;
  433. begin
  434. Name:='array ['+IntToStr(def^.lowrange)+'..'+IntToStr(def^.highrange)+'] of ';
  435. if assigned(def^.definition) then
  436. Name:=Name+GetDefinitionStr(def^.definition);
  437. GetArrayDefStr:=Name;
  438. end;
  439. function GetFileDefStr(def: pfiledef): string;
  440. var Name: string;
  441. begin
  442. Name:='';
  443. case def^.filetype of
  444. ft_text : Name:='text';
  445. ft_untyped : Name:='file';
  446. ft_typed : Name:='file of '+GetDefinitionStr(def^.typed_as);
  447. end;
  448. GetFileDefStr:=Name;
  449. end;
  450. function GetStringDefStr(def: pstringdef): string;
  451. var Name: string;
  452. begin
  453. Name:='';
  454. case def^.string_typ of
  455. st_shortstring :
  456. if def^.len=255 then
  457. Name:='shortstring'
  458. else
  459. Name:='string['+IntToStr(def^.len)+']';
  460. st_longstring :
  461. Name:='longstring';
  462. st_ansistring :
  463. Name:='ansistring';
  464. st_widestring :
  465. Name:='widestring';
  466. else ;
  467. end;
  468. GetStringDefStr:=Name;
  469. end;
  470. function retdefassigned(def: pabstractprocdef): boolean;
  471. var OK: boolean;
  472. begin
  473. OK:=false;
  474. if assigned(def^.retdef) then
  475. if UpcaseStr(GetDefinitionStr(def^.retdef))<>'VOID' then
  476. OK:=true;
  477. retdefassigned:=OK;
  478. end;
  479. function GetAbsProcParmDefStr(def: pabstractprocdef): string;
  480. var Name: string;
  481. dc: pdefcoll;
  482. Count: integer;
  483. CurName: string;
  484. begin
  485. Name:='';
  486. dc:=def^.para1; Count:=0;
  487. while dc<>nil do
  488. begin
  489. CurName:='';
  490. case dc^.paratyp of
  491. vs_Value : ;
  492. vs_Const : CurName:=CurName+'const ';
  493. vs_Var : CurName:=CurName+'var ';
  494. end;
  495. if assigned(dc^.data) then
  496. CurName:=CurName+GetDefinitionStr(dc^.data);
  497. if dc^.next<>nil then
  498. CurName:=', '+CurName;
  499. Name:=CurName+Name;
  500. dc:=dc^.next; Inc(Count);
  501. end;
  502. GetAbsProcParmDefStr:=Name;
  503. end;
  504. function GetAbsProcDefStr(def: pabstractprocdef): string;
  505. var Name: string;
  506. begin
  507. Name:=GetAbsProcParmDefStr(def);
  508. if Name<>'' then Name:='('+Name+')';
  509. if retdefassigned(def) then
  510. Name:='function'+Name+': '+GetDefinitionStr(def^.retdef)
  511. else
  512. Name:='procedure'+Name;
  513. GetAbsProcDefStr:=Name;
  514. end;
  515. function GetProcDefStr(def: pprocdef): string;
  516. var DName: string;
  517. J: integer;
  518. begin
  519. { DName:='';
  520. if assigned(def) then
  521. begin
  522. if assigned(def^.parast) then
  523. begin
  524. with def^.parast^ do
  525. for J:=1 to number_symbols do
  526. begin
  527. if J<>1 then DName:=DName+', ';
  528. ParSym:=GetsymNr(J);
  529. if ParSym=nil then Break;
  530. DName:=DName+ParSym^.Name;
  531. end;
  532. end
  533. end;}
  534. DName:=GetAbsProcDefStr(def);
  535. GetProcDefStr:=DName;
  536. end;
  537. function GetProcVarDefStr(def: pprocvardef): string;
  538. begin
  539. GetProcVarDefStr:=GetAbsProcDefStr(def);
  540. end;
  541. function GetSetDefStr(def: psetdef): string;
  542. var Name: string;
  543. begin
  544. Name:='';
  545. case def^.settype of
  546. normset : Name:='set';
  547. smallset : Name:='set';
  548. varset : Name:='varset';
  549. end;
  550. Name:=Name+' of ';
  551. Name:=Name+GetDefinitionStr(def^.setof);
  552. GetSetDefStr:=Name;
  553. end;
  554. function GetDefinitionStr(def: pdef): string;
  555. var Name: string;
  556. sym: psym;
  557. begin
  558. Name:='';
  559. if def<>nil then
  560. begin
  561. if assigned(def^.sym) then
  562. Name:=def^.sym^.name;
  563. if Name='' then
  564. case def^.deftype of
  565. arraydef :
  566. Name:=GetArrayDefStr(parraydef(def));
  567. stringdef :
  568. Name:=GetStringDefStr(pstringdef(def));
  569. enumdef :
  570. Name:=GetEnumDefStr(penumdef(def));
  571. procdef :
  572. Name:=GetProcDefStr(pprocdef(def));
  573. procvardef :
  574. Name:=GetProcVarDefStr(pprocvardef(def));
  575. filedef :
  576. Name:=GetFileDefStr(pfiledef(def));
  577. setdef :
  578. Name:=GetSetDefStr(psetdef(def));
  579. end;
  580. end;
  581. GetDefinitionStr:=Name;
  582. end;
  583. function GetEnumItemName(Sym: penumsym): string;
  584. var Name: string;
  585. ES: penumsym;
  586. begin
  587. Name:='';
  588. if assigned(sym) and assigned(sym^.definition) then
  589. if assigned(sym^.definition^.sym) then
  590. begin
  591. { ES:=sym^.definition^.First;
  592. while (ES<>nil) and (ES^.Value<>sym^.Value) do
  593. ES:=ES^.next;
  594. if assigned(es) and (es^.value=sym^.value) then
  595. Name:=}
  596. Name:=sym^.definition^.sym^.name;
  597. if Name<>'' then
  598. Name:=Name+'('+IntToStr(sym^.value)+')';
  599. end;
  600. GetEnumItemName:=Name;
  601. end;
  602. function GetConstValueName(sym: pconstsym): string;
  603. var Name: string;
  604. begin
  605. Name:='';
  606. { if assigned(sym^.definition) then
  607. if assigned(sym^.definition^.sym) then
  608. Name:=sym^.definition^.sym^.name;}
  609. if Name='' then
  610. case sym^.consttype of
  611. constord :
  612. Name:=sym^.definition^.sym^.name+'('+IntToStr(sym^.value)+')';
  613. conststring :
  614. Name:=''''+GetStr(PString(sym^.Value))+'''';
  615. constreal:
  616. Name:=FloatToStr(PBestReal(sym^.Value)^);
  617. constbool:
  618. { if boolean(sym^.Value)=true then
  619. Name:='TRUE'
  620. else
  621. Name:='FALSE';}
  622. Name:='Longbool('+IntToStr(sym^.Value)+')';
  623. constint:
  624. Name:=IntToStr(sym^.value);
  625. constchar:
  626. Name:=''''+chr(sym^.Value)+'''';
  627. constset:
  628. { Name:=SetToStr(pnormalset(sym^.Value))};
  629. constnil: ;
  630. end;
  631. GetConstValueName:=Name;
  632. end;
  633. procedure ProcessDefIfStruct(definition: pdef);
  634. begin
  635. if assigned(definition) then
  636. begin
  637. case definition^.deftype of
  638. recorddef :
  639. if precdef(definition)^.symtable<>Table then
  640. ProcessSymTable(Symbol,Symbol^.Items,precdef(definition)^.symtable);
  641. objectdef :
  642. if precdef(definition)^.symtable<>Table then
  643. ProcessSymTable(Symbol,Symbol^.Items,pobjectdef(definition)^.publicsyms);
  644. { leads to infinite loops !!
  645. pointerdef :
  646. with ppointerdef(definition)^ do
  647. if assigned(definition) then
  648. if assigned(definition^.sym) then
  649. ProcessDefIfStruct(definition^.sym^.definition);}
  650. end;
  651. end;
  652. end;
  653. begin
  654. if not Assigned(Table) then
  655. Exit;
  656. if Owner=nil then
  657. Owner:=New(PSortedSymbolCollection, Init(10,50));
  658. defcount:=Table^.number_defs;
  659. symcount:=Table^.number_symbols;
  660. { for I:=0 to defcount-1 do
  661. begin
  662. Def:=Table^.GetDefNr(I);
  663. end;}
  664. for I:=1 to symcount do
  665. begin
  666. Sym:=Table^.GetsymNr(I);
  667. if Sym=nil then Continue;
  668. ParamCount:=0;
  669. New(Symbol, Init(Sym^.Name,Sym^.Typ,''));
  670. case Sym^.Typ of
  671. varsym :
  672. with pvarsym(sym)^ do
  673. begin
  674. if assigned(definition) then
  675. if assigned(definition^.sym) then
  676. SetVType(Symbol,definition^.sym^.name)
  677. else
  678. SetVType(Symbol,GetDefinitionStr(definition));
  679. ProcessDefIfStruct(definition);
  680. end;
  681. constsym :
  682. SetDType(Symbol,GetConstValueName(pconstsym(sym)));
  683. enumsym :
  684. if assigned(penumsym(sym)^.definition) then
  685. SetDType(Symbol,GetEnumItemName(penumsym(sym)));
  686. unitsym :
  687. begin
  688. { ProcessSymTable(Symbol^.Items,punitsym(sym)^.unitsymtable);}
  689. end;
  690. syssym :
  691. { if assigned(Table^.Name) then
  692. if Table^.Name^='SYSTEM' then}
  693. begin
  694. Symbol^.Params:=TypeNames^.Add('...');
  695. end;
  696. funcretsym :
  697. if Assigned(OwnerSym) then
  698. with pfuncretsym(sym)^ do
  699. if assigned(funcretdef) then
  700. if assigned(funcretdef^.sym) then
  701. SetVType(OwnerSym,funcretdef^.sym^.name);
  702. procsym :
  703. begin
  704. with pprocsym(sym)^ do
  705. if assigned(definition) then
  706. begin
  707. ProcessSymTable(Symbol,Symbol^.Items,definition^.parast);
  708. if assigned(definition^.parast) then
  709. begin
  710. Symbol^.Params:=TypeNames^.Add(GetAbsProcParmDefStr(definition));
  711. end
  712. else { param-definition is NOT assigned }
  713. if assigned(Table^.Name) then
  714. if Table^.Name^='SYSTEM' then
  715. begin
  716. Symbol^.Params:=TypeNames^.Add('...');
  717. end;
  718. if assigned(definition^.localst) and
  719. (definition^.localst^.symtabletype<>staticsymtable) then
  720. ProcessSymTable(Symbol,Symbol^.Items,definition^.localst);
  721. end;
  722. end;
  723. typesym :
  724. begin
  725. with ptypesym(sym)^ do
  726. if assigned(definition) then
  727. case definition^.deftype of
  728. arraydef :
  729. SetDType(Symbol,GetArrayDefStr(parraydef(definition)));
  730. enumdef :
  731. SetDType(Symbol,GetEnumDefStr(penumdef(definition)));
  732. procdef :
  733. SetDType(Symbol,GetProcDefStr(pprocdef(definition)));
  734. procvardef :
  735. SetDType(Symbol,GetProcVarDefStr(pprocvardef(definition)));
  736. objectdef :
  737. with pobjectdef(definition)^ do
  738. begin
  739. if childof=nil then
  740. S:='.'
  741. else
  742. S:=childof^.name^;
  743. Symbol^.Ancestor:=TypeNames^.Add(S);
  744. Symbol^.IsClass:=(options and oo_is_class)<>0;
  745. ProcessSymTable(Symbol,Symbol^.Items,pobjectdef(definition)^.publicsyms);
  746. end;
  747. recorddef :
  748. begin
  749. Symbol^.IsRecord:=true;
  750. ProcessSymTable(Symbol,Symbol^.Items,precdef(definition)^.symtable);
  751. end;
  752. filedef :
  753. SetDType(Symbol,GetFileDefStr(pfiledef(definition)));
  754. setdef :
  755. SetDType(Symbol,GetSetDefStr(psetdef(definition)));
  756. end;
  757. end;
  758. end;
  759. Ref:=Sym^.defref;
  760. while Assigned(Symbol) and assigned(Ref) do
  761. begin
  762. inputfile:=get_source_file(ref^.moduleindex,ref^.posinfo.fileindex);
  763. if Assigned(inputfile) and Assigned(inputfile^.name) then
  764. begin
  765. New(Reference, Init(ModuleNames^.Add(inputfile^.name^),
  766. ref^.posinfo.line,ref^.posinfo.column));
  767. Symbol^.References^.Insert(Reference);
  768. end;
  769. Ref:=Ref^.nextref;
  770. end;
  771. if Assigned(Symbol) then
  772. Owner^.Insert(Symbol);
  773. end;
  774. end;
  775. var
  776. T: PSymTable;
  777. UnitS: PSymbol;
  778. hp : pmodule;
  779. begin
  780. DisposeBrowserCol;
  781. NewBrowserCol;
  782. hp:=pmodule(loaded_units.first);
  783. while assigned(hp) do
  784. begin
  785. t:=psymtable(hp^.globalsymtable);
  786. if assigned(t) then
  787. begin
  788. New(UnitS, Init(T^.Name^,unitsym,''));
  789. Modules^.Insert(UnitS);
  790. ProcessSymTable(UnitS,UnitS^.Items,T);
  791. if cs_local_browser in aktmoduleswitches then
  792. begin
  793. t:=psymtable(hp^.localsymtable);
  794. if assigned(t) then
  795. ProcessSymTable(UnitS,UnitS^.Items,T);
  796. end;
  797. end;
  798. hp:=pmodule(hp^.next);
  799. end;
  800. end;
  801. {*****************************************************************************
  802. Initialize
  803. *****************************************************************************}
  804. var
  805. oldexit : pointer;
  806. procedure browcol_exit;{$ifndef FPC}far;{$endif}
  807. begin
  808. exitproc:=oldexit;
  809. DisposeBrowserCol;
  810. end;
  811. procedure InitBrowserCol;
  812. begin
  813. end;
  814. procedure DoneBrowserCol;
  815. begin
  816. { nothing, the collections are freed in the exitproc }
  817. end;
  818. begin
  819. oldexit:=exitproc;
  820. exitproc:=@browcol_exit;
  821. end.
  822. {
  823. $Log$
  824. Revision 1.8 1999-03-03 01:38:11 pierre
  825. * avoid infinite recursion in ProcessDefIfStruct
  826. Revision 1.7 1999/02/22 11:51:32 peter
  827. * browser updates from gabor
  828. Revision 1.6 1999/02/04 09:31:59 pierre
  829. + added objects and records symbol tables
  830. Revision 1.5 1999/02/03 09:44:32 pierre
  831. * symbol nubering begins with 1 in number_symbols
  832. * program tmodule has globalsymtable for its staticsymtable
  833. (to get it displayed in IDE globals list)
  834. + list of symbol (browcol) greatly improved for IDE
  835. Revision 1.4 1999/02/02 16:38:38 peter
  836. * no endless loop with localst=staticsymtable
  837. Revision 1.3 1999/01/22 10:19:43 peter
  838. * fixed typo
  839. Revision 1.2 1999/01/21 11:49:14 peter
  840. * updates from gabor
  841. Revision 1.1 1999/01/12 14:25:24 peter
  842. + BrowserLog for browser.log generation
  843. + BrowserCol for browser info in TCollections
  844. * released all other UseBrowser
  845. }