From 4e5f79cd6747a4db3c1119ceb42c7d62b3b27e2f Mon Sep 17 00:00:00 2001 From: Raymond Date: Sun, 28 Mar 2010 20:02:57 +0200 Subject: [PATCH] MY SHIT --- Projects/SAMufasaGUI/framefunctionlist.pas | 85 ++++++++++++++++------ Projects/SAMufasaGUI/testunit.pas | 6 +- Units/Misc/CastaliaPasLex.pas | 10 ++- Units/Misc/v_ideCodeInsight.pas | 6 +- Units/Misc/v_ideCodeParser.pas | 50 ++++++++++++- 5 files changed, 128 insertions(+), 29 deletions(-) diff --git a/Projects/SAMufasaGUI/framefunctionlist.pas b/Projects/SAMufasaGUI/framefunctionlist.pas index 3c62d35..a0c8a79 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; @@ -51,13 +52,14 @@ type TMethodInfo = record MethodStr : PChar; BeginPos : integer; +// FileName : PChar; end; PMethodInfo = ^TMethodInfo; implementation uses - TestUnit, Graphics, simpleanalyzer; + TestUnit, Graphics, stringutil, simpleanalyzer,v_ideCodeInsight,v_ideCodeParser; { TFunctionListFrame } @@ -102,10 +104,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 +153,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,31 +184,67 @@ begin end; procedure TFunctionListFrame.LoadScriptTree(Script: String); +procedure AddProcsTree(Node : TTreeNode; Procs : TDeclarationList; FileName : 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); + tmpNode.Data := GetMem(SizeOf(TMethodInfo)); + with PMethodInfo(tmpNode.Data)^ do + begin + MethodStr := strnew(Pchar(CleanDeclaration)); + BeginPos:= StartPos; + end; + end; +end; + +procedure AddIncludes(Include : TCodeInsight); +var + parentNode : TTreeNode; + 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(Include.Includes[i]) +end; var I : integer; - Analyzer : TScriptAnalyzer; - tmpNode : TTreeNode; + Analyzing : TCodeInsight; + MS : TMemoryStream; begin + 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; + 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(Analyzing.Includes[i]); end; ScriptNode.Expand(true); - Analyzer.free; + Analyzing.Free; end; function TFunctionListFrame.Find(Next : boolean; backwards : boolean = false) : boolean; diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index e33d32d..4e3f594 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -1643,10 +1643,13 @@ var begin if node = nil then exit; - if Node.Level > 0 then + 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 + CurrScript.SynEdit.SelStart := MethodInfo.BeginPos + 1; end; if Node.level = 0 then StatusBar.Panels[Panel_ScriptPath].Text := 'Section: ' + Node.Text; @@ -2034,6 +2037,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 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_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..3264778 100644 --- a/Units/Misc/v_ideCodeParser.pas +++ b/Units/Misc/v_ideCodeParser.pas @@ -104,12 +104,18 @@ type function GetRealType: TDeclaration; overload; end; + { TciProcedureDeclaration } + TciProcedureDeclaration = class(TDeclaration) private fProcType: string; fParams: string; fSynParams: string; + fName : string; + fCleanDecl : string; + function GetCleanDeclaration: string; + function GetName: string; function GetProcType: string; function GetParams: string; function GetSynParams: string; @@ -118,6 +124,8 @@ type public function GetParamDeclarations: TDeclarationArray; + property CleanDeclaration : string read GetCleanDeclaration; + property Name : string read GetName; property ProcType: string read GetProcType; property Params: string read GetParams; property SynParams: string read GetSynParams; @@ -780,6 +788,46 @@ begin Result := fProcType; end; +function TciProcedureDeclaration.GetName: string; +var + ProcedureName : TciProcedureName; +begin + if (fName <> '') then + result := fName + else + begin + ProcedureName := TciProcedureName(fItems.GetFirstItemOfClass(TciProcedureName)); + if ProcedureName <> nil then + result := ProcedureName.ShortText + else + Result := ''; + fName := result; + end; +end; + +function TciProcedureDeclaration.GetCleanDeclaration: string; +var + Return : TciReturnType; +begin + if (fCleanDecl <> '') then + result := fCleanDecl + else + begin + result := ''; + if Name = '' then + exit; + result := proctype + ' ' + Name; + 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 +1056,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;