* HTML/JS Resource support

git-svn-id: trunk@43317 -
This commit is contained in:
michael 2019-10-27 13:08:44 +00:00
parent 1dbfd85a20
commit 71b6573e41
7 changed files with 570 additions and 3 deletions

3
.gitattributes vendored
View File

@ -8164,10 +8164,13 @@ packages/pastojs/src/pas2jsfileutilsunix.inc svneol=native#text/plain
packages/pastojs/src/pas2jsfileutilswin.inc svneol=native#text/plain packages/pastojs/src/pas2jsfileutilswin.inc svneol=native#text/plain
packages/pastojs/src/pas2jsfs.pp svneol=native#text/plain packages/pastojs/src/pas2jsfs.pp svneol=native#text/plain
packages/pastojs/src/pas2jsfscompiler.pp svneol=native#text/plain packages/pastojs/src/pas2jsfscompiler.pp svneol=native#text/plain
packages/pastojs/src/pas2jshtmlresources.pp svneol=native#text/plain
packages/pastojs/src/pas2jsjsresources.pp svneol=native#text/plain
packages/pastojs/src/pas2jslibcompiler.pp svneol=native#text/plain packages/pastojs/src/pas2jslibcompiler.pp svneol=native#text/plain
packages/pastojs/src/pas2jslogger.pp svneol=native#text/plain packages/pastojs/src/pas2jslogger.pp svneol=native#text/plain
packages/pastojs/src/pas2jspcucompiler.pp svneol=native#text/plain packages/pastojs/src/pas2jspcucompiler.pp svneol=native#text/plain
packages/pastojs/src/pas2jspparser.pp svneol=native#text/plain packages/pastojs/src/pas2jspparser.pp svneol=native#text/plain
packages/pastojs/src/pas2jsresources.pp svneol=native#text/plain
packages/pastojs/src/pas2jsresstrfile.pp svneol=native#text/plain packages/pastojs/src/pas2jsresstrfile.pp svneol=native#text/plain
packages/pastojs/src/pas2jsuseanalyzer.pp svneol=native#text/plain packages/pastojs/src/pas2jsuseanalyzer.pp svneol=native#text/plain
packages/pastojs/src/pas2jsutils.pp svneol=native#text/plain packages/pastojs/src/pas2jsutils.pp svneol=native#text/plain

View File

@ -38,7 +38,7 @@ uses
Classes, SysUtils, contnrs, Classes, SysUtils, contnrs,
jsbase, jstree, jswriter, JSSrcMap, fpjson, jsbase, jstree, jswriter, JSSrcMap, fpjson,
PScanner, PParser, PasTree, PasResolver, PasResolveEval, PasUseAnalyzer, PScanner, PParser, PasTree, PasResolver, PasResolveEval, PasUseAnalyzer,
pas2jsresstrfile, pas2jsresstrfile, pas2jsresources, pas2jshtmlresources, pas2jsjsresources,
FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser, Pas2jsUseAnalyzer; FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser, Pas2jsUseAnalyzer;
const const
@ -150,11 +150,14 @@ type
rvcUnit rvcUnit
); );
TP2JSResourceStringFile = (rsfNone,rsfUnit,rsfProgram); TP2JSResourceStringFile = (rsfNone,rsfUnit,rsfProgram);
TResourceMode = (rmNone,rmHTML,rmJS);
const const
DefaultP2jsCompilerOptions = [coShowErrors,coSourceMapXSSIHeader,coUseStrict]; DefaultP2jsCompilerOptions = [coShowErrors,coSourceMapXSSIHeader,coUseStrict];
DefaultP2JSResourceStringFile = rsfProgram; DefaultP2JSResourceStringFile = rsfProgram;
DefaultP2jsRTLVersionCheck = rvcNone; DefaultP2jsRTLVersionCheck = rvcNone;
DefaultResourceMode = rmHTML;
coShowAll = [coShowErrors..coShowDebug]; coShowAll = [coShowErrors..coShowDebug];
coO1Enable = [coEnumValuesAsNumbers]; coO1Enable = [coEnumValuesAsNumbers];
coO1Disable = [coKeepNotUsedPrivates,coKeepNotUsedDeclarationsWPO]; coO1Disable = [coKeepNotUsedPrivates,coKeepNotUsedDeclarationsWPO];
@ -350,6 +353,7 @@ type
FPCUFilename: string; FPCUFilename: string;
FPCUSupport: TPCUSupport; FPCUSupport: TPCUSupport;
FReaderState: TPas2jsReaderState; FReaderState: TPas2jsReaderState;
FResourceHandler: TPas2jsResourceHandler;
FScanner: TPas2jsPasScanner; FScanner: TPas2jsPasScanner;
FShowDebug: boolean; FShowDebug: boolean;
FUnitFilename: string; FUnitFilename: string;
@ -357,6 +361,7 @@ type
FUsedBy: array[TUsedBySection] of TFPList; // list of TPas2jsCompilerFile FUsedBy: array[TUsedBySection] of TFPList; // list of TPas2jsCompilerFile
function GetUsedBy(Section: TUsedBySection; Index: integer): TPas2jsCompilerFile; function GetUsedBy(Section: TUsedBySection; Index: integer): TPas2jsCompilerFile;
function GetUsedByCount(Section: TUsedBySection): integer; function GetUsedByCount(Section: TUsedBySection): integer;
procedure HandleResources(Sender: TObject; const aFileName: String; aOptions: TStrings);
function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean; function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
function OnConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean; function OnConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean;
procedure OnPasResolverLog(Sender: TObject; const Msg: String); procedure OnPasResolverLog(Sender: TObject; const Msg: String);
@ -403,6 +408,7 @@ type
function GetModuleName: string; function GetModuleName: string;
class function GetFile(aModule: TPasModule): TPas2jsCompilerFile; class function GetFile(aModule: TPasModule): TPas2jsCompilerFile;
public public
Property ResourceHandler : TPas2jsResourceHandler Read FResourceHandler Write FResourceHandler;
property PasFileName: String Read FPasFileName; property PasFileName: String Read FPasFileName;
property PasUnitName: string read FPasUnitName write FPasUnitName;// unit name in source, initialized from UnitFilename property PasUnitName: string read FPasUnitName write FPasUnitName;// unit name in source, initialized from UnitFilename
property Converter: TPasToJSConverter read FConverter; property Converter: TPasToJSConverter read FConverter;
@ -497,6 +503,8 @@ type
FSrcMapSourceRoot: string; FSrcMapSourceRoot: string;
FUnits: TPasAnalyzerKeySet; // set of TPas2jsCompilerFile, key is PasUnitName FUnits: TPasAnalyzerKeySet; // set of TPas2jsCompilerFile, key is PasUnitName
FWPOAnalyzer: TPas2JSAnalyzer; FWPOAnalyzer: TPas2JSAnalyzer;
FResourceMode : TResourceMode;
FResources : TPas2JSResourceHandler;
FResourceStrings : TResourceStringsFile; FResourceStrings : TResourceStringsFile;
FResourceStringFile : TP2JSResourceStringFile; FResourceStringFile : TP2JSResourceStringFile;
procedure AddInsertJSFilename(const aFilename: string); procedure AddInsertJSFilename(const aFilename: string);
@ -551,6 +559,7 @@ type
procedure SetWriteMsgToStdErr(const AValue: boolean); procedure SetWriteMsgToStdErr(const AValue: boolean);
procedure WriteJSToFile(const MapFileName: string; aFileWriter: TPas2JSMapper); procedure WriteJSToFile(const MapFileName: string; aFileWriter: TPas2JSMapper);
procedure WriteResourceStrings(aFileName: String); procedure WriteResourceStrings(aFileName: String);
procedure WriteResources(aFileName: String);
procedure WriteSrcMap(const MapFileName: string; aFileWriter: TPas2JSMapper); procedure WriteSrcMap(const MapFileName: string; aFileWriter: TPas2JSMapper);
private private
procedure AddDefinesForTargetPlatform; procedure AddDefinesForTargetPlatform;
@ -561,6 +570,7 @@ type
private private
// params, cfg files // params, cfg files
FCurParam: string; FCurParam: string;
FResourceOutputFile: String;
procedure LoadConfig(CfgFilename: string); procedure LoadConfig(CfgFilename: string);
procedure ReadEnvironment; procedure ReadEnvironment;
procedure ReadParam(Param: string; Quick, FromCmdLine: boolean); procedure ReadParam(Param: string; Quick, FromCmdLine: boolean);
@ -603,7 +613,7 @@ type
procedure CreateJavaScript(aFile: TPas2jsCompilerFile; procedure CreateJavaScript(aFile: TPas2jsCompilerFile;
Checked: TPasAnalyzerKeySet { set of TPas2jsCompilerFile, key is UnitFilename }); Checked: TPasAnalyzerKeySet { set of TPas2jsCompilerFile, key is UnitFilename });
procedure FinishSrcMap(SrcMap: TPas2JSSrcMap); virtual; procedure FinishSrcMap(SrcMap: TPas2JSSrcMap); virtual;
// WriteSingleJSFile does not // WriteSingleJSFile does not recurse
procedure WriteSingleJSFile(aFile: TPas2jsCompilerFile; CombinedFileWriter: TPas2JSMapper); procedure WriteSingleJSFile(aFile: TPas2jsCompilerFile; CombinedFileWriter: TPas2JSMapper);
// WriteJSFiles recurses uses clause // WriteJSFiles recurses uses clause
procedure WriteJSFiles(aFile: TPas2jsCompilerFile; procedure WriteJSFiles(aFile: TPas2jsCompilerFile;
@ -618,6 +628,8 @@ type
function GetExitCode: Longint; virtual; function GetExitCode: Longint; virtual;
procedure SetExitCode(Value: Longint); virtual; procedure SetExitCode(Value: Longint); virtual;
Procedure SetWorkingDir(const aDir: String); virtual; Procedure SetWorkingDir(const aDir: String); virtual;
Procedure CreateResourceSupport; virtual;
public public
constructor Create; virtual; constructor Create; virtual;
destructor Destroy; override; destructor Destroy; override;
@ -698,6 +710,8 @@ type
property SrcMapBaseDir: string read FSrcMapBaseDir write SetSrcMapBaseDir; // includes trailing pathdelim property SrcMapBaseDir: string read FSrcMapBaseDir write SetSrcMapBaseDir; // includes trailing pathdelim
property Namespaces: TStringList read FNamespaces; property Namespaces: TStringList read FNamespaces;
property NamespacesFromCmdLine: integer read FNamespacesFromCmdLine; property NamespacesFromCmdLine: integer read FNamespacesFromCmdLine;
Property ResourceMode : TResourceMode Read FResourceMode Write FResourceMode;
Property ResourceOutputFile : String Read FResourceOutputFile Write FResourceOutputFile;
// can be set optionally, will be freed by compiler // can be set optionally, will be freed by compiler
property ConfigSupport: TPas2JSConfigSupport Read FConfigSupport Write FConfigSupport; property ConfigSupport: TPas2JSConfigSupport Read FConfigSupport Write FConfigSupport;
property PostProcessorSupport: TPas2JSPostProcessorSupport Read FPostProcessorSupport Write FPostProcessorSupport; property PostProcessorSupport: TPas2JSPostProcessorSupport Read FPostProcessorSupport Write FPostProcessorSupport;
@ -1052,6 +1066,7 @@ begin
Scanner.LogEvents:=PascalResolver.ScannerLogEvents; Scanner.LogEvents:=PascalResolver.ScannerLogEvents;
Scanner.OnLog:=@OnScannerLog; Scanner.OnLog:=@OnScannerLog;
Scanner.OnFormatPath:=@Compiler.FormatPath; Scanner.OnFormatPath:=@Compiler.FormatPath;
Scanner.RegisterResourceHandler('*',@HandleResources);
// create parser (Note: this sets some scanner options to defaults) // create parser (Note: this sets some scanner options to defaults)
FParser := TPas2jsPasParser.Create(Scanner, FileResolver, PascalResolver); FParser := TPas2jsPasParser.Create(Scanner, FileResolver, PascalResolver);
@ -1147,6 +1162,13 @@ begin
Result:=FUsedBy[Section].Count; Result:=FUsedBy[Section].Count;
end; end;
procedure TPas2jsCompilerFile.HandleResources(Sender: TObject; const aFileName: String; aOptions: TStrings);
begin
// maybe emit message ?
FResourceHandler.StartUnit(PasModule.Name);
FResourceHandler.HandleResource(aFileName,aOptions);
end;
function TPas2jsCompilerFile.OnConverterIsElementUsed(Sender: TObject; function TPas2jsCompilerFile.OnConverterIsElementUsed(Sender: TObject;
El: TPasElement): boolean; El: TPasElement): boolean;
begin begin
@ -1506,6 +1528,8 @@ begin
Converter.OnIsElementUsed:=@OnConverterIsElementUsed; Converter.OnIsElementUsed:=@OnConverterIsElementUsed;
Converter.OnIsTypeInfoUsed:=@OnConverterIsTypeInfoUsed; Converter.OnIsTypeInfoUsed:=@OnConverterIsTypeInfoUsed;
FJSModule:=Converter.ConvertPasElement(PasModule,PascalResolver); FJSModule:=Converter.ConvertPasElement(PasModule,PascalResolver);
if FResourceHandler.Outputmode=romJS then
FJSModule:=FResourceHandler.WriteJS(PasUnitName,FJSModule);
except except
on E: ECompilerTerminate do on E: ECompilerTerminate do
raise; raise;
@ -2633,6 +2657,55 @@ begin
end; end;
procedure TPas2jsCompiler.WriteResources(aFileName: String);
Var
{$IFDEF Pas2js}
buf: TJSArray;
{$ELSE}
buf: TMemoryStream;
{$ENDIF}
S : TJSONStringType;
begin
Log.LogMsg(nWritingFile,[FullFormatPath(aFilename)],'',0,0,False);
try
{$IFDEF Pas2js}
buf:=TJSArray.new;
{$ELSE}
buf:=TMemoryStream.Create;
{$ENDIF}
try
S:=FResources.AsString;
{$ifdef pas2js}
buf.push(S);
{$else}
buf.Write(S[1],length(S));
{$endif}
FS.SaveToFile(buf,aFilename);
finally
{$IFDEF Pas2js}
buf:=nil;
{$ELSE}
buf.Free;
{$ENDIF}
end;
except
on E: Exception do begin
if ShowDebug then
Log.LogExceptionBackTrace(E);
{$IFDEF FPC}
if E.Message<>SafeFormat(SFCreateError,[aFileName]) then
{$ENDIF}
Log.LogPlain('Error: '+E.Message);
Log.LogMsg(nUnableToWriteFile,[FullFormatPath(aFilename)]);
Terminate(ExitCodeWriteError);
end
{$IFDEF Pas2js}
else HandleJSException('[20181031190737] TPas2jsCompiler.WriteJSFiles',JSExceptValue);
{$ENDIF}
end;
end;
procedure TPas2jsCompiler.WriteSingleJSFile(aFile: TPas2jsCompilerFile; CombinedFileWriter: TPas2JSMapper); procedure TPas2jsCompiler.WriteSingleJSFile(aFile: TPas2jsCompilerFile; CombinedFileWriter: TPas2JSMapper);
Procedure WriteToStandardOutput(aFileWriter : TPas2JSMapper); Procedure WriteToStandardOutput(aFileWriter : TPas2JSMapper);
@ -2674,7 +2747,7 @@ procedure TPas2jsCompiler.WriteSingleJSFile(aFile: TPas2jsCompilerFile; Combined
Var Var
aFileWriter : TPas2JSMapper; aFileWriter : TPas2JSMapper;
isSingleFile : Boolean; isSingleFile : Boolean;
MapFilename : String; ResFileName,MapFilename : String;
begin begin
aFileWriter:=CombinedFileWriter; aFileWriter:=CombinedFileWriter;
@ -2685,11 +2758,16 @@ begin
begin begin
aFileWriter:=CreateFileWriter(aFile,''); aFileWriter:=CreateFileWriter(aFile,'');
if aFile.IsMainFile and Not AllJSIntoMainJS then if aFile.IsMainFile and Not AllJSIntoMainJS then
begin
InsertCustomJSFiles(aFileWriter); InsertCustomJSFiles(aFileWriter);
if FResources.OutputMode=romExtraJS then
aFileWriter.WriteFile(FResources.AsString,GetResolvedMainJSFile);
end;
end; end;
if FResourceStringFile<>rsfNone then if FResourceStringFile<>rsfNone then
AddUnitResourceStrings(aFile); AddUnitResourceStrings(aFile);
FResources.DoneUnit(aFile.isMainFile);
EmitJavaScript(aFile,aFileWriter); EmitJavaScript(aFile,aFileWriter);
@ -2719,6 +2797,16 @@ begin
if (FResourceStringFile=rsfUnit) or (aFile.IsMainFile and (FResourceStringFile<>rsfNone)) then if (FResourceStringFile=rsfUnit) or (aFile.IsMainFile and (FResourceStringFile<>rsfNone)) then
if FResourceStrings.StringsCount>0 then if FResourceStrings.StringsCount>0 then
WriteResourceStrings(ChangeFileExt(aFileWriter.DestFileName,'.jrs')); WriteResourceStrings(ChangeFileExt(aFileWriter.DestFileName,'.jrs'));
// Writeln('IsSingleFile ',isSingleFile,' mainfile: ',aFile.IsMainFile,' filename: ', aFileWriter.DestFileName);
if aFile.isMainFile and (FResources.OutputMode=romFile) and (FResources.ResourceCount>0) then
begin
ResFileName:=FResourceOutputFile;
if ResFileName='' then
// default is projectname-res.ext, to avoid projectname.html, used in web projects in Lazarus IDE
ResFileName:=ChangeFileExt(aFileWriter.DestFileName,'-res'+FResources.OutputFileExtension);
WriteResources(ResFileName);
end;
// write source map // write source map
if aFileWriter.SrcMap<>nil then if aFileWriter.SrcMap<>nil then
WriteSrcMap(MapFileName,aFileWriter); WriteSrcMap(MapFileName,aFileWriter);
@ -2759,17 +2847,21 @@ begin
if Checked.ContainsItem(aFile) then exit; if Checked.ContainsItem(aFile) then exit;
Checked.Add(aFile); Checked.Add(aFile);
aFileWriter:=CombinedFileWriter; aFileWriter:=CombinedFileWriter;
if AllJSIntoMainJS and (aFileWriter=nil) then if AllJSIntoMainJS and (aFileWriter=nil) then
begin begin
// create CombinedFileWriter // create CombinedFileWriter
aFileWriter:=CreateFileWriter(aFile,GetResolvedMainJSFile); aFileWriter:=CreateFileWriter(aFile,GetResolvedMainJSFile);
InsertCustomJSFiles(aFileWriter); InsertCustomJSFiles(aFileWriter);
if FResources.OutputMode=romExtraJS then
aFileWriter.WriteFile(FResources.AsString,GetResolvedMainJSFile);
end; end;
Try Try
// convert dependencies // convert dependencies
CheckUsesClause(aFileWriter,aFile.GetPasMainUsesClause); CheckUsesClause(aFileWriter,aFile.GetPasMainUsesClause);
CheckUsesClause(aFileWriter,aFile.GetPasImplUsesClause); CheckUsesClause(aFileWriter,aFile.GetPasImplUsesClause);
// Write me... // Write me...
WriteSingleJSFile(aFile,aFileWriter); WriteSingleJSFile(aFile,aFileWriter);
finally finally
@ -2879,6 +2971,15 @@ begin
if aDir='' then ; if aDir='' then ;
end; end;
procedure TPas2jsCompiler.CreateResourceSupport;
begin
Case FResourceMode of
rmNone : FResources:=TNoResources.Create(FS);
rmHTML : FResources:=THTMLResourceLinkHandler.Create(FS);
rmJS : FResources:=TJSResourceHandler.Create(FS);
end;
end;
procedure TPas2jsCompiler.Terminate(TheExitCode: integer); procedure TPas2jsCompiler.Terminate(TheExitCode: integer);
begin begin
ExitCode:=TheExitCode; ExitCode:=TheExitCode;
@ -3442,6 +3543,27 @@ begin
else else
ParamFatal('invalid resource string file format (-Jr) "'+aValue+'"'); ParamFatal('invalid resource string file format (-Jr) "'+aValue+'"');
end; end;
'R': // -JR<...>
begin
I:=Pos('=',aValue);
if I=0 then
I:=Length(aValue)+1;
S:=Copy(aValue,1,I-1);
if S='' then
ParamFatal('missing value for -JR option')
else if (S='none') then
FResourceMode:=rmNone
else if (S='js') then
FResourceMode:= rmJS
else if (S='html') then
begin
FResourceMode:=rmHTML;
S:=Copy(aValue,I+1,Length(aValue)-I);
FResourceOutputFile:=S;
if (FResourceOutputFile<>'') and (ExtractFileExt(FResourceOutputFile)='') then
FResourceOutputFile:=FResourceOutputFile+'.html';
end;
end;
'u': // -Ju<foreign path> 'u': // -Ju<foreign path>
if not Quick then if not Quick then
begin begin
@ -4028,6 +4150,7 @@ begin
FFiles:=CreateSetOfCompilerFiles(kcFilename); FFiles:=CreateSetOfCompilerFiles(kcFilename);
FUnits:=CreateSetOfCompilerFiles(kcUnitName); FUnits:=CreateSetOfCompilerFiles(kcUnitName);
FResourceMode:=DefaultResourceMode;
FResourceStrings:=TResourceStringsFile.Create; FResourceStrings:=TResourceStringsFile.Create;
FReadingModules:=TFPList.Create; FReadingModules:=TFPList.Create;
InitParamMacros; InitParamMacros;
@ -4323,6 +4446,9 @@ begin
for i:=0 to ParamList.Count-1 do for i:=0 to ParamList.Count-1 do
ReadParam(ParamList[i],false,true); ReadParam(ParamList[i],false,true);
// At this point we know what kind of resources we must use
CreateResourceSupport;
// now we know, if the logo can be displayed // now we know, if the logo can be displayed
if ShowLogo then if ShowLogo then
WriteLogo; WriteLogo;
@ -4514,6 +4640,10 @@ begin
w(' -Jrnone: Do not write resource string file'); w(' -Jrnone: Do not write resource string file');
w(' -Jrunit: Write resource string file per unit with all resource strings'); w(' -Jrunit: Write resource string file per unit with all resource strings');
w(' -Jrprogram: Write resource string file per program with all used resource strings in program'); w(' -Jrprogram: Write resource string file per program with all used resource strings in program');
w(' -Jr<x> Control writing of linked resources');
w(' -JRnone: Do not write resources');
w(' -JRjs: Write resources in Javascript structure');
w(' -JRhtml[=filename] : Write resources as preload links in HTML file (default is projectfile-res.html)');
w(' -Jpcmd<command>: Run postprocessor. For each generated js execute command passing the js as stdin and read the new js from stdout. This option can be added multiple times to call several postprocessors in succession.'); w(' -Jpcmd<command>: Run postprocessor. For each generated js execute command passing the js as stdin and read the new js from stdout. This option can be added multiple times to call several postprocessors in succession.');
w(' -Ju<x>: Add <x> to foreign unit paths. Foreign units are not compiled.'); w(' -Ju<x>: Add <x> to foreign unit paths. Foreign units are not compiled.');
WritePrecompiledFormats; WritePrecompiledFormats;
@ -4809,6 +4939,7 @@ begin
aPasTree.ParserLogEvents:=aPasTree.ParserLogEvents+[pleInterface,pleImplementation]; aPasTree.ParserLogEvents:=aPasTree.ParserLogEvents+[pleInterface,pleImplementation];
// scanner // scanner
aFile.ResourceHandler:=FResources;;
aFile.CreateScannerAndParser(FS.CreateResolver); aFile.CreateScannerAndParser(FS.CreateResolver);
if ShowDebug then if ShowDebug then

View File

@ -228,6 +228,7 @@ type
FOnReadFile: TPas2jsReadFileEvent; FOnReadFile: TPas2jsReadFileEvent;
FOnWriteFile: TPas2jsWriteFileEvent; FOnWriteFile: TPas2jsWriteFileEvent;
FResetStamp: TChangeStamp; FResetStamp: TChangeStamp;
FResourcePaths: TStringList;
FUnitPaths: TStringList; FUnitPaths: TStringList;
FUnitPathsFromCmdLine: integer; FUnitPathsFromCmdLine: integer;
FPCUPaths: TStringList; FPCUPaths: TStringList;
@ -257,6 +258,7 @@ type
function FindCustomJSFileName(const aFilename: string): String; override; function FindCustomJSFileName(const aFilename: string): String; override;
function FindUnitJSFileName(const aUnitFilename: string): String; override; function FindUnitJSFileName(const aUnitFilename: string): String; override;
function FindUnitFileName(const aUnitname, InFilename, ModuleDir: string; out IsForeign: boolean): String; override; function FindUnitFileName(const aUnitname, InFilename, ModuleDir: string; out IsForeign: boolean): String; override;
function FindResourceFileName(const aFilename, ModuleDir: string): String; override;
function FindIncludeFileName(const aFilename, ModuleDir: string): String; override; function FindIncludeFileName(const aFilename, ModuleDir: string): String; override;
function AddIncludePaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean; function AddIncludePaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
function AddUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean; function AddUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
@ -286,6 +288,7 @@ type
public public
property BaseDirectory: string read FBaseDirectory write SetBaseDirectory; // includes trailing pathdelim property BaseDirectory: string read FBaseDirectory write SetBaseDirectory; // includes trailing pathdelim
property ForeignUnitPaths: TStringList read FForeignUnitPaths; property ForeignUnitPaths: TStringList read FForeignUnitPaths;
property ResourcePaths : TStringList read FResourcePaths;
property ForeignUnitPathsFromCmdLine: integer read FForeignUnitPathsFromCmdLine; property ForeignUnitPathsFromCmdLine: integer read FForeignUnitPathsFromCmdLine;
property IncludePaths: TStringList read FIncludePaths; property IncludePaths: TStringList read FIncludePaths;
property IncludePathsFromCmdLine: integer read FIncludePathsFromCmdLine; property IncludePathsFromCmdLine: integer read FIncludePathsFromCmdLine;
@ -1453,6 +1456,7 @@ begin
FIncludePaths:=TStringList.Create; FIncludePaths:=TStringList.Create;
FForeignUnitPaths:=TStringList.Create; FForeignUnitPaths:=TStringList.Create;
FUnitPaths:=TStringList.Create; FUnitPaths:=TStringList.Create;
FResourcePaths:=TStringList.Create;
FFiles:=TPasAnalyzerKeySet.Create( FFiles:=TPasAnalyzerKeySet.Create(
{$IFDEF Pas2js} {$IFDEF Pas2js}
@Pas2jsCachedFileToKeyName,@PtrFilenameToKeyName @Pas2jsCachedFileToKeyName,@PtrFilenameToKeyName
@ -1977,6 +1981,50 @@ begin
Result:=''; Result:='';
end; end;
function TPas2jsFilesCache.FindResourceFileName(const aFilename, ModuleDir: string): String;
var
SearchedDirs: TStringList;
function SearchInDir(Dir: string; var Filename: string): boolean;
// search in Dir for pp, pas, p times given case, lower case, upper case
begin
Dir:=IncludeTrailingPathDelimiter(Dir);
if IndexOfFile(SearchedDirs,Dir)>=0 then exit(false);
SearchedDirs.Add(Dir);
if SearchLowUpCase(Filename) then exit(true);
Result:=false;
end;
var
i: Integer;
begin
//writeln('TPas2jsFilesCache.FindUnitFileName "',aUnitname,'" ModuleDir="',ModuleDir,'"');
Result:='';
SearchedDirs:=TStringList.Create;
try
Result:=SetDirSeparators(aFilename);
// First search in ModuleDir
if SearchInDir(ModuleDir,Result) then
exit;
// Then in resource paths
for i:=0 to ResourcePaths.Count-1 do
if SearchInDir(ResourcePaths[i],Result) then
exit;
// Not sure
// finally search in unit paths
// for i:=0 to UnitPaths.Count-1 do
// if SearchInDir(UnitPaths[i],Result) then exit;
finally
SearchedDirs.Free;
end;
Result:='';
end;
function TPas2jsFilesCache.FindUnitJSFileName(const aUnitFilename: string): String; function TPas2jsFilesCache.FindUnitJSFileName(const aUnitFilename: string): String;
begin begin

View File

@ -97,6 +97,7 @@ Type
function FindSourceFileName(const aFilename: string): String; virtual; abstract; function FindSourceFileName(const aFilename: string): String; virtual; abstract;
Public Public
// Public Abstract. Must be overridden // Public Abstract. Must be overridden
function FindResourceFileName(const aFilename, ModuleDir: string): String; virtual; abstract;
function FindIncludeFileName(const aFilename, ModuleDir: string): String; virtual; abstract; function FindIncludeFileName(const aFilename, ModuleDir: string): String; virtual; abstract;
function LoadFile(Filename: string; Binary: boolean = false): TPas2jsFile; virtual; abstract; function LoadFile(Filename: string; Binary: boolean = false): TPas2jsFile; virtual; abstract;
Function FileExists(Const aFileName: String): Boolean; virtual; abstract; Function FileExists(Const aFileName: String): Boolean; virtual; abstract;
@ -164,6 +165,7 @@ Type
public public
constructor Create(aFS: TPas2jsFS); reintroduce; constructor Create(aFS: TPas2jsFS); reintroduce;
// Redirect all calls to FS. // Redirect all calls to FS.
function FindResourceFileName(const aFilename: string): String; override;
function FindIncludeFileName(const aFilename: string): String; override; function FindIncludeFileName(const aFilename: string): String; override;
function FindIncludeFile(const aFilename: string): TLineReader; override; function FindIncludeFile(const aFilename: string): TLineReader; override;
function FindSourceFile(const aFilename: string): TLineReader; override; function FindSourceFile(const aFilename: string): TLineReader; override;
@ -430,9 +432,15 @@ end;
constructor TPas2jsFSResolver.Create(aFS: TPas2jsFS); constructor TPas2jsFSResolver.Create(aFS: TPas2jsFS);
begin begin
Inherited Create;
FFS:=aFS; FFS:=aFS;
end; end;
function TPas2jsFSResolver.FindResourceFileName(const aFilename: string): String;
begin
Result:=FS.FindResourceFileName(aFilename,BaseDirectory);
end;
function TPas2jsFSResolver.FindIncludeFileName(const aFilename: string): String; function TPas2jsFSResolver.FindIncludeFileName(const aFilename: string): String;
begin begin

View File

@ -0,0 +1,110 @@
unit pas2jshtmlresources;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, pas2jsResources, pas2jsFS;
Type
{ THTMLResourceLinkHandler }
THTMLResourceLinkHandler = Class(TPas2jsResourceHandler)
Private
FLinkType: string;
FPrefix: String;
FResources : tstrings;
Protected
function GetResourceCount: Integer; override;
function GetAsString: String; override;
Function CreateDataLink(Const aResourceName,aFormat,aData : String) : String;
Public
Constructor Create(aFS : TPas2JSFS); override;
Class Function OutputMode : TResourceOUtputMode; override;
Class Function OutputFileExtension : String; override;
Procedure HandleResource (aFileName : string; Options : TStrings); override;
Procedure ClearUnit; override;
Procedure DoneUnit(IsMainFile : Boolean); override;
destructor Destroy; override;
// ID is IDPrefix-resourcename. The default Prefix is 'resource'
Property IDPrefix : String Read FPrefix Write FPrefix;
Property LinkType : string Read FLinkType Write FLinkType;
Property Resources : TStrings Read FResources;
end;
implementation
{ THTMLResourceLinkHandler }
function THTMLResourceLinkHandler.GetResourceCount: Integer;
begin
Result:=FResources.Count;
end;
function THTMLResourceLinkHandler.GetAsString: String;
begin
Result:=FResources.Text;
end;
function THTMLResourceLinkHandler.CreateDataLink(const aResourceName, aFormat, aData: String): String;
begin
Result:=Format('<link rel="%s" id="%s-%s" data-unit="%s" href="data:%s;base64,%s" />',[linkType,IDPrefix,aResourceName,CurrentUnitName,aFormat,aData]);
end;
procedure THTMLResourceLinkHandler.HandleResource(aFileName: string; Options: TStrings);
Var
S : String;
aFormat,ResourceName : String;
begin
S:=GetFileAsBase64(aFileName);
aFormat:=GetFormat(aFileName,Options);
ResourceName:=Options.Values['name'];
if ResourceName='' then
ResourceName:=ChangeFileExt(ExtractFileName(aFileName),'');
Resources.Add(CreateDataLink(ResourceName,aFormat,S))
end;
constructor THTMLResourceLinkHandler.Create(aFS: TPas2JSFS);
begin
inherited Create(aFS);
FResources:=TStringList.Create;
IDPrefix:='resource';
LinkType:='preload';
end;
class function THTMLResourceLinkHandler.OutputMode: TResourceOutputMode;
begin
Result:=romFile;
end;
class function THTMLResourceLinkHandler.OutputFileExtension: String;
begin
Result:='.html';
end;
procedure THTMLResourceLinkHandler.ClearUnit;
begin
inherited ClearUnit;
FResources.Clear;
end;
procedure THTMLResourceLinkHandler.DoneUnit(IsMainFile : Boolean);
begin
// Do no call inherited, it will clear the list
end;
destructor THTMLResourceLinkHandler.Destroy;
begin
FreeAndNil(FResources);
inherited Destroy;
end;
end.

View File

@ -0,0 +1,103 @@
unit pas2jsjsresources;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, pas2jsResources, pas2jsFS;
Type
{ TJSResourceLinkHandler }
{ TJSResourceHandler }
TJSResourceHandler = Class(TPas2jsResourceHandler)
Private
FResources : TStrings;
function GetResourceJSStatement(aFileName: String; Options: TStrings): String;
Protected
function GetResourceCount: Integer; override;
function GetAsString: String; override;
Public
Constructor Create(aFS : TPas2JSFS); override;
Class Function OutputMode : TResourceOutputMode; override;
Class Function OutputFileExtension : String; override;
Procedure HandleResource (aFileName : string; Options : TStrings); override;
destructor Destroy; override;
Property Resources : TStrings Read FResources;
end;
implementation
{ TJSResourceHandler }
function TJSResourceHandler.GetResourceCount: Integer;
begin
Result:=FResources.Count;
end;
function TJSResourceHandler.GetAsString: String;
Var
I : Integer;
N,V : String;
begin
Result:='';
For I:=0 to FResources.Count-1 do
begin
FResources.GetNameValue(I,N,V);
Result:=Result+V+#10;
end;
end;
constructor TJSResourceHandler.Create(aFS: TPas2JSFS);
begin
inherited Create(aFS);
FResources:=TStringList.Create;
end;
class function TJSResourceHandler.OutputMode: TResourceOutputMode;
begin
Result:=romExtraJS;
end;
class function TJSResourceHandler.OutputFileExtension: String;
begin
Result:='.js';
end;
Function TJSResourceHandler.GetResourceJSStatement(aFileName : String; Options: TStrings) : String;
Const
SAddResource = 'rtl.addResource({name: "%s", unit: "%s", format: "%s", encoding: "base64", data: "%s"});';
Var
aFormat,aName,aData : String;
begin
aData:=GetFileAsBase64(aFileName);
aFormat:=GetFormat(aFileName,Options);
aName:=Options.Values['name'];
if aName='' then
aName:=ChangeFileExt(ExtractFileName(aFileName),'');
Result:=Format(SAddResource,[aName,CurrentUnitName,aFormat,aData]);
end;
procedure TJSResourceHandler.HandleResource(aFileName: string; Options: TStrings);
begin
// PRepending unit name allows to extract easier all resources for a single unit
FResources.Add(CurrentUnitName+'='+GetResourceJSStatement(aFileName,Options));
end;
destructor TJSResourceHandler.Destroy;
begin
FreeAndNil(FResources);
inherited Destroy;
end;
end.

View File

@ -0,0 +1,164 @@
unit pas2jsresources;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, pas2jsfs, jsTree;
Type
TResourceScopeMode = (rmProgram,rmUnit);
{ TPas2jsResourceHandler }
TResourceOutputMode = (romNone,romJS,romFile,romExtraJS);
TPas2jsResourceHandler = class(TObject)
private
FCurrentUnitName: String;
FFS: TPas2JSFS;
Protected
// Must be overridden
function GetResourceCount: Integer; virtual; abstract;
// Content of file, if file based.
function GetAsString: String; virtual; abstract;
// Detect some common formats
Function GetFormat(const aFileName : string; aOptions : TStrings) : string; virtual;
Public
Constructor Create(aFS : TPas2JSFS); virtual;
// Called for every found resource
Procedure HandleResource (aFileName : string; Options : TStrings); virtual; abstract;
// Extension of output file, if file based
Class Function OutputFileExtension : String; virtual;
// True if output is file based (i.e. written to separate file)
Class Function OutputMode : TResourceOutputMode; virtual; abstract;
// Load resource file. Can be used in descendents
Function LoadFile(aFileName : string) : TPas2jsFile;
// Load resource file and encode as base64 string. Can be used in descendents
Function GetFileAsBase64(aFileName : string) : string;
// This is called for every unit.
Procedure StartUnit(Const aUnitName : String); virtual;
// This is called at the start of every unit if OutputIsUnitBased is true.
Procedure ClearUnit; virtual;
// This is called at the end of every unit if OutputIsUnitBased is true. Only once if not.
Procedure DoneUnit(isMainFile : Boolean); virtual;
// This is called when Javascript is written for a unit
Function WriteJS(const aUnitName : String; aModule : TJSElement) : TJSElement; virtual;
// Current unit.
Property CurrentUnitName : String Read FCurrentUnitName;
// Passed at create
property FS : TPas2JSFS Read FFS;
// Return file content for writing to file if IsFileBased
Property AsString : String Read GetAsString;
// Number of resources
Property ResourceCount : Integer Read GetResourceCount;
end;
{ TNoResources }
TNoResources = Class(TPas2jsResourceHandler)
Public
Procedure HandleResource (aFileName : string; Options : TStrings); override;
Class Function OutputMode : TResourceOutputMode; override;
end;
implementation
{$IFNDEF PAS2JS}
uses base64;
{ TNoResources }
procedure TNoResources.HandleResource(aFileName: string; Options: TStrings);
begin
// Do nothing
end;
class function TNoResources.OutputMode: TResourceOutputMode;
begin
result:=romNone;
end;
{$ENDIF}
{ TPas2jsResourceHandler }
function TPas2jsResourceHandler.GetFormat(const aFileName: string; aOptions: TStrings): string;
Var
E : String;
begin
Result:=aOptions.Values['format'];
if Result='' then
begin
E:=ExtractFileExt(aFileName);
if (E<>'') and (E[1]='.') then
E:=Copy(E,2,Length(E)-1);
if Pos(LowerCase(E),';png;jpg;jpeg;bmp;ico;')>0 then
Result:='image/'+E
else if Pos(LowerCase(E),';htm;html;')>0 then
Result:='text/html'
else if Pos(LowerCase(E),';txt;lpr;pas;pp;')>0 then
Result:='text/text'
else if Pos(LowerCase(E),';js;')>0 then
Result:='application/javascript'
else if Pos(LowerCase(E),';json;')>0 then
Result:='application/javascript'
else
Result:='application/octet-stream';
end;
end;
constructor TPas2jsResourceHandler.Create(aFS: TPas2JSFS);
begin
FFS:=aFS;
end;
class function TPas2jsResourceHandler.OutputFileExtension: String;
begin
Result:='';
end;
function TPas2jsResourceHandler.LoadFile(aFileName: string): TPas2jsFile;
begin
Result:=FS.LoadFile(aFileName,True);
end;
function TPas2jsResourceHandler.GetFileAsBase64(aFileName: string): string;
Var
F : TPas2JSFile;
begin
F:=LoadFile(aFileName);
Result:=EncodeStringBase64(F.Source);
// Do not release, FS will release all files
end;
procedure TPas2jsResourceHandler.ClearUnit;
begin
FCurrentUnitName:='';
end;
procedure TPas2jsResourceHandler.StartUnit(const aUnitName: String);
begin
FCurrentUnitName:=aUnitName;
end;
procedure TPas2jsResourceHandler.DoneUnit(isMainFile: Boolean);
begin
if not isMainFile then
ClearUnit;
end;
function TPas2jsResourceHandler.WriteJS(const aUnitName: String; aModule: TJSElement): TJSElement;
begin
Result:=aModule;
end;
end.