From 7b3b694b0924db706f46320db6c6bf88f0207d6f Mon Sep 17 00:00:00 2001 From: Raymond Date: Sun, 28 Mar 2010 22:11:12 +0200 Subject: [PATCH] Ctrl click now works better, goes to new files etc.. Tree is now generated using Niels' parser (has an include tree to, not sure if its too slow). And fixed some other stuff.. --- Projects/SAMufasaGUI/framefunctionlist.pas | 83 +++++++++++++++------- Projects/SAMufasaGUI/framescript.pas | 24 ++++--- Projects/SAMufasaGUI/testunit.pas | 53 ++++++++++++-- Units/Misc/v_ideCodeParser.pas | 23 +++--- 4 files changed, 131 insertions(+), 52 deletions(-) diff --git a/Projects/SAMufasaGUI/framefunctionlist.pas b/Projects/SAMufasaGUI/framefunctionlist.pas index a0c8a79..4322862 100644 --- a/Projects/SAMufasaGUI/framefunctionlist.pas +++ b/Projects/SAMufasaGUI/framefunctionlist.pas @@ -49,17 +49,16 @@ type { public declarations } end; - TMethodInfo = record - MethodStr : PChar; - BeginPos : integer; -// FileName : PChar; + TMethodInfo = packed record + MethodStr,Filename : PChar; + BeginPos,endpos : integer; end; PMethodInfo = ^TMethodInfo; implementation uses - TestUnit, Graphics, stringutil, simpleanalyzer,v_ideCodeInsight,v_ideCodeParser; + TestUnit, Graphics, stringutil, simpleanalyzer,v_ideCodeInsight,v_ideCodeParser,lclintf; { TFunctionListFrame } @@ -112,8 +111,8 @@ begin MethodInfo := PMethodInfo(Node.data); if MethodInfo^.MethodStr <> nil then StrDispose(MethodInfo^.MethodStr); -{ if MethodInfo^.FileName <> nil then - StrDispose(MethodInfo^.filename);} + if MethodInfo^.FileName <> nil then + StrDispose(MethodInfo^.filename); Freemem(node.data,sizeof(TMethodInfo)); end; end; @@ -184,7 +183,7 @@ begin end; procedure TFunctionListFrame.LoadScriptTree(Script: String); -procedure AddProcsTree(Node : TTreeNode; Procs : TDeclarationList; FileName : string); +procedure AddProcsTree(Node : TTreeNode; Procs : TDeclarationList; Path : string); var i : integer; tmpNode : TTreeNode; @@ -193,19 +192,20 @@ begin; if (Procs[i] is TciProcedureDeclaration) then with Procs[i] as TciProcedureDeclaration do begin - tmpNode := FunctionList.Items.AddChild(Node,name); + tmpNode := FunctionList.Items.AddChild(Node,name.ShortText); tmpNode.Data := GetMem(SizeOf(TMethodInfo)); with PMethodInfo(tmpNode.Data)^ do begin MethodStr := strnew(Pchar(CleanDeclaration)); - BeginPos:= StartPos; + Filename:= strnew(pchar(path)); + BeginPos:= name.StartPos ; + EndPos := name.StartPos + Length(TrimRight(name.RawText)); end; end; end; -procedure AddIncludes(Include : TCodeInsight); +procedure AddIncludes(ParentNode : TTreeNode; Include : TCodeInsight); var - parentNode : TTreeNode; i : integer; begin; parentNode := FunctionList.Items.AddChild( @@ -213,19 +213,25 @@ begin; Include.FileName)); AddProcsTree(parentNode,Include.Items,Include.FileName); for i := 0 to high(Include.Includes) do - AddIncludes(Include.Includes[i]) + 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..'); + exit; + end; + FunctionList.BeginUpdate; ScriptNode.DeleteChildren; Analyzing := TCodeInsight.Create(); Analyzing.OnFindInclude:= @Form1.OnCCFindInclude; @@ -241,20 +247,21 @@ begin begin; IncludesNode.DeleteChildren; for i := 0 to high(Analyzing.Includes) do - AddIncludes(Analyzing.Includes[i]); + AddIncludes(IncludesNode, Analyzing.Includes[i]); end; ScriptNode.Expand(true); + 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 @@ -301,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; @@ -316,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 @@ -336,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; @@ -349,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; @@ -364,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 a2d3337..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,16 +1656,25 @@ var begin if node = nil then exit; + 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); @@ -2401,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 @@ -2421,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/v_ideCodeParser.pas b/Units/Misc/v_ideCodeParser.pas index 3264778..52f3af4 100644 --- a/Units/Misc/v_ideCodeParser.pas +++ b/Units/Misc/v_ideCodeParser.pas @@ -104,18 +104,19 @@ type function GetRealType: TDeclaration; overload; end; - { TciProcedureDeclaration } + TciProcedureName = class(TDeclaration); + { TciProcedureDeclaration } TciProcedureDeclaration = class(TDeclaration) private fProcType: string; fParams: string; fSynParams: string; - fName : string; + fName : TciProcedureName; fCleanDecl : string; function GetCleanDeclaration: string; - function GetName: string; + function GetName: TciProcedureName; function GetProcType: string; function GetParams: string; function GetSynParams: string; @@ -125,7 +126,7 @@ type function GetParamDeclarations: TDeclarationArray; property CleanDeclaration : string read GetCleanDeclaration; - property Name : string read GetName; + property Name : TciProcedureName read GetName; property ProcType: string read GetProcType; property Params: string read GetParams; property SynParams: string read GetSynParams; @@ -158,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 @@ -788,19 +789,19 @@ begin Result := fProcType; end; -function TciProcedureDeclaration.GetName: string; +function TciProcedureDeclaration.GetName: TciProcedureName; var ProcedureName : TciProcedureName; begin - if (fName <> '') then + if (fName <> nil) then result := fName else begin ProcedureName := TciProcedureName(fItems.GetFirstItemOfClass(TciProcedureName)); if ProcedureName <> nil then - result := ProcedureName.ShortText + result := ProcedureName else - Result := ''; + Result := nil; fName := result; end; end; @@ -814,9 +815,9 @@ begin else begin result := ''; - if Name = '' then + if Name = nil then exit; - result := proctype + ' ' + Name; + result := proctype + ' ' + Name.ShortText; if Params <> '' then result := result + '(' + params + ')'; Return := fItems.GetFirstItemOfClass(TciReturnType) as TciReturnType;