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:
parent
af9a1d0c31
commit
8038ebe39a
@ -6,10 +6,20 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, FileUtil, LResources, MufasaBase,Forms, ComCtrls, StdCtrls, Controls,
|
Classes, SysUtils, FileUtil, LResources, MufasaBase,Forms, ComCtrls, StdCtrls, Controls,
|
||||||
ExtCtrls, Buttons;
|
ExtCtrls, Buttons,mmisc,v_ideCodeInsight;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
|
{ TFillThread }
|
||||||
|
|
||||||
|
TFillThread = class(TThread)
|
||||||
|
public
|
||||||
|
Analyzer : TCodeInsight;
|
||||||
|
MS : TMemoryStream;
|
||||||
|
FunctionList : ^TTreeView;
|
||||||
|
IncludesNode,ScriptNode : TTreeNode;
|
||||||
|
procedure execute; override;
|
||||||
|
end;
|
||||||
{ TFunctionListFrame }
|
{ TFunctionListFrame }
|
||||||
|
|
||||||
TFunctionListFrame = class(TFrame)
|
TFunctionListFrame = class(TFrame)
|
||||||
@ -18,6 +28,7 @@ type
|
|||||||
FunctionListLabel: TLabel;
|
FunctionListLabel: TLabel;
|
||||||
CloseButton: TSpeedButton;
|
CloseButton: TSpeedButton;
|
||||||
procedure editSearchListChange(Sender: TObject);
|
procedure editSearchListChange(Sender: TObject);
|
||||||
|
procedure FillThreadTerminate(Sender: TObject);
|
||||||
procedure FrameEndDock(Sender, Target: TObject; X, Y: Integer);
|
procedure FrameEndDock(Sender, Target: TObject; X, Y: Integer);
|
||||||
procedure FunctionListDblClick(Sender: TObject);
|
procedure FunctionListDblClick(Sender: TObject);
|
||||||
procedure FunctionListDeletion(Sender: TObject; Node: TTreeNode);
|
procedure FunctionListDeletion(Sender: TObject; Node: TTreeNode);
|
||||||
@ -31,6 +42,9 @@ type
|
|||||||
Shift: TShiftState; X, Y: Integer);
|
Shift: TShiftState; X, Y: Integer);
|
||||||
private
|
private
|
||||||
FFilterTree : TTreeView;
|
FFilterTree : TTreeView;
|
||||||
|
FLastScript : string;
|
||||||
|
Filtering : boolean;
|
||||||
|
FillThread : TFillThread;
|
||||||
procedure FilterTreeVis(Vis : boolean);
|
procedure FilterTreeVis(Vis : boolean);
|
||||||
function GetFilterTree: TTreeView;
|
function GetFilterTree: TTreeView;
|
||||||
{ private declarations }
|
{ private declarations }
|
||||||
@ -58,7 +72,7 @@ type
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
TestUnit, Graphics, stringutil, simpleanalyzer,v_ideCodeInsight,v_ideCodeParser,lclintf;
|
TestUnit, Graphics, stringutil, simpleanalyzer,v_ideCodeParser,lclintf;
|
||||||
|
|
||||||
{ TFunctionListFrame }
|
{ TFunctionListFrame }
|
||||||
|
|
||||||
@ -67,6 +81,19 @@ begin
|
|||||||
Find(false);
|
Find(false);
|
||||||
end;
|
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
|
procedure TFunctionListFrame.FrameEndDock(Sender, Target: TObject; X, Y: Integer
|
||||||
);
|
);
|
||||||
begin
|
begin
|
||||||
@ -183,77 +210,36 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TFunctionListFrame.LoadScriptTree(Script: String);
|
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
|
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
|
if script = '' then
|
||||||
exit;
|
exit;
|
||||||
if ScriptNode = nil then
|
if ScriptNode = nil then
|
||||||
exit;
|
exit;
|
||||||
if FilterTree.Visible then
|
if FillThread <> nil then {Already busy filling!}
|
||||||
begin
|
|
||||||
mDebugLn('Might get some acces violations now..');
|
|
||||||
exit;
|
exit;
|
||||||
end;
|
if FLastScript = Script then
|
||||||
|
exit;
|
||||||
|
FLastScript:= Script;
|
||||||
|
Filtering := FilterTree.Visible;
|
||||||
|
if FilterTree.Visible then
|
||||||
|
FilterTreeVis(false);
|
||||||
FunctionList.BeginUpdate;
|
FunctionList.BeginUpdate;
|
||||||
ScriptNode.DeleteChildren;
|
ScriptNode.DeleteChildren;
|
||||||
Analyzing := TCodeInsight.Create();
|
FillThread := TFillThread.Create(true);
|
||||||
Analyzing.OnFindInclude:= @Form1.OnCCFindInclude;
|
FillThread.FunctionList := @Self.FunctionList;
|
||||||
Analyzing.OnMessage:= @Form1.OnCCMessage;
|
FillThread.Analyzer := TCodeInsight.Create;
|
||||||
Analyzing.FileName:= Form1.CurrScript.ScriptFile;
|
with FillThread,FillThread.Analyzer do
|
||||||
|
begin
|
||||||
|
OnFindInclude := @Form1.OnCCFindInclude;
|
||||||
|
FileName := Form1.CurrScript.ScriptFile;
|
||||||
MS := TMemoryStream.Create;
|
MS := TMemoryStream.Create;
|
||||||
MS.Write(Script[1],length(script));
|
MS.Write(Script[1],length(script));
|
||||||
Analyzing.Run(MS,nil,-1,true);
|
OnTerminate:=@FillThreadTerminate;
|
||||||
AddProcsTree(ScriptNode,Analyzing.Items,Analyzing.FileName); //Add the procedures of the script to the script tree
|
FillThread.ScriptNode := self.ScriptNode;
|
||||||
|
FillThread.IncludesNode := self.IncludesNode;
|
||||||
//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]);
|
|
||||||
end;
|
end;
|
||||||
ScriptNode.Expand(true);
|
FillThread.resume;
|
||||||
FunctionList.EndUpdate;
|
//See FillThreadTerminate for the rest of this procedure
|
||||||
Analyzing.Free;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TFunctionListFrame.Find(Next : boolean; backwards : boolean = false) : boolean;
|
function TFunctionListFrame.Find(Next : boolean; backwards : boolean = false) : boolean;
|
||||||
@ -458,6 +444,58 @@ begin
|
|||||||
end;
|
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
|
initialization
|
||||||
{$R *.lfm}
|
{$R *.lfm}
|
||||||
|
|
||||||
|
@ -3110,4 +3110,10 @@ object Form1: TForm1
|
|||||||
left = 568
|
left = 568
|
||||||
top = 200
|
top = 200
|
||||||
end
|
end
|
||||||
|
object FunctionListTimer: TTimer
|
||||||
|
Interval = 750
|
||||||
|
OnTimer = FunctionListTimerTimer
|
||||||
|
left = 608
|
||||||
|
top = 200
|
||||||
|
end
|
||||||
end
|
end
|
||||||
|
@ -118,6 +118,7 @@ type
|
|||||||
MouseTimer: TTimer;
|
MouseTimer: TTimer;
|
||||||
NewsTimer: TTimer;
|
NewsTimer: TTimer;
|
||||||
SCARHighlighter: TSynFreePascalSyn;
|
SCARHighlighter: TSynFreePascalSyn;
|
||||||
|
FunctionListTimer: TTimer;
|
||||||
TT_Console: TToolButton;
|
TT_Console: TToolButton;
|
||||||
TT_Cut: TToolButton;
|
TT_Cut: TToolButton;
|
||||||
TT_Copy: TToolButton;
|
TT_Copy: TToolButton;
|
||||||
@ -255,6 +256,7 @@ type
|
|||||||
procedure FunctionListChange(Sender: TObject; Node: TTreeNode);
|
procedure FunctionListChange(Sender: TObject; Node: TTreeNode);
|
||||||
procedure FunctionListEnter(Sender: TObject);
|
procedure FunctionListEnter(Sender: TObject);
|
||||||
procedure FunctionListExit(Sender: TObject);
|
procedure FunctionListExit(Sender: TObject);
|
||||||
|
procedure FunctionListTimerTimer(Sender: TObject);
|
||||||
procedure MenuItemExtensionsClick(Sender: TObject);
|
procedure MenuItemExtensionsClick(Sender: TObject);
|
||||||
procedure MenuItemHandbookClick(Sender: TObject);
|
procedure MenuItemHandbookClick(Sender: TObject);
|
||||||
procedure MenuItemColourHistoryClick(Sender: TObject);
|
procedure MenuItemColourHistoryClick(Sender: TObject);
|
||||||
@ -421,15 +423,6 @@ type
|
|||||||
property CurrHighlighter : TSynCustomHighlighter read GetHighlighter;
|
property CurrHighlighter : TSynCustomHighlighter read GetHighlighter;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TProcThread }
|
|
||||||
|
|
||||||
TProcThread = class(TThread)
|
|
||||||
public
|
|
||||||
StartWait : Cardinal;
|
|
||||||
ClassProc : procedure of object;
|
|
||||||
NormalProc : procedure;
|
|
||||||
procedure Execute; override;
|
|
||||||
end;
|
|
||||||
procedure ClearDebug;
|
procedure ClearDebug;
|
||||||
procedure formWriteln( S : String);
|
procedure formWriteln( S : String);
|
||||||
procedure formWritelnEx( S : String);
|
procedure formWritelnEx( S : String);
|
||||||
@ -1860,6 +1853,12 @@ begin
|
|||||||
// StatusBar.Panels[2].Text:= '';
|
// StatusBar.Panels[2].Text:= '';
|
||||||
end;
|
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);
|
procedure TForm1.MenuItemExtensionsClick(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
ExtensionsForm.Show;
|
ExtensionsForm.Show;
|
||||||
@ -1941,6 +1940,7 @@ begin
|
|||||||
CloseAction := caNone;
|
CloseAction := caNone;
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
|
FunctionListTimer.Enabled:= false;
|
||||||
FreeAndNil(ExtManager);
|
FreeAndNil(ExtManager);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -2791,7 +2791,7 @@ begin
|
|||||||
StartText := SynEdit.Lines.text;
|
StartText := SynEdit.Lines.text;
|
||||||
ScriptName:= ExtractFileNameOnly(filename);
|
ScriptName:= ExtractFileNameOnly(filename);
|
||||||
mDebugLn('Script name will be: ' + ScriptName);
|
mDebugLn('Script name will be: ' + ScriptName);
|
||||||
ScriptFile:= SetDirSeparators(FileName);
|
ScriptFile:= FileName;
|
||||||
ScriptChanged := false;
|
ScriptChanged := false;
|
||||||
AddRecentFile(filename);
|
AddRecentFile(filename);
|
||||||
RefreshTab();
|
RefreshTab();
|
||||||
@ -2919,18 +2919,6 @@ begin
|
|||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TProcThread }
|
|
||||||
|
|
||||||
procedure TProcThread.Execute;
|
|
||||||
begin
|
|
||||||
if startwait <> 0 then
|
|
||||||
sleep(StartWait);
|
|
||||||
if NormalProc <> nil then
|
|
||||||
NormalProc;
|
|
||||||
if ClassProc <> nil then
|
|
||||||
ClassProc;
|
|
||||||
end;
|
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
{$R *.lfm}
|
{$R *.lfm}
|
||||||
|
|
||||||
|
@ -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) : TStringArray;overload;
|
||||||
function UnTar(const Input : TStream;const outputdir : string; overwrite : boolean): boolean;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
|
implementation
|
||||||
|
|
||||||
function DecompressBZip2(const input: TStream; const BlockSize: Cardinal): TMemoryStream;
|
function DecompressBZip2(const input: TStream; const BlockSize: Cardinal): TMemoryStream;
|
||||||
@ -93,5 +103,18 @@ begin;
|
|||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TProcThread }
|
||||||
|
|
||||||
|
procedure TProcThread.Execute;
|
||||||
|
begin
|
||||||
|
if startwait <> 0 then
|
||||||
|
sleep(StartWait);
|
||||||
|
if NormalProc <> nil then
|
||||||
|
NormalProc;
|
||||||
|
if ClassProc <> nil then
|
||||||
|
ClassProc;
|
||||||
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user