1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-05 17:05:19 -05:00

Made the functionlist parse on a timer + in a different thread.

This commit is contained in:
Raymond 2010-04-07 16:23:48 +02:00
parent af9a1d0c31
commit 8038ebe39a
4 changed files with 141 additions and 86 deletions

View File

@ -6,10 +6,20 @@ interface
uses
Classes, SysUtils, FileUtil, LResources, MufasaBase,Forms, ComCtrls, StdCtrls, Controls,
ExtCtrls, Buttons;
ExtCtrls, Buttons,mmisc,v_ideCodeInsight;
type
{ TFillThread }
TFillThread = class(TThread)
public
Analyzer : TCodeInsight;
MS : TMemoryStream;
FunctionList : ^TTreeView;
IncludesNode,ScriptNode : TTreeNode;
procedure execute; override;
end;
{ TFunctionListFrame }
TFunctionListFrame = class(TFrame)
@ -18,6 +28,7 @@ type
FunctionListLabel: TLabel;
CloseButton: TSpeedButton;
procedure editSearchListChange(Sender: TObject);
procedure FillThreadTerminate(Sender: TObject);
procedure FrameEndDock(Sender, Target: TObject; X, Y: Integer);
procedure FunctionListDblClick(Sender: TObject);
procedure FunctionListDeletion(Sender: TObject; Node: TTreeNode);
@ -31,6 +42,9 @@ type
Shift: TShiftState; X, Y: Integer);
private
FFilterTree : TTreeView;
FLastScript : string;
Filtering : boolean;
FillThread : TFillThread;
procedure FilterTreeVis(Vis : boolean);
function GetFilterTree: TTreeView;
{ private declarations }
@ -58,7 +72,7 @@ type
implementation
uses
TestUnit, Graphics, stringutil, simpleanalyzer,v_ideCodeInsight,v_ideCodeParser,lclintf;
TestUnit, Graphics, stringutil, simpleanalyzer,v_ideCodeParser,lclintf;
{ TFunctionListFrame }
@ -67,6 +81,19 @@ begin
Find(false);
end;
procedure TFunctionListFrame.FillThreadTerminate(Sender: TObject);
begin
FillThread.Analyzer.Free;
FreeAndNil(FillThread);
ScriptNode.Expand(true);
FunctionList.EndUpdate;
if Filtering then
begin
FilterTreeVis(True);
Find(false,false);
end;
end;
procedure TFunctionListFrame.FrameEndDock(Sender, Target: TObject; X, Y: Integer
);
begin
@ -183,77 +210,36 @@ begin
end;
procedure TFunctionListFrame.LoadScriptTree(Script: String);
procedure AddProcsTree(Node : TTreeNode; Procs : TDeclarationList; Path : string);
var
i : integer;
tmpNode : TTreeNode;
begin;
for i := 0 to Procs.Count - 1 do
if (Procs[i] is TciProcedureDeclaration) then
with Procs[i] as TciProcedureDeclaration do
begin
tmpNode := FunctionList.Items.AddChild(Node,name.ShortText);
tmpNode.Data := GetMem(SizeOf(TMethodInfo));
FillChar(PMethodInfo(tmpNode.Data)^,SizeOf(TMethodInfo),0);
with PMethodInfo(tmpNode.Data)^ do
begin
MethodStr := strnew(Pchar(CleanDeclaration));
Filename:= strnew(pchar(path));
BeginPos:= name.StartPos ;
EndPos := name.StartPos + Length(TrimRight(name.RawText));
end;
end;
end;
procedure AddIncludes(ParentNode : TTreeNode; Include : TCodeInsight);
var
i : integer;
begin;
parentNode := FunctionList.Items.AddChild(
IncludesNode,ExtractFileNameOnly(
Include.FileName));
AddProcsTree(parentNode,Include.Items,Include.FileName);
for i := 0 to high(Include.Includes) do
AddIncludes(ParentNode,Include.Includes[i])
end;
var
I : integer;
Analyzing : TCodeInsight;
MS : TMemoryStream;
time : longword;
begin
Time := GetTickCount;
if script = '' then
exit;
if ScriptNode = nil then
exit;
if FilterTree.Visible then
begin
mDebugLn('Might get some acces violations now..');
if FillThread <> nil then {Already busy filling!}
exit;
end;
if FLastScript = Script then
exit;
FLastScript:= Script;
Filtering := FilterTree.Visible;
if FilterTree.Visible then
FilterTreeVis(false);
FunctionList.BeginUpdate;
ScriptNode.DeleteChildren;
Analyzing := TCodeInsight.Create();
Analyzing.OnFindInclude:= @Form1.OnCCFindInclude;
Analyzing.OnMessage:= @Form1.OnCCMessage;
Analyzing.FileName:= Form1.CurrScript.ScriptFile;
FillThread := TFillThread.Create(true);
FillThread.FunctionList := @Self.FunctionList;
FillThread.Analyzer := TCodeInsight.Create;
with FillThread,FillThread.Analyzer do
begin
OnFindInclude := @Form1.OnCCFindInclude;
FileName := Form1.CurrScript.ScriptFile;
MS := TMemoryStream.Create;
MS.Write(Script[1],length(script));
Analyzing.Run(MS,nil,-1,true);
AddProcsTree(ScriptNode,Analyzing.Items,Analyzing.FileName); //Add the procedures of the script to the script tree
//Lame condition.. We must check if nothing new has been included since
//last generation of the tree.. However, this will do fine for now ;)
if IncludesNode.Count <> length(Analyzing.Includes) then
begin;
IncludesNode.DeleteChildren;
for i := 0 to high(Analyzing.Includes) do
AddIncludes(IncludesNode, Analyzing.Includes[i]);
OnTerminate:=@FillThreadTerminate;
FillThread.ScriptNode := self.ScriptNode;
FillThread.IncludesNode := self.IncludesNode;
end;
ScriptNode.Expand(true);
FunctionList.EndUpdate;
Analyzing.Free;
FillThread.resume;
//See FillThreadTerminate for the rest of this procedure
end;
function TFunctionListFrame.Find(Next : boolean; backwards : boolean = false) : boolean;
@ -458,6 +444,58 @@ begin
end;
{ TFillThread }
procedure TFillThread.execute;
procedure AddProcsTree(Node : TTreeNode; Procs : TDeclarationList; Path : string);
var
i : integer;
tmpNode : TTreeNode;
begin;
for i := 0 to Procs.Count - 1 do
if (Procs[i] is TciProcedureDeclaration) then
with Procs[i] as TciProcedureDeclaration do
begin
tmpNode := FunctionList^.Items.AddChild(Node,name.ShortText);
tmpNode.Data := GetMem(SizeOf(TMethodInfo));
FillChar(PMethodInfo(tmpNode.Data)^,SizeOf(TMethodInfo),0);
with PMethodInfo(tmpNode.Data)^ do
begin
MethodStr := strnew(Pchar(CleanDeclaration));
Filename:= strnew(pchar(path));
BeginPos:= name.StartPos ;
EndPos := name.StartPos + Length(TrimRight(name.RawText));
end;
end;
end;
procedure AddIncludes(ParentNode : TTreeNode; Include : TCodeInsight);
var
i : integer;
begin;
parentNode := FunctionList^.Items.AddChild(
IncludesNode,ExtractFileNameOnly(
Include.FileName));
AddProcsTree(parentNode,Include.Items,Include.FileName);
for i := 0 to high(Include.Includes) do
AddIncludes(ParentNode,Include.Includes[i])
end;
var
i : integer;
begin
Analyzer.Run(MS,nil,-1,true);
AddProcsTree(ScriptNode,Analyzer.Items,Analyzer.FileName); //Add the procedures of the script to the script tree
//Lame condition.. We must check if nothing new has been included since
//last generation of the tree.. However, this will do fine for now ;)
if IncludesNode.Count <> length(Analyzer.Includes) then
begin;
IncludesNode.DeleteChildren;
for i := 0 to high(Analyzer.Includes) do
AddIncludes(IncludesNode, Analyzer.Includes[i]);
end;
end;
initialization
{$R *.lfm}

View File

@ -3110,4 +3110,10 @@ object Form1: TForm1
left = 568
top = 200
end
object FunctionListTimer: TTimer
Interval = 750
OnTimer = FunctionListTimerTimer
left = 608
top = 200
end
end

View File

@ -118,6 +118,7 @@ type
MouseTimer: TTimer;
NewsTimer: TTimer;
SCARHighlighter: TSynFreePascalSyn;
FunctionListTimer: TTimer;
TT_Console: TToolButton;
TT_Cut: TToolButton;
TT_Copy: TToolButton;
@ -255,6 +256,7 @@ type
procedure FunctionListChange(Sender: TObject; Node: TTreeNode);
procedure FunctionListEnter(Sender: TObject);
procedure FunctionListExit(Sender: TObject);
procedure FunctionListTimerTimer(Sender: TObject);
procedure MenuItemExtensionsClick(Sender: TObject);
procedure MenuItemHandbookClick(Sender: TObject);
procedure MenuItemColourHistoryClick(Sender: TObject);
@ -421,15 +423,6 @@ type
property CurrHighlighter : TSynCustomHighlighter read GetHighlighter;
end;
{ TProcThread }
TProcThread = class(TThread)
public
StartWait : Cardinal;
ClassProc : procedure of object;
NormalProc : procedure;
procedure Execute; override;
end;
procedure ClearDebug;
procedure formWriteln( S : String);
procedure formWritelnEx( S : String);
@ -1860,6 +1853,12 @@ begin
// StatusBar.Panels[2].Text:= '';
end;
procedure TForm1.FunctionListTimerTimer(Sender: TObject);
begin
if Self.Visible and (CurrScript <> nil) then
frmFunctionList.LoadScriptTree(CurrScript.SynEdit.Text);
end;
procedure TForm1.MenuItemExtensionsClick(Sender: TObject);
begin
ExtensionsForm.Show;
@ -1941,6 +1940,7 @@ begin
CloseAction := caNone;
exit;
end;
FunctionListTimer.Enabled:= false;
FreeAndNil(ExtManager);
end;
@ -2791,7 +2791,7 @@ begin
StartText := SynEdit.Lines.text;
ScriptName:= ExtractFileNameOnly(filename);
mDebugLn('Script name will be: ' + ScriptName);
ScriptFile:= SetDirSeparators(FileName);
ScriptFile:= FileName;
ScriptChanged := false;
AddRecentFile(filename);
RefreshTab();
@ -2919,18 +2919,6 @@ begin
inherited Destroy;
end;
{ TProcThread }
procedure TProcThread.Execute;
begin
if startwait <> 0 then
sleep(StartWait);
if NormalProc <> nil then
NormalProc;
if ClassProc <> nil then
ClassProc;
end;
initialization
{$R *.lfm}

View File

@ -11,6 +11,16 @@ function DecompressBZip2(const input : TStream; const BlockSize : Cardinal = 409
function UnTar(const Input : TStream) : TStringArray;overload;
function UnTar(const Input : TStream;const outputdir : string; overwrite : boolean): boolean;overload;
type
{ TProcThread }
TProcThread = class(TThread)
public
StartWait : Cardinal;
ClassProc : procedure of object;
NormalProc : procedure;
procedure Execute; override;
end;
implementation
function DecompressBZip2(const input: TStream; const BlockSize: Cardinal): TMemoryStream;
@ -93,5 +103,18 @@ begin;
end;
{ TProcThread }
procedure TProcThread.Execute;
begin
if startwait <> 0 then
sleep(StartWait);
if NormalProc <> nil then
NormalProc;
if ClassProc <> nil then
ClassProc;
end;
end.