diff --git a/Projects/SAMufasaGUI/framefunctionlist.pas b/Projects/SAMufasaGUI/framefunctionlist.pas index 76ffd4f..911bdb3 100644 --- a/Projects/SAMufasaGUI/framefunctionlist.pas +++ b/Projects/SAMufasaGUI/framefunctionlist.pas @@ -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; - 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]); + 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)); + 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} diff --git a/Projects/SAMufasaGUI/framescript.pas b/Projects/SAMufasaGUI/framescript.pas index a0c5346..baa8045 100644 --- a/Projects/SAMufasaGUI/framescript.pas +++ b/Projects/SAMufasaGUI/framescript.pas @@ -28,7 +28,7 @@ interface uses Classes, SysUtils, FileUtil, LResources, Forms, SynHighlighterPas, SynEdit, SynEditMarkupHighAll, - mmlpsthread,ComCtrls, SynEditKeyCmds, LCLType,MufasaBase, SynEditMarkupSpecialLine, Graphics, Controls, + mmlpsthread,ComCtrls, SynEditKeyCmds, LCLType,MufasaBase, SynEditMarkupSpecialLine, Graphics, Controls, SynEditStrConst, v_ideCodeInsight, v_ideCodeParser, CastaliaPasLexTypes, CastaliaSimplePasPar, SynEditHighlighter,synedittextbase; const ecCodeCompletion = ecUserFirst; @@ -266,7 +266,7 @@ var s: string; Attri: TSynHighlighterAttributes; begin - AllowMouseLink := SynEdit.GetHighlighterAttriAtRowCol(Point(X, Y), s, Attri) and (Attri.Name = 'Identifier'); + AllowMouseLink := SynEdit.GetHighlighterAttriAtRowCol(Point(X, Y), s, Attri) and (Attri.Name = SYNS_AttrIdentifier); end; procedure TScriptFrame.SynEditProcessCommand(Sender: TObject; @@ -301,7 +301,8 @@ var d: TDeclaration; dd: TDeclaration; begin - if (Command = ecCodeCompletion) and ((not SynEdit.GetHighlighterAttriAtRowCol(SynEdit.CaretXY, s, Attri)) or (Attri.Name = 'Identifier')) then + if (Command = ecCodeCompletion) and ((not SynEdit.GetHighlighterAttriAtRowCol(SynEdit.CaretXY, s, Attri)) or + ((Attri.Name = SYNS_AttrIdentifier) or (Attri.name = SYNS_AttrSymbol))) then begin {form1.FunctionListShown(True); with form1.frmFunctionList do diff --git a/Projects/SAMufasaGUI/testunit.lfm b/Projects/SAMufasaGUI/testunit.lfm index 4db6254..94b4392 100644 --- a/Projects/SAMufasaGUI/testunit.lfm +++ b/Projects/SAMufasaGUI/testunit.lfm @@ -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 diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 6a6c683..e8eb4b8 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -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} diff --git a/Units/MMLAddon/mmisc.pas b/Units/MMLAddon/mmisc.pas index ab0d13e..45f3e4d 100644 --- a/Units/MMLAddon/mmisc.pas +++ b/Units/MMLAddon/mmisc.pas @@ -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. diff --git a/Units/Misc/v_autocompleteform.pas b/Units/Misc/v_autocompleteform.pas index 687673b..b622e87 100644 --- a/Units/Misc/v_autocompleteform.pas +++ b/Units/Misc/v_autocompleteform.pas @@ -587,7 +587,7 @@ begin; exit; if EndPos.y = beginpos.y then begin - result := copy(strings[beginpos.y],beginpos.x, endpos.x - beginpos.x + 1); + result := copy(strings[beginpos.y],beginpos.x, endpos.x - beginpos.x); exit; end; result := copy(strings[beginpos.y],beginpos.x, length(strings[beginpos.y]) - beginpos.x + 1);