Simba/PS: Add/Fix include_once support.

Units/MMLAddon/mmlpsthread.pas

@@ -180,6 +180,8 @@ type
         procedure OnCompile(Sender: TPSScript);
         function RequireFile(Sender: TObject; const OriginFileName: String;
                             var FileName, OutPut: string): Boolean;
+        function FileAlreadyIncluded(Sender: TObject; FileName: string): Boolean;
+
         procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler);
         procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
         procedure OutputMessages;
@@ -464,9 +466,9 @@ begin
       if (path <> '') then
         if Includes.Find(path,i) then
         begin
-          psWriteln('Include_Once file already included');
+          Writeln('include_once: File already included.'); // debug message
           Result := False;
-        end;
+        end
     end;
   end else
     Result := True;
@@ -576,6 +578,7 @@ begin
   PSScript.UsePreProcessor:= True;
   PSScript.CompilerOptions := PSScript.CompilerOptions + [icBooleanShortCircuit];
   PSScript.OnNeedFile := @RequireFile;
+  PSScript.OnFileAlreadyIncluded := @FileAlreadyIncluded;
   PSScript.OnProcessDirective:=@OnProcessDirective;
   PSScript.OnProcessUnknowDirective:=@PSScriptProcessUnknowDirective;
   PSScript.OnCompile:= @OnCompile;
@@ -692,6 +695,22 @@ begin
       '{$IFDEF __REMOVE_IS_INCLUDE}{$UNDEF IS_INCLUDE}{$ENDIF}';
 end;
 
+function TPSThread.FileAlreadyIncluded(Sender: TObject; FileName: string): Boolean;
+var
+  path: string;
+  i: integer;
+begin
+  path := FindFile(Filename,[ScriptPath,IncludePath]);
+  if (path <> '') then
+    if Includes.Find(path,i) then
+    begin
+      psWriteln('Include_Once file already included');
+      Result := False;
+    end;
+  Includes.Add(path);
+  Result := True;
+end;
+
 procedure SIRegister_Mufasa(cl: TPSPascalCompiler);
 begin
   SIRegister_MML(cl);

Units/PascalScript/uPSComponent.pas

@@ -93,6 +93,10 @@ type
   {Script engine event function}
   TPSOnNeedFile = function (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean of object;
 
+  { Added by Wizzup }
+  TPSOnFileAlreadyIncluded = function (Sender: TObject; FileName: tbtstring): Boolean of object;
+  { Wizzup out }
+
   TPSOnProcessDirective = procedure (
                             Sender: TPSPreProcessor;
                             Parser: TPSPascalPreProcessorParser;
@@ -120,6 +124,9 @@ type
     FPP: TPSPreProcessor;
     FMainFileName: tbtstring;
     FOnNeedFile: TPSOnNeedFile;
+    { Added by Wizzup }
+    FOnFileAlreadyIncluded: TPSOnFileAlreadyIncluded;
+    { Wizzup out }
     FUsePreProcessor: Boolean;
     FDefines: TStrings;
     FOnVerifyProc: TPSVerifyProc;
@@ -152,6 +159,9 @@ type
 
     //--jgv new
     function  DoOnNeedFile (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean; virtual;
+    { Added by Wizzup }
+    function  DoOnFileAlreadyIncluded (Sender: TObject; FileName: tbtstring): Boolean; virtual;
+    { Wizzup out }
     function  DoOnUnknowUses (Sender: TPSPascalCompiler; const Name: tbtstring): Boolean; virtual; // return true if processed
     procedure DoOnCompImport; virtual;
     procedure DoOnCompile; virtual;
@@ -285,6 +295,10 @@ type
 
     property OnNeedFile: TPSOnNeedFile read FOnNeedFile write FOnNeedFile;
 
+    { Added by Wizzup }
+    property OnFileAlreadyIncluded: TPSOnFileAlreadyIncluded read FOnFileAlreadyIncluded write FOnFileAlreadyIncluded;
+    { Wizzup out }
+
     property Defines: TStrings read FDefines write SetDefines;
 
     property OnVerifyProc: TPSVerifyProc read FOnVerifyProc write FOnVerifyProc;
@@ -535,6 +549,13 @@ begin
   Result := TPSScript (Sender.ID).DoOnNeedFile(Sender.ID, CallingFileName, FileName, Output);
 end;
 
+{ Added by Wizzup }
+function CEOnFileAlreadyIncluded(Sender: TPSPreProcessor; FileName: tbtstring): Boolean;
+begin
+  Result := TPSScript (Sender.ID).DoOnFileAlreadyIncluded(Sender.ID, Filename);
+end;
+{ Wizzup out }
+
 procedure CompTranslateLineInfo(Sender: TPSPascalCompiler; var Pos, Row, Col: Cardinal; var Name: tbtstring);
 var
   res: TPSLineInfoResults;
@@ -649,6 +670,10 @@ begin
   FPP.Id := Self;
   FPP.OnNeedFile := CENeedFile;
 
+  { Added by Wizzup }
+  FPP.OnFileAlreadyIncluded:= CEOnFileAlreadyIncluded;
+  { Wizzup out }
+
   FDefines := TStringList.Create;
 end;
 
@@ -1049,6 +1074,17 @@ begin
     Result := False;
 end;
 
+{ Added by Wizzup }
+function TPSScript.DoOnFileAlreadyIncluded(Sender: TObject;
+  FileName: tbtstring): Boolean;
+begin
+  If Assigned (OnFileAlreadyIncluded) then
+    Result := OnFileAlreadyIncluded(Sender, FileName)
+  else
+    Result := False;
+end;
+{ Wizzup out }
+
 function TPSScript.DoOnUnknowUses(Sender: TPSPascalCompiler;
   const Name: tbtstring): Boolean;
 var

Units/PascalScript/uPSPreProcessor.pas

@@ -14,6 +14,11 @@ type
   TPSPascalPreProcessorParser = class;
 
   TPSOnNeedFile = function (Sender: TPSPreProcessor; const callingfilename: tbtstring; var FileName, Output: tbtstring): Boolean;
+
+  { Added by Wizzup }
+  TPSOnFileAlreadyIncluded = function (Sender: TPSPreProcessor; FileName: tbtstring): Boolean;
+  { Wizzup out }
+
   TPSOnProcessDirective = procedure (
                             Sender: TPSPreProcessor;
                             Parser: TPSPascalPreProcessorParser;
@@ -91,6 +96,9 @@ type
     FCurrentDefines, FDefines: TStringList;
     FCurrentLineInfo: TPSLineInfoList;
     FOnNeedFile: TPSOnNeedFile;
+    { Added by Wizzup }
+    FOnFileAlreadyIncluded: TPSOnFileAlreadyIncluded;
+    { Wizzup out }
     FAddedPosition: Cardinal;
     FDefineState: TPSDefineStates;
     FMaxLevel: Longint;
@@ -109,6 +117,10 @@ type
 
     property OnNeedFile: TPSOnNeedFile read FOnNeedFile write FOnNeedFile;
 
+    { Added by Wizzup }
+    property OnFileAlreadyIncluded: TPSOnFileAlreadyIncluded read FOnFileAlreadyIncluded write FOnFileAlreadyIncluded;
+    { Wizzup out }
+
     property Defines: TStringList read FDefines write FDefines;
 
     property MainFile: tbtstring read FMainFile write FMainFile;
@@ -213,6 +225,9 @@ const
 
   RPS_TooManyNestedInclude = 'Too many nested include files while processing ''%s'' from ''%s''';
   RPS_IncludeNotFound = 'Unable to find file ''%s'' used from ''%s''';
+  { Added by Wizzup }
+  RPS_IncludeOnceNotFound = 'Unable to check if file ''%s'' is already included, used from ''%s''';
+  { Wizzup out }
   RPS_DefineTooManyParameters = 'Too many parameters at %d:%d';
   RPS_NoIfdefForEndif = 'No IFDEF for ENDIF at %d:%d';
   RPS_NoIfdefForElse = 'No IFDEF for ELSE at %d:%d';
@@ -614,7 +629,7 @@ begin
         If AppContinue then
         //-- end jgv
 
-          if (Name = 'I') or (Name = 'INCLUDE') or (Name = 'INCLUDE_ONCE') then
+          if (Name = 'I') or (Name = 'INCLUDE') then
           begin
             if FDefineState.DoWrite then
             begin
@@ -623,6 +638,23 @@ begin
               FCurrentLineInfo.Current := current;
               FAddedPosition := Cardinal(Dest.Position) - Item.StartPos - Parser.Pos;
             end;
+          { Added by Wizzup }
+          end else if (Name = 'INCLUDE_ONCE') then
+          begin
+              if FDefineState.DoWrite then
+              if (@OnFileAlreadyIncluded = nil) then
+                 raise EPSPreProcessor.CreateFmt(RPS_IncludeOnceNotFound, [FileName, OrgFileName])
+              else
+              begin
+                if not OnFileAlreadyIncluded(Self, FileName) then
+                begin
+                  FAddedPosition := 0;
+                  IntPreProcess(Level +1, FileName, s, Dest);
+                  FCurrentLineInfo.Current := current;
+                  FAddedPosition := Cardinal(Dest.Position) - Item.StartPos - Parser.Pos;
+                end;
+              end;
+            { Wizzup out }
           end else if (Name = 'DEFINE') then
           begin
             if FDefineState.DoWrite then