fpc/utils/pas2js/pas2jsfilecache.pp

{ Author: Mattias Gaertner  2017  [email protected]

  Abstract:
    TPas2jsFileResolver extends TFileResolver and searches source files.
}
unit Pas2jsFileCache;

{$mode objfpc}{$H+}

{$i pas2js_defines.inc}

interface

uses
  Classes, SysUtils, AVL_Tree,
  PScanner, PasResolver, FPPJsSrcMap,
  Pas2jsLogger, Pas2jsFileUtils;

const // Messages
  nIncludeSearch = 201; sIncludeSearch = 'Include file search: %s';
  nUnitSearch = 202; sUnitSearch = 'Unitsearch: %s';
  nSearchingFileFound = 203; sSearchingFileFound = 'Searching file: %s... found';
  nSearchingFileNotFound = 204; sSearchingFileNotFound = 'Searching file: %s... not found';

type
  EPas2jsFileCache = class(Exception);

type
  TP2jsFileCacheOption = (
    caoShowFullFilenames,
    caoShowTriedUsedFiles,
    caoAllJSIntoMainJS
    );
  TP2jsFileCacheOptions = set of TP2jsFileCacheOption;
const
  DefaultPas2jsFileCacheOptions = [];
  p2jsfcoCaption: array[TP2jsFileCacheOption] of string = (
    // only used by experts, no need for resourcestrings
    'Show full filenames',
    'Show tried/used files',
    'Combine all JavaScript into main file'
    );

type
  TPas2jsFilesCache = class;
  TPas2jsCachedFile = class;

  { TPas2jsFileResolver }

  TPas2jsFileResolver = class(TFileResolver)
  private
    FCache: TPas2jsFilesCache;
  public
    constructor Create(aCache: TPas2jsFilesCache); reintroduce;
    function FindIncludeFile(const aFilename: string): TLineReader; override;
    function FindIncludeFileName(const aFilename: string): String; reintroduce;
    function FindSourceFile(const aFilename: string): TLineReader; override;
    function FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String;
    function FindUnitJSFileName(const aUnitFilename: string): String;
    function FindCustomJSFileName(const aFilename: string): String;
    function FileExistsLogged(const Filename: string): boolean;
    function SearchLowUpCase(var Filename: string): boolean; virtual;
    property Cache: TPas2jsFilesCache read FCache;
  end;

  { TPas2jsFileLineReader }

  TPas2jsFileLineReader = class(TLineReader)
  private
    FCachedFile: TPas2jsCachedFile;
    FIsEOF: boolean;
    FLineNumber: integer;
    FSource: string;
    FSrcPos: PChar;
  public
    constructor Create(const AFilename: string); override;
    constructor Create(aFile: TPas2jsCachedFile); reintroduce;
    function IsEOF: Boolean; override;
    function ReadLine: string; override;
    property LineNumber: integer read FLineNumber;
    property CachedFile: TPas2jsCachedFile read FCachedFile;
    property Source: string read FSource;
    property SrcPos: PChar read FSrcPos;
  end;

  { TPas2jsCachedFile }

  TPas2jsCachedFile = class
  private
    FCache: TPas2jsFilesCache;
    FChangeStamp: TChangeStamp;
    FFileEncoding: string;
    FFilename: string;
    FLastErrorMsg: string;
    FLoaded: boolean;
    FLoadedFileAge: longint;
    FSource: string;
    FCacheStamp: TChangeStamp; // Cache.ResetStamp when file was loaded
  public
    constructor Create(aCache: TPas2jsFilesCache; const aFilename: string); reintroduce;
    function Load(RaiseOnError: boolean): boolean;
    function CreateLineReader(RaiseOnError: boolean): TPas2jsFileLineReader;
    property FileEncoding: string read FFileEncoding;
    property Filename: string read FFilename;
    property Source: string read FSource; // UTF-8 without BOM
    property Cache: TPas2jsFilesCache read FCache;
    property ChangeStamp: TChangeStamp read FChangeStamp;// changed when Source changed
    property Loaded: boolean read FLoaded; // Source valid, but may contain an old version
    property LastErrorMsg: string read FLastErrorMsg;
    property LoadedFileAge: longint read FLoadedFileAge;// only valid if Loaded=true
  end;

  TPas2jsReadFileEvent = function(aFilename: string; var aSource: string): boolean of object;

  TPas2jsCachedFilesState = (
    cfsMainJSFileResolved
    );
  TPas2jsFileCacheStates = set of TPas2jsCachedFilesState;

  TPas2jsSearchPathKind = (
    spkPath,      // e.g. unitpaths, includepaths
    spkIdentifier // e.g. namespaces, trailing - means remove
    );

  { TPas2jsFilesCache }

  TPas2jsFilesCache = class
  private
    FBaseDirectory: string;
    FFiles: TAVLTree; // tree of TPas2jsCachedFile sorted for Filename
    FForeignUnitPaths: TStringList;
    FForeignUnitPathsFromCmdLine: integer;
    FIncludePaths: TStringList;
    FIncludePathsFromCmdLine: integer;
    FInsertFilenames: TStringList;
    FLog: TPas2jsLogger;
    FMainJSFile: string;
    FMainJSFileResolved: string; // only valid if cfsMainJSFileResolved in FStates
    FMainSrcFile: string;
    FNamespaces: TStringList;
    FNamespacesFromCmdLine: integer;
    FOnReadFile: TPas2jsReadFileEvent;
    FOptions: TP2jsFileCacheOptions;
    FReadLineCounter: SizeInt;
    FResetStamp: TChangeStamp;
    FSrcMapBaseDir: string;
    FStates: TPas2jsFileCacheStates;
    FUnitOutputPath: string;
    FUnitPaths: TStringList;
    FUnitPathsFromCmdLine: integer;
    function GetAllJSIntoMainJS: Boolean;
    function GetShowFullFilenames: boolean;
    function GetShowTriedUsedFiles: boolean;
    procedure RegisterMessages;
    procedure SetAllJSIntoMainJS(AValue: Boolean);
    procedure SetBaseDirectory(AValue: string);
    function AddSearchPaths(const Paths: string; Kind: TPas2jsSearchPathKind;
      FromCmdLine: boolean; var List: TStringList; var CmdLineCount: integer): string;
    procedure SetMainJSFile(AValue: string);
    procedure SetOptions(AValue: TP2jsFileCacheOptions);
    procedure SetShowFullFilenames(AValue: boolean);
    procedure SetShowTriedUsedFiles(AValue: boolean);
    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;
    procedure Reset;
    function AddIncludePaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
    function AddNamespaces(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
    function AddUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
    function AddSrcUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
    function CreateResolver: TPas2jsFileResolver;
    function FormatPath(const aPath: string): string;
    function GetResolvedMainJSFile: string;
    function LoadTextFile(Filename: string): TPas2jsCachedFile;
    function NormalizeFilename(const Filename: string; RaiseOnError: boolean): string;
    procedure InsertCustomJSFiles(aWriter: TPas2JSMapper);
    function IndexOfInsertFilename(const aFilename: string): integer;
    procedure AddInsertFilename(const aFilename: string);
    procedure RemoveInsertFilename(const aFilename: string);
  public
    property AllJSIntoMainJS: Boolean read GetAllJSIntoMainJS write SetAllJSIntoMainJS;
    property BaseDirectory: string read FBaseDirectory write SetBaseDirectory; // includes trailing pathdelim
    property ForeignUnitPaths: TStringList read FForeignUnitPaths;
    property ForeignUnitPathsFromCmdLine: integer read FForeignUnitPathsFromCmdLine;
    property IncludePaths: TStringList read FIncludePaths;
    property IncludePathsFromCmdLine: integer read FIncludePathsFromCmdLine;
    property InsertFilenames: TStringList read FInsertFilenames;
    property Log: TPas2jsLogger read FLog;
    property MainJSFile: string read FMainJSFile write SetMainJSFile;
    property MainSrcFile: string read FMainSrcFile write FMainSrcFile;
    property Namespaces: TStringList read FNamespaces;
    property NamespacesFromCmdLine: integer read FNamespacesFromCmdLine;
    property Options: TP2jsFileCacheOptions read FOptions write SetOptions default DefaultPas2jsFileCacheOptions;
    property ReadLineCounter: SizeInt read FReadLineCounter write FReadLineCounter;
    property ResetStamp: TChangeStamp read FResetStamp;
    property SrcMapBaseDir: string read FSrcMapBaseDir write SetSrcMapBaseDir; // includes trailing pathdelim
    property ShowFullPaths: boolean read GetShowFullFilenames write SetShowFullFilenames;
    property ShowTriedUsedFiles: boolean read GetShowTriedUsedFiles write SetShowTriedUsedFiles;
    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;
function CompareCachedFiles(File1, File2: Pointer): integer;
function ConvertTextToUTF8(const Src: string; var SrcEncoding: string): string;
function GuessEncoding(const Src: string): string;
function HasUTF8BOM(const s: string): boolean;
function RemoveUTFBOM(const s: string): string;

implementation

function CompareFilenameWithCachedFile(Filename, CachedFile: Pointer): integer;
var
  Cache: TPas2jsCachedFile absolute CachedFile;
begin
  Result:=CompareFilenames(AnsiString(Filename),Cache.Filename);
end;

function CompareCachedFiles(File1, File2: Pointer): integer;
var
  Cache1: TPas2jsCachedFile absolute File1;
  Cache2: TPas2jsCachedFile absolute File2;
begin
  Result:=CompareFilenames(Cache1.Filename,Cache2.Filename);
end;

function ConvertTextToUTF8(const Src: string; var SrcEncoding: string): string;
var
  p: PChar;
  NormSrcEncoding: String;
begin
  Result:=Src;
  if SrcEncoding='' then
    SrcEncoding:=GuessEncoding(Src);
  if Result='' then exit;
  NormSrcEncoding:=NormalizeEncoding(SrcEncoding);
  if NormSrcEncoding=NormalizeEncoding(EncodingUTF8) then begin
    p:=PChar(Result);
    if (p^=#$EF) and (p[1]=#$BB) and (p[2]=#$BF) then begin
      // cut out UTF-8 BOM
      Delete(Result,1,3);
    end;
  end else if (NormSrcEncoding=EncodingSystem)
      or (NormSrcEncoding=GetDefaultTextEncoding) then begin
    Result:=SystemCPToUTF8(Result);
  end else
    EPas2jsFileCache.Create('invalid encoding "'+SrcEncoding+'"');
end;

function GuessEncoding(const Src: string): string;
var
  p: PChar;
  l: SizeInt;
  i: Integer;
begin
  if Src='' then exit(EncodingUTF8);

  if HasUTF8BOM(Src) then
    // UTF-8 BOM
    exit(EncodingUTF8);

  // try UTF-8 (this includes ASCII)
  l:=length(Src);
  p:=PChar(Src);
  repeat
    if ord(p^)<128 then begin
      // ASCII
      if (p^=#0) and (p-PChar(Src)>=l) then
        exit(EncodingUTF8);
      inc(p);
    end else begin
      i:=UTF8CharacterStrictLength(p);
      if i=0 then
        break;
      inc(p,i);
    end;
  until false;

  // use system encoding
  Result:=GetDefaultTextEncoding;
end;

function HasUTF8BOM(const s: string): boolean;
var
  p: PChar;
begin
  if s='' then exit(false);
  p:=PChar(s);
  Result:=(p^=#$EF) and (p[1]=#$BB) and (p[2]=#$BF);
end;

function RemoveUTFBOM(const s: string): string;
begin
  Result:=s;
  if not HasUTF8BOM(Result) then exit;
  Delete(Result,1,3);
end;

{ TPas2jsFileLineReader }

constructor TPas2jsFileLineReader.Create(const AFilename: string);
begin
  raise Exception.Create('TPas2jsFileLineReader.Create no cache "'+AFilename+'"');
end;

constructor TPas2jsFileLineReader.Create(aFile: TPas2jsCachedFile);
begin
  inherited Create(aFile.Filename);
  FCachedFile:=aFile;
  FSource:=aFile.Source;
  FSrcPos:=PChar(FSource);
  FIsEOF:=FSource='';
end;

function TPas2jsFileLineReader.IsEOF: Boolean;
begin
  Result:=FIsEOF;
end;

function TPas2jsFileLineReader.ReadLine: string;
var
  p: PChar;

  procedure GetLine;
  var
    l: SizeInt;
  begin
    l:=p-FSrcPos;
    SetLength(Result,l);
    if l>0 then
      Move(FSrcPos^,Result[1],l);
    FSrcPos:=p;
    inc(FLineNumber);
    if (CachedFile<>nil) and (CachedFile.Cache<>nil) then
      inc(CachedFile.Cache.FReadLineCounter);
    //writeln('GetLine "',Result,'"');
  end;

var
  c: Char;
begin
  if FIsEOF then exit('');
  p:=FSrcPos;
  repeat
    c:=p^;
    case c of
    #0:
      if p-PChar(FSource)=length(FSource) then begin
        FIsEOF:=true;
        GetLine;
        exit;
      end;
    #10,#13:
      begin
        GetLine;
        inc(p);
        if (p^ in [#10,#13]) and (p^<>c) then inc(p);
        if (p^=#0) and (p-PChar(FSource)=length(FSource)) then
          FIsEOF:=true;
        FSrcPos:=p;
        exit;
      end;
    end;
    inc(p);
  until false;
  Result:='';
end;

{ TPas2jsCachedFile }

constructor TPas2jsCachedFile.Create(aCache: TPas2jsFilesCache;
  const aFilename: string);
begin
  FChangeStamp:=InvalidChangeStamp;
  FCache:=aCache;
  FCacheStamp:=Cache.ResetStamp;
  FFilename:=aFilename;
end;

function TPas2jsCachedFile.Load(RaiseOnError: boolean): boolean;

  procedure Err(const ErrorMsg: string);
  begin
    FLastErrorMsg:=ErrorMsg;
    if RaiseOnError then
      raise EPas2jsFileCache.Create(FLastErrorMsg);
  end;

var
  NewSource: string;
begin
  {$IFDEF VerboseFileCache}
  writeln('TPas2jsCachedFile.Load START "',Filename,'" Loaded=',Loaded);
  {$ENDIF}
  if Loaded then begin
    // already loaded, check if it still valid
    if (Cache.ResetStamp=FCacheStamp) then begin
      // nothing changed
      Result:=FLastErrorMsg='';
      if (not Result) and RaiseOnError then
        raise EPas2jsFileCache.Create(FLastErrorMsg);
      exit;
    end;
    {$IFDEF VerboseFileCache}
    writeln('TPas2jsCachedFile.Load CHECK FILEAGE "',Filename,'"');
    {$ENDIF}
    if LoadedFileAge=FileAge(Filename) then
      exit(true);
  end;
  {$IFDEF VerboseFileCache}
  writeln('TPas2jsCachedFile.Load FIRST or RELOAD ',Filename,' Loaded=',Loaded);
  {$ENDIF}
  // needs (re)load
  Result:=false;
  if not FileExists(Filename) then begin
    Err('File not found "'+Filename+'"');
    exit;
  end;
  if DirectoryExists(Filename) then begin
    Err('File is a directory "'+Filename+'"');
    exit;
  end;
  NewSource:='';
  if not Cache.ReadFile(Filename,NewSource) then exit;
  {$IFDEF VerboseFileCache}
  writeln('TPas2jsCachedFile.Load ENCODE ',Filename,' FFileEncoding=',FFileEncoding);
  {$ENDIF}
  FSource:=ConvertTextToUTF8(NewSource,FFileEncoding);
  FLoaded:=true;
  FCacheStamp:=Cache.ResetStamp;
  FLoadedFileAge:=FileAge(Filename);
  {$IFDEF VerboseFileCache}
  writeln('TPas2jsCachedFile.Load END ',Filename,' FFileEncoding=',FFileEncoding);
  {$ENDIF}
end;

function TPas2jsCachedFile.CreateLineReader(RaiseOnError: boolean
  ): TPas2jsFileLineReader;
begin
  if not Load(RaiseOnError) then
    exit(nil);
  Result:=TPas2jsFileLineReader.Create(Self);
end;

{ TPas2jsFileResolver }

constructor TPas2jsFileResolver.Create(aCache: TPas2jsFilesCache);
begin
  inherited Create;
  FCache:=aCache;
end;

function TPas2jsFileResolver.FindIncludeFile(const aFilename: string): TLineReader;
var
  Filename: String;
begin
  Result:=nil;
  Filename:=FindIncludeFileName(aFilename);
  if Filename='' then exit;
  try
    Result := TFileLineReader.Create(Filename); // ToDo: 1. convert encoding to UTF-8, 2. use cache
  except
    // error is shown in the scanner, which has the context information
  end;
end;

function TPas2jsFileResolver.FindIncludeFileName(const aFilename: string): String;

  function SearchCasedInIncPath(const Filename: string): string;
  var
    i: Integer;
  begin
    // file name is relative
    // first search in the same directory as the unit
    if BaseDirectory<>'' then
      begin
      Result:=BaseDirectory+Filename;
      if SearchLowUpCase(Result) then exit;
      end;
    // then search in include path
    for i:=0 to IncludePaths.Count-1 do begin
      Result:=IncludePaths[i]+Filename;
      if SearchLowUpCase(Result) then exit;
    end;
    Result:='';
  end;

var
  Filename : string;
begin
  Result := '';

  // convert pathdelims to system
  Filename:=SetDirSeparators(aFilename);
  if Cache.ShowTriedUsedFiles then
    Cache.Log.LogMsgIgnoreFilter(nIncludeSearch,[Filename]);

  if FilenameIsAbsolute(Filename) then begin
    Result:=Filename;
    if not SearchLowUpCase(Result) then
      Result:='';
    exit;
  end;

  // search with the given file extension (even if no ext)
  Result:=SearchCasedInIncPath(Filename);
  if Result<>'' then exit;

  if ExtractFileExt(Filename)='' then begin
    // search with the default file extensions
    Result:=SearchCasedInIncPath(Filename+'.inc');
    if Result<>'' then exit;
    Result:=SearchCasedInIncPath(Filename+'.pp');
    if Result<>'' then exit;
    Result:=SearchCasedInIncPath(Filename+'.pas');
    if Result<>'' then exit;
  end;
end;

function TPas2jsFileResolver.FindSourceFile(const aFilename: string): TLineReader;
begin
  Result:=nil;
  if not FileExists(aFilename) then
    raise EFileNotFoundError.Create(aFilename)
  else
    Result:=Cache.LoadTextFile(aFilename).CreateLineReader(false);
end;

function TPas2jsFileResolver.FindUnitFileName(const aUnitname,
  InFilename: string; out IsForeign: boolean): String;

  function SearchInDir(Dir: string; var Filename: string): boolean;
  // search in Dir for pp, pas, p times given case, lower case, upper case
  begin
    Filename:=Dir+aUnitname+'.pp';
    if SearchLowUpCase(Filename) then exit(true);
    Filename:=Dir+aUnitname+'.pas';
    if SearchLowUpCase(Filename) then exit(true);
    Filename:=Dir+aUnitname+'.p';
    if SearchLowUpCase(Filename) then exit(true);
    Result:=false;
  end;

var
  i: Integer;
begin
  Result:='';

  if InFilename<>'' then begin
    Cache.Log.LogMsgIgnoreFilter(nSearchingFileNotFound,['not yet implemented "in" '+Cache.FormatPath(InFilename)])
    // ToDo
  end;

  // first search in foreign unit paths
  IsForeign:=true;
  for i:=0 to Cache.ForeignUnitPaths.Count-1 do
    if SearchInDir(Cache.ForeignUnitPaths[i],Result) then begin
      IsForeign:=true;
      exit;
    end;

  // then in BaseDirectory
  IsForeign:=false;
  if SearchInDir(BaseDirectory,Result) then exit;

  // finally search in unit paths
  for i:=0 to Cache.UnitPaths.Count-1 do
    if SearchInDir(Cache.UnitPaths[i],Result) then exit;

  Result:='';
end;

function TPas2jsFileResolver.FindUnitJSFileName(const aUnitFilename: string
  ): String;
begin
  Result:='';
  if aUnitFilename='' then exit;
  if Cache.AllJSIntoMainJS then begin
    Result:=Cache.GetResolvedMainJSFile;
  end else begin
    if Cache.UnitOutputPath<>'' then
      Result:=Cache.UnitOutputPath+ChangeFileExt(ExtractFileName(aUnitFilename),'.js')
    else
      Result:=ChangeFileExt(aUnitFilename,'.js');
  end;
end;

function TPas2jsFileResolver.FindCustomJSFileName(const aFilename: string
  ): String;

  function SearchInDir(const Dir: string): boolean;
  var
    CurFilename: String;
  begin
    CurFilename:=Dir+aFilename;
    Result:=FileExistsLogged(CurFilename);
    if Result then
      FindCustomJSFileName:=CurFilename;
  end;

var
  i: Integer;
begin
  Result:='';

  if FilenameIsAbsolute(aFilename) then
    begin
    Result:=aFilename;
    if not FileExistsLogged(Result) then
      Result:='';
    exit;
    end;

  if ExtractFilePath(aFilename)<>'' then
    begin
    Result:=ExpandFileNameUTF8(aFilename,BaseDirectory);
    if not FileExistsLogged(Result) then
      Result:='';
    exit;
    end;

  // first search in foreign unit paths
  for i:=0 to Cache.ForeignUnitPaths.Count-1 do
    if SearchInDir(Cache.ForeignUnitPaths[i]) then
      exit;

  // then in BaseDirectory
  if SearchInDir(BaseDirectory) then exit;

  // finally search in unit paths
  for i:=0 to Cache.UnitPaths.Count-1 do
    if SearchInDir(Cache.UnitPaths[i]) then exit;

  Result:='';
end;

function TPas2jsFileResolver.FileExistsLogged(const Filename: string): boolean;
begin
  Result:=FileExists(Filename);
  if Cache.ShowTriedUsedFiles then
    if Result then
      Cache.Log.LogMsgIgnoreFilter(nSearchingFileFound,[Cache.FormatPath(Filename)])
    else
      Cache.Log.LogMsgIgnoreFilter(nSearchingFileNotFound,[Cache.FormatPath(Filename)]);
end;

function TPas2jsFileResolver.SearchLowUpCase(var Filename: string): boolean;
{$IFNDEF CaseInsensitiveFilenames}
var
  CasedFilename: String;
{$ENDIF}
begin
  if FileExistsLogged(Filename) then
    exit(true);
  if StrictFileCase then
    exit(false);
  {$IFNDEF CaseInsensitiveFilenames}
  CasedFilename:=ExtractFilePath(Filename)+LowerCase(ExtractFileName(Filename));
  if (Filename<>CasedFilename) and FileExistsLogged(CasedFilename) then begin
    Filename:=CasedFilename;
    exit(true);
  end;
  CasedFilename:=ExtractFilePath(Filename)+UpperCase(ExtractFileName(Filename));
  if (Filename<>CasedFilename) and FileExistsLogged(CasedFilename) then begin
    Filename:=CasedFilename;
    exit(true);
  end;
  {$ENDIF}
  Result:=false;
end;

{ TPas2jsFilesCache }

procedure TPas2jsFilesCache.RegisterMessages;
begin
  Log.RegisterMsg(mtInfo,nIncludeSearch,sIncludeSearch);
  Log.RegisterMsg(mtInfo,nUnitSearch,sUnitSearch);
  Log.RegisterMsg(mtInfo,nSearchingFileFound,sSearchingFileFound);
  Log.RegisterMsg(mtInfo,nSearchingFileNotFound,sSearchingFileNotFound);
end;

function TPas2jsFilesCache.GetAllJSIntoMainJS: Boolean;
begin
  Result:=caoAllJSIntoMainJS in FOptions;
end;

function TPas2jsFilesCache.GetShowFullFilenames: boolean;
begin
  Result:=caoShowFullFilenames in FOptions;
end;

function TPas2jsFilesCache.GetShowTriedUsedFiles: boolean;
begin
  Result:=caoShowTriedUsedFiles in FOptions;
end;

procedure TPas2jsFilesCache.SetAllJSIntoMainJS(AValue: Boolean);
begin
  SetOption(caoAllJSIntoMainJS,AValue);
end;

procedure TPas2jsFilesCache.SetBaseDirectory(AValue: string);
begin
  AValue:=ExpandDirectory(AValue);
  if FBaseDirectory=AValue then Exit;
  FBaseDirectory:=AValue;
end;

function TPas2jsFilesCache.AddSearchPaths(const Paths: string;
  Kind: TPas2jsSearchPathKind; FromCmdLine: boolean; var List: TStringList;
  var CmdLineCount: integer): string;
// cmd line paths are added in front of the cfg paths
// cmd line paths are added in order, cfg paths are added in reverse order
// multi paths separated by semicolon are added in order
// duplicates are removed
var
  Added: Integer;

  function Add(aPath: string): boolean;
  var
    Remove: Boolean;
    i: Integer;
  begin
    Remove:=false;
    // search duplicate
    case Kind of
    spkPath:
      begin
        i:=List.Count-1;
        while (i>=0) and (CompareFilenames(aPath,List[i])<>0) do dec(i);
      end;
    spkIdentifier:
      begin
        if aPath[length(aPath)]='-' then begin
          Delete(aPath,length(aPath),1);
          Remove:=true;
        end;
        if not IsValidIdent(aPath,true,true) then
        begin
          AddSearchPaths:=aPath;
          exit(false);
        end;
        i:=List.Count-1;
        while (i>=0) and (CompareText(aPath,List[i])<>0) do dec(i);
      end;
    end;

    if Remove then begin
      // remove
      if i>=0 then begin
        List.Delete(i);
        if CmdLineCount>i then dec(CmdLineCount);
      end;
      exit(true);
    end;

    if FromCmdLine then begin
      // from cmdline: append in order to the cmdline params, in front of cfg params
      if i>=0 then begin
        if i<=CmdLineCount then exit(true);
        List.Delete(i);
      end;
      List.Insert(CmdLineCount,aPath);
      inc(CmdLineCount);
    end else begin
      // from cfg: append in reverse order to the cfg params, behind cmdline params
      if i>=0 then begin
        if i<=CmdLineCount+Added then exit(true);
        List.Delete(i);
      end;
      List.Insert(CmdLineCount+Added,aPath);
      inc(Added);
    end;
    Result:=true;
  end;

var
  aPath: String;
  p, i: integer;
  aPaths: TStringList;
begin
  Result:='';
  p:=1;
  Added:=0;
  aPaths:=TStringList.Create;
  try
    while p<=length(Paths) do begin
      aPath:=GetNextDelimitedItem(Paths,';',p);
      if aPath='' then continue;
      if Kind=spkPath then
        aPath:=ExpandDirectory(aPath);
      if (aPath='') then continue;
      aPaths.Clear;
      FindMatchingFiles(aPath,1000,aPaths);
      if aPaths.Count=0 then begin
        if not Add(aPath) then exit;
      end else begin
        for i:=0 to aPaths.Count-1 do
          if not Add(aPaths[i]) then exit;
      end;
    end;
  finally
    aPaths.Free;
  end;
end;

procedure TPas2jsFilesCache.SetMainJSFile(AValue: string);
begin
  if FMainJSFile=AValue then Exit;
  FMainJSFile:=AValue;
end;

procedure TPas2jsFilesCache.SetOptions(AValue: TP2jsFileCacheOptions);
begin
  if FOptions=AValue then Exit;
  FOptions:=AValue;
end;

procedure TPas2jsFilesCache.SetShowFullFilenames(AValue: boolean);
begin
  SetOption(caoShowFullFilenames,AValue);
end;

procedure TPas2jsFilesCache.SetShowTriedUsedFiles(AValue: boolean);
begin
  SetOption(caoShowTriedUsedFiles,AValue);
end;

procedure TPas2jsFilesCache.SetSrcMapBaseDir(const AValue: string);
var
  NewValue: String;
begin
  NewValue:=ExpandDirectory(AValue);
  if FSrcMapBaseDir=NewValue then Exit;
  FSrcMapBaseDir:=NewValue;
end;

procedure TPas2jsFilesCache.SetUnitOutputPath(AValue: string);
begin
  AValue:=ExpandDirectory(AValue);
  if FUnitOutputPath=AValue then Exit;
  FUnitOutputPath:=AValue;
end;

procedure TPas2jsFilesCache.SetOption(Flag: TP2jsFileCacheOption; Enable: boolean
  );
begin
  if Enable then
    Include(FOptions,Flag)
  else
    Exclude(FOptions,Flag);
  if Flag in [caoAllJSIntoMainJS] then
    Exclude(FStates,cfsMainJSFileResolved);
end;

function TPas2jsFilesCache.ReadFile(Filename: string; var Source: string
  ): boolean;
var
  ms: TMemoryStream;
begin
  Result:=false;
  try
    if Assigned(OnReadFile) then
      Result:=OnReadFile(Filename,Source);
    if Result 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;
  FResetStamp:=InvalidChangeStamp;
  FLog:=aLog;
  FOptions:=DefaultPas2jsFileCacheOptions;
  FIncludePaths:=TStringList.Create;
  FInsertFilenames:=TStringList.Create;
  FForeignUnitPaths:=TStringList.Create;
  FNamespaces:=TStringList.Create;
  FUnitPaths:=TStringList.Create;
  FFiles:=TAVLTree.Create(@CompareCachedFiles);
  RegisterMessages;
end;

destructor TPas2jsFilesCache.Destroy;
begin
  FLog:=nil;
  FFiles.FreeAndClear;
  FreeAndNil(FFiles);
  FreeAndNil(FInsertFilenames);
  FreeAndNil(FIncludePaths);
  FreeAndNil(FForeignUnitPaths);
  FreeAndNil(FNamespaces);
  FreeAndNil(FUnitPaths);
  inherited Destroy;
end;

procedure TPas2jsFilesCache.Reset;
begin
  IncreaseChangeStamp(FResetStamp);
  FOptions:=DefaultPas2jsFileCacheOptions;
  FMainJSFile:='';
  FMainSrcFile:='';
  FBaseDirectory:='';
  FSrcMapBaseDir:='';
  FUnitOutputPath:='';
  FReadLineCounter:=0;
  FForeignUnitPaths.Clear;
  FUnitPaths.Clear;
  FIncludePaths.Clear;
  FStates:=FStates-[cfsMainJSFileResolved];
end;

function TPas2jsFilesCache.AddIncludePaths(const Paths: string;
  FromCmdLine: boolean; out ErrorMsg: string): boolean;
begin
  ErrorMsg:=AddSearchPaths(Paths,spkPath,FromCmdLine,FIncludePaths,FIncludePathsFromCmdLine);
  Result:=ErrorMsg='';
end;

function TPas2jsFilesCache.AddNamespaces(const Paths: string;
  FromCmdLine: boolean; out ErrorMsg: string): boolean;
begin
  ErrorMsg:=AddSearchPaths(Paths,spkIdentifier,FromCmdLine,FNamespaces,FNamespacesFromCmdLine);
  Result:=ErrorMsg='';
end;

function TPas2jsFilesCache.AddUnitPaths(const Paths: string;
  FromCmdLine: boolean; out ErrorMsg: string): boolean;
begin
  ErrorMsg:=AddSearchPaths(Paths,spkPath,FromCmdLine,FUnitPaths,FUnitPathsFromCmdLine);
  Result:=ErrorMsg='';
end;

function TPas2jsFilesCache.AddSrcUnitPaths(const Paths: string;
  FromCmdLine: boolean; out ErrorMsg: string): boolean;
begin
  ErrorMsg:=AddSearchPaths(Paths,spkPath,FromCmdLine,FForeignUnitPaths,FForeignUnitPathsFromCmdLine);
  Result:=ErrorMsg='';
end;

function TPas2jsFilesCache.CreateResolver: TPas2jsFileResolver;
begin
  Result := TPas2jsFileResolver.Create(Self);
  Result.UseStreams:=false;
  Result.BaseDirectory:=BaseDirectory; // beware: will be changed by Scanner.OpenFile
end;

function TPas2jsFilesCache.FormatPath(const aPath: string): string;
begin
  Result:=aPath;
  if (Result='') or (BaseDirectory='') then exit;
  if FilenameIsAbsolute(aPath) then begin
    if not ShowFullPaths then begin
      if BaseDirectory=LeftStr(Result,length(BaseDirectory)) then
        Delete(Result,1,length(BaseDirectory));
    end;
  end else begin
    if ShowFullPaths then
      Result:=BaseDirectory+Result;
  end;
end;

function TPas2jsFilesCache.GetResolvedMainJSFile: string;
begin
  if not (cfsMainJSFileResolved in FStates) then begin
    if MainJSFile='.' then
      FMainJSFileResolved:=''
    else begin
      FMainJSFileResolved:=MainJSFile;
      if FMainJSFileResolved='' then begin
        // no option -o
        if UnitOutputPath<>'' then begin
          // option -FU and no -o => put into UnitOutputPath
          FMainJSFileResolved:=UnitOutputPath+ChangeFileExt(ExtractFilename(MainSrcFile),'.js')
        end else begin
          // no -FU and no -o => put into source directory
          FMainJSFileResolved:=ChangeFileExt(MainSrcFile,'.js');
        end;
      end else begin
        // has option -o
        if (ExtractFilePath(FMainJSFileResolved)='') and (UnitOutputPath<>'') then
          FMainJSFileResolved:=UnitOutputPath+FMainJSFileResolved;
      end;
    end;
    Include(FStates,cfsMainJSFileResolved);
  end;
  Result:=FMainJSFileResolved;
end;

function TPas2jsFilesCache.LoadTextFile(Filename: string): TPas2jsCachedFile;
var
  Node: TAVLTreeNode;
begin
  Filename:=NormalizeFilename(Filename,true);
  Node:=FFiles.FindKey(Pointer(Filename),@CompareFilenameWithCachedFile);
  if Node=nil then begin
    // new file
    Result:=TPas2jsCachedFile.Create(Self,Filename);
    FFiles.Add(Result);
  end else begin
    Result:=TPas2jsCachedFile(Node.Data);
  end;
  Result.Load(true);
end;

function TPas2jsFilesCache.NormalizeFilename(const Filename: string;
  RaiseOnError: boolean): string;
begin
  Result:=Filename;
  if ExtractFilename(Result)='' then
    if RaiseOnError then
      raise EFileNotFoundError.Create('invalid file name "'+Filename+'"');
  Result:=ExpandFileNameUTF8(Result);
  if (ExtractFilename(Result)='') or not FilenameIsAbsolute(Result) then
    if RaiseOnError then
      raise EFileNotFoundError.Create('invalid file name "'+Filename+'"');
end;

procedure TPas2jsFilesCache.InsertCustomJSFiles(aWriter: TPas2JSMapper);
var
  i: Integer;
  Filename: String;
  FileResolver: TPas2jsFileResolver;
  aFile: TPas2jsCachedFile;
begin
  if InsertFilenames.Count=0 then exit;
  FileResolver:=CreateResolver;
  try
    for i:=0 to InsertFilenames.Count-1 do begin
      Filename:=FileResolver.FindCustomJSFileName(ResolveDots(InsertFilenames[i]));
      if Filename='' then
        raise EFileNotFoundError.Create('invalid custom JS file name "'+InsertFilenames[i]+'"');
      aFile:=LoadTextFile(Filename);
      if aFile.Source='' then continue;
      aWriter.WriteFile(aFile.Source,Filename);
    end
  finally
    FileResolver.Free;
  end;
end;

function TPas2jsFilesCache.IndexOfInsertFilename(const aFilename: string
  ): integer;
var
  i: Integer;
begin
  for i:=0 to FInsertFilenames.Count-1 do
    if CompareFilenames(aFilename,InsertFilenames[i])=0 then
      exit(i);
  Result:=-1;
end;

procedure TPas2jsFilesCache.AddInsertFilename(const aFilename: string);
begin
  if IndexOfInsertFilename(aFilename)<0 then
    InsertFilenames.Add(aFilename);
end;

procedure TPas2jsFilesCache.RemoveInsertFilename(const aFilename: string);
var
  i: Integer;
begin
  i:=IndexOfInsertFilename(aFilename);
  if i>=0 then
    InsertFilenames.Delete(i);
end;

end.