pastojs: added hook GetFileSrcAttr to skip generating srcmap of some files

packages/pastojs/src/pas2jscompiler.pp

@@ -594,7 +594,7 @@ type
     procedure ReadVerbosityFlags(Param: String; p: integer);
   protected
     // Create various other classes. Virtual so they can be overridden in descendents
-    function CreateJSMapper: TPas2JSMapper;virtual;
+    function CreateJSMapper: TPas2JSMapper; virtual;
     function CreateJSWriter(aFileWriter: TPas2JSMapper): TJSWriter; virtual;
     function CreateLog: TPas2jsLogger; virtual;
     function CreateMacroEngine: TPas2jsMacroEngine;virtual;
@@ -618,7 +618,7 @@ type
     procedure HandleOptionInfo(aValue: string);
     function HandleOptionOptimization(C: Char; aValue: String): Boolean;
     // DoWriteJSFile: return false to use the default write function.
-    function DoWriteJSFile(const DestFilename: String; aWriter: TPas2JSMapper): Boolean; virtual;
+    function DoWriteJSFile(const DestFilename, MapFilename: String; aWriter: TPas2JSMapper): Boolean; virtual;
     procedure Compile(StartTime: TDateTime);
     procedure ProcessQueue;
     function MarkNeedBuilding(aFile: TPas2jsCompilerFile;
@@ -2335,11 +2335,12 @@ begin
   end;
 end;
 
-function TPas2jsCompiler.DoWriteJSFile(const DestFilename: String;
+function TPas2jsCompiler.DoWriteJSFile(const DestFilename, MapFilename: String;
   aWriter: TPas2JSMapper): Boolean;
 begin
   Result:=False;
   if DestFilename='' then ;
+  if MapFilename='' then ;
   if aWriter=nil then ;
 end;
 
@@ -2350,7 +2351,6 @@ begin
 end;
 
 function TPas2jsCompiler.CreateJSMapper: TPas2JSMapper;
-
 begin
   Result:=TPas2JSMapper.Create(4096);
 end;
@@ -2418,7 +2418,6 @@ begin
   end;
 end;
 
-
 procedure TPas2jsCompiler.WriteJSToFile(const MapFileName: string;
   aFileWriter: TPas2JSMapper);
 
@@ -2428,7 +2427,7 @@ Var
   {$ELSE}
   buf: TMemoryStream;
   {$ENDIF}
-  Src : String;
+  WithUTF8BOM: Boolean;
 
 begin
   // write js
@@ -2439,34 +2438,8 @@ begin
     buf:=TMemoryStream.Create;
     {$ENDIF}
     try
-      {$IFDEF FPC_HAS_CPSTRING}
-      // UTF8-BOM
-      if (Log.Encoding='') or (Log.Encoding='utf8') then
-      begin
-        Src:=String(UTF8BOM);
-        buf.Write(Src[1],length(Src));
-      end;
-      {$ENDIF}
-      // JS source
-      {$IFDEF Pas2js}
-      buf:=TJSArray(aFileWriter.Buffer).slice();
-      {$ELSE}
-      buf.Write(aFileWriter.Buffer^,aFileWriter.BufferLength);
-      {$ENDIF}
-      // source map comment
-      if aFileWriter.SrcMap<>nil then
-      begin
-        Src:='//# sourceMappingURL='+ExtractFilename(MapFilename)+LineEnding;
-        {$IFDEF Pas2js}
-        buf.push(Src);
-        {$ELSE}
-        buf.Write(Src[1],length(Src));
-        {$ENDIF}
-      end;
-      //SetLength(Src,buf.Position);
-      //Move(buf.Memory^,Src[1],length(Src));
-      //writeln('TPas2jsCompiler.WriteJSFiles ====',Src);
-      //writeln('TPas2jsCompiler.WriteJSFiles =======================');
+      WithUTF8BOM:=(Log.Encoding='') or (Log.Encoding='utf8');
+      aFileWriter.SaveJSToStream(WithUTF8BOM,ExtractFilename(MapFilename),buf);
       {$IFDEF Pas2js}
       {$ELSE}
       buf.Position:=0;
@@ -2801,8 +2774,12 @@ begin
       if Assigned(PostProcessorSupport) then
         PostProcessorSupport.CallPostProcessors(aFile.JSFilename,aFileWriter);
 
+      MapFilename:=aFileWriter.DestFilename+'.map';
+
+      CheckOutputDir(aFileWriter.DestFileName);
+
       // Give chance to descendants to write file
-      JSFileWritten:=DoWriteJSFile(aFile.JSFilename,aFileWriter);
+      JSFileWritten:=DoWriteJSFile(aFile.JSFilename,MapFilename,aFileWriter);
 
       if (aFile.JSFilename='') and (MainJSFile='.') then
         WriteToStandardOutput(aFileWriter);
@@ -2810,9 +2787,6 @@ begin
       //writeln('TPas2jsCompiler.WriteJSFiles ',aFile.UnitFilename,' ',aFile.JSFilename);
       Log.LogMsg(nWritingFile,[FullFormatPath(aFileWriter.DestFilename)],'',0,0, not (coShowLineNumbers in Options));
 
-      CheckOutputDir(aFileWriter.DestFileName);
-
-      MapFilename:=aFileWriter.DestFilename+'.map';
       if not JSFileWritten then
         WriteJSToFile(MapFileName,aFileWriter);
       if (FResourceStringFile=rsfUnit) or (aFile.IsMainFile and (FResourceStringFile<>rsfNone)) then

packages/pastojs/src/pas2jsfilecache.pp

@@ -33,7 +33,7 @@ uses
   Classes, SysUtils,
   fpjson,
   PScanner, PasResolver, PasUseAnalyzer,
-  Pas2jsLogger, Pas2jsFileUtils, Pas2JSFS;
+  Pas2jsLogger, Pas2jsFileUtils, Pas2JSFS, Pas2JSUtils;
 
 
 type
@@ -107,7 +107,7 @@ type
     property Sorted: boolean read FSorted write SetSorted; // descending, sort first case insensitive, then sensitive
   end;
 
-  TReadDirectoryEvent = function(Dir: TPas2jsCachedDirectory): boolean of object;// true = skip default function
+  TPas2jsReadDirectoryEvent = function(Dir: TPas2jsCachedDirectory): boolean of object;// true = skip default function
 
   { TPas2jsCachedDirectories }
 
@@ -117,7 +117,7 @@ type
     FDirectories: TPasAnalyzerKeySet;// set of TPas2jsCachedDirectory, key is Directory
     FWorkingDirectory: string;
   private
-    FOnReadDirectory: TReadDirectoryEvent;
+    FOnReadDirectory: TPas2jsReadDirectoryEvent;
     type
       TFileInfo = record
         Filename: string;
@@ -148,7 +148,7 @@ type
                       CreateIfNotExists: boolean = true;
                       DoReference: boolean = true): TPas2jsCachedDirectory;
     property WorkingDirectory: string read FWorkingDirectory write SetWorkingDirectory; // used for relative filenames, contains trailing path delimiter
-    property OnReadDirectory: TReadDirectoryEvent read FOnReadDirectory write FOnReadDirectory;
+    property OnReadDirectory: TPas2jsReadDirectoryEvent read FOnReadDirectory write FOnReadDirectory;
   end;
 
 type
@@ -205,7 +205,13 @@ type
     function CreateLineReader(RaiseOnError: boolean): TSourceLineReader; override;
   end;
 
+  TPas2jsFileSrcAttr = packed record
+    AllowSrcMap: boolean;
+  end;
+  PPas2jsFileSrcAttr = ^TPas2jsFileSrcAttr;
+
   TPas2jsReadFileEvent = function(aFilename: string; var aSource: string): boolean of object;
+  TPas2jsGetFileSrcAttrEvent = procedure(aFilename: string; var Attr: TPas2jsFileSrcAttr) of object;
   TPas2jsWriteFileEvent = procedure(aFilename: string; Source: string) of object;
 
   TPas2jsSearchPathKind = (
@@ -225,6 +231,7 @@ type
     FIncludePaths: TStringList;
     FIncludePathsFromCmdLine: integer;
     FLog: TPas2jsLogger;
+    FOnGetFileSrcAttr: TPas2jsGetFileSrcAttrEvent;
     FOnReadFile: TPas2jsReadFileEvent;
     FOnWriteFile: TPas2jsWriteFileEvent;
     FResetStamp: TChangeStamp;
@@ -234,16 +241,16 @@ type
     FPCUPaths: TStringList;
     function FileExistsILogged(var Filename: string): integer;
     function FileExistsLogged(const Filename: string): boolean;
-    function GetOnReadDirectory: TReadDirectoryEvent;
+    function GetOnReadDirectory: TPas2jsReadDirectoryEvent;
     procedure RegisterMessages;
     procedure SetBaseDirectory(AValue: string);
     function AddSearchPaths(const Paths: string; Kind: TPas2jsSearchPathKind;
       FromCmdLine: boolean; var List: TStringList; var CmdLineCount: integer): string;
-    procedure SetOnReadDirectory(AValue: TReadDirectoryEvent);
+    procedure SetOnReadDirectory(AValue: TPas2jsReadDirectoryEvent);
   protected
     function FindSourceFileName(const aFilename: string): String; override;
     function GetHasPCUSupport: Boolean; virtual;
-    function ReadFile(Filename: string; var Source: string): boolean; virtual;
+    function ReadFile(Filename: string; var Source: string; var Attr: TPas2jsFileSrcAttr): boolean; virtual;
     procedure FindMatchingFiles(Mask: string; MaxCount: integer; Files: TStrings);// find files, matching * and ?
   public
     constructor Create(aLog: TPas2jsLogger); overload;
@@ -296,8 +303,9 @@ type
     property ResetStamp: TChangeStamp read FResetStamp;
     property UnitPaths: TStringList read FUnitPaths;
     property UnitPathsFromCmdLine: integer read FUnitPathsFromCmdLine;
-    property OnReadDirectory: TReadDirectoryEvent read GetOnReadDirectory write SetOnReadDirectory;
+    property OnReadDirectory: TPas2jsReadDirectoryEvent read GetOnReadDirectory write SetOnReadDirectory;
     property OnReadFile: TPas2jsReadFileEvent read FOnReadFile write FOnReadFile;
+    property OnGetFileSrcAttr: TPas2jsGetFileSrcAttrEvent read FOnGetFileSrcAttr write FOnGetFileSrcAttr;
     property OnWriteFile: TPas2jsWriteFileEvent read FOnWriteFile write FOnWriteFile;
   end;
 
@@ -1120,6 +1128,7 @@ function TPas2jsCachedFile.Load(RaiseOnError: boolean; Binary: boolean
 var
   NewSource: string;
   b: Boolean;
+  SrcAttr: TPas2jsFileSrcAttr;
 begin
   {$IFDEF VerboseFileCache}
   writeln('TPas2jsCachedFile.Load START "',Filename,'" Loaded=',Loaded);
@@ -1157,11 +1166,13 @@ begin
     exit;
   end;
   NewSource:='';
+  SrcAttr:=Default(TPas2jsFileSrcAttr);
+  SrcAttr.AllowSrcMap:=not Binary;
   if RaiseOnError then
-    b:=Cache.ReadFile(Filename,NewSource)
+    b:=Cache.ReadFile(Filename,NewSource,SrcAttr)
   else
     try
-      b:=Cache.ReadFile(Filename,NewSource);
+      b:=Cache.ReadFile(Filename,NewSource,SrcAttr);
     except
     end;
   if not b then begin
@@ -1187,6 +1198,7 @@ begin
   FLoaded:=true;
   FCacheStamp:=Cache.ResetStamp;
   FLoadedFileAge:=Cache.DirectoryCache.FileAge(Filename);
+  AllowSrcMap:=SrcAttr.AllowSrcMap;
   {$IFDEF VerboseFileCache}
   writeln('TPas2jsCachedFile.Load END ',Filename,' FFileEncoding=',FFileEncoding);
   {$ENDIF}
@@ -1344,13 +1356,13 @@ begin
   end;
 end;
 
-procedure TPas2jsFilesCache.SetOnReadDirectory(AValue: TReadDirectoryEvent);
+procedure TPas2jsFilesCache.SetOnReadDirectory(AValue: TPas2jsReadDirectoryEvent);
 begin
   DirectoryCache.OnReadDirectory:=AValue;
 end;
 
-function TPas2jsFilesCache.ReadFile(Filename: string; var Source: string
-  ): boolean;
+function TPas2jsFilesCache.ReadFile(Filename: string; var Source: string;
+  var Attr: TPas2jsFileSrcAttr): boolean;
 {$IFDEF Pas2js}
 {$ELSE}
 var
@@ -1361,28 +1373,31 @@ begin
   try
     if Assigned(OnReadFile) then
       Result:=OnReadFile(Filename,Source);
-    if Result then
-      Exit;
-    {$IFDEF Pas2js}
-    try
-      Source:=NJS_FS.readFileSync(Filename,new(['encoding','utf8']));
-    except
-      raise EReadError.Create(String(JSExceptValue));
-    end;
-    Result:=true;
-    {$ELSE}
-    ms:=TMemoryStream.Create;
-    try
-      ms.LoadFromFile(Filename);
-      SetLength(Source,ms.Size);
-      ms.Position:=0;
-      if Source<>'' then
-        ms.Read(Source[1],length(Source));
+    if not Result then
+      begin
+      {$IFDEF Pas2js}
+      try
+        Source:=NJS_FS.readFileSync(Filename,new(['encoding','utf8']));
+      except
+        raise EReadError.Create(String(JSExceptValue));
+      end;
       Result:=true;
-    finally
-      ms.Free;
-    end;
-    {$ENDIF}
+      {$ELSE}
+      ms:=TMemoryStream.Create;
+      try
+        ms.LoadFromFile(Filename);
+        SetLength(Source,ms.Size);
+        ms.Position:=0;
+        if Source<>'' then
+          ms.Read(Source[1],length(Source));
+        Result:=true;
+      finally
+        ms.Free;
+      end;
+      {$ENDIF}
+      end;
+    if Assigned(OnGetFileSrcAttr) then
+      OnGetFileSrcAttr(Filename,Attr);
   except
     on E: Exception do begin
       EPas2jsFileCache.Create('Error reading file "'+Filename+'": '+E.Message);
@@ -2142,7 +2157,7 @@ begin
       Log.LogMsgIgnoreFilter(nSearchingFileNotFound,[FormatPath(Filename)]);
 end;
 
-function TPas2jsFilesCache.GetOnReadDirectory: TReadDirectoryEvent;
+function TPas2jsFilesCache.GetOnReadDirectory: TPas2jsReadDirectoryEvent;
 begin
   Result:=DirectoryCache.OnReadDirectory;
 end;

packages/pastojs/src/pas2jsfiler.pp

@@ -94,7 +94,7 @@ uses
   {$endif}
   fpjson, jsonparser, jsonscanner,
   PasTree, PScanner, PParser, PasResolveEval, PasResolver,
-  Pas2jsFileUtils, FPPas2Js, jsbase;
+  Pas2jsFileUtils, FPPas2Js, Pas2JSUtils, jsbase;
 
 const
   PCUMagic = 'Pas2JSCache';

packages/pastojs/src/pas2jsfileutils.pp

@@ -31,7 +31,7 @@ uses
   {$IFDEF Pas2JS}
   JS, NodeJS, Node.FS,
   {$ENDIF}
-  SysUtils, Classes;
+  SysUtils, Classes, Pas2JSUtils;
 
 function FilenameIsAbsolute(const aFilename: string):boolean;
 function FilenameIsWinAbsolute(const aFilename: string):boolean;
@@ -96,13 +96,6 @@ function GetUnixEncoding: string;
 function IsASCII(const s: string): boolean; inline;
 
 {$IFDEF FPC_HAS_CPSTRING}
-const
-  UTF8BOM = #$EF#$BB#$BF;
-function UTF8CharacterStrictLength(P: PChar): integer;
-
-function UTF8ToUTF16(const s: string): UnicodeString;
-function UTF16ToUTF8(const s: UnicodeString): string;
-
 function UTF8ToSystemCP(const s: string): string;
 function SystemCPToUTF8(const s: string): string;
 
@@ -923,65 +916,6 @@ begin
 end;
 {$ENDIF}
 
-{$IFDEF FPC_HAS_CPSTRING}
-function UTF8CharacterStrictLength(P: PChar): integer;
-begin
-  if p=nil then exit(0);
-  if ord(p^)<%10000000 then
-  begin
-    // regular single byte character
-    exit(1);
-  end
-  else if ord(p^)<%11000000 then
-  begin
-    // invalid single byte character
-    exit(0);
-  end
-  else if ((ord(p^) and %11100000) = %11000000) then
-  begin
-    // should be 2 byte character
-    if (ord(p[1]) and %11000000) = %10000000 then
-      exit(2)
-    else
-      exit(0);
-  end
-  else if ((ord(p^) and %11110000) = %11100000) then
-  begin
-    // should be 3 byte character
-    if ((ord(p[1]) and %11000000) = %10000000)
-    and ((ord(p[2]) and %11000000) = %10000000) then
-      exit(3)
-    else
-      exit(0);
-  end
-  else if ((ord(p^) and %11111000) = %11110000) then
-  begin
-    // should be 4 byte character
-    if ((ord(p[1]) and %11000000) = %10000000)
-    and ((ord(p[2]) and %11000000) = %10000000)
-    and ((ord(p[3]) and %11000000) = %10000000) then
-      exit(4)
-    else
-      exit(0);
-  end else
-    exit(0);
-end;
-
-function UTF8ToUTF16(const s: string): UnicodeString;
-begin
-  Result:=UTF8Decode(s);
-end;
-
-function UTF16ToUTF8(const s: UnicodeString): string;
-begin
-  if s='' then exit('');
-  Result:=UTF8Encode(s);
-  // prevent UTF8 codepage appear in the strings - we don't need codepage
-  // conversion magic
-  SetCodePage(RawByteString(Result), CP_ACP, False);
-end;
-{$ENDIF}
-
 {$IFDEF Unix}
   {$I pas2jsfileutilsunix.inc}
 {$ENDIF}

packages/pastojs/src/pas2jsfs.pp

@@ -143,6 +143,7 @@ Type
 
   TPas2jsFile = class
   private
+    FAllowSrcMap: boolean;
     FFilename: string;
     FFS: TPas2JSFS;
     FSource: string;
@@ -153,8 +154,9 @@ Type
     function CreateLineReader(RaiseOnError: boolean): TSourceLineReader; virtual; abstract;
     function Load(RaiseOnError: boolean; Binary: boolean): boolean; virtual; abstract;
     property Source: string read FSource; // UTF-8 without BOM or Binary
-    Property FS: TPas2JSFS Read FFS;
+    property FS: TPas2JSFS Read FFS;
     property Filename: string read FFilename;
+    property AllowSrcMap: boolean read FAllowSrcMap write FAllowSrcMap;
   end;
 
   { TPas2jsFSResolver }

packages/pastojs/src/pas2jsfscompiler.pp

@@ -25,15 +25,22 @@ interface
 uses
   SysUtils,
   PasUseAnalyzer,
+  FPPJsSrcMap,
   Pas2jsFileCache, Pas2jsCompiler,
   Pas2JSFS,
   Pas2jsFileUtils;
 
 Type
+
+  { TPas2jsFSCompiler }
+
   TPas2jsFSCompiler = Class(TPas2JSCompiler)
   private
     function GetFileCache: TPas2jsFilesCache;
     function OnMacroEnv(Sender: TObject; var Params: string; Lvl: integer): boolean;
+  Protected
+    function CreateJSMapper: TPas2JSMapper; override;
+    function OnJSMapperIsBinary(Sender: TObject; const aFilename: string): boolean; virtual;
   Public
     Procedure SetWorkingDir(const aDir: String); override;
     function CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet; override;
@@ -104,7 +111,7 @@ end;
 function TPas2jsFSCompiler.CreateFS: TPas2JSFS;
 
 Var
-  C :  TPas2jsFilesCache;
+  C: TPas2jsFilesCache;
 
 begin
   C:=TPas2jsFilesCache.Create(Log);
@@ -126,6 +133,21 @@ begin
   Result:=true;
 end;
 
+function TPas2jsFSCompiler.CreateJSMapper: TPas2JSMapper;
+begin
+  Result:=inherited CreateJSMapper;
+  Result.OnIsBinary:=@OnJSMapperIsBinary;
+end;
+
+function TPas2jsFSCompiler.OnJSMapperIsBinary(Sender: TObject;
+  const aFilename: string): boolean;
+var
+  CurFile: TPas2jsCachedFile;
+begin
+  CurFile:=FileCache.FindFile(aFilename);
+  Result:=(CurFile=nil) or (not CurFile.AllowSrcMap);
+end;
+
 procedure TPas2jsFSCompiler.SetWorkingDir(const aDir: String);
 begin
   inherited SetWorkingDir(aDir);

packages/pastojs/src/pas2jslibcompiler.pp

@@ -70,7 +70,7 @@ Type
     function GetLogEncoding: String;
     procedure SetLogEncoding(AValue: String);
   Protected
-    Function DoWriteJSFile(const DestFilename: String; aWriter: TPas2JSMapper): Boolean; override;
+    Function DoWriteJSFile(const DestFilename, MapFilename: String; aWriter: TPas2JSMapper): Boolean; override;
     Procedure GetLastError(AError : PAnsiChar; Var AErrorLength : Longint;
       AErrorClass : PAnsiChar; Var AErrorClassLength : Longint);
     Function ReadFile(aFilename: string; var aSource: string): boolean; virtual;
@@ -134,19 +134,29 @@ begin
   Log.Encoding := AValue;
 end;
 
-function TLibraryPas2JSCompiler.DoWriteJSFile(const DestFilename: String; aWriter: TPas2JSMapper): Boolean;
+function TLibraryPas2JSCompiler.DoWriteJSFile(const DestFilename,
+  MapFilename: String; aWriter: TPas2JSMapper): Boolean;
 
 Var
-  Src : string;
+  WithUTF8BOM: Boolean;
+  ms: TMemoryStream;
 
 begin
   Result:=Assigned(OnWriteJSCallBack);
   if Result then
+    begin
+    ms:=TMemoryStream.Create;
     try
-      Src:=aWriter.{$IF FPC_FULLVERSION>30101}AsString{$ELSE}AsAnsistring{$ENDIF};
-      OnWriteJSCallBack(OnWriteJSData,PAnsiChar(DestFileName),Length(DestFileName),PAnsiChar(Src),Length(Src));
-    except
-      Result:=False;
+      try
+        WithUTF8BOM:=(Log.Encoding='') or (Log.Encoding='utf8');
+        aWriter.SaveJSToStream(WithUTF8BOM,ExtractFilename(MapFilename),ms);
+        OnWriteJSCallBack(OnWriteJSData,PAnsiChar(DestFileName),Length(DestFileName),PAnsiChar(ms.Memory),ms.Position);
+      except
+        Result:=False;
+      end;
+    finally
+      ms.Free;
+    end;
     end;
 end;
 

utils/pas2js/compileserver.lpi

@@ -1,15 +1,15 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="12"/>
+    <Version Value="11"/>
     <General>
       <Flags>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
         <MainUnitHasScaledStatement Value="False"/>
-        <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
       <Title Value="compileserver"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
@@ -48,7 +48,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="../../packages/fcl-base/src;../../packages/fcl-js/src;../../packages/fcl-json/src;../../packages/fcl-passrc/src;../../packages/pastojs/src"/>
+      <OtherUnitFiles Value="../../packages/fcl-js/src;../../packages/fcl-json/src;../../packages/fcl-passrc/src;../../packages/pastojs/src"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
   </CompilerOptions>