moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-25 18:52:15 -05:00
Code Issues Releases Wiki Activity

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

Browse Source
This commit is contained in:
Niels 2010-03-28 22:39:23 +02:00
commit 11d2fa0fc6
7 changed files with 240 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

148
Projects/SAMufasaGUI/framefunctionlist.pas
View File

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

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;

59
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,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();

10
Units/Misc/CastaliaPasLex.pas
View File

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

2
Units/Misc/v_autocompleteform.pas
View File

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

6
Units/Misc/v_ideCodeInsight.pas
View File

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

53
Units/Misc/v_ideCodeParser.pas
View File

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