Simba/Projects/SAMufasaGUI/framefunctionlist.pas

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;
  { Don't free the thread when it is already stopped... This causes deadlocks? }
  //FreeAndNil(FillThread);
  ScriptNode.Expand(true);
  FunctionList.EndUpdate;
  if Filtering then
  begin
    FilterTreeVis(True);
    Find(false,false);
  end;
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);
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;
    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.