mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-03 01:18:30 +02:00
+ FindProcedure implemented
This commit is contained in:
parent
241f775056
commit
7dd9e33e40
@ -14,9 +14,97 @@
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
procedure TIDEApp.FindProcedure;
|
||||
function ProcedureDialog(S : string) : PDialog;
|
||||
var D: PDialog;
|
||||
R,R1,R2: TRect;
|
||||
IL: PInputLine;
|
||||
begin
|
||||
NotImplemented;
|
||||
R.Assign(0,0,40,8);
|
||||
New(D, Init(R, dialog_proceduredialog));
|
||||
with D^ do
|
||||
begin
|
||||
Options:=Options or ofCentered;
|
||||
GetExtent(R); R.Grow(-3,-2); R.B.Y:=R.A.Y+1;
|
||||
R1.Copy(R);
|
||||
R2.Copy(R); Inc(R2.A.Y);Inc(R2.B.Y);
|
||||
New(IL, Init(R2,255));
|
||||
Insert(IL);
|
||||
IL^.SetData(S);
|
||||
Insert(New(PLabel, Init(R1, label_enterproceduretofind, IL)));
|
||||
GetExtent(R); R.Grow(-8,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10;
|
||||
Insert(New(PButton, Init(R, button_OK, cmOK, bfDefault)));
|
||||
R.Move(15,0);
|
||||
Insert(New(PButton, Init(R, button_Cancel, cmCancel, bfNormal)));
|
||||
end;
|
||||
IL^.Select;
|
||||
ProcedureDialog:=D;
|
||||
end;
|
||||
|
||||
|
||||
procedure TIDEApp.FindProcedure;
|
||||
var R: TRect;
|
||||
S: PSortedSymbolCollection;
|
||||
Overflow: boolean;
|
||||
ProcS : string;
|
||||
Level : longint;
|
||||
|
||||
function NameMatches(const St : string) : boolean;
|
||||
begin
|
||||
NameMatches:=(ProcS='') or (Pos(ProcS,UpcaseStr(St)) > 0);
|
||||
end;
|
||||
|
||||
procedure InsertInS(P: PSymbol); {$ifndef FPC}far;{$endif}
|
||||
|
||||
procedure InsertItemsInS(P: PSymbolCollection);
|
||||
var I: Sw_integer;
|
||||
begin
|
||||
for I:=0 to P^.Count-1 do
|
||||
InsertInS(P^.At(I));
|
||||
end;
|
||||
|
||||
begin
|
||||
Inc(level);
|
||||
if S^.Count=MaxCollectionSize then
|
||||
begin Overflow:=true; Exit; end;
|
||||
if {(P^.typ = procsym) this needs symconst unit which I prefer to avoid }
|
||||
((P^.GetTypeName='proc') or (P^.GetTypeName='func'))
|
||||
and NameMatches(P^.GetName) then
|
||||
S^.Insert(P);
|
||||
{ this is wrong because it inserted args or locals of proc
|
||||
in the globals list !! PM}
|
||||
if (P^.Items<>nil) and (level=1) then
|
||||
InsertItemsInS(P^.Items);
|
||||
Dec(level);
|
||||
end;
|
||||
|
||||
var
|
||||
EditorWindow : PSourceWindow;
|
||||
begin
|
||||
level:=0;
|
||||
if BrowCol.Modules=nil then
|
||||
begin ErrorBox(msg_nodebuginfoavailable,nil); Exit; end;
|
||||
EditorWindow:=FirstEditorWindow;
|
||||
If assigned(EditorWindow) then
|
||||
ProcS:=LowerCaseStr(EditorWindow^.Editor^.GetCurrentWord)
|
||||
else
|
||||
ProcS:='';
|
||||
if ExecuteDialog(ProcedureDialog(ProcS),@ProcS)=cmCancel then
|
||||
exit;
|
||||
ProcS:=UpcaseStr(ProcS);
|
||||
Overflow:=false;
|
||||
if assigned(ProcedureCollection) then
|
||||
begin
|
||||
ProcedureCollection^.deleteAll;
|
||||
Dispose(ProcedureCollection,done);
|
||||
end;
|
||||
New(S, Init(500,500));
|
||||
ProcedureCollection:=S;
|
||||
BrowCol.Modules^.ForEach(@InsertInS);
|
||||
if Overflow then
|
||||
WarningBox(msg_toomanysymbolscantdisplayall,nil);
|
||||
Desktop^.GetExtent(R); R.A.X:=R.B.X-35;
|
||||
Desktop^.Insert(New(PBrowserWindow, Init(R,
|
||||
label_sym_findprocedure,SearchFreeWindowNo,nil,label_sym_findprocedure2+ProcS,'',S,nil,nil,nil)));
|
||||
end;
|
||||
|
||||
procedure TIDEApp.Objects;
|
||||
@ -140,7 +228,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2001-08-04 11:30:23 peter
|
||||
Revision 1.2 2001-10-24 21:49:56 pierre
|
||||
+ FindProcedure implemented
|
||||
|
||||
Revision 1.1 2001/08/04 11:30:23 peter
|
||||
* ide works now with both compiler versions
|
||||
|
||||
Revision 1.1.2.1 2001/03/20 00:20:42 pierre
|
||||
|
@ -332,6 +332,9 @@ const
|
||||
dialog_browsesymbol = 'Browse Symbol';
|
||||
label_entersymboltobrowse = 'Enter S~y~mbol to browse';
|
||||
|
||||
dialog_proceduredialog = 'Find Procedure';
|
||||
label_enterproceduretofind = 'Enter ~m~atching expr.';
|
||||
|
||||
dialog_gdbwindow = 'GDB window';
|
||||
|
||||
dialog_disaswindow = 'Disassembly window';
|
||||
@ -675,6 +678,8 @@ const
|
||||
label_sym_objects = 'Objects';
|
||||
label_sym_globalscope = 'Global scope';
|
||||
label_sym_globals = 'Globals';
|
||||
label_sym_findprocedure = 'Procedures';
|
||||
label_sym_findprocedure2 = 'Matching ';
|
||||
|
||||
{ Symbol browser meminfo page }
|
||||
msg_sizeinmemory = 'Size in memory';
|
||||
@ -1007,7 +1012,10 @@ const
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2001-10-12 14:21:47 pierre
|
||||
Revision 1.4 2001-10-24 21:49:56 pierre
|
||||
+ FindProcedure implemented
|
||||
|
||||
Revision 1.3 2001/10/12 14:21:47 pierre
|
||||
+ show error if switch to new screen mode failed
|
||||
|
||||
Revision 1.2 2001/08/29 23:31:27 pierre
|
||||
|
@ -222,6 +222,7 @@ procedure RemoveBrowsersCollection;
|
||||
|
||||
const
|
||||
GlobalsCollection : PSortedCollection = nil;
|
||||
ProcedureCollection : PSortedCollection = nil;
|
||||
ModulesCollection : PSortedCollection = nil;
|
||||
|
||||
implementation
|
||||
@ -266,6 +267,12 @@ begin
|
||||
Dispose(GlobalsCollection,done);
|
||||
GlobalsCollection:=nil;
|
||||
end;
|
||||
if assigned(ProcedureCollection) then
|
||||
begin
|
||||
ProcedureCollection^.deleteAll;
|
||||
Dispose(ProcedureCollection,done);
|
||||
ProcedureCollection:=nil;
|
||||
end;
|
||||
if assigned(ModulesCollection) then
|
||||
begin
|
||||
ModulesCollection^.deleteAll;
|
||||
@ -1812,7 +1819,10 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2001-08-05 12:23:00 peter
|
||||
Revision 1.4 2001-10-24 21:49:56 pierre
|
||||
+ FindProcedure implemented
|
||||
|
||||
Revision 1.3 2001/08/05 12:23:00 peter
|
||||
* Automatically support for fvision or old fv
|
||||
|
||||
Revision 1.2 2001/08/05 02:01:48 peter
|
||||
|
Loading…
Reference in New Issue
Block a user