paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-08 09:59:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

pas2js: added OnReadFile hook

Browse Source 
git-svn-id: trunk@37792 -
This commit is contained in:
Mattias Gaertner 2017-12-24 10:12:59 +00:00
parent fb7d2d9ebd
commit 656ddcccf7
4 changed files with 87 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
utils/pas2js/pas2jscompiler.pp
View File

@ -1878,6 +1878,7 @@ var
aFile: TPas2jsFileLineReader;
IfLvl, SkipLvl, OldCfgLineNumber: Integer;
Skip: TSkip;
CacheFile: TPas2jsCachedFile;
begin
if ShowTriedUsedFiles then
Log.LogMsgIgnoreFilter(nReadingOptionsFromFile,[CfgFilename]);
@ -1889,7 +1890,8 @@ begin
OldCfgFilename:=FCurrentCfgFilename;
FCurrentCfgFilename:=CfgFilename;
OldCfgLineNumber:=FCurrentCfgLineNumber;
aFile:=TPas2jsFileLineReader.Create(CfgFilename);
CacheFile:=FileCache.LoadTextFile(CfgFilename);
aFile:=CacheFile.CreateLineReader(true);
while not aFile.IsEOF do begin
Line:=aFile.ReadLine;
FCurrentCfgLineNumber:=aFile.LineNumber;

80
utils/pas2js/pas2jsfilecache.pp
View File

@ -110,6 +110,8 @@ type
property LoadedFileAge: longint read FLoadedFileAge;// only valid if Loaded=true
end;
TPas2jsReadFileEvent = function(aFilename: string; var aSource: string): boolean of object;
TPas2jsCachedFilesState = (
cfsMainJSFileResolved
);
@ -137,6 +139,7 @@ type
FMainSrcFile: string;
FNamespaces: TStringList;
FNamespacesFromCmdLine: integer;
FOnReadFile: TPas2jsReadFileEvent;
FOptions: TP2jsFileCacheOptions;
FReadLineCounter: SizeInt;
FResetStamp: TChangeStamp;
@ -160,6 +163,8 @@ type
procedure SetSrcMapBaseDir(const AValue: string);
procedure SetUnitOutputPath(AValue: string);
procedure SetOption(Flag: TP2jsFileCacheOption; Enable: boolean);
protected
function ReadFile(Filename: string; var Source: string): boolean; virtual;
public
constructor Create(aLog: TPas2jsLogger);
destructor Destroy; override;
@ -199,6 +204,7 @@ type
property UnitOutputPath: string read FUnitOutputPath write SetUnitOutputPath; // includes trailing pathdelim
property UnitPaths: TStringList read FUnitPaths;
property UnitPathsFromCmdLine: integer read FUnitPathsFromCmdLine;
property OnReadFile: TPas2jsReadFileEvent read FOnReadFile write FOnReadFile;
end;
function CompareFilenameWithCachedFile(Filename, CachedFile: Pointer): integer;
@ -300,33 +306,8 @@ end;
{ TPas2jsFileLineReader }
constructor TPas2jsFileLineReader.Create(const AFilename: string);
var
ms: TMemoryStream;
NewSource, FileEncoding: string;
begin
//writeln('TPas2jsFileLineReader.Create ',AFilename);
inherited Create(AFilename);
ms:=TMemoryStream.Create;
try
try
ms.LoadFromFile(Filename);
SetLength(NewSource,ms.Size);
ms.Position:=0;
if NewSource<>'' then
ms.Read(NewSource[1],length(NewSource));
except
on E: Exception do begin
EPas2jsFileCache.Create('Error reading file "'+Filename+'": '+E.Message);
exit;
end;
end;
finally
ms.Free;
end;
FileEncoding:='';
FSource:=ConvertTextToUTF8(NewSource,FileEncoding);
FSrcPos:=PChar(FSource);
FIsEOF:=FSource='';
raise Exception.Create('TPas2jsFileLineReader.Create no cache "'+AFilename+'"');
end;
constructor TPas2jsFileLineReader.Create(aFile: TPas2jsCachedFile);
@ -413,7 +394,6 @@ function TPas2jsCachedFile.Load(RaiseOnError: boolean): boolean;
end;
var
ms: TMemoryStream;
NewSource: string;
begin
{$IFDEF VerboseFileCache}
@ -447,23 +427,8 @@ begin
Err('File is a directory "'+Filename+'"');
exit;
end;
ms:=TMemoryStream.Create;
try
try
ms.LoadFromFile(Filename);
SetLength(NewSource,ms.Size);
ms.Position:=0;
if NewSource<>'' then
ms.Read(NewSource[1],length(NewSource));
except
on E: Exception do begin
Err('Error reading file "'+Filename+'": '+E.Message);
exit;
end;
end;
finally
ms.Free;
end;
NewSource:='';
if not Cache.ReadFile(Filename,NewSource) then exit;
{$IFDEF VerboseFileCache}
writeln('TPas2jsCachedFile.Load ENCODE ',Filename,' FFileEncoding=',FFileEncoding);
{$ENDIF}
@ -895,6 +860,33 @@ begin
Exclude(FStates,cfsMainJSFileResolved);
end;
function TPas2jsFilesCache.ReadFile(Filename: string; var Source: string
): boolean;
var
ms: TMemoryStream;
begin
Result:=false;
try
if Assigned(OnReadFile) then
if OnReadFile(Filename,Source) then exit;
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;
except
on E: Exception do begin
EPas2jsFileCache.Create('Error reading file "'+Filename+'": '+E.Message);
end;
end;
end;
constructor TPas2jsFilesCache.Create(aLog: TPas2jsLogger);
begin
inherited Create;

42
utils/pas2js/pas2jslib.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<Version Value="11"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
@ -20,20 +20,50 @@
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
</Modes>
</RunParams>
<Units Count="2">
<Units Count="9">
<Unit0>
<Filename Value="pas2jslib.pp"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="pas2jscompiler.pas"/>
<Filename Value="pas2jscompiler.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Pas2jsCompiler"/>
</Unit1>
<Unit2>
<Filename Value="pas2jsfilecache.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Pas2jsFileCache"/>
</Unit2>
<Unit3>
<Filename Value="pas2js_defines.inc"/>
<IsPartOfProject Value="True"/>
</Unit3>
<Unit4>
<Filename Value="pas2jsfileutils.pp"/>
<IsPartOfProject Value="True"/>
</Unit4>
<Unit5>
<Filename Value="pas2jsfileutilsunix.inc"/>
<IsPartOfProject Value="True"/>
</Unit5>
<Unit6>
<Filename Value="pas2jsfileutilswin.inc"/>
<IsPartOfProject Value="True"/>
</Unit6>
<Unit7>
<Filename Value="pas2jslogger.pp"/>
<IsPartOfProject Value="True"/>
</Unit7>
<Unit8>
<Filename Value="pas2jspparser.pp"/>
<IsPartOfProject Value="True"/>
</Unit8>
</Units>
</ProjectOptions>
<CompilerOptions>

15
utils/pas2js/pas2jslib.pp
View File

@ -11,7 +11,7 @@ uses
---------------------------------------------------------------------}
Type
TLibLogCallBack = Procedure (Data : Pointer; Msg : PansiChar; MsgLen : Integer); stdcall;
TLibLogCallBack = Procedure (Data : Pointer; Msg : PAnsiChar; MsgLen : Integer); stdcall;
TWriteJSCallBack = Procedure (Data : Pointer;
AFileName: PAnsiChar; AFileNameLen : Integer;
AFileData : PAnsiChar; AFileDataLen: Int32); stdcall;
@ -30,6 +30,7 @@ Type
Function DoWriteJSFile(const DestFilename: 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;
Public
Constructor Create; override;
Procedure DoLibraryLog(Sender : TObject; Const Msg : String);
@ -60,8 +61,9 @@ begin
end;
end;
procedure TLibraryPas2JSCompiler.GetLastError(AError: PAnsiChar; var AErrorLength : Longint;
AErrorClass: PAnsiChar; var AErrorClassLength : Longint);
procedure TLibraryPas2JSCompiler.GetLastError(AError: PAnsiChar;
Var AErrorLength: Longint; AErrorClass: PAnsiChar;
Var AErrorClassLength: Longint);
Var
L : Integer;
@ -79,10 +81,17 @@ begin
Move(FLastErrorClass[1],AErrorClass^,L);
end;
function TLibraryPas2JSCompiler.ReadFile(aFilename: string; var aSource: string
): boolean;
begin
Result:=false; // use default reader
end;
constructor TLibraryPas2JSCompiler.Create;
begin
inherited Create;
Log.OnLog:=@DoLibraryLog;
FileCache.OnReadFile:=@ReadFile;
end;
procedure TLibraryPas2JSCompiler.DoLibraryLog(Sender: TObject; const Msg: String);