Merge ssh://villavu.com:54367/simba

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
+  if FillThread <> nil then {Already busy filling!}
-  begin
-    mDebugLn('Might get some acces violations now..');
     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();
+  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
-  MS := TMemoryStream.Create;
+  begin
-  MS.Write(Script[1],length(script));
+    OnFindInclude := @Form1.OnCCFindInclude;
-  Analyzing.Run(MS,nil,-1,true);
+    FileName := Form1.CurrScript.ScriptFile;
-  AddProcsTree(ScriptNode,Analyzing.Items,Analyzing.FileName); //Add the procedures of the script to the script tree
+    MS := TMemoryStream.Create;
-
+    MS.Write(Script[1],length(script));
-  //Lame condition.. We must check if nothing new has been included since
+    OnTerminate:=@FillThreadTerminate;
-  //last generation of the tree.. However, this will do fine for now ;)
+    FillThread.ScriptNode := self.ScriptNode;
-  if IncludesNode.Count <> length(Analyzing.Includes) then
+    FillThread.IncludesNode := self.IncludesNode;
-  begin;
-    IncludesNode.DeleteChildren;
-    for i := 0 to high(Analyzing.Includes) do
-      AddIncludes(IncludesNode, Analyzing.Includes[i]);
   end;
-  ScriptNode.Expand(true);
+  FillThread.resume;
-  FunctionList.EndUpdate;
+ //See FillThreadTerminate for the rest of this procedure
-  Analyzing.Free;
 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}
 

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

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

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}
 

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.
 

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);