lazarus/components/pas2js/regpas2jsvscode.pas

unit regpas2jsvscode;

{$mode objfpc}{$H+}
interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
  ProjectIntf, LazIDEIntf, LazFileUtils;

type

  { TVSCodeExtensionProjectDescriptor }

  TVSCodeExtensionProjectDescriptor = class(TProjectDescriptor)
  Private
    FPackagePublisher : string;
    FPackageClassName : String;
    FPackageDir,
    FPackageLicense,
    FPackageName,
    FPackageDescription : String;
    FKeyWords,
    FCommands : TStrings;
    FContributesCommands : TStrings;
    FFiles : TStrings;
    procedure AddFileToProject(const aFileName: string);
    procedure AddGlueFile({%H-}aProject: TLazProject);
    procedure AddLaunchFile({%H-}aProject: TLazProject);
    procedure AddPackageJSONFile({%H-}aProject: TLazProject);
    procedure AddProjectFile(AProject: TLazProject);
    procedure AddTasksFile({%H-}aProject: TLazProject);
    procedure CreateProjectDirs;
    procedure CreateProjectSource(Src: TStrings);
    procedure DoDefaultReplaceMents(Src: TStrings);
    procedure InitVars;
    procedure InsertHandlerDefinitions(Src: TStrings; aIndex, aIndent: Integer);
    procedure InsertHandlerImplementations(Src: TStrings; aIndex: Integer);
    procedure InsertHandlerRegistrations(Src: TStrings; aIndex,aIndent: Integer);
    function LoadDefault(Src: TStrings; aFileName: string): boolean;
    Function ShowOptionsDialog : TModalResult;
  public
    constructor Create(); override;
    destructor destroy; override;
    Function DoInitDescriptor : TModalResult; override;
    function GetLocalizedName: string; override;
    function GetLocalizedDescription: string; override;
    function InitProject(AProject: TLazProject) : TModalResult; override;
    function CreateStartFiles({%H-}AProject: TLazProject) : TModalResult; override;
  published
    { Published declarations }
  end;

procedure Register;

implementation

uses
  fpjson,frmpas2jsvscodeextensionsettings,  CompOptsIntf, pjscontroller,
  MenuIntf, pjsprojectoptions, pjsdsgnoptions, strpas2jsdesign;

Var
  VSCodeProjDesc:TVSCodeExtensionProjectDescriptor;

procedure Register;

begin
  VSCodeProjDesc:=TVSCodeExtensionProjectDescriptor.Create();
  RegisterProjectDescriptor(VSCodeProjDesc);
end;


{ TVSCodeExtensionProjectDescriptor }

function TVSCodeExtensionProjectDescriptor.ShowOptionsDialog : TModalResult;

begin
  With TVSCodeExtensionSettingsForm.Create(Application) do
    try
      PkgDescription:=FPackageDescription;
      PkgName:=FPackageName;
      PkgPublisher:=FPackagePublisher;
      PkgClassName:=FPackageClassName;
      PkgCommands:=FCommands;
      PkgContributesCommands:=FContributesCommands;
      PkgLicense:=FPackageLicense;
      PkgKeyWords:=FkeyWords.CommaText;
      PkgDir:=FPackageDir;
      Result:=ShowModal;
      if (Result=mrOK) then
        begin
        FPackageDescription:=PkgDescription;
        FPackageName:=PkgName;
        FPackageClassName:=PkgClassName;
        FPackagePublisher:=PkgPublisher;
        FCommands.Assign(PkgCommands);
        FContributesCommands.Assign(PkgContributesCommands);
        FPackageLicense:=PkgLicense;
        FKeyWords.CommaText:=PkgKeyWords;
        FPackageDir:=IncludeTrailingPathDelimiter(PkgDir);
        end;
    finally
      Free;
    end;
end;


constructor TVSCodeExtensionProjectDescriptor.Create;
begin
  inherited Create;
  FKeyWords:=TStringList.Create;
  FCommands:=TStringList.Create;
  FContributesCommands:=TStringList.Create;
  FFiles:=TStringList.Create;
  InitVars;
  Name:='pas2jsvscodeextension';
end;

destructor TVSCodeExtensionProjectDescriptor.destroy;
begin
  FreeAndNil(FFiles);
  FreeAndNil(FCommands);
  FreeAndNil(FKeywords);
  FreeAndNil(FContributesCommands);
  Inherited;
end;


function TVSCodeExtensionProjectDescriptor.GetLocalizedName: string;
begin
  Result:=pjsdNewVSCodeExtension;
end;

function TVSCodeExtensionProjectDescriptor.GetLocalizedDescription: string;
begin
  Result:=pjsdNewVSCodeExtensionDescr;
end;

Procedure TVSCodeExtensionProjectDescriptor.InitVars;

begin
  FPackageDir:=GetUserDir+'myvscodeextension';
  FPackageClassName:='TMyVSCodeExtensionApplication';

  FPackageName:='myvscodeextension';
  FPackageDescription:='My VS Code Extension';
  FPackagePublisher:='me';
  FPackageLicense:='MIT';
  FKeyWords.Clear;
  FCommands.Clear;
  FContributesCommands.Clear;
end;

function TVSCodeExtensionProjectDescriptor.DoInitDescriptor: TModalResult;

begin
  initVars;
  Result:=ShowOptionsDialog;

end;

Procedure TVSCodeExtensionProjectDescriptor.CreateProjectDirs;

Const
  DirCount = 3;
  DefDirs : Array [1..DirCount] of string =
      ('','.vscode','js');

Var
  S : String;

begin
  FPackageDir:=IncludeLeadingPathDelimiter(FPackageDir);
  For S in DefDirs do
    If not ForceDirectories(FPackageDir+S) then
      ShowMessage('Failed to create directory '+FPackageDir+S);
end;

{$I vscodedefaults.inc}

Procedure TVSCodeExtensionProjectDescriptor.InsertHandlerDefinitions(Src : TStrings; aIndex,aIndent : Integer);

Var
  I,Cnt : Integer;
  Prefix,N,V : String;

  procedure AddLn(aLine : String);

  begin
    Src.Insert(aIndex+Cnt,aLine);
    inc(cnt);
  end;


begin
  cnt:=0;
  Src.Delete(aIndex);
  Prefix:=StringOfChar(' ',aIndent-2); // approximate
  For I:=0 to FCommands.Count-1 do
    begin
    FCommands.GetNameValue(I,N,V);
    AddLn(Prefix+'function '+V+'(args : TJSValueDynArray) : JSValue;');
    end;
end;

Procedure TVSCodeExtensionProjectDescriptor.InsertHandlerImplementations(Src : TStrings; aIndex : Integer);

Var
  cnt : Integer;

  procedure AddLn(aLine : String);

  begin
    Src.Insert(aIndex+Cnt,aLine);
    inc(cnt);
  end;
Var
  I : Integer;
  N,V : String;

begin
  cnt:=0;
  Src.Delete(aIndex);
  For I:=0 to FCommands.Count-1 do
    begin
    AddLn('');
    FCommands.GetNameValue(I,N,V);
    AddLn('function '+FPackageClassName+'.'+V+'(args : TJSValueDynArray) : JSValue;');
    AddLn('');
    AddLn('begin');
    AddLn('  Result:=null;');
    AddLn('end;');
    AddLn('');
    end;
end;

Procedure TVSCodeExtensionProjectDescriptor.InsertHandlerRegistrations(Src : TStrings; aIndex,aIndent : Integer);

Var
  cnt : Integer;

  procedure AddLn(aLine : String);

  begin
    Src.Insert(aIndex+Cnt,Space(aIndent)+aLine);
    inc(cnt);
  end;
Var
  I : Integer;
  N,V : String;

begin
  Src.Delete(aIndex);
  if FCommands.Count=0 then exit;
  For I:=0 to FCommands.Count-1 do
    begin
    FCommands.GetNameValue(I,N,V);
    AddLn('disp:=VSCode.commands.registerCommand('''+N+''', @'+V+');');
    AddLn('TJSArray(ExtensionContext.subscriptions).push(disp);');
    end;
end;

Procedure TVSCodeExtensionProjectDescriptor.DoDefaultReplacements(Src : TStrings);

Var
  I,P : Integer;

begin
  For I:=Src.Count-1 downto 0 do
    begin
    Src[i]:=StringReplace(Src[I],'%PACKAGENAME%',FPackageName,[rfReplaceALl]);
    Src[i]:=StringReplace(Src[I],'%PACKAGEPROJECTNAME%',StripNonIdentifierChars(FPackageName),[rfReplaceALl]);
    Src[i]:=StringReplace(Src[I],'%CLASSNAME%',FPackageClassName,[rfReplaceALl]);
    P:=pos('%PACKAGEHANDLERINTFS%',Src[i]);
    if P>0 then
      InsertHandlerDefinitions(Src,I,P);
    P:=pos('%PACKAGEHANDLERIMPLS%',Src[i]);
    if P>0 then
      InsertHandlerImplementations(Src,I);
    P:=pos('%PACKAGEHANDLERREGS%',Src[i]);
    if P>0 then
      InsertHandlerRegistrations(Src,I,P);
    end;
end;

function TVSCodeExtensionProjectDescriptor.LoadDefault(Src : TStrings; aFileName : string) : boolean;

Var
  FN : String;

begin
  Result:=(PJSOptions.AtomTemplateDir<>'');
  if Result then
    begin
    FN:=IncludeTrailingPathDelimiter(PJSOptions.AtomTemplateDir)+aFileName;
    Result:=FileExists(FN);
    if Result then
      Src.LoadFromFile(FN);
    end;
end;


Procedure TVSCodeExtensionProjectDescriptor.AddGlueFile(aProject : TLazProject);

Var
  Src : TStrings;
  FN : String;

begin
  FN:=FPackageDir+'js'+PathDelim+'packageglue.js';
  Src:=TStringList.Create;
  try
    if not LoadDefault(Src,'glue.js') then
      GetDefaultGlueFile(Src);
    DoDefaultReplaceMents(Src);
    Src.SaveToFile(FN);
  finally
    Src.Free;
  end;
  AddFileToProject(FN);
end;

Procedure TVSCodeExtensionProjectDescriptor.AddTasksFile(aProject : TLazProject);

Var
  Src : TStrings;
  FN : String;

begin
  FN:=FPackageDir+'.vscode'+PathDelim+'tasks.json';
  Src:=TStringList.Create;
  try
    if not LoadDefault(Src,'tasks.json') then
      GetDefaultTasksFile(Src);
    DoDefaultReplaceMents(Src);
    Src.SaveToFile(FN);
  finally
    Src.Free;
  end;
  AddFileToProject(FN);
end;

Procedure TVSCodeExtensionProjectDescriptor.AddLaunchFile(aProject : TLazProject);

Var
  Src : TStrings;
  FN : String;

begin
  FN:=FPackageDir+'.vscode'+PathDelim+'launch.json';
  Src:=TStringList.Create;
  try
    if not LoadDefault(Src,'launch.json') then
      GetDefaultLaunchFile(Src);
    DoDefaultReplaceMents(Src);
    Src.SaveToFile(FN);
  finally
    Src.Free;
  end;
  AddFileToProject(FN);
end;



Procedure TVSCodeExtensionProjectDescriptor.AddPackageJSONFile(aProject : TLazProject);

Var
  b,aJSON,Contribs,Cmd : TJSONObject;
  cmds, keys : TJSONArray;
  S,N,V : String;
  I : Integer;
  aStream : TStringStream;

begin
  aJSON:=TJSONObject.Create([
   'name',FPackagename,
   'main','js/packageglue.js',
   'version','0.0.1',
   'description',FPackageDescription,
   'license',FPackageLicense
  ]);
  try
    Keys:=TJSONArray.Create;
    aJSON.add('keywords',keys);
    For S in FKeyWords do
      Keys.Add(S);
    Contribs:=TJSONObject.Create;
    aJSON.Add('contributes',Contribs);
    cmds:=TJSONArray.Create;
    Contribs.Add('commands',cmds);
    For I:=0 to FContributesCommands.Count-1 do
      begin
      FContributesCommands.GetNameValue(I,N,V);
      cmd:=TJSONObject.Create(['command',N,'title',v]);
      cmds.Add(cmd);
      end;
    cmds:=TJSONArray.Create;
    aJSON.Add('activationEvents',cmds);
    for I:=0 to FCommands.Count-1 do
      begin
      FContributesCommands.GetNameValue(I,N,V);
      cmds.Add('onCommand:'+N);
      end;
    b:=TJSONObject.Create(['vscode','^1.32.0']);
    aJSON.Add('engines',b);
    b:=TJSONObject.Create(['@types/vscode', '^1.32.0']);
    aJSON.Add('devDependencies',b);
    aStream:=TStringStream.Create(aJSON.FormatJSON);
    aStream.SaveToFile(FPackageDir+'package.json');
  finally
    aJSON.Free;
    aStream.Free;
  end;
end;

procedure TVSCodeExtensionProjectDescriptor.CreateProjectSource(Src : TStrings);

begin
  if not LoadDefault(Src,'project.lpr') then
    GetDefaultProjectFile(Src);
  DoDefaultReplaceMents(Src);

end;

procedure TVSCodeExtensionProjectDescriptor.AddProjectFile(AProject: TLazProject);

Var
  aFile : TLazProjectFile;
  FN : String;
  Src : TStrings;

begin
  FN:=FPackageDir+StripNonIdentifierChars(FPackageName)+'.lpr';
  aFile:=aProject.CreateProjectFile(FN);
  AFile.IsPartOfProject:=true;
  AProject.AddFile(AFile,False);
  AProject.MainFileID:=0;
  Src:=TStringList.Create;
  try
    CreateProjectSource(Src);
    Src.SaveToFile(FN);
    AProject.MainFile.SetSourceText(src.Text,true);
  Finally
    Src.Free;
  end;
end;

function TVSCodeExtensionProjectDescriptor.InitProject(AProject: TLazProject) : TModalResult;

Var
  CompOpts : TLazCompilerOptions;
begin
  AProject.Title:=FPackageName;
  AProject.ProjectInfoFile:=FPackageDir+StripNonIdentifierChars(FPackageName)+'.lpi';
  AProject.CustomData.Values[PJSProject]:='1';
  CreateProjectDirs;
  CompOpts:=AProject.LazCompilerOptions;
  SetDefaultNodeJSCompileOptions(CompOpts);
  CompOpts.TargetFilename:='lib/'+StripNonIdentifierChars(FPackageName)+'.js';
  CompOpts.CustomOptions:='-Jivscodeimports.js -Jirtl.js -Jc '+CompOpts.CustomOptions+' -Javscodeexports.js';
  SetDefaultNodeRunParams(AProject.RunParameters.GetOrCreate('Default'));
  AddProjectFile(aProject);
  Result:=mrOK;
end;

Procedure TVSCodeExtensionProjectDescriptor.AddFileToProject(Const aFileName : string);

begin
  FFiles.Add(aFileName);
end;



Function TVSCodeExtensionProjectDescriptor.CreateStartFiles(AProject: TLazProject) : TModalresult;

var
  aFileName : String;

begin
  FFiles.Clear;
  AddGlueFile(aProject);
  AddTasksFile(aProject);
  AddLaunchFile(aProject);
  AddPackageJSONFile(aProject);
  For aFileName in FFiles do
    LazarusIDE.DoOpenEditorFile(aFileName, -1, -1, [ofProjectLoading,ofQuiet,ofAddToProject]);
  Result:=mrOK;
end;


end.