diff --git a/Projects/SAMufasaGUI/framefunctionlist.pas b/Projects/SAMufasaGUI/framefunctionlist.pas index 3c62d35..4322862 100644 --- a/Projects/SAMufasaGUI/framefunctionlist.pas +++ b/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 - MethodStr : PChar; - BeginPos : integer; + TMethodInfo = packed record + MethodStr,Filename : PChar; + 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; - tmpNode : TTreeNode; + Analyzing : TCodeInsight; + 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); - tmpNode.Data := GetMem(SizeOf(TMethodInfo)); - with PMethodInfo(tmpNode.Data)^ do - begin - MethodStr:= strnew(PChar(Analyzer.Methods[i].CreateMethodStr)); - BeginPos:= Analyzer.Methods[i].BeginPos; - end; + mDebugLn('Might get some acces violations now..'); + exit; + end; + FunctionList.BeginUpdate; + ScriptNode.DeleteChildren; + Analyzing := TCodeInsight.Create(); + 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! - RootNode := FilterTree.Items.AddChild(nil,Node.Parent.Text); + if node.level = 2 then + 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 diff --git a/Projects/SAMufasaGUI/framescript.pas b/Projects/SAMufasaGUI/framescript.pas index 52e2dc4..969756b 100644 --- a/Projects/SAMufasaGUI/framescript.pas +++ b/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)) - else + begin + 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 - 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); + Form1.LoadScriptFile(ErrorData.Module,true,true);//Checks if the file is already open! ErrorData.Module:= ''; Form1.CurrScript.ErrorData := Self.ErrorData; Form1.CurrScript.HandleErrorData; diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 02c9ff1..ff3b1f7 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/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(); diff --git a/Units/Misc/CastaliaPasLex.pas b/Units/Misc/CastaliaPasLex.pas index 789f274..164fe2b 100644 --- a/Units/Misc/CastaliaPasLex.pas +++ b/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; diff --git a/Units/Misc/v_autocompleteform.pas b/Units/Misc/v_autocompleteform.pas index a58de24..4102261 100644 --- a/Units/Misc/v_autocompleteform.pas +++ b/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; diff --git a/Units/Misc/v_ideCodeInsight.pas b/Units/Misc/v_ideCodeInsight.pas index d09cfb6..57eafb7 100644 --- a/Units/Misc/v_ideCodeInsight.pas +++ b/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 diff --git a/Units/Misc/v_ideCodeParser.pas b/Units/Misc/v_ideCodeParser.pas index cb72f97..52f3af4 100644 --- a/Units/Misc/v_ideCodeParser.pas +++ b/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;