Simba/Units/Misc/v_ideCodeInsight.pas

unit v_ideCodeInsight;

{$include ValistusDefines.inc}

interface

uses
  SysUtils, Classes,
  CastaliaPasLex,
  CastaliaPasLexTypes,
  v_ideCodeParser;

type
  TCodeInsight = class;
  TCodeInsightArray = array of TCodeInsight;

  TOnFindInclude = function(Sender: TObject; var FileName: string): Boolean of object;

  TCodeInsight = class(TCodeParser)
  protected
    fFileName: string;
    fMemoryStream: TMemoryStream;
    fOwnStream: Boolean;

    fPos: Integer;
    fDeclarationAtPos: TDeclaration;

    fOnFindInclude: TOnFindInclude;
    fIncludes: TCodeInsightArray;

    InFunc: TDeclarationArray;
    InWith: TDeclarationArray;
    InClassFunction: Integer;

    Proposal_Filled: Boolean;
    Proposal_ItemList: TStrings;
    Proposal_InsertList: TStrings;

    procedure SetPos(APos: Integer);

    procedure Reset;
    procedure Init;

    function FindInclude(var FileName: string): Boolean;
    procedure ParseInclude(FileName: string);
    procedure OnInclude(Sender: TmwBasePasLex); override;

    function GetVarType(s: string; out Decl: TDeclaration; Return: TVarBase): Boolean;
    function GetFuncType(FuncName, FuncClass: string; out Decl: TDeclaration; Return: TVarBase): Boolean;
    function FindStruct(s: string; out Decl: TDeclaration; Return: TVarBase; var ArrayCount: Integer): Boolean;
  public
    function GetExpressionAtPos(var BraceCount, BracketCount, CommaCount: Integer; IgnoreBrackets: Boolean = False): string; overload;
    function GetExpressionAtPos: string; overload;
    function FindVarBase(s: string; GetStruct: Boolean = False; Return: TVarBase = vbName): TDeclaration;

    constructor Create(FileName: string = ''); reintroduce;
    destructor Destroy; override;
    procedure Assign(From: TObject); override;
    procedure Run(SourceStream: TCustomMemoryStream = nil; BaseDefines: TStringList = nil; MaxPos: Integer = -1); reintroduce;

    procedure Proposal_AddDeclaration(Item: TDeclaration; ItemList, InsertList: TStrings);
    procedure FillProposal;
    procedure FillSynCompletionProposal(ItemList, InsertList: TStrings; Prefix: string = '');

    property OnFindInclude: TOnFindInclude read fOnFindInclude write fOnFindInclude;
    property FileName: string read fFileName write fFileName;
    property Position: Integer read fPos write SetPos;
    property DeclarationAtPos: TDeclaration read fDeclarationAtPos;
    property Includes: TCodeInsightArray read fIncludes;
  end;

  TIncludeBuffer = record
    Script: string;
    DefinesIn, DefinesOut: TSaveDefinesRec;
    LastChanged: Integer;
    CodeInsight: TCodeInsight;
  end;
  TIncludeBufferArray = array of TIncludeBuffer;

var
  CoreBuffer: TCodeInsightArray;
  IncludeBuffer: TIncludeBufferArray;

implementation

uses
  v_Constants, v_MiscFunctions;

procedure ClearCoreBuffer;
var
  i: Integer;
begin
  for i := 0 to High(CoreBuffer) do
    FreeAndNil(CoreBuffer[i]);

  SetLength(IncludeBuffer, 0);
end;

procedure DeleteIncludeBufferIndex(Index: Integer);
var
  i: Integer;
begin
  IncludeBuffer[Index].CodeInsight.Free;

  for i := Index to High(IncludeBuffer) - 1 do
    IncludeBuffer[i] := IncludeBuffer[i + 1];

  SetLength(IncludeBuffer, Length(IncludeBuffer) - 1);
end;

procedure ClearIncludeBuffer;
var
  i: Integer;
begin
  for i := 0 to High(IncludeBuffer) do
    IncludeBuffer[i].CodeInsight.Free;

  SetLength(IncludeBuffer, 0);
end;

function GetIncludeBuffer(FileName: string; ci: TCodeInsight): TIncludeBuffer;
var
  i, l, lc: Integer;
  Defines: TSaveDefinesRec;
  DefineMatch: Boolean;
begin
  lc := 1;//FileAge(FileName);
  Defines := ci.Lexer.SaveDefines;
  l := Length(IncludeBuffer);

  for i := l - 1 downto 0 do
  begin
    if (IncludeBuffer[i].CodeInsight.FileName = FileName) then
    begin
      DefineMatch := (IncludeBuffer[i].DefinesIn.Defines = Defines.Defines) and (IncludeBuffer[i].DefinesIn.Stack = Defines.Stack);

      if (ci.FileName = IncludeBuffer[i].Script) and (not DefineMatch) then
      begin
        DeleteIncludeBufferIndex(i);
        Dec(l);
        Break;
      end
      else if DefineMatch then
      begin

        //if (IncludeBuffer[i].LastChanged = lc) then
        begin
          ci.Lexer.LoadDefines(IncludeBuffer[i].DefinesOut);
          Result := IncludeBuffer[i];
          Exit;
        end;

        DeleteIncludeBufferIndex(i);
        Dec(l);
        Break;
      end;
    end;
  end;

  SetLength(IncludeBuffer, l + 1);
  with IncludeBuffer[l] do
  begin
    Script := ci.FileName;
    DefinesIn := Defines;
    LastChanged := lc;
    CodeInsight := TCodeInsight.Create(FileName);

    with CodeInsight do
    begin
      Assign(ci);
      //Lexer.CloneDefinesFrom(ci.Lexer);
      Run;
      //DefinesOut := Lexer.SaveDefines;  Weird bug, so moved out of the with statement
      ci.Lexer.CloneDefinesFrom(Lexer);
    end;

  end;

  IncludeBuffer[l].DefinesOut := IncludeBuffer[l].CodeInsight.Lexer.SaveDefines;
  Result := IncludeBuffer[l];
end;

function TCodeInsight.FindInclude(var FileName: string): Boolean;
var
  s: string;
begin
  s := FileName;
  if Assigned(OnFindInclude) and OnFindInclude(Self, s) then
  begin
    FileName := s;
    Exit(True);
  end;

  s := ExtractFilePath(fFileName);
  if (s <> '') and FileExists(s + FileName) then
  begin
    FileName := s + FileName;
    Exit(True);
  end;

  {s := ExtractFilePath(ParamStr(0));
  if (s <> '') and FileExists(s + FileName) then
  begin
    FileName := s + FileName;
    Exit(True);
  end;

  Result := FileExists(FileName);}

  Result := False;
end;

procedure TCodeInsight.ParseInclude(FileName: string);
var
  l: Integer;
begin
  l := Length(fIncludes);
  SetLength(fIncludes, l + 1);
  fIncludes[l] := GetIncludeBuffer(FileName, Self).CodeInsight;
end;

procedure TCodeInsight.OnInclude(Sender: TmwBasePasLex);
var
  Param: string;
  i: Integer;
begin
  Param := Sender.DirectiveParam;
  Param := StringReplace(Param, '/', '\', [rfReplaceAll]);
  if (not Sender.IsJunk) and (Param <> '') then
  begin
    if FindInclude(Param) then
    begin
      if (LowerCase(Sender.Token) = 'include_once') then
        for i := High(fIncludes) downto 0 do
          if (fIncludes[i].FileName = Param) then
          begin
            Param := '';
            Break;
          end;

      if (Param <> '') then
        ParseInclude(Param);
    end
    else if Assigned(OnMessage) then
      OnMessage(Self, meError, Format(ci_UnknownInclude, [Param]), Sender.PosXY.X, Sender.PosXY.Y);
  end;

  inherited;
end;

procedure TCodeInsight.SetPos(APos: Integer);
begin
  if (fPos = APos) then
    Exit;
  Reset;
  fPos := APos;
  Init;
end;

procedure TCodeInsight.Init;
var
  a, b: TDeclarationArray;
  d: TDeclaration;
  i, ii: Integer;
  s: string;
begin
  if (fPos >= 0) then
    fDeclarationAtPos := fItems.GetItemInPos(fPos, fPos, True)
  else
    fDeclarationAtPos  := nil;

  (*if (fDeclarationatPos is TciJunk) and (fDeclarationatPos.Owner <> nil) {and (fDeclarationatPos.EndPos = fPos)} then
    fDeclarationAtPos := fDeclarationatPos.Owner;*)

  if (fDeclarationAtPos <> nil) and (not (fDeclarationAtPos is TciJunk)) then
  begin
    InFunc := fDeclarationAtPos.GetOwnersOfClass(TciProcedureDeclaration);
    if (fDeclarationAtPos is TciProcedureDeclaration) then
    begin
      SetLength(InFunc, Length(InFunc) + 1);
      InFunc[High(InFunc)] := fDeclarationAtPos;
    end;

    if (Length(InFunc) > 0) and (InFunc[0].Owner = nil) then
    begin
      d := InFunc[0].Items.GetFirstItemOfClass(TciProcedureClassName);
      if (d <> nil) then
        d := FindVarBase(d.CleanText, True, vbType);
      if (d <> nil) and (d is TciStruct) then
      begin
        SetLength(InWith, Length(InWith) + 1);
        InClassFunction := High(InWith);
        InWith[InClassFunction] := d;
      end;
    end;

    a := fDeclarationAtPos.GetOwnersOfClass(TciWithStatement);
    if (fDeclarationAtPos is TciWithStateMent) then
    begin
      SetLength(a, Length(a) + 1);
      a[High(a)] := fDeclarationAtPos;
    end
    else if fDeclarationAtPos.HasOwnerClass(TciClassType, d, True) then
    begin
      SetLength(InWith, Length(InWith) + 1);
      InWith[High(InWith)] := d;
    end;

    for i := High(a) downto Low(a) do
    begin
      b := a[i].Items.GetItemsOfClass(TciVariable);
      for ii := Low(b) to High(b) do
      begin
        if (fDeclarationAtPos is TciVariable) and (b[ii].EndPos >= fPos) then
          Continue;
        s := b[ii].CleanText;
        d := FindVarBase(s, True, vbType);
        if (d <> nil) and (d is TciStruct) then
        begin
          SetLength(InWith, Length(InWith) + 1);
          InWith[High(InWith)] := d;
        end;
      end;
    end;
  end;
end;

procedure TCodeInsight.Reset;
begin
  Lexer.Init;

  //SetLength(fIncludes, 0);
  SetLength(InFunc, 0);
  SetLength(InWith, 0);
  InClassFunction := -1;

  Proposal_ItemList.Clear;
  Proposal_InsertList.Clear;
  Proposal_Filled := False;

  fDeclarationAtPos := nil;
end;

function TCodeInsight.GetVarType(s: string; out Decl: TDeclaration; Return: TVarBase): Boolean;
var
  a, b: TDeclarationArray;
  i, ii, iii, iiii, FuncOffset, SetOffset: Integer;
  c: array [1..3] of TDeclarationClass;
  d: TDeclaration;
begin
  Result := False;
  FuncOffset := 0;
  SetOffset := 0;

  if (s = 'RESULT') and (Length(InFunc) > 0) then
  begin
    Decl := InFunc[Low(InFunc)].Items.GetFirstItemOfClass(TciReturnType);
    if (Decl <> nil) then
    begin
      Result := True;
      Exit;
    end;
  end;

  if (s = 'SELF') and (InClassFunction <> -1) and InWith[InClassFunction].HasOwnerClass(TciTypeDeclaration, d, True) then
  begin
    Decl := d.Items.GetFirstItemOfClass(TciTypeName);
    if (Decl <> nil) then
    begin
      Result := True;
      Exit;
    end;
  end;

  for i := Low(InFunc) to High(InFunc) + 1 do
  begin
    for iiii := 1 to 3 do
    begin
      case iiii of
        1:
          begin
            c[1] := TciVarDeclaration;
            c[2] := TciVarName;
            c[3] := TciTypeKind;
          end;
        2:
          begin
            if (Return = vbType) then
              Continue;
            c[1] := TciConstantDeclaration;
            c[2] := TciConstantName;
            c[3] := TciExpression;
          end;
        3:
          begin
            if (Return = vbType) then
              Continue;
            c[1] := TciLabelDeclaration;
            c[2] := TciLabelName;
            c[3] := nil;
          end;
        else
          Continue;
      end;
     if (i = High(InFunc) + 1) then
        a := fItems.GetItemsOfClass(c[1])
      else
        a := InFunc[i].Items.GetItemsOfClass(c[1]);
      for ii := Low(a) to High(a) do
      begin
        b := a[ii].Items.GetItemsOfClass(c[2]);
        for iii := Low(b) to High(b) do
          if (PrepareString(b[iii].CleanText) = s) then
          begin
            Result := True;
            if (Return = vbType) and (c[3] <> nil) then
              Decl := a[ii].Items.GetFirstItemOfClass(c[3])
            else
              Decl := b[iii];
            Exit;
          end;
        end;
    end;

    if (Return = vbName) then
    begin
      if (i = High(InFunc) + 1) then
        a := fItems.GetItemsOfClass(TciQualifiedIdentifier, True)
      else
        a := InFunc[i].Items.GetItemsOfClass(TciQualifiedIdentifier, True);
      for ii := Low(a) to High(a) - SetOffset do
      begin
        if (i = High(InFunc) + 1) then
          if a[ii].HasOwnerClass(TciTypeDeclaration, d, True) then
          begin
            if d.HasOwnerClass(TciProcedureDeclaration, d, True) then
              Continue;
          end
          else if a[ii].HasOwnerClass(TciProcedureDeclaration, d, True) and (d.Owner <> nil) then
            Continue;

        if (PrepareString(a[ii].CleanText) = s) then
        begin
          Result := True;
          Decl := a[ii];
          Exit;
        end;
      end;
      SetOffset := Length(a);
    end;

    if (i <= High(InFunc)) then
    begin
      a := InFunc[i].Items.GetItemsOfClass(TciParameterName, True);
      for ii := Low(a) to High(a) - FuncOffset do
        if (PrepareString(a[ii].CleanText) = s) then
        begin
          Result := True;
          if (Return = vbType) then
            Decl := a[ii].Owner.Items.GetFirstItemOfClass(TciParameterType)
           else
            Decl := a[ii];
          Exit;
        end;
      FuncOffset := Length(a);
    end;
  end;
end;

function TCodeInsight.GetFuncType(FuncName, FuncClass: string; out Decl: TDeclaration; Return: TVarBase): Boolean;
var
  a: TDeclarationArray;
  b: TDeclaration;
  i, ii: Integer;
begin
  Result := False;

  for ii := Low(InFunc) to High(InFunc) + 1 do
  begin
    if (ii = High(InFunc) + 1) then
      a := fItems.GetItemsOfClass(TciProcedureDeclaration)
    else
      a := InFunc[ii].Items.GetItemsOfClass(TciProcedureDeclaration);
   for i := Low(a) to High(a) do
    begin
      b := nil;
      if (FuncClass <> '') then
        b := a[i].Items.GetFirstItemOfClass(TciProcedureClassName);
      if ((FuncClass = '') and (b = nil)) or ((b <> nil) and (PrepareString(b.CleanText) = FuncClass)) then
      begin
        b := a[i].Items.GetFirstItemOfClass(TciProcedureName);
        if (b <> nil) and (PrepareString(b.CleanText) = FuncName) then
        begin
          Result := True;
          if (Return = vbType) then
            Decl := a[i].Items.GetFirstItemOfClass(TciReturnType)
          else
            Decl := b;

          if (a[i].Items.GetFirstItemOfClass(TciForward) = nil) then
            Exit;
        end;
      end;
    end;
  end;
end;

function TCodeInsight.FindStruct(s: string; out Decl: TDeclaration; Return: TVarBase; var ArrayCount: Integer): Boolean;
var
  a, b: TDeclarationArray;
  i, ii: Integer;
begin
  Result := False;
  s := PrepareString(s);
  a := fItems.GetItemsOfClass(TciTypeDeclaration);

  for i := Low(a) to High(a) do
  begin
    b := a[i].Items.GetItemsOfClass(TciTypeName);
    for ii := Low(b) to High(b) do
      if (PrepareString(b[ii].CleanText) = s) then
      begin
        Result := True;
        if (Return = vbType) then
        begin
          Decl := a[i].Items.GetFirstItemOfClass(TciTypeKind);
          if (Decl = nil) then
            Decl := a[i].Items.GetFirstItemOfClass(TciClassType);
          if (Decl is TciTypeKind) then
            Decl := TciTypeKind(Decl).GetRealType(ArrayCount);
          if (Decl is TciStruct) then
            Result := True
          else
            Result := (Decl <> nil) and FindStruct(Decl.CleanText, Decl, Return, ArrayCount);
        end
        else
          Decl := b[ii];
        if (Decl <> nil) then
          Exit;
      end;
  end;
end;

function TCodeInsight.GetExpressionAtPos(var BraceCount, BracketCount, CommaCount: Integer; IgnoreBrackets: Boolean = False): string;
var
  i, StartPos, EndPos: Integer;
  s: string;
  a: TDeclarationArray;
  d: TDeclaration;
  LastWasDot: Boolean;
begin
  Result := '';
  d := nil;
  if (fDeclarationAtPos = nil) or
     (fDeclarationAtPos is TciJunk) or
     (not (
       (fDeclarationAtPos.HasOwnerClass(TciCompoundStatement, d, True) or (fDeclarationAtPos is TciCompoundStatement)) or
       (fDeclarationAtPos.HasOwnerClass(TciConstantDeclaration, d, True) or (fDeclarationAtPos is TciConstantDeclaration)) or
       (fDeclarationAtPos.HasOwnerClass(TciVarDeclaration, d, True) or (fDeclarationAtPos is TciVarDeclaration)) or
       (fDeclarationAtPos.HasOwnerClass(TciLabelDeclaration, d, True) or (fDeclarationAtPos is TciLabelDeclaration)) or
       (fDeclarationAtPos.HasOwnerClass(TciTypeDeclaration, d, True) or (fDeclarationAtPos is TciTypeDeclaration)) or
       (fDeclarationAtPos.HasOwnerClass(TciProcedureDeclaration, d, True) or (fDeclarationAtPos is TciProcedureDeclaration))
     )) then
    Exit;
  if (d = nil) then
    d := fDeclarationAtPos;
  a := d.Items.GetItemsOfClass(TciJunk, True);
  EndPos := fPos - d.StartPos;
  s := d.CleanText;

  for i := Low(a) to High(a) do
    if (fPos > a[i].EndPos) then
      if (Pos(LineEnding, a[i].RawText) > 0) then
        EndPos := EndPos - a[i].EndPos + a[i].StartPos + Length(LineEnding)
      else
        EndPos := EndPos - a[i].EndPos + a[i].StartPos + 1;

  StartPos := EndPos;
  LastWasDot := False;
  while (StartPos > 0) do
  begin
    if (BraceCount = 0) and ((BracketCount = 0) or IgnoreBrackets) and (s[StartPos] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) then
      {nothing}
    else if (BraceCount = 0) and ((BracketCount = 0) or IgnoreBrackets) and (s[StartPos] in [#10, #11, #13, #32]) then
    begin
      i := StartPos;
      Dec(StartPos);
      while (StartPos > 0) and (s[StartPos] in [#10, #11, #13, #32]) do
        Dec(StartPos);
      if not ((LastWasDot and (s[StartPos] in ['a'..'z', 'A'..'Z', '0'..'9', '_', ']', ')'])) or ((not LastWasDot) and (s[StartPos] = '.'))) then
      begin
        StartPos := i;
        Break;
      end;
      Inc(StartPos);
    end
    else if (s[StartPos] = '.') then
    begin
      LastWasDot := True;
      Dec(StartPos);
      Continue;
    end
    else if (s[StartPos] = ']') then
      Inc(BracketCount)
    else if (s[StartPos] = '[') then
    begin
      Dec(BracketCount);
      LastWasDot := True;
      Dec(StartPos);
      Continue;
    end
    else if (s[StartPos] = ')') then
      Inc(BraceCount)
    else if (s[StartPos] = '(') then
    begin
      Dec(BraceCount);
      LastWasDot := True;
      Dec(StartPos);
      Continue;
    end
    else if (BraceCount = 1) and (BracketCount = 0) and (s[StartPos] = ',')  then
      Inc(CommaCount)
    else if (BraceCount = 0) and ((BracketCount = 0) or IgnoreBrackets) then
      Break;

    if (BraceCount < 0) or ((BracketCount < 0) and (not IgnoreBrackets)) then
    begin
      Dec(StartPos, BraceCount);
      Dec(StartPos, BracketCount);
      Break;
    end;
    LastWasDot := False;
    Dec(StartPos);
  end;

  Result := CompressWhiteSpace(Copy(s, StartPos + 1, EndPos - StartPos));
end;

function TCodeInsight.GetExpressionAtPos: string;
var
  bcc, bkc, cc: Integer;
begin
  bcc := 0;
  bkc := 0;
  cc := 0;
  Result := GetExpressionAtPos(bcc, bkc, cc);
end;

function TCodeInsight.FindVarBase(s: string; GetStruct: Boolean = False; Return: TVarBase = vbName): TDeclaration;

  function PartOfWith(s: string; out Decl: TDeclaration; Return: TVarBase; CheckClass: Boolean): Boolean;
  var
    i: Integer;
  begin
    Result := False;
    for i := High(InWith) downto Low(InWith) do
      if CheckClass xor (i <> InClassFunction) then
        if TciStruct(InWith[i]).HasField(s, Decl, Return) then
        begin
          Result := True;
          Break;
        end;
  end;

  function DoGetVarType(s: string; out Decl: TDeclaration; Return: TVarBase): Boolean;

    function CheckIt(s: string; Item: TCodeInsight; out Decl: TDeclaration; Return: TVarBase; const CheckCore: Boolean = True): Boolean;
    var
      i: Integer;
    begin
      Result := False;
      if Item.GetVarType(s, Decl, Return) then
        Exit(True);

      for i := High(Item.Includes) downto Low(Item.Includes) do
        if CheckIt(s, Item.Includes[i], Decl, Return) then
          Exit(True);

      if (not CheckCore) then
        Exit;
      for i := High(CoreBuffer) downto Low(CoreBuffer) do
        if CheckIt(s, CoreBuffer[i], Decl, Return, False) then
          Exit(True);
    end;

  begin
    Result := CheckIt(s, Self, Decl, Return);
  end;

  function DoGetFuncType(FuncName, FuncClass: string; out Decl: TDeclaration; Return: TVarBase): Boolean;

    function CheckIt(FuncName, FuncClass: string; Item: TCodeInsight; out Decl: TDeclaration; Return: TVarBase; const CheckCore: Boolean = True): Boolean;
    var
      i: Integer;
    begin
      Result := False;
      if Item.GetFuncType(FuncName, FuncClass, Decl, Return) then
        Exit(True);

      for i := High(Item.Includes) downto Low(Item.Includes) do
        if CheckIt(FuncName, FuncClass, Item.Includes[i], Decl, Return) then
          Exit(True);

      if (not CheckCore) then
        Exit;
      for i := High(CoreBuffer) downto Low(CoreBuffer) do
        if CheckIt(FuncName, FuncClass, CoreBuffer[i], Decl, Return, False) then
          Exit(True);
    end;

  begin
    Result := CheckIt(FuncName, FuncClass, Self, Decl, Return);
  end;

  function DoFindStruct(s: string; out Decl: TDeclaration; Return: TVarBase; var ArrayCount: Integer): Boolean;

    function CheckIt(s: string; Item: TCodeInsight; out Decl: TDeclaration; Return: TVarBase; var ArrayCount: Integer; const CheckCore: Boolean = True): Boolean;
    var
      i: Integer;
    begin
      Result := False;
      if Item.FindStruct(s, Decl, Return, ArrayCount) then
        Exit(True);

      for i := High(Item.Includes) downto Low(Item.Includes) do
        if CheckIt(s, Item.Includes[i], Decl, Return, ArrayCount) then
          Exit(True);

      if (not CheckCore) then
        Exit;
      for i := High(CoreBuffer) downto Low(CoreBuffer) do
        if CheckIt(s, CoreBuffer[i], Decl, Return, ArrayCount, False) then
          Exit(True);
    end;

  begin
    Result := CheckIt(s, Self, Decl, Return, ArrayCount);
  end;

var
  f, NameClass: string;
  sa: TStringArray;
  d: TDeclaration;
  i, NeedArrayCount, ArrayCount: Integer;
  InStruct: TciStruct;
  VarBase: TVarBase;
  Found, CheckVar, IsForward: Boolean;
begin
  Result := nil;
  if (fDeclarationAtPos is TciJunk) or (PrepareString(s) = '') then
    Exit;

  InStruct := nil;
  NameClass := '';
  IsForward := False;
  CheckVar := (fPos < 0);
  sa := Explode('.', PrePrepareString(s));

  if (fDeclarationAtPos <> nil) then
  begin
    if (fDeclarationAtPos is TciProcedureName) and (fDeclarationAtPos.Owner <> nil) then
    begin
      if fDeclarationAtPos.HasOwnerClass(TciClassType, d, True) and (d.Owner <> nil) then
      begin
        d := d.Owner.Items.GetFirstItemOfClass(TciTypeName);
        if (d <> nil) then
          NameClass := PrepareString(d.CleanText);
      end
      else if (fDeclarationAtPos.Owner.Items.GetFirstItemOfClass(TciForward) <> nil) then
        IsForward := True;
    end;

    if (Return = vbName) and (
         (fDeclarationAtPos is TciVarName) or
         (fDeclarationAtPos is TciConstantName) or
         (fDeclarationAtPos is TciTypeName) or
         (fDeclarationAtPos is TciLabelName) or
         ((fDeclarationAtPos is TciProcedureName) and
           (NameClass = '') and
           (fDeclarationAtPos.Owner <> nil) and
           (not IsForward) and
           (fDeclarationAtPos.Owner.Items.GetFirstItemOfClass(TciProcedureClassName) = nil)) or
         (fDeclarationAtPos is TciParameterName) or
         (fDeclarationAtPos is TciFieldName) or
         (fDeclarationAtPos is TciQualifiedIdentifier)) then
      Exit;
    CheckVar := (NameClass = '') and ((
      (Length(InFunc) > 0) or
        (Length(InWith) > 0) or
        (fDeclarationAtPos is TciCompoundStatement) or
        (fDeclarationAtPos is TciExpression) or
        fDeclarationAtPos.HasOwnerClass(TciCompoundStatement, d, True)) or (
      (Return = vbType) and (
        (fDeclarationAtPos is TciTypeKind) or
        (fDeclarationAtPos is TciParameterType) or
        (fDeclarationAtPos is TciReturnType) or
        (fDeclarationAtPos is TciQualifiedIdentifier) or
        (fDeclarationAtPos is TciExpression))));
  end;

  for i := Low(sa) to High(sa) do
  begin
    f := PrepareString(sa[i], ArrayCount);
    NeedArrayCount := 0;

    if (Return = vbName) and (i = High(sa)) then
      VarBase := vbName
    else
      VarBase := vbType;

    if (InStruct <> nil) then
      Found := InStruct.HasField(f, Result, VarBase)
    else
    begin
      Found := CheckVar and PartOfWith(f, Result, VarBase, False);
      if (not Found) and (i = Low(sa)) then
      begin
        Found :=
          (CheckVar and DoGetVarType(f, Result, VarBase)) or
          ((CheckVar or (NameClass <> '') or IsForward) and DoGetFuncType(f, NameClass, Result, VarBase)) or
          DoFindStruct(f, Result, VarBase, NeedArrayCount);
      end;
      if (not Found) and CheckVar then
        Found := PartOfWith(f, Result, VarBase, True);
    end;

    if Found and (Result is TciTypeKind) then
      Result := TciTypeKind(Result).GetRealType(NeedArrayCount);

    if Found and (Result <> nil) and (not (Result is TciStruct)) and ((i < High(sa)) or GetStruct) then
      Found := DoFindStruct(Result.CleanText, Result, VarBase, NeedArrayCount);

    if Found and (Result <> nil) and (ArrayCount <> NeedArrayCount) and ((Result is TciStruct) or (InStruct <> nil)) and ((i < High(sa)) or GetStruct) then
    begin
      if (InStruct <> nil) then
        Result := InStruct.GetDefault(VarBase)
      else
        Result := TciStruct(Result).GetDefault(VarBase);

      Found := (Result <> nil);

      if Found and (Result is TciTypeKind) then
        Result := TciTypeKind(Result).GetRealType(NeedArrayCount);

      if Found and (not (Result is TciStruct)) and ((i < High(sa)) or GetStruct) then
        Found := DoFindStruct(Result.CleanText, Result, VarBase, NeedArrayCount);

      if (not Found) then
      begin
        if Assigned(OnMessage) then
          OnMessage(Self, meError, Format(ci_RangeError, [sa[i], s]), -1, -1);
        Result := nil;
        Exit;
      end;
    end;

    if (not Found) or (Result = nil) then
    begin
      if Assigned(OnMessage) then
        if (i > Low(sa)) then
          OnMessage(Self, meError, Format(ci_UnknownMember, [sa[i], s]), -1, -1)
        else
          OnMessage(Self, meError, Format(ci_UnknownStruct, [sa[i], s]), -1, -1);
      Result := nil;
      Exit;
    end;

    InStruct := TciStruct(Result);
  end;
end;

constructor TCodeInsight.Create(FileName: string = '');
begin
  inherited Create;

  Proposal_InsertList := TStringList.Create;
  //TStringList(Proposal_InsertList).Sorted := True;
  Proposal_ItemList := TStringList.Create;

  fOnFindInclude := nil;
  fFileName := FileName;
  if (fFileName <> '') and (not FileExists(fFileName)) then
    fFileName := '';
  fPos := -1;
  Reset;

  fOwnStream := (fFileName <> '');
  if fOwnStream then
  begin
    fMemoryStream := TMemoryStream.Create;
    fMemoryStream.LoadFromFile(fFileName);
  end
  else
    fMemoryStream := nil;
end;

destructor TCodeInsight.Destroy;
begin
  if fOwnStream then
    FreeAndNil(fMemoryStream);

  FreeAndNil(Proposal_InsertList);
  FreeAndNil(Proposal_ItemList);

  inherited;
end;

procedure TCodeInsight.Assign(From: TObject);
begin
  if (From is TCodeInsight) then
    with From as TCodeInsight do
    begin
      Self.OnFindInclude := OnFindInclude;
    end;

  inherited;
end;

procedure TCodeInsight.Run(SourceStream: TCustomMemoryStream = nil; BaseDefines: TStringList = nil; MaxPos: Integer = -1);
begin
  if Assigned(BaseDefines) then
  begin
    Lexer.ClearDefines;
    Lexer.Defines.Assign(BaseDefines);
  end;
  SetLength(fIncludes, 0);

  if fOwnStream then
    inherited Run(fMemoryStream, MaxPos - 1)
  else if Assigned(SourceStream) then
    inherited Run(SourceStream, MaxPos - 1);

  if (MaxPos > -1) then
    Position := MaxPos;
end;

procedure TCodeInsight.Proposal_AddDeclaration(Item: TDeclaration; ItemList, InsertList: TStrings);

  function FormatFirstColumn(s: string): string; inline;
  begin
    Result := '{#clNavy}' + LowerCase(s) + '{#0} {|}'
  end;

  function FormatTypeName(s: string): string; inline;
  begin
    Result := '{#clBlue}' + s;
  end;

  function FormatMainName(s: string): string; inline;
  begin
    Result := '{B+}' + s + '{B-}';
  end;

  function FormatMainExtra(s: string): string; inline;
  begin
    Result := '{I+}' + s + '{I-}'
  end;

  function GetEnumTypeName(Item: TDeclaration): string;
  begin
    Result := 'Enumeration';
    if (Item.Items.Count > 0) then
      Result := Result + '(' + Item.Items[0].ShortText;
    if (Item.Items.Count > 1) then
      Result := Result + '..' + Item.Items[Item.Items.Count - 1].ShortText + ')';
  end;

  procedure AddEnums(Item: {TCodeInsight}TDeclaration; ItemList, InsertList: TStrings); overload;
  var
    {i,} ii, SetOffset: Integer;
    a: TDeclarationArray;
    d: TDeclaration;
    s: string;
  begin
    SetOffset := 0;
    //for i := Low(Item.InFunc) to High(Item.InFunc) + 1 do
    begin
      //if (i = High(Item.InFunc) + 1) then
        a := Item.Items.GetItemsOfClass(TciQualifiedIdentifier, True);
      //else
      //  a := Item.InFunc[i].Items.GetItemsOfClass(TciQualifiedIdentifier, True);
      for ii := Low(a) to High(a) - SetOffset do
      begin
        {if (i = High(Item.InFunc) + 1) then
          if a[ii].HasOwnerClass(TciTypeDeclaration, d, True) then
          begin
            if d.HasOwnerClass(TciProcedureDeclaration, d, True) then
              Continue;
          end
          else if a[ii].HasOwnerClass(TciProcedureDeclaration, d, True) and (d.Owner <> nil) then
            Continue;}

        s := FormatFirstColumn('enum') + FormatMainName(a[ii].ShortText);
        if a[ii].HasOwnerClass(TciTypeDeclaration, d, True) then
        begin
          d := d.Items.GetFirstItemOfClass(TciTypeName);
          if (d <> nil) then
            s := s + ' ' + FormatMainExtra('(' + d.ShortText + ')');
        end;
        ItemList.Insert(InsertList.Add(a[ii].ShortText), s);
      end;
      //SetOffset := Length(a);
    end;
  end;

  procedure AddEnums(a: TDeclarationArray; ItemList, InsertList: TStrings); overload;
  var
    i: Integer;
  begin
    for i := Low(a) to High(a) do
      AddEnums(a[i], ItemList, InsertList);
  end;

  procedure AddFuncDeclaration(Item: TciProcedureDeclaration; ItemList, InsertList: TStrings);
  var
    s, n: string;
    d: TDeclaration;
  begin
    s := FormatFirstColumn(Item.ProcType);
    d := Item.Items.GetFirstItemOfClass(TciProcedureName);
    if (d = nil) then
      Exit;
    n := d.ShortText;
    s := s + FormatMainName(n);
    if (Item.Params <> '') then
    begin
      s := s + FormatMainExtra('(' + Item.Params + ')');
      //n := n {+ '('};
    end;
    d := Item.Items.GetFirstItemOfClass(TciReturnType);
    if (d <> nil) then
      s := s + ': ' + FormatTypeName(d.ShortText)
    {else
      s := s + ';'};
    ItemList.Insert(InsertList.Add(n), s);

    AddEnums(Item.GetParamDeclarations, ItemList, InsertList);
    if (d <> nil) then
      AddEnums(d, ItemList, InsertList);
  end;

var
  i: Integer;
  FirstColumn, s, n: string;
  a: TDeclarationArray;
  b: array[1..2] of TDeclaration;
  c: array[0..2] of TDeclarationClass;
begin
  if (Item is TciProcedureDeclaration) then
  begin
    AddFuncDeclaration(TciProcedureDeclaration(Item), ItemList, InsertList);
    Exit;
  end;

  c[0] := nil;
  c[1] := nil;
  c[2] := nil;
  if (Item is TciVarDeclaration) then
  begin
    FirstColumn := FormatFirstColumn('variable');
    c[0] := TciVarName;
    c[2] := TciTypeKind;
  end
  else if (Item is TciConstantDeclaration) then
  begin
    FirstColumn := FormatFirstColumn('constant');
    c[0] := TciConstantName;
    c[1] := TciExpression;
  end
  else if (Item is TciLabelDeclaration) then
  begin
    FirstColumn := FormatFirstColumn('label');
    c[0] := TciLabelName;
  end
  else if (Item is TciTypeDeclaration) then
  begin
    FirstColumn := FormatFirstColumn('type');
    c[0] := TciTypeName;
    c[2] := TciTypeKind;
  end
  else if (Item is TciClassField) then
  begin
    FirstColumn := FormatFirstColumn('variable');
    c[0] := TciFieldName;
    c[2] := TciTypeKind;
  end
  else if (Item is TciClassProperty) then
  begin
    FirstColumn := FormatFirstColumn('property');
    c[0] := TciFieldName;
    c[2] := TciTypeKind;
  end
  else if (Item is TciConstParameter) or
          (Item is TciOutParameter) or
          (Item is TciFormalParameter) or
          (Item is TciInParameter) or
          (Item is TciVarParameter) then
  begin
    FirstColumn := FormatFirstColumn('param');
    c[0] := TciParameterName;
    c[2] := TciParameterType;
  end;

  if (c[0] = nil) then
    Exit;

  a := Item.Items.GetItemsOfClass(c[0]);
  if (c[1] <> nil) then
    b[1] := Item.Items.GetFirstItemOfClass(c[1])
  else
    b[1] := nil;
  if (c[2] <> nil) then
  begin
    b[2] := Item.Items.GetFirstItemOfClass(c[2]);
    if (b[2] is TciTypeKind) and (b[2].Items.Count > 0) and (not (b[2].Items[0] is TciArrayType)) then
      b[2] := b[2].Items[0];
  end
  else
    b[2] := nil;
  for i := Low(a) to High(a) do
  begin
    n := a[i].ShortText;
    (*{$IFDEF ciCHECKDUPLICATES}
    if (InsertList.IndexOf(n) > -1) then
      Continue;
    {$ENDIF}*)
    s := FirstColumn + FormatMainName(n);
    if (b[1] <> nil) then
      s := s + FormatMainExtra(' = ' + b[1].ShortText);
    if (b[2] <> nil) then
      if (b[2] is TciEnumType) then
        s := s + ': ' + FormatTypeName(GetEnumTypeName(b[2]))
      else
        s := s + ': ' + FormatTypeName(b[2].ShortText)
    {else
      s := s + ';'};

    ItemList.Insert(InsertList.Add(n), s);
    if (b[2] <> nil) and (b[2].Items.Count > 0) then
      AddEnums(b[2], ItemList, InsertList);
  end;
end;

procedure TCodeInsight.FillProposal;
var
  i: Integer;
begin
  if (not Proposal_Filled) then
  begin
    Proposal_ItemList.BeginUpdate;
    Proposal_InsertList.BeginUpdate;

    try
      for i := 0 to Items.Count - 1 do
        Proposal_AddDeclaration(Items[i], Proposal_ItemList, Proposal_InsertList);
      Proposal_Filled := True;
    finally
      Proposal_ItemList.EndUpdate;
      Proposal_InsertList.EndUpdate;
    end;
  end;
end;

procedure TCodeInsight.FillSynCompletionProposal(ItemList, InsertList: TStrings; Prefix: string = '');

  procedure AddFile(Item: TCodeInsight; ItemList, InsertList: TStrings);
  var
    i: Integer;
  begin
    if (not Item.Proposal_Filled) then
      Item.FillProposal;

    {$IFNDEF ciCHECKDUPLICATES}
    ItemList.AddStrings(Item.Proposal_ItemList);
    InsertList.AddStrings(Item.Proposal_InsertList);
    {$ELSE}
    for i := 0 to Item.Proposal_InsertList.Count - 1 do
      if (InsertList.IndexOf(Item.Proposal_InsertList[i]) = -1) then
      begin
        ItemList.Insert(InsertList.Add(Item.Proposal_InsertList[i]), Item.Proposal_ItemList[i]);
        //ItemList.Add(Item.Proposal_ItemList[i]);
      end;
    {$ENDIF}

    //AddEnums(Item, ItemList, InsertList);
    for i := Low(Item.Includes) to High(Item.Includes) do
      AddFile(Item.Includes[i], ItemList, InsertList);
  end;

var
  i, ii: Integer;
  d: TDeclaration;
begin
  ItemList.BeginUpdate;
  InsertList.BeginUpdate;
  try
    ItemList.Clear;
    InsertList.Clear;

    if (PrepareString(Prefix) <> '') then
    begin
      d := FindVarBase(Prefix, True, vbType);
      if (d <> nil) then
        for i := 0 to d.Items.Count - 1 do
          Proposal_AddDeclaration(d.Items[i], ItemList, InsertList);
    end
    else
    begin
      for i := High(InWith) downto Low(InWith) do
        if (i <> InClassFunction) then
          for ii := 0 to InWith[i].Items.Count - 1 do
            Proposal_AddDeclaration(InWith[i].Items[ii], ItemList, InsertList);

      for i := Low(InFunc) to High(InFunc) do
        for ii := 0 to InFunc[i].Items.Count - 1 do
           Proposal_AddDeclaration(InFunc[i].Items[ii], ItemList, InsertList);

      if (InClassFunction <> -1) then
        for i := 0 to InWith[InClassFunction].Items.Count - 1 do
          Proposal_AddDeclaration(InWith[InClassFunction].Items[i], ItemList, InsertList);

      AddFile(Self, ItemList, InsertList);
      for i := 0 to High(CoreBuffer) do
        AddFile(CoreBuffer[i], ItemList, InsertList);
    end;
  finally
    ItemList.EndUpdate;
    InsertList.EndUpdate;
  end;
end;

initialization
  {nothing}
finalization
  ClearIncludeBuffer;
  ClearCoreBuffer;

end.