freepascal.compiler/packages/fcl-js/examples/cgutils.pp

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 2022 by the Free Pascal development team
    Original author: Michael van Canneyt

    Some helper routines for the CGI code generator app

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

unit cgutils;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, pascodegen, tstopas;

Type
   TSettings = record
     basedir : string;
     cachefile : string;
   end;

   { TLoggingConverter }

   TLoggingConverter = Class(TTypescriptToPas)
   private
     FLogs: TStrings;
     procedure DoMyLog(Sender: TObject; LogType: TCodegenLogType; const Msg: String);
   Public
     Constructor Create(Aowner: TComponent); override;
     Property Logs : TStrings Read FLogs Write Flogs;
   end;

Procedure GetDeclarationFileNames(const BaseDir,aDir : String; aList: TStrings);
Procedure ConvertFile(Const BaseDir,aFileName,aUnitName : String; aOptions : TConversionOptions; aPascal,aLog : TStrings);
Function GetOutputUnitName(Const aFileName,aUnitName : String) : string;
Function GetInputFileName(Const BaseDir,aFileName : String) : string;
Function GetSettings : TSettings;

implementation

uses inifiles;

Function GetSettings : TSettings;

begin
  Result.BaseDir:=ExtractFilePath(ParamStr(0));
  Result.CacheFile:=GetTempDir(True)+'definitelytypedcache.lst';
  With TIniFile.Create(GetAppConfigFile(True)) do
    try
      Result.BaseDir:=ReadString('Settings','BaseDir',Result.BaseDir);
      Result.cachefile:=ReadString('Settings','CacheDir',Result.CacheFile);
    finally
      Free;
    end;
end;

Procedure GetDeclarationFileNames(Const BaseDir,aDir : String; aList: TStrings);

Var
  Info : TSearchRec;
  D,FN : string;

begin
  D:=IncludeTrailingPathDelimiter(aDir);
  if FindFirst(D+'*.d.ts',0,Info)=0 then
    try
      Repeat
      FN:=Info.Name;
      if (FN<>'.') and (FN<>'..') then
        Alist.Add(ExtractRelativePath(BaseDir,D+FN));
      until FindNext(Info)<>0;
    finally
      FindClose(Info);
    end;
   if FindFirst(D+AllFilesMask,faDirectory,Info)=0 then
      try
        Repeat
          if (Info.Attr and faDirectory)<>0 then
            begin
            FN:=Info.Name;
            if (FN<>'.') and (FN<>'..') then
              GetDeclarationFileNames(BaseDir,D+FN,aList);
            end;
        until FindNext(Info)<>0;
      finally
        FindClose(Info);
      end;
end;

Function GetInputFileName(Const BaseDir,aFileName : String) : string;

Var
  BD,FN : String;

begin
  BD:=IncludeTrailingPathDelimiter(BaseDir);
  FN:=BD+aFileName;
  if Not FileExists(FN) then
    if Not DirectoryExists(BD+aFileName) then
      FN:=''
    else
      begin
      FN:=IncludeTrailingPathDelimiter(BD+aFileName)+'index.d.ts';
      if not FileExists(FN) then
        Fn:='';
      end;
  if FN='' then
    Raise ETSToPas.Create('No such file: '+aFileName);
  Result:=FN;
end;

Function GetOutputUnitName(Const aFileName,aUnitName : String) : string;

Var
  UN : String;
begin
  UN:=aUnitName;
  if aUnitName='' then
    begin
    UN:=ChangeFileExt(ChangeFileExt(ExtractFileName(aFilename),''),'');
    if UN='index' then
      UN:=ExtractFileName(ExcludeTrailingPathDelimiter(ExtractFilePath(aFileName)));
    end;
  Result:=UN;
end;

procedure AddWebAliases(S: Tstrings);

begin
  With S do
    begin
    {$i web.inc}
    end;
end;

procedure AddJSAliases(S: Tstrings);

begin
  With S do
    begin
    Add('Object=TJSObject');
    Add('Function=TJSFunction');
    Add('RegExp=TJSRegexp');
    Add('Promise=TJSPromise');
    Add('Date=TJSDate');
    Add('Array=TJSArray');
    Add('Iterator=TJSIterator');
    Add('IteratorResult=TJSIteratorResult');
    Add('AsyncIterator=TJSAsyncIterator');
    Add('ArrayBuffer=TJSArrayBuffer');
    Add('Set=TJSSet');
    Add('Map=TJSMap');
    Add('BufferSource=TJSBufferSource');
    Add('DataView=TJSDataView');
    Add('Int8Array=TJSInt8Array');
    Add('Int8ClampedArray=TJSInt8ClampedArray');
    Add('Int16Array=TJSInt16Array');
    Add('Int32Array=TJSInt32Array');
    Add('Uint8Array=TJSUInt8Array');
    Add('Uint8ClampedArray=TJSUInt8ClampedArray');
    Add('Uint16Array=TJSUInt16Array');
    Add('Uint32Array=TJSUInt32Array');
    Add('Float32Array=TJSFloat32Array');
    Add('Float64Array=TJSFloat64Array');
    Add('JSON=TJSJSON');
    Add('TextDecoder=TJSTextDecoder');
    Add('TextEncoder=TJSTextEncoder');
    Add('SyntaxError=TJSSyntaxError');
    Add('Error=TJSError');
    end;
end;

Procedure ConvertFile(Const BaseDir,aFileName,aUnitName : String; aOptions : TConversionOptions; aPascal,aLog : TStrings);

Var
  L : TLoggingConverter;
  UN,Fn : String;

begin
  FN:=GetInputFileName(BaseDir,aFileName);
  UN:=GetOutputUnitName(FN,aUnitName);
  L:=TLoggingConverter.Create(Nil);
  try
    L.Options:=aOptions;
    L.InputFileName:=FN;
    L.OutputUnitName:=UN;
    L.Logs:=aLog;
    AddJSAliases(L.TypeAliases);
    AddWebAliases(L.TypeAliases);
    L.Execute;
    aPascal.Assign(L.Source);
  finally
    L.Free;
  end;
end;

{ TLoggingConverter }

procedure TLoggingConverter.DoMyLog(Sender: TObject; LogType: TCodegenLogType; const Msg: String);

Var
  S : String;

begin
  Str(LogType,S);
  If Assigned(Flogs) then
    Flogs.Add('['+S+']: '+Msg);
end;

constructor TLoggingConverter.Create(Aowner: TComponent);
begin
  inherited Create(Aowner);
  OnLog:=@DoMyLog;
end;

end.