Hopefully fixed a bug in code completion.

2024-12-22 15:28:50 -05:00 · 2010-03-28 11:38:06 +02:00 · 2010-03-28 11:38:06 +02:00 · 9237cdecef
commit 9237cdecef
parent c12064bcb1
5 changed files with 63 additions and 35 deletions
--- a/Projects/SAMufasaGUI/framescript.pas
+++ b/Projects/SAMufasaGUI/framescript.pas
@ -146,7 +146,9 @@ var
  sp, ep: Integer;
 begin
  mp := TCodeInsight.Create;
+  {$IFDEF ciDEBUG}
  mp.OnMessage := @Form1.OnCCMessage;
+  {$ENDIF}
  mp.OnFindInclude := @Form1.OnCCFindInclude;

  ms := TMemoryStream.Create;
@ -290,7 +292,9 @@ begin
        Synedit.MarkupByClass[TSynEditMarkupHighlightAllCaret].TempDisable;
      end;}
    mp := TCodeInsight.Create;
+    {$IFDEF ciDEBUG}
    mp.OnMessage := @Form1.OnCCMessage;
+    {$ENDIF}
    mp.OnFindInclude := @Form1.OnCCFindInclude;

    ms := TMemoryStream.Create;
--- a/Projects/SAMufasaGUI/testunit.pas
+++ b/Projects/SAMufasaGUI/testunit.pas
@ -316,7 +316,9 @@ type
    procedure UpdateMenuButtonClick(Sender: TObject);
    procedure UpdateTimerCheck(Sender: TObject);

+    {$IFDEF ciDEBUG}
    procedure OnCCMessage(Sender: TObject; const Typ: TMessageEventType; const Msg: string; X, Y: Integer);
+    {$ENDIF}
    procedure OnCompleteCode(Str: string);
    function OnCCFindInclude(Sender: TObject; var FileName: string): Boolean;
  private
@ -438,6 +440,7 @@ end;
 var
   DebugCriticalSection: syncobjs.TCriticalSection;

+{$IFDEF ciDEBUG}
 procedure TForm1.OnCCMessage(Sender: TObject; const Typ: TMessageEventType; const Msg: string; X, Y: Integer);
 begin
  if (Typ = meNotSupported) then
@ -447,6 +450,7 @@ begin
      Exit;
  mDebugLn('ERROR: '+Format('%d:%d %s', [Y + 1, X, Msg])+' in '+TCodeInsight(Sender).FileName);
 end;
+{$ENDIF}

 procedure TForm1.OnCompleteCode(Str: string);
 var
@ -1756,33 +1760,38 @@ procedure TForm1.FormCreate(Sender: TObject);
    ms: TMemoryStream;
  begin
    InitalizeTMThread(t);
-    if (not (t is TPSThread)) then
-      Exit;
-    a := TPSScriptExtension.Create(Self);
-    b := TStringList.Create;
-    ms := TMemoryStream.Create;
-
+    KillThread(t.ThreadID);
+    if (t is TPSThread) then
    try
-      with TPSThread(t).PSScript do
-      begin
-        a.OnCompile := OnCompile;
-        a.OnCompImport := OnCompImport;
-        a.OnExecImport := OnExecImport;
-      end;
-      a.GetValueDefs(b);
+      a := TPSScriptExtension.Create(Self);
+      b := TStringList.Create;
+      ms := TMemoryStream.Create;

-      SetLength(CoreBuffer, 1);
-      CoreBuffer[0] := TCodeInsight.Create;
-      with CoreBuffer[0] do
-      begin
-        OnMessage := @OnCCMessage;
-        b.SaveToStream(ms);
-        Run(ms);
+      try
+        with TPSThread(t).PSScript do
+        begin
+          a.OnCompile := OnCompile;
+          a.OnCompImport := OnCompImport;
+          a.OnExecImport := OnExecImport;
+        end;
+        a.GetValueDefs(b);
+
+        SetLength(CoreBuffer, 1);
+        CoreBuffer[0] := TCodeInsight.Create;
+        with CoreBuffer[0] do
+        begin
+          {$IFDEF ciDEBUG}
+          OnMessage := @OnCCMessage;
+          {$ENDIF}
+          b.SaveToStream(ms);
+          Run(ms, nil, -1, True);
+        end;
+      finally
+        b.Free;
+        a.Free;
      end;
    finally
-      ms.Free;
-      b.Free;
-      a.Free;
+      //KillThread(t.ThreadID);
      t.Free;
    end;
  end;
--- a/Units/Misc/PSDump.pas
+++ b/Units/Misc/PSDump.pas
@ -13,7 +13,7 @@ unit PSDump;
 interface

 uses
-  {$IFNDEF LINUX} Windows, {$ENDIF} SysUtils, Classes, uPSRuntime, uPSUtils, uPSComponent,
+  SysUtils, Classes, uPSRuntime, uPSUtils, uPSComponent,
  uPSCompiler, uPSC_dll, typInfo;

 type
@ -82,11 +82,11 @@ type
  _TMyPascalCompiler = class(TPSPascalCompiler);
 procedure TPSScriptExtension.GetCodeProps;

-  function TypeToString(t: TPSType; Definition: Boolean = False): string; forward;
+  function TypeToString(t: TPSType; Definition: Boolean = False): tbtstring; forward;

-  function FunctionType(f: TObject): string;
+  function FunctionType(f: TObject): tbtstring;
  const
-    FuncStr: array[Boolean] of string = ('procedure', 'function');
+    FuncStr: array[Boolean] of tbtstring = ('procedure', 'function');
  begin
    if (f is TPSDelphiClassItemConstructor) then
      Result := 'constructor'
@ -102,7 +102,7 @@ procedure TPSScriptExtension.GetCodeProps;
      Result := '';
  end;

-  function ParamsToString(d: TPSParametersDecl; CheckResult: Boolean = True): string;
+  function ParamsToString(d: TPSParametersDecl; CheckResult: Boolean = True): tbtstring;
  const
    ParamStr: array [pmIn..pmInOut] of tbtstring = ('','out ','var ');
  var
@ -124,11 +124,11 @@ procedure TPSScriptExtension.GetCodeProps;
      Result := Result + ': ' + TypeToString(d.Result);
  end;

-  function ClassItemsToString(c: TPSCompileTimeClass; DoneList: TStrings = nil): string;
+  function ClassItemsToString(c: TPSCompileTimeClass; DoneList: TStrings = nil): tbtstring;
  var
    ci: TPSDelphiClassItem;
    i, ii: Integer;
-    s: string;
+    s: tbtstring;
    Def: PtrUInt;
    ListFree: Boolean;
  begin
@ -186,7 +186,7 @@ procedure TPSScriptExtension.GetCodeProps;
      DoneList.Free;
  end;

-  function TypeToString(t: TPSType; Definition: Boolean = False): string;
+  function TypeToString(t: TPSType; Definition: Boolean = False): tbtstring;
  var
    r: PIFPSRecordFieldTypeDef;
    i: Integer;
@ -235,7 +235,7 @@ procedure TPSScriptExtension.GetCodeProps;
      Result := t.OriginalName;
  end;

-  function IfRVariantToString(v: TIfRVariant): string;
+  function IfRVariantToString(v: TIfRVariant): tbtstring;
  begin
    case v.FType.BaseType of
      btU8: Result := IntToStr(v.tu8);         
--- a/Units/Misc/ValistusDefines.inc
+++ b/Units/Misc/ValistusDefines.inc
@ -1,7 +1,11 @@
 //Code Insight
+{$IFNDEF LINUX}
+  {$DEFINE ccFORMRESIZE}
+{$ENDIF}
 {.$DEFINE ccFORMCAPTION}
-{$DEFINE ccFORMRESIZE}
+
 {$DEFINE ciCHECKDUPLICATES}
+{$DEFINE ciDEBUG}
 {$DEFINE D8_NEWER1}
 {$DEFINE D9_NEWER}
 {$DEFINE D10_NEWER}
--- a/Units/Misc/v_ideCodeInsight.pas
+++ b/Units/Misc/v_ideCodeInsight.pas
@ -56,7 +56,7 @@ type
    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 Run(SourceStream: TCustomMemoryStream = nil; BaseDefines: TStringList = nil; MaxPos: Integer = -1; ManageStream: Boolean = False); reintroduce;

    procedure Proposal_AddDeclaration(Item: TDeclaration; ItemList, InsertList: TStrings);
    procedure FillProposal;
@ -916,7 +916,7 @@ begin
  inherited;
 end;

-procedure TCodeInsight.Run(SourceStream: TCustomMemoryStream = nil; BaseDefines: TStringList = nil; MaxPos: Integer = -1);
+procedure TCodeInsight.Run(SourceStream: TCustomMemoryStream = nil; BaseDefines: TStringList = nil; MaxPos: Integer = -1; ManageStream: Boolean = False);
 begin
  if Assigned(BaseDefines) then
  begin
@ -925,6 +925,17 @@ begin
  end;
  SetLength(fIncludes, 0);

+  if ManageStream then
+  begin
+    if (SourceStream <> nil) then
+    begin
+      if fOwnStream then
+        FreeAndNil(fMemoryStream);
+      fMemoryStream := TMemoryStream(SourceStream);
+    end;
+    fOwnStream := True;
+  end;
+
  if fOwnStream then
    inherited Run(fMemoryStream, MaxPos - 1)
  else if Assigned(SourceStream) then