1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-13 21:05:12 -05:00
Simba/Projects/SAMufasaGUI/framefunctionlist.pas

465 lines
14 KiB
ObjectPascal

unit framefunctionlist;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, MufasaBase,Forms, ComCtrls, StdCtrls, Controls,
ExtCtrls, Buttons;
type
{ TFunctionListFrame }
TFunctionListFrame = class(TFrame)
editSearchList: TEdit;
FunctionList: TTreeView;
FunctionListLabel: TLabel;
CloseButton: TSpeedButton;
procedure editSearchListChange(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;
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_ideCodeInsight,v_ideCodeParser,lclintf;
{ TFunctionListFrame }
procedure TFunctionListFrame.editSearchListChange(Sender: TObject);
begin
Find(false);
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;
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
begin;
Form1.CurrScript.SynEdit.InsertTextAtCaret( GetMethodName(PMethodInfo(node.Data)^.MethodStr,true));
Form1.RefreshTab;
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);
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));
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;
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;
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);
FunctionList.EndUpdate;
Analyzing.Free;
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;
initialization
{$I framefunctionlist.lrs}
end.