* Merging revisions r46442 from trunk:

------------------------------------------------------------------------
    r46442 | michael | 2020-08-15 09:26:44 +0200 (Sat, 15 Aug 2020) | 1 line
    
    * unit alias possibility
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@46623 -

utils/pas2js/libstub.pp

@@ -147,6 +147,12 @@ begin
     Move(C[1],AErrorClass^,L);
 end;
 
+Procedure SetStubCreatorUnitAliasCallBack(P : PStubCreator; ACallBack : TUnitAliasCallBack; CallBackData : Pointer); stdcall;
+begin
+  TStubCreator(P).OnUnitAlias:=ACallBack;
+  TStubCreator(P).OnUnitAliasData:=CallBackData;
+end;
+
 exports
   // Stub creator
   GetStubCreator,
@@ -160,7 +166,8 @@ exports
   GetStubCreatorLastError,
   AddStubCreatorDefine,
   AddStubCreatorForwardClass,
-  ExecuteStubCreator;
+  ExecuteStubCreator,
+  SetStubCreatorUnitAliasCallBack;
 
 end.
 

utils/pas2js/stubcreator.pp

@@ -36,6 +36,8 @@ type
 
   TWriteCallBack = Procedure (Data : Pointer; AFileData : PAnsiChar; AFileDataLen: Int32); stdcall;
   TWriteEvent = Procedure(AFileData : String) of object;
+  TUnitAliasCallBack = Function (Data: Pointer; AUnitName: PAnsiChar;
+    var AUnitNameMaxLen: Int32): boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 
   { TStubCreator }
 
@@ -45,6 +47,7 @@ type
     FHeaderStream: TStream;
     FIncludePaths: TStrings;
     FInputFile: String;
+    FOnUnitAliasData: Pointer;
     FOnWrite: TWriteEvent;
     FOnWriteCallBack: TWriteCallBack;
     FOutputFile: String;
@@ -60,10 +63,12 @@ type
     FCallBackData : Pointer;
     FLastErrorClass : String;
     FLastError : String;
+    FOnUnitAlias : TUnitAliasCallBack;
     procedure SetDefines(AValue: TStrings);
     procedure SetIncludePaths(AValue: TStrings);
     procedure SetOnWrite(AValue: TWriteEvent);
     procedure SetWriteCallback(AValue: TWriteCallBack);
+    function CheckUnitAlias(const AUnitName: String): String;
   Protected
     procedure DoExecute;virtual;
     Procedure DoWriteEvent; virtual;
@@ -81,9 +86,10 @@ type
     // OutputStream can be used combined with write callbacks.
     Property OutputStream : TStream Read FOutputStream Write FOutputStream;
     Property HeaderStream : TStream Read FHeaderStream Write FHeaderStream;
+    Property OnUnitAlias: TUnitAliasCallBack read FOnUnitAlias Write FOnUnitAlias;
+    Property OnUnitAliasData : Pointer Read FOnUnitAliasData Write FOnUnitAliasData;
     Property OnWriteCallBack : TWriteCallBack Read FOnWriteCallBack Write SetWriteCallback;
     Property CallbackData : Pointer Read FCallBackData Write FCallBackData;
-
   Published
     Property Defines : TStrings Read FDefines Write SetDefines;
     Property ConfigFileName : String Read FConfigFile Write FConfigFile;
@@ -97,6 +103,8 @@ type
 
 Implementation
 
+uses Math;
+
 ResourceString
   SErrNoDestGiven = 'No destination file specified.';
   SErrNoSourceParsed = 'Parsing produced no file.';
@@ -131,6 +139,23 @@ begin
     FWriteStream:=TStringStream.Create('');
 end;
 
+function TStubCreator.CheckUnitAlias(const AUnitName: String): String;
+const
+  MAX_UNIT_NAME_LENGTH = 255;
+
+var
+   UnitMaxLenthName: Integer;
+
+begin
+  Result := AUnitName;
+  UnitMaxLenthName := Max(MAX_UNIT_NAME_LENGTH, Result.Length);
+
+  SetLength(Result, UnitMaxLenthName);
+
+  if FOnUnitAlias(OnUnitAliasData, @Result[1], UnitMaxLenthName) then
+    Result := LeftStr(PChar(Result), UnitMaxLenthName);
+end;
+
 procedure TStubCreator.DoWriteEvent;
 
 Var
@@ -279,7 +304,7 @@ end;
 
 
 
-Function TStubCreator.GetModule : TPasModule;
+function TStubCreator.GetModule: TPasModule;
 
 Var
   SE : TSimpleEngine;
@@ -327,7 +352,8 @@ begin
   end;
 end;
 
-function TStubCreator.MaybeGetFileStream(AStream: TStream; const AFileName: String; AfileMode : Word) : TStream;
+function TStubCreator.MaybeGetFileStream(AStream: TStream;
+  const AFileName: String; aFileMode: Word): TStream;
 begin
   If Assigned(AStream) then
     Result:=AStream
@@ -359,7 +385,7 @@ begin
 end;
 
 
-procedure TStubCreator.WriteModule(M : TPAsModule);
+procedure TStubCreator.WriteModule(M: TPasModule);
 
 Var
   F,H : TStream;
@@ -386,6 +412,10 @@ begin
      W:=TPasWriter.Create(F);
      W.Options:=FOptions;
      U:=FExtraUnits;
+
+     if Assigned(FOnUnitAlias) then
+       W.OnUnitAlias:=@CheckUnitAlias;
+
      if Pos(LowerCase(DTypesUnit),LowerCase(U)) = 0 then
        begin
        if (U<>'') then