mirror of
https://github.com/moparisthebest/Simba
synced 2024-12-24 16:28:53 -05:00
525 lines
15 KiB
ObjectPascal
525 lines
15 KiB
ObjectPascal
unit framefunctionlist;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, LResources, MufasaBase,Forms, ComCtrls, StdCtrls, Controls,
|
|
ExtCtrls, Buttons,mmisc,v_ideCodeInsight;
|
|
|
|
type
|
|
|
|
{ TFillThread }
|
|
|
|
TFillThread = class(TThread)
|
|
public
|
|
Analyzer : TCodeInsight;
|
|
MS : TMemoryStream;
|
|
FunctionList : ^TTreeView;
|
|
IncludesNode,ScriptNode : TTreeNode;
|
|
procedure execute; override;
|
|
end;
|
|
{ TFunctionListFrame }
|
|
|
|
TFunctionListFrame = class(TFrame)
|
|
editSearchList: TEdit;
|
|
FunctionList: TTreeView;
|
|
FunctionListLabel: TLabel;
|
|
CloseButton: TSpeedButton;
|
|
procedure editSearchListChange(Sender: TObject);
|
|
procedure FillThreadTerminate(Sender: TObject);
|
|
procedure FrameEndDock(Sender, Target: TObject; X, Y: Integer);
|
|
procedure FunctionListDblClick(Sender: TObject);
|
|
procedure FunctionListDeletion(Sender: TObject; Node: TTreeNode);
|
|
procedure FunctionListLabelMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure FunctionListMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure DockFormOnClose(Sender: TObject; var CloseAction: TCloseAction);
|
|
procedure CloseButtonClick(Sender: TObject);
|
|
procedure FunctionListMouseUp(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
private
|
|
FFilterTree : TTreeView;
|
|
FLastScript : string;
|
|
Filtering : boolean;
|
|
FillThread : TFillThread;
|
|
procedure FilterTreeVis(Vis : boolean);
|
|
function GetFilterTree: TTreeView;
|
|
{ private declarations }
|
|
public
|
|
DraggingNode : TTreeNode;
|
|
ScriptNode : TTreeNode;
|
|
IncludesNode : TTreeNode;
|
|
InCodeCompletion : boolean;
|
|
CompletionCaret : TPoint;
|
|
StartWordCompletion : TPoint;
|
|
CompletionLine : string;
|
|
CompletionStart : string;
|
|
property FilterTree : TTreeView read GetFilterTree;
|
|
procedure LoadScriptTree( Script : String);
|
|
function Find(Next : boolean; backwards : boolean = false) : boolean;
|
|
{ public declarations }
|
|
end;
|
|
|
|
TMethodInfo = packed record
|
|
MethodStr,Filename : PChar;
|
|
BeginPos,endpos : integer;
|
|
end;
|
|
PMethodInfo = ^TMethodInfo;
|
|
|
|
implementation
|
|
|
|
uses
|
|
TestUnit, Graphics, stringutil, simpleanalyzer,v_ideCodeParser,lclintf;
|
|
|
|
{ TFunctionListFrame }
|
|
|
|
procedure TFunctionListFrame.editSearchListChange(Sender: TObject);
|
|
begin
|
|
Find(false);
|
|
end;
|
|
|
|
procedure TFunctionListFrame.FillThreadTerminate(Sender: TObject);
|
|
begin
|
|
FillThread.Analyzer.Free;
|
|
ScriptNode.Expand(true);
|
|
FunctionList.EndUpdate;
|
|
if Filtering then
|
|
begin
|
|
FilterTreeVis(True);
|
|
Find(false,false);
|
|
end;
|
|
FillThread := nil;
|
|
end;
|
|
|
|
procedure TFunctionListFrame.FrameEndDock(Sender, Target: TObject; X, Y: Integer
|
|
);
|
|
begin
|
|
if Target is TPanel then
|
|
begin
|
|
Form1.SplitterFunctionList.Visible := true;
|
|
CloseButton.Visible:= true;
|
|
end
|
|
else if Target is TCustomDockForm then
|
|
begin
|
|
TCustomDockForm(Target).Caption := 'Functionlist';
|
|
TCustomDockForm(Target).OnClose := @DockFormOnClose;
|
|
Form1.SplitterFunctionList.Visible:= false;
|
|
CloseButton.Visible:= false;
|
|
end;
|
|
end;
|
|
|
|
procedure TFunctionListFrame.FunctionListDblClick(Sender: TObject);
|
|
var
|
|
Node : TTreeNode;
|
|
MethodInfo : TMethodInfo;
|
|
begin
|
|
if FilterTree.Visible then
|
|
Node := FilterTree.Selected
|
|
else
|
|
node := FunctionList.Selected;
|
|
if node<> nil then
|
|
if node.Level > 0 then
|
|
if node.Data <> nil then
|
|
if InCodeCompletion then
|
|
begin
|
|
Form1.CurrScript.SynEdit.InsertTextAtCaret( GetMethodName(PMethodInfo(node.Data)^.MethodStr,true));
|
|
Form1.RefreshTab;
|
|
end
|
|
else
|
|
begin
|
|
MethodInfo := PMethodInfo(node.Data)^;
|
|
if DraggingNode = node then
|
|
if (MethodInfo.BeginPos > 0) then
|
|
begin;
|
|
if MethodInfo.Filename <> nil then
|
|
if MethodInfo.Filename <> '' then
|
|
begin;
|
|
// Writeln(MethodInfo.filename);
|
|
Form1.LoadScriptFile(MethodInfo.Filename,true,true);
|
|
end;
|
|
Form1.CurrScript.SynEdit.SelStart := MethodInfo.BeginPos + 1;
|
|
Form1.CurrScript.SynEdit.SelEnd := MethodInfo.EndPos + 1;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFunctionListFrame.FunctionListDeletion(Sender: TObject;
|
|
Node: TTreeNode);
|
|
var
|
|
MethodInfo : PMethodInfo;
|
|
begin
|
|
if node.data <> nil then
|
|
begin
|
|
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;
|
|
|
|
procedure TFunctionListFrame.FunctionListLabelMouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
Self.DragKind := dkDock;
|
|
Self.BeginDrag(false, 40);
|
|
end;
|
|
|
|
procedure TFunctionListFrame.DockFormOnClose(Sender: TObject; var CloseAction: TCloseAction);
|
|
begin
|
|
CloseAction := caHide;
|
|
Form1.MenuItemFunctionList.Checked := False;
|
|
end;
|
|
|
|
procedure TFunctionListFrame.CloseButtonClick(Sender: TObject);
|
|
begin
|
|
self.Hide;
|
|
Form1.MenuItemFunctionList.Checked := False;
|
|
end;
|
|
|
|
procedure TFunctionListFrame.FunctionListMouseUp(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
N: TTreeNode;
|
|
MethodInfo : TMethodInfo;
|
|
begin
|
|
if InCodeCompletion then
|
|
begin;
|
|
mDebugLn('Not yet implemented');
|
|
exit;
|
|
end;
|
|
if not (Sender is TTreeView) then
|
|
exit;
|
|
N := TTreeView(Sender).GetNodeAt(x, y);
|
|
if(N = nil)then
|
|
exit;
|
|
end;
|
|
|
|
procedure TFunctionListFrame.FilterTreeVis(Vis: boolean);
|
|
begin
|
|
FunctionList.Visible:= not Vis;
|
|
FilterTree.Visible := Vis;
|
|
end;
|
|
|
|
function TFunctionListFrame.GetFilterTree: TTreeView;
|
|
begin
|
|
Result := FFilterTree;
|
|
if Assigned(Result) then
|
|
exit;
|
|
FFilterTree := TTreeView.Create(Self);
|
|
FFilterTree.Parent := Self;
|
|
FFilterTree.Visible := false;
|
|
FFilterTree.SetBounds(FunctionList.Left,FunctionList.Top,FunctionList.Width,FunctionList.Height);
|
|
FFilterTree.Align := alClient;
|
|
FFilterTree.ReadOnly:= True;
|
|
FFilterTree.ScrollBars:= ssAutoBoth;
|
|
FFilterTree.OnMouseDown:= FunctionList.OnMouseDown;
|
|
FFilterTree.OnMouseUp:= FunctionList.OnMouseUp;
|
|
FFilterTree.OnChange:= FunctionList.OnChange;
|
|
FFilterTree.OnExit := FunctionList.OnExit;
|
|
FFilterTree.OnDblClick:= FunctionList.OnDblClick;
|
|
Result := FFilterTree;
|
|
//We do not want to delete the data from the FilterTree
|
|
// FilterTree.OnDeletion:= FunctionList.OnDeletion;
|
|
end;
|
|
|
|
procedure TFunctionListFrame.LoadScriptTree(Script: String);
|
|
begin
|
|
if script = '' then
|
|
exit;
|
|
if ScriptNode = nil then
|
|
exit;
|
|
if FillThread <> nil then {Already busy filling!}
|
|
exit;
|
|
if FLastScript = Script then
|
|
exit;
|
|
FLastScript:= Script;
|
|
Filtering := FilterTree.Visible;
|
|
if FilterTree.Visible then
|
|
FilterTreeVis(false);
|
|
FunctionList.BeginUpdate;
|
|
ScriptNode.DeleteChildren;
|
|
FillThread := TFillThread.Create(true);
|
|
FillThread.FunctionList := @Self.FunctionList;
|
|
FillThread.Analyzer := TCodeInsight.Create;
|
|
with FillThread,FillThread.Analyzer do
|
|
begin
|
|
OnFindInclude := @Form1.OnCCFindInclude;
|
|
FileName := Form1.CurrScript.ScriptFile;
|
|
MS := TMemoryStream.Create;
|
|
MS.Write(Script[1],length(script));
|
|
OnTerminate:=@FillThreadTerminate;
|
|
FreeOnTerminate := True;
|
|
FillThread.ScriptNode := self.ScriptNode;
|
|
FillThread.IncludesNode := self.IncludesNode;
|
|
end;
|
|
FillThread.resume;
|
|
//See FillThreadTerminate for the rest of this procedure
|
|
end;
|
|
|
|
function TFunctionListFrame.Find(Next : boolean; backwards : boolean = false) : boolean;
|
|
var
|
|
Start,Len,i,ii,index,posi,c: Integer;
|
|
FoundFunction : boolean;
|
|
LastSection : Array[1..2] of String;
|
|
str : string;
|
|
RootNode : TTreeNode;
|
|
NormalNode,tmpNode : TTreeNode;
|
|
Node : TTreeNode;
|
|
InsertStr : string;
|
|
begin
|
|
if(editSearchList.Text = '')then
|
|
begin
|
|
editSearchList.Color := clWhite;
|
|
FunctionList.FullCollapse;
|
|
if InCodeCompletion then
|
|
begin;
|
|
Form1.CurrScript.SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart;
|
|
Form1.CurrScript.SynEdit.LogicalCaretXY:= point(CompletionCaret.x,CompletionCaret.y);
|
|
Form1.CurrScript.SynEdit.SelEnd:= Form1.CurrScript.SynEdit.SelStart;
|
|
end;
|
|
FilterTreeVis(False);
|
|
ScriptNode.Expand(true);
|
|
exit;
|
|
end;
|
|
|
|
//We only have to search the next item in our filter tree.. Fu-king easy!
|
|
if next then
|
|
begin;
|
|
if FilterTree.Visible = false then
|
|
begin;
|
|
mDebugLn('ERROR: You cannot search next, since the Tree isnt generated yet');
|
|
Find(false);
|
|
exit;
|
|
end;
|
|
if FilterTree.Selected <> nil then
|
|
begin;
|
|
if backwards then
|
|
start := FilterTree.Selected.AbsoluteIndex - 1
|
|
else
|
|
Start := FilterTree.Selected.AbsoluteIndex + 1;
|
|
end
|
|
else
|
|
begin
|
|
if backwards then
|
|
Start := FilterTree.Items.Count - 1
|
|
else
|
|
Start := 0;
|
|
end;
|
|
Len := FilterTree.Items.Count;
|
|
i := start + len; //This is for the backwards compatibily, we do mod anways.. it just makes sure -1 isn't negative.
|
|
c := 0;
|
|
while c < (len ) do
|
|
begin;
|
|
if (FilterTree.Items[i mod len].HasChildren = false) then
|
|
begin
|
|
FilterTree.Items[i mod len].Selected:= true;
|
|
InsertStr := FilterTree.Items[i mod len].Text;
|
|
Result := true;
|
|
break;
|
|
end;
|
|
if backwards then
|
|
dec(i)
|
|
else
|
|
inc(i);
|
|
inc(c);
|
|
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[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) and (node.HasChildren = false) then
|
|
if(pos(lowercase(editSearchList.Text), lowercase(Node.Text)) > 0)then
|
|
begin
|
|
if not FoundFunction then
|
|
begin
|
|
FoundFunction := True;
|
|
index := i mod FunctionList.Items.Count;
|
|
InsertStr:= node.Text;
|
|
end;
|
|
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;
|
|
// break;
|
|
end;
|
|
end;
|
|
Result := FoundFunction;
|
|
|
|
if Result then
|
|
begin;
|
|
FilterTreeVis(True);
|
|
FilterTree.FullExpand;
|
|
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;
|
|
FunctionList.Items[index].ExpandParents;
|
|
editSearchList.Color := clWhite;
|
|
|
|
|
|
end else
|
|
begin
|
|
FilterTreeVis(false);
|
|
editSearchList.Color := 6711039;
|
|
if InCodeCompletion then
|
|
Form1.CurrScript.SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart;
|
|
end;
|
|
FilterTree.EndUpdate;
|
|
end;
|
|
|
|
if result and InCodeCompletion then
|
|
begin;
|
|
str := format(CompletionLine, [InsertStr]);
|
|
with Form1.CurrScript.SynEdit do
|
|
begin;
|
|
Lines[CompletionCaret.y - 1] := str;
|
|
LogicalCaretXY:= StartWordCompletion;
|
|
i := SelStart;
|
|
posi := pos(lowercase(editSearchList.text), lowercase(InsertStr)) + length(editSearchList.text) - 1; //underline the rest of the word
|
|
if Posi = Length(InsertStr) then //Special occasions
|
|
begin;
|
|
if Length(editSearchList.Text) <> Posi then //We found the last part of the text -> for exmaple when you Search for bitmap, you can find LoadBitmap -> We underline 'Load'
|
|
begin;
|
|
SelStart := i;
|
|
SelEnd := i + pos(lowercase(editSearchList.text), lowercase(InsertStr)) -1;
|
|
Exit;
|
|
end;
|
|
//We searched for the whole text -> for example LoadBitmap, and we found LoadBitmap -> Underline the whole text
|
|
Posi := 0;
|
|
end;
|
|
//Underline the rest of the word
|
|
SelStart := i + posi;
|
|
SelEnd := SelStart + Length(InsertStr) - posi;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFunctionListFrame.FunctionListMouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
N: TTreeNode;
|
|
begin
|
|
if button = mbRight then
|
|
exit;
|
|
if InCodeCompletion then
|
|
begin;
|
|
mDebugLn('Not yet implemented');
|
|
exit;
|
|
end;
|
|
if not (Sender is TTreeView) then
|
|
exit;
|
|
N := TTreeView(Sender).GetNodeAt(x, y);
|
|
if(N = nil)then
|
|
begin
|
|
Self.DragKind := dkDock;
|
|
Self.BeginDrag(false, 40);
|
|
exit;
|
|
end;
|
|
Self.DragKind := dkDrag;
|
|
if(Button = mbLeft) and (N.Level > 0)then
|
|
Self.BeginDrag(False, 10);
|
|
DraggingNode := N;
|
|
end;
|
|
|
|
|
|
{ TFillThread }
|
|
|
|
procedure TFillThread.execute;
|
|
procedure AddProcsTree(Node : TTreeNode; Procs : TDeclarationList; Path : string);
|
|
var
|
|
i : integer;
|
|
tmpNode : TTreeNode;
|
|
begin;
|
|
if procs = nil then
|
|
exit;
|
|
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));
|
|
FillChar(PMethodInfo(tmpNode.Data)^,SizeOf(TMethodInfo),0);
|
|
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;
|
|
begin
|
|
Analyzer.Run(MS,nil,-1,true);
|
|
AddProcsTree(ScriptNode,Analyzer.Items,Analyzer.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(Analyzer.Includes) then
|
|
begin;
|
|
IncludesNode.DeleteChildren;
|
|
for i := 0 to high(Analyzer.Includes) do
|
|
AddIncludes(IncludesNode, Analyzer.Includes[i]);
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
{$R *.lfm}
|
|
|
|
end.
|
|
|