pas2js: callback for read directory

git-svn-id: trunk@37958 -

packages/pastojs/src/pas2jsfilecache.pp

@@ -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);

packages/pastojs/src/pas2jslibcompiler.pp

@@ -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.