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

Projects/SAMufasaGUI/framefunctionlist.pas

@@ -37,6 +37,7 @@ type
   public
     DraggingNode : TTreeNode;
     ScriptNode : TTreeNode;
+    IncludesNode : TTreeNode;
     InCodeCompletion : boolean;
     CompletionCaret : TPoint;
     StartWordCompletion : TPoint;
@@ -48,16 +49,16 @@ type
     { public declarations }
   end; 
 
-  TMethodInfo = record
+  TMethodInfo = packed record
-    MethodStr : PChar;
+    MethodStr,Filename : PChar;
-    BeginPos : integer;
+    BeginPos,endpos : integer;
   end;
   PMethodInfo = ^TMethodInfo;
 
 implementation
 
 uses
-  TestUnit, Graphics, simpleanalyzer;
+  TestUnit, Graphics, stringutil, simpleanalyzer,v_ideCodeInsight,v_ideCodeParser,lclintf;
 
 { TFunctionListFrame }
 
@@ -102,10 +103,16 @@ end;
 
 procedure TFunctionListFrame.FunctionListDeletion(Sender: TObject;
   Node: TTreeNode);
+var
+  MethodInfo : PMethodInfo;
 begin
   if node.data <> nil then
   begin
-    StrDispose(PMethodInfo(node.data)^.MethodStr);
+    MethodInfo := PMethodInfo(Node.data);
+    if MethodInfo^.MethodStr <> nil then
+      StrDispose(MethodInfo^.MethodStr);
+    if MethodInfo^.FileName <> nil then
+      StrDispose(MethodInfo^.filename);
     Freemem(node.data,sizeof(TMethodInfo));
   end;
 end;
@@ -145,13 +152,6 @@ begin
   N := TTreeView(Sender).GetNodeAt(x, y);
   if(N = nil)then
     exit;
-  if button = mbRight then
-    if N.Data <> nil then
-    begin
-      MethodInfo := PMethodInfo(N.data)^;
-      if (MethodInfo.BeginPos > 0) then
-        Form1.CurrScript.SynEdit.SelStart := MethodInfo.BeginPos + 1;
-    end;
 end;
 
 procedure TFunctionListFrame.FilterTreeVis(Vis: boolean);
@@ -183,41 +183,85 @@ 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));
+        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;
-  Analyzer : TScriptAnalyzer;
+  Analyzing : TCodeInsight;
-  tmpNode : TTreeNode;
+  MS : TMemoryStream;
+  time : longword;
 begin
+  Time := GetTickCount;
+  if script = '' then
+    exit;
   if ScriptNode = nil then
     exit;
   if FilterTree.Visible then
-    mDebugLn('Might get some acces violations now..');
-  ScriptNode.DeleteChildren;
-  Analyzer := TScriptAnalyzer.create;
-  Analyzer.ScriptToAnalyze:= Script;
-  Analyzer.analyze;
-  for i := 0 to Analyzer.MethodLen - 1 do
   begin
-    tmpNode := FunctionList.Items.AddChild(ScriptNode,Analyzer.Methods[i].Name);
+    mDebugLn('Might get some acces violations now..');
-    tmpNode.Data := GetMem(SizeOf(TMethodInfo));
+    exit;
-    with PMethodInfo(tmpNode.Data)^ do
+  end;
-    begin
+  FunctionList.BeginUpdate;
-      MethodStr:= strnew(PChar(Analyzer.Methods[i].CreateMethodStr));
+  ScriptNode.DeleteChildren;
-      BeginPos:= Analyzer.Methods[i].BeginPos;
+  Analyzing := TCodeInsight.Create();
-    end;
+  Analyzing.OnFindInclude:= @Form1.OnCCFindInclude;
+  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]);
   end;
   ScriptNode.Expand(true);
-  Analyzer.free;
+  FunctionList.EndUpdate;
+  Analyzing.Free;
 end;
 
 function TFunctionListFrame.Find(Next : boolean; backwards : boolean = false) : boolean;
 var
-  Start,Len,i,index,posi,c: Integer;
+  Start,Len,i,ii,index,posi,c: Integer;
   FoundFunction : boolean;
-  LastSection : string;
+  LastSection : Array[1..2] of String;
   str : string;
   RootNode : TTreeNode;
-  NormalNode : TTreeNode;
+  NormalNode,tmpNode : TTreeNode;
   Node : TTreeNode;
   InsertStr : string;
 begin
@@ -264,7 +308,7 @@ begin
     c := 0;
     while c < (len ) do
     begin;
-      if FilterTree.Items[i mod len].Level = 1 then
+      if (FilterTree.Items[i mod len].HasChildren = false) then
       begin
         FilterTree.Items[i mod len].Selected:= true;
         InsertStr := FilterTree.Items[i mod len].Text;
@@ -279,18 +323,21 @@ begin
     end;
   end else
   begin
+    FilterTree.BeginUpdate;
     FilterTree.Items.Clear;
+
     FoundFunction := False;
     if FunctionList.Selected <> nil then
       Start := FunctionList.Selected.AbsoluteIndex
     else
       Start := 0;
     Len := FunctionList.Items.Count;
-    LastSection := '';
+    LastSection[1] := '';
+    LastSection[2] := '';
     for i := start to start + FunctionList.Items.Count - 1 do
     begin;
       Node := FunctionList.Items[i mod FunctionList.Items.Count];
-      if(Node.Level = 1)then
+      if(Node.Level >= 1) and (node.HasChildren = false) then
         if(pos(lowercase(editSearchList.Text), lowercase(Node.Text)) > 0)then
         begin
           if not FoundFunction then
@@ -299,10 +346,31 @@ begin
             index := i mod FunctionList.Items.Count;
             InsertStr:= node.Text;
           end;
-          if LastSection <> Node.Parent.Text then //We enter a new section, add it to the filter tree!
+          if node.level = 2 then
-            RootNode := FilterTree.Items.AddChild(nil,Node.Parent.Text);
+          begin;
+            if node.Parent.text <> lastsection[2] then
+            begin
+              if node.parent.parent.text <> lastsection[1] then
+              begin;
+                rootnode := FilterTree.Items.AddChild(nil,node.parent.parent.text);
+                lastsection[1] := rootnode.text;
+                rootnode := FilterTree.Items.AddChild(Rootnode,node.parent.text);
+                lastsection[2] := rootnode.text;
+              end else
+              begin
+                rootnode := FilterTree.Items.AddChild(rootnode.parent,node.parent.text);
+                lastsection[2] := rootnode.text;
+              end;
+            end;
+          end else
+          begin
+            if node.parent.text <> lastsection[1] then
+            begin
+              rootnode := FilterTree.Items.AddChild(nil,node.parent.text);
+              lastsection[1] := Rootnode.text;
+            end;
+          end;
           FilterTree.Items.AddChild(RootNode,Node.Text).Data := Node.Data;
-          LastSection:= RootNode.Text;
   //        break;
         end;
       end;
@@ -312,7 +380,10 @@ begin
       begin;
         FilterTreeVis(True);
         FilterTree.FullExpand;
-        FilterTree.Items[1].Selected:= True;
+        c := 0;
+        while FilterTree.Items[c].HasChildren do
+          inc(c);
+        FilterTree.Items[c].Selected:= True;
         mDebugLn(FunctionList.Items[Index].Text);
         FunctionList.FullCollapse;
         FunctionList.Items[Index].Selected := true;
@@ -327,6 +398,7 @@ begin
         if InCodeCompletion then
           Form1.CurrScript.SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart;
       end;
+    FilterTree.EndUpdate;
   end;
 
   if result and InCodeCompletion then

Projects/SAMufasaGUI/framescript.pas

@@ -162,8 +162,18 @@ begin
     if (d <> nil) then
     begin
       if (TCodeInsight(d.Parser).FileName <> mp.FileName) then
-        mDebugLn('Declared in "' + TCodeInsight(d.Parser).FileName  + '" at ' + IntToStr(d.StartPos))
+      begin
-      else
+        if FileExists(TCodeInsight(d.Parser).FileName) then
+        begin;
+          if Form1.LoadScriptFile(TCodeInsight(d.Parser).FileName,true,true) then
+          begin;
+            Form1.CurrScript.SynEdit.SelStart:= d.StartPos + 1;
+            Form1.CurrScript.SynEdit.SelEnd := d.StartPos + Length(TrimRight(d.RawText)) + 1;
+          end;
+        end
+        else
+          mDebugLn('Declared in "' + TCodeInsight(d.Parser).FileName  + '" at ' + IntToStr(d.StartPos));
+      end else
       begin
         SynEdit.SelStart := d.StartPos + 1;
         SynEdit.SelEnd := d.StartPos + Length(TrimRight(d.RawText)) + 1;
@@ -429,15 +439,7 @@ begin
     else
     begin
       ErrorData.Module:= SetDirSeparators(ErrorData.Module);// Set it right ;-)
-      for i := 0 to Form1.Tabs.Count - 1 do
+      Form1.LoadScriptFile(ErrorData.Module,true,true);//Checks if the file is already open!
-        if lowercase(TMufasaTab(Form1.Tabs[i]).ScriptFrame.ScriptFile) = lowercase(ErrorData.Module) then
-        begin;
-          ErrorData.Module:= '';
-          TMufasaTab(Form1.Tabs[i]).ScriptFrame.ErrorData := Self.ErrorData;
-          TMufasaTab(Form1.Tabs[i]).ScriptFrame.HandleErrorData;
-          Exit;
-        end;
-      Form1.LoadScriptFile(ErrorData.Module,true);
       ErrorData.Module:= '';
       Form1.CurrScript.ErrorData := Self.ErrorData;
       Form1.CurrScript.HandleErrorData;

Projects/SAMufasaGUI/testunit.pas

@@ -352,7 +352,7 @@ type
     property ScriptState : TScriptState read GetScriptState write SetScriptState;
     procedure SafeCallThread;
     function OpenScript : boolean;
-    function LoadScriptFile(filename : string; AlwaysOpenInNewTab : boolean = false) : boolean;
+    function LoadScriptFile(filename : string; AlwaysOpenInNewTab : boolean = false; CheckOtherTabs : boolean = true) : boolean;
     function SaveCurrentScript : boolean;
     function SaveCurrentScriptAs : boolean;
     function CanExitOrOpen : boolean;
@@ -362,6 +362,7 @@ type
     procedure StopScript;
     procedure AddTab;
     procedure StopCodeCompletion;
+    function FindTab(filename : string) : integer;
     function DeleteTab( TabIndex : integer; CloseLast : boolean; Silent : boolean = false) : boolean;
     procedure ClearTab( TabIndex : integer);
     procedure CloseTabs(Exclude: integer = -1; Silent : boolean = false); //-1 for no exclusion
@@ -965,6 +966,7 @@ begin
   CreateSetting('Settings/Fonts/LoadOnStartUp', 'True');
   CreateSetting('Settings/Tabs/OpenNextOnClose','False');
   CreateSetting('Settings/Tabs/OpenScriptInNewTab','True');
+  CreateSetting('Settings/Tabs/CheckTabsBeforeOpen','True');
   CreateSetting('Settings/ColourPicker/ShowHistoryOnPick', 'True');
   CreateSetting('Settings/General/MaxRecentFiles','10');
   CreateSetting('Settings/MainForm/NormalSize','739:555');
@@ -1259,7 +1261,7 @@ procedure TForm1.OnSaveScript(const Filename: string);
 begin
   with CurrScript do
   begin
-    ScriptFile:= Filename;
+    ScriptFile:= SetDirSeparators(Filename);
     ScriptName:= ExtractFileNameOnly(Filename);
     mDebugLn('Script name will be: ' + ScriptName);
     FormWritelnEx('Succesfully saved: ' + Filename);
@@ -1551,6 +1553,21 @@ begin
     end;
 end;
 
+function TForm1.FindTab(filename: string): integer;
+var
+  i : integer;
+begin
+  FileName := SetDirSeparators(filename);
+  for i := 0 to Form1.Tabs.Count - 1 do
+    {$ifdef MSWindows} //Case insensitive
+    if lowercase(TMufasaTab(Tabs[i]).ScriptFrame.ScriptFile) = lowercase(filename) then
+    {$else}
+    if TMufasaTab(Tabs[i]).ScriptFrame.ScriptFile = filename then
+    {$endif}
+      exit(i);
+  result := -1;
+end;
+
 procedure TForm1.editSearchListExit(Sender: TObject);
 begin
   frmFunctionList.editSearchList.Color := clWhite;
@@ -1639,13 +1656,25 @@ var
 begin
   if node = nil then
     exit;
-  if Node.Level > 0 then
+  if Node.level = 0 then
+    StatusBar.Panels[Panel_ScriptPath].Text := 'Section: ' + Node.Text;
+  if (Node.Level > 0) and (Node.Data <> nil) then
   begin
     MethodInfo := PMethodInfo(node.Data)^;
     StatusBar.Panels[Panel_ScriptPath].Text := MethodInfo.MethodStr;
+    if frmFunctionList.DraggingNode = node then
+      if (MethodInfo.BeginPos > 0) then
+      begin;
+        if MethodInfo.Filename <> nil then
+          if MethodInfo.Filename <> '' then
+          begin;
+            Writeln(MethodInfo.filename);
+            LoadScriptFile(MethodInfo.Filename,true,true);
+          end;
+        CurrScript.SynEdit.SelStart := MethodInfo.BeginPos + 1;
+        CurrScript.SynEdit.SelEnd := MethodInfo.EndPos + 1;
+      end;
   end;
-  if Node.level = 0 then
-    StatusBar.Panels[Panel_ScriptPath].Text := 'Section: ' + Node.Text;
 end;
 
 procedure TForm1.FunctionListEnter(Sender: TObject);
@@ -2028,6 +2057,7 @@ begin
     Sections := TStringList.Create;
     LastSection := '';
     frmFunctionList.ScriptNode := Tree.Items.Add(nil,'Script');
+    frmFunctionList.IncludesNode := Tree.Items.Add(nil,'Includes');
     for i := 0 to high(Methods) do
     begin;
       if Methods[i].Section <> LastSection then
@@ -2397,17 +2427,32 @@ begin
   end;
 end;
 
-function TForm1.LoadScriptFile(filename: string; AlwaysOpenInNewTab: boolean
+function TForm1.LoadScriptFile(filename: string; AlwaysOpenInNewTab: boolean; CheckOtherTabs : boolean
   ): boolean;
 var
   OpenInNewTab : boolean;
+  CheckTabsFirst : boolean;
+  Tab : integer;
 begin
   if AlwaysOpenInNewTab then
     OpenInNewTab := true
   else
     OpenInNewTab:= (LowerCase(LoadSettingDef('Settings/Tabs/OpenScriptInNewTab','True')) = 'true');
+  if CheckOtherTabs then
+    CheckTabsFirst := True
+  else
+    CheckTabsFirst := (Lowercase(LoadSettingDef('Settings/Tabs/CheckTabsBeforeOpen','True')) = 'true');
   if FileExists(FileName) then
   begin;
+    if CheckTabsFirst then
+    begin;
+      Tab :=  FindTab(filename);
+      if tab <> -1 then
+      begin
+        TMufasaTab(Tabs[tab]).ScriptFrame.MakeActiveScriptFrame;
+        exit(true);
+      end;
+    end;
     if OpenInNewTab and (CurrScript.SynEdit.Text <> CurrScript.ScriptDefault) then //Add la tab!
       self.addtab;
     with CurrScript do
@@ -2417,7 +2462,7 @@ begin
       StartText := SynEdit.Lines.text;
       ScriptName:= ExtractFileNameOnly(filename);
       mDebugLn('Script name will be: ' + ScriptName);
-      ScriptFile:= FileName;
+      ScriptFile:= SetDirSeparators(FileName);
       ScriptChanged := false;
       AddRecentFile(filename);
       RefreshTab();

Units/Misc/CastaliaPasLex.pas

@@ -259,6 +259,7 @@ type
     procedure InitLine;
     function GetDirectiveKind: TptTokenKind;
     function GetDirectiveParam: string;
+    function GetDirectiveParamOriginal : string;
     function GetStringContent: string;
     function GetIsJunk: Boolean;
     function GetIsSpace: Boolean;
@@ -321,6 +322,7 @@ type
     property CommentState: Pointer read GetCommentState write SetCommentState;
     property CompilerDirective: string read GetCompilerDirective;
     property DirectiveParam: string read GetDirectiveParam;
+    property DirectiveParamOriginal : string read GetDirectiveParamOriginal;
 	property IsJunk: Boolean read GetIsJunk;
     property IsSpace: Boolean read GetIsSpace;
     property Line: AnsiString write SetLine;
@@ -2404,7 +2406,7 @@ begin
   dec(Run);
 end;
 
-function TmwBasePasLex.GetDirectiveParam: string;
+function TmwBasePasLex.GetDirectiveParamOriginal : string;
 var
   EndPos: Integer;
   ParamLen: Integer;
@@ -2436,7 +2438,11 @@ begin
   if fOrigin[TempRun] = ' ' then inc(TempRun);
   ParamLen := EndPos - TempRun;
   SetString(Result, (FOrigin + TempRun), ParamLen);
-  Result := UpperCase(Result);
+end;
+
+function TmwBasePasLex.GetDirectiveParam: string;
+begin
+  result := uppercase(GetDirectiveParamOriginal);
 end;
 
 procedure TmwBasePasLex.Init;

Units/Misc/v_autocompleteform.pas

@@ -312,7 +312,7 @@ begin
     {$IFDEF FPC}UnlockSelectionChange;{$ENDIF}
   end;
 
-  if {$IFDEF FPC}(odPainted in State) or{$ENDIF} (not Visible) or (ARect.Left > ClientRect.Right) or (ARect.Top > ClientRect.Bottom) or (Index < 0) or (Index >= Items.Count) then
+  if (not Visible) or (ARect.Left > ClientRect.Right) or (ARect.Top > ClientRect.Bottom) or (Index < 0) or (Index >= Items.Count) then
     Exit;
 
   tl := ARect.Left;

Units/Misc/v_ideCodeInsight.pas

@@ -224,8 +224,12 @@ var
   Param: string;
   i: Integer;
 begin
-  Param := Sender.DirectiveParam;
+  Param := Sender.DirectiveParamOriginal;
+  {$ifdef FPC}
+  param := SetDirSeparators(param);
+  {$ELSE}
   Param := StringReplace(Param, '/', '\', [rfReplaceAll]);
+  {$ENDIF}
   if (not Sender.IsJunk) and (Param <> '') then
   begin
     if FindInclude(Param) then

Units/Misc/v_ideCodeParser.pas

@@ -104,12 +104,19 @@ type
     function GetRealType: TDeclaration; overload;
   end;
 
+  TciProcedureName = class(TDeclaration);
+
+  { TciProcedureDeclaration }
   TciProcedureDeclaration = class(TDeclaration)
   private
     fProcType: string;
     fParams: string;
     fSynParams: string;
+    fName : TciProcedureName;
+    fCleanDecl : string;
 
+    function GetCleanDeclaration: string;
+    function GetName: TciProcedureName;
     function GetProcType: string;
     function GetParams: string;
     function GetSynParams: string;
@@ -118,6 +125,8 @@ type
   public
     function GetParamDeclarations: TDeclarationArray;
 
+    property CleanDeclaration : string read GetCleanDeclaration;
+    property Name : TciProcedureName read GetName;
     property ProcType: string read GetProcType;
     property Params: string read GetParams;
     property SynParams: string read GetSynParams;
@@ -150,7 +159,7 @@ type
   TciLabelName = class(TDeclaration);                                       //Label
 
   //TciProcedureDeclaration = class(TDeclaration);                            //Procedure/Function
-  TciProcedureName = class(TDeclaration);                                   //Procedure/Function
+  //TciProcedureName = class(TDeclaration);                                   //Procedure/Function
   TciProcedureClassName = class(TDeclaration);                              //Class Procedure/Function
   TciReturnType = class(TciTypeKind);                                       //Function Result
   TciForward = class(TciTypeKind);                                          //Forwarding
@@ -780,6 +789,46 @@ begin
   Result := fProcType;
 end;
 
+function TciProcedureDeclaration.GetName: TciProcedureName;
+var
+  ProcedureName : TciProcedureName;
+begin
+  if (fName <> nil) then
+    result := fName
+  else
+  begin
+    ProcedureName := TciProcedureName(fItems.GetFirstItemOfClass(TciProcedureName));
+    if ProcedureName <> nil then
+      result := ProcedureName
+    else
+      Result := nil;
+    fName := result;
+  end;
+end;
+
+function TciProcedureDeclaration.GetCleanDeclaration: string;
+var
+  Return : TciReturnType;
+begin
+  if (fCleanDecl <> '') then
+    result := fCleanDecl
+  else
+  begin
+    result := '';
+    if Name = nil then
+      exit;
+    result := proctype + ' ' + Name.ShortText;
+    if Params <> '' then
+      result := result + '(' + params + ')';
+    Return := fItems.GetFirstItemOfClass(TciReturnType) as TciReturnType;
+    if (Return <> nil) then
+      result := result + ': ' + Return.ShortText
+    else
+      result := result + ';';
+  end;
+end;
+
+
 function TciProcedureDeclaration.GetParams: string;
 var
   i: Integer;
@@ -1008,7 +1057,7 @@ begin
   if (not Sender.IsJunk) then
   begin
     PushStack(TciInclude, Sender.TokenPos);
-    fStack.Top.RawText := Sender.DirectiveParam;
+    fStack.Top.RawText := Sender.DirectiveParamOriginal;
     PopStack(Sender.TokenPos + Sender.TokenLen);
   end;