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

pas2js: callback for read directory

Browse Source 
git-svn-id: trunk@37958 -
This commit is contained in:
Mattias Gaertner 2018-01-13 13:02:23 +00:00
parent 42ce6db215
commit 4af3029bba
2 changed files with 54 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
packages/pastojs/src/pas2jsfilecache.pp
View File

@ -57,6 +57,8 @@ type
FSorted: boolean;
function GetEntries(Index: integer): TPas2jsCachedDirectoryEntry;
procedure SetSorted(const AValue: boolean);
protected
procedure DoReadDir; virtual;
public
constructor Create(aPath: string; aPool: TPas2jsCachedDirectories);
destructor Destroy; override;
@ -89,6 +91,8 @@ 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
{ TPas2jsCachedDirectories }
TPas2jsCachedDirectories = class
@ -97,6 +101,7 @@ type
FDirectories: TAVLTree;// tree of TPas2jsCachedDirectory sorted by Directory
FWorkingDirectory: string;
private
FOnReadDirectory: TReadDirectoryEvent;
type
TFileInfo = record
Filename: string;
@ -126,6 +131,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;
end;
type
@ -463,6 +469,28 @@ begin
FEntries.Sort(@ComparePas2jsDirectoryEntries); // sort descending
end;
procedure TPas2jsCachedDirectory.DoReadDir;
var
Info: TUnicodeSearchRec;
begin
if Assigned(Pool.OnReadDirectory) then
if Pool.OnReadDirectory(Self) then exit;
// Note: do not add a 'if not DirectoryExists then exit'.
// This will not work on automounted directories. You must use FindFirst.
if FindFirst(UnicodeString(Path+AllFilesMask),faAnyFile,Info)=0 then begin
repeat
// check if special file
if (Info.Name='.') or (Info.Name='..') or (Info.Name='')
then
continue;
// add file
Add(String(Info.Name),Info.Time,Info.Attr,Info.Size);
until FindNext(Info)<>0;
end;
FindClose(Info);
end;
constructor TPas2jsCachedDirectory.Create(aPath: string;
aPool: TPas2jsCachedDirectories);
begin
@ -499,27 +527,11 @@ begin
end;
procedure TPas2jsCachedDirectory.Update;
var
Info: TUnicodeSearchRec;
begin
if not NeedsUpdate then exit;
FChangeStamp:=Pool.ChangeStamp;
Clear;
// Note: do not add a 'if not DirectoryExists then exit'.
// This will not work on automounted directories. You must use FindFirst.
if FindFirst(UnicodeString(Path+AllFilesMask),faAnyFile,Info)=0 then begin
repeat
// check if special file
if (Info.Name='.') or (Info.Name='..') or (Info.Name='')
then
continue;
// add file
Add(String(Info.Name),Info.Time,Info.Attr,Info.Size);
until FindNext(Info)<>0;
end;
FindClose(Info);
DoReadDir;
FChangeStamp:=Pool.ChangeStamp;
Sorted:=true;
{$IFDEF VerbosePas2JSDirCache}
writeln('TPas2jsCachedDirectories.Update "',Path,'" Count=',Count);

25
packages/pastojs/src/pas2jslibcompiler.pp
View File

@ -15,6 +15,8 @@ Const
DefaultReadBufferSize = 32*1024; // 32kb buffer
Type
PDirectoryCache = Pointer;
TLibLogCallBack = Procedure (Data : Pointer; Msg : PAnsiChar; MsgLen : Integer); stdcall;
TWriteJSCallBack = Procedure (Data : Pointer;
AFileName: PAnsiChar; AFileNameLen : Integer;
@ -22,6 +24,7 @@ Type
TReadPasCallBack = Procedure (Data : Pointer;
AFileName: PAnsiChar; AFileNameLen : Integer;
AFileData : PAnsiChar; Var AFileDataLen: Int32); stdcall;
TReadDirCallBack = Procedure (P : PDirectoryCache; ADirPath: PAnsiChar); stdcall;
{ TLibraryPas2JSCompiler }
@ -31,6 +34,7 @@ Type
FLastErrorClass: String;
FOnLibLogCallBack: TLibLogCallBack;
FOnLibLogData: Pointer;
FOnReadDir: TReadDirCallBack;
FOnReadPasData: Pointer;
FOnReadPasFile: TReadPasCallBack;
FOnWriteJSCallBack: TWriteJSCallBack;
@ -41,6 +45,7 @@ Type
Procedure GetLastError(AError : PAnsiChar; Var AErrorLength : Longint;
AErrorClass : PAnsiChar; Var AErrorClassLength : Longint);
Function ReadFile(aFilename: string; var aSource: string): boolean; virtual;
Function ReadDirectory(Dir: TPas2jsCachedDirectory): boolean; virtual;
Public
Constructor Create; override;
Procedure DoLibraryLog(Sender : TObject; Const Msg : String);
@ -54,13 +59,13 @@ Type
Property OnReadPasFile : TReadPasCallBack Read FOnReadPasFile Write FOnReadPasFile;
Property OnReadPasData : Pointer Read FOnReadPasData Write FOnReadPasData;
Property ReadBufferLen : Cardinal Read FReadBufferLen Write FReadBufferLen;
Property OnReadDir: TReadDirCallBack read FOnReadDir write FOnReadDir;
end;
Type
PPas2JSCompiler = Pointer;
PStubCreator = Pointer;
Procedure SetPas2JSWriteJSCallBack(P : PPas2JSCompiler; ACallBack : TWriteJSCallBack; CallBackData : Pointer); stdcall;
Procedure SetPas2JSCompilerLogCallBack(P : PPas2JSCompiler; ACallBack : TLibLogCallBack; CallBackData : Pointer); stdcall;
Procedure SetPas2JSReadPasCallBack(P : PPas2JSCompiler; ACallBack : TReadPasCallBack; CallBackData : Pointer; ABufferSize : Cardinal); stdcall;
@ -68,11 +73,21 @@ Function RunPas2JSCompiler(P : PPas2JSCompiler; ACompilerExe, AWorkingDir : PAns
Procedure FreePas2JSCompiler(P : PPas2JSCompiler); stdcall;
Function GetPas2JSCompiler : PPas2JSCompiler; stdcall;
Procedure GetPas2JSCompilerLastError(P : PPas2JSCompiler; AError : PAnsiChar; Var AErrorLength : Longint; AErrorClass : PAnsiChar; Var AErrorClassLength : Longint); stdcall;
Procedure AddDirectoryEntry(P: PDirectoryCache; AFilename: PAnsiChar;
AAge: TPas2jsFileAgeTime; AAttr: TPas2jsFileAttr; ASize: TPas2jsFileSize); stdcall;
implementation
{ TLibraryPas2JSCompiler }
function TLibraryPas2JSCompiler.ReadDirectory(Dir: TPas2jsCachedDirectory
): boolean;
begin
Result:=false; // return false to call the default TPas2jsCachedDirectory.DoReadDir
if Assigned(OnReadDir) then
OnReadDir(Dir,PAnsiChar(Dir.Path));
end;
function TLibraryPas2JSCompiler.DoWriteJSFile(const DestFilename: String; aWriter: TPas2JSMapper): Boolean;
Var
@ -148,6 +163,7 @@ begin
Log.OnLog:=@DoLibraryLog;
FileCache.OnReadFile:=@ReadFile;
FReadBufferLen:=DefaultReadBufferSize;
FileCache.DirectoryCache.OnReadDirectory:=@ReadDirectory;
end;
procedure TLibraryPas2JSCompiler.DoLibraryLog(Sender: TObject; const Msg: String);
@ -254,5 +270,12 @@ begin
TLibraryPas2JSCompiler(P).GetLastError(AError,AErrorLength,AErrorClass,AErrorClassLength);
end;
procedure AddDirectoryEntry(P: PDirectoryCache; AFilename: PAnsiChar;
AAge: TPas2jsFileAgeTime; AAttr: TPas2jsFileAttr; ASize: TPas2jsFileSize);
stdcall;
begin
TPas2jsCachedDirectory(P).Add(AFilename,AAge,AAttr,ASize);
end;
end.