moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-22 07:18:51 -05:00
Code Issues Releases Wiki Activity

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..

Browse Source
This commit is contained in:
Raymond 2010-03-28 22:11:12 +02:00
parent 9235a38b95
commit 7b3b694b09
4 changed files with 131 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
Projects/SAMufasaGUI/framefunctionlist.pas
View File

@ -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

24
Projects/SAMufasaGUI/framescript.pas
View File

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

53
Projects/SAMufasaGUI/testunit.pas
View File

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

23
Units/Misc/v_ideCodeParser.pas
View File

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