unit uRORODLNotifier;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Delphi IDE Integration
{
{ compiler: Delphi 5 and up
{ platform: Win32
{
{ (c)opyright RemObjects Software. all rights reserved.
{
{ Using this code requires a valid license of the RemObjects SDK
{ which can be obtained at http://www.remobjects.com.
{----------------------------------------------------------------------------}

{$I RemObjects.inc}

interface

uses Classes, ToolsApi, uROIDETools;

type
  TROUnitType = (utIntf, utInvk, utImpl, utAsync, utRes);
  TROUnitTypes = set of TROUnitType;


  { TRORODLNotifier }
  TRORODLNotifier = class(TNotifierObject, IOTAIDENotifier, IOTAIDENotifier50)
  private
    fMessages : TIDEMessageList;

  protected
    procedure FileNotification(NotifyCode: TOTAFileNotification;
      const FileName: string; var Cancel: Boolean);

    procedure AfterCompile(Succeeded: Boolean); overload;
    procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); overload;
    procedure AfterCompile(Succeeded: Boolean; IsCodeInsight: Boolean); overload;


  public
    procedure BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean; var Cancel: Boolean); overload;
    procedure GenerateUnits(const aProject: IOTAProject; aTypes: TROUnitTypes);

    constructor Create;
    destructor Destroy; override;

  end;

function ProcessProject(const Project: IOTAProject; aMessageList : TIDEMessageList; aTypes: TROUnitTypes = [utIntf, utInvk, utImpl, utRes]) : boolean;

procedure Register;

implementation

uses
  Controls, SysUtils, Dialogs,
  uRODLGenTools, uRORes, uRODL, uROServer, uROClasses, uRODLToXML,
  uRODLConvertersUtils,
  {.$IFNDEF REMOBJECTS_CODEGEN2}
  uRODLToPascalInvk, uRODLToPascalIntf, uRODLToPascalImpl, uRODLToPascalAsync,
  {.$ENDIF}
  {$IFDEF MSWINDOWS}fCustomIDEMessagesForm, fROServerClassForm{$ENDIF}
  {$IFDEF LINUX}fCustomIDEMessagesFormKylix{$ENDIF}, uEWMenuManager, uEWOTAHelpers;


var notifieridx : integer = -1;

procedure Register;
begin
  notifieridx := Services.AddNotifier(TRORODLNotifier.Create);
end;

procedure RemoveNotifier;
begin
  if (notifieridx<>-1)
    then Services.RemoveNotifier(notifieridx);
end;

{ RODL file processing }

function ProcessProject(const Project: IOTAProject; aMessageList : TIDEMessageList; aTypes: TROUnitTypes = [utIntf, utInvk, utImpl, utRes]) : boolean;

    {$IFNDEF REMOBJECTS_CODEGEN2}
    function GenUnit(aConverterClass : TRODLConverterClass; aLibrary : TRODLLibrary; aShortRodlFilename: string; aService : TRODLService = nil; SkipIfPresent : boolean = FALSE) : boolean; overload;
    var
      conv : TRODLConverter;
      lAttributes: Integer;
      lServiceName: string;
      unitname : string;
      module : IOTAModule;
      clsnme, requnits : string;
      passaveaborted : boolean;
    begin
      result := FALSE;

      conv := NIL;
      try
        conv := aConverterClass.Create(NIL);

        if Assigned(aService) then lServiceName := aService.Info.Name else lServiceName := '';
        unitname := ExtractFilePath(Project.FileName)+conv.GetTargetFileName(aLibrary, lServiceName);

        // Checks the module is already in the project
        try
          module := FindModuleByUnitName(Project, unitname);
        except
          on E:EFOpenError do module := nil;
          else raise;
        end;

        // If it is and the file is not supposed to be regenerated just exists
        if (module<>NIL) and SkipIfPresent then begin
          aMessageList.Add(mWarning, aShortRodlFilename+': Skipping regeneration of unit '+ExtractFileName(unitname));
          result := TRUE;
          Exit;
        end
        {$IFDEF MSWINDOWS}
        else if (conv is TRODLToImpl) and (aService.Ancestor='') then begin
          if not SelectROServerClassType(lServiceName, clsnme, requnits) then Abort;
          TRODLToImpl(conv).ServerClassName := clsnme;
          TRODLToImpl(conv).RequiredUnits := requnits;
        end{$ENDIF};

        {$IFDEF MSWINDOWS}
        if FileExists(unitname) then begin
          lAttributes := FileGetAttr(unitname);
          if (lAttributes and faReadOnly) = faReadOnly then begin
            //case MessageDlg(Format('%s is readonly, overwrite anyway?',[ExtractFileName(unitname)]),
            case MessageDlg(Format('%s is readonly and cannot be regenerated.',[ExtractFileName(unitname)]),
                          mtConfirmation, [{mbYes, mbYesToAll} mbCancel, mbIgnore], 0) of
              mrCancel: Abort();
              mrIgnore: begin
                  result := true;
                  exit;
                end;
              mrYes: begin
                  FileSetAttr(unitname, lAttributes xor faReadOnly);
                  //ToDo: need to turn buffer non-readonly, too.
                  exit;
                end;
              mrYesToAll: //ToDo.
            end;
          end;
        end;
        {$ENDIF}

        // Converts the RODL file
        conv.Convert(aLibrary, lServiceName);

        if (module=NIL) then begin
          // If not present adds it double checking for file existance if SkipIfPresent. It's for implementation
          // units that might be there and have code already in but not be part of the DPR (for any weird reason)

          passaveaborted := FALSE;
          if SkipIfPresent and FileExists(unitname) then begin
            case MessageDlg(
              Format('Unit "%s" has been prepared but a file with the same name already exist in "%s".'#13+
                     'Do you want to overwrite file %s?',
                     [ExtractFileName(unitname), ExtractFilePath(unitname), ExtractFileName(unitname)]),
                     mtWarning, [mbYes, mbNo, mbCancel], 0) of

              mrCancel : Exit;
              mrNo : passaveaborted := TRUE;
              mrYes: { no-op};
            end
          end;

          if not passaveaborted then begin
            if conv is TRODLToImpl then with conv as TRODLToImpl do begin
              if WriteDataModule then
                WriteDFM(aLibrary, lServiceName, ChangeFileExt(unitname, '.dfm'));
            end;

            conv.Buffer.SaveToFile(unitname);
          end;

          {$IFDEF BDS}
          Project.AddFile(unitname, false);
          {$ELSE}
          Project.AddFile(unitname, (aConverterClass=TRODLToImpl) and TRODLToImpl(conv).WriteDataModule);
          {$ENDIF}

          if (aConverterClass <> TRODLToInvk)
            then ActionServices.OpenFile(unitname);

        end
        else begin
          // Otherwise updates the source

          WriteModuleSource(module, Trim(conv.Buffer.Text), '');
        end;

        if SkipIfPresent then
          aMessageList.Add(mInfo, Format(aShortRodlFilename+': Implementation unit for service %s generated',
                                         [lServiceName]));


        result := TRUE;
      finally
        conv.Free;
      end;
    end;
    {$ENDIF}

    function GenUnit(aType: TROCodeGenType; aLibrary : TRODLLibrary; aShortRodlFilename: string; aService : TRODLService = nil; SkipIfPresent : boolean = FALSE) : boolean; overload;
    var
      lAttributes: Integer;
      lServiceName: string;
      lLanguage: TROCodeGenLanguage;
      lUnitname: string;
      lModule : IOTAModule;
      lClassname, lRequiredUnits: string;
      lCodeStream, lHeaderStream: TStringStream;

    begin
      result := FALSE;

      lLanguage := CodeGenLanuageFromProjectPersonality(Project);

      if Assigned(aService) then lServiceName := aService.Info.Name else lServiceName := '';
      lUnitname := ExtractFilePath(Project.FileName)+GetTargetFileName(aLibrary, aService, aType, lLanguage);

      // Checks the module is already in the project
      try
        lModule := FindModuleByUnitName(Project, lUnitname);
      except
        on E:EFOpenError do lModule := nil;
        else raise;
      end;

      // If it is and the file is not supposed to be regenerated just exists
      if SkipIfPresent and assigned(lModule) then begin
        aMessageList.Add(mWarning, aShortRodlFilename+': Skipping regeneration of unit '+ExtractFileName(lUnitname));
        result := TRUE;
        Exit;
      end;
      if SkipIfPresent and FileExists(lUnitname) then begin
        case MessageDlg(Format('A unit named "%s" already exist, but is not part of the project.'#13+
                                'Do you want to overwrite the file?', [ExtractFileName(lUnitname)]),
                        mtWarning, [mbYes, mbNo, mbCancel], 0) of
          mrCancel: Abort;
          mrNo: begin
              result := true;
              Exit;
            end;
          mrYes: { no-op};
        end
      end;

      lRequiredUnits := '';
      lClassname := '';
      if (aType = cgtImpl) and (aService.Ancestor='') then begin
        {$IFDEF MSWINDOWS}
        if not SelectROServerClassType(lServiceName, lClassname, lRequiredUnits) then Abort;
        {$ELSE}
        lClassname := 'TRORemoteDataModule';
        {$ENDIF};
      end;

      {$IFDEF MSWINDOWS}
      if FileExists(lUnitname) then begin
        lAttributes := FileGetAttr(lUnitname);
        if (lAttributes and faReadOnly) = faReadOnly then begin
          //case MessageDlg(Format('%s is readonly, overwrite anyway?',[ExtractFileName(unitname)]),
          case MessageDlg(Format('%s is readonly and cannot be regenerated.',[ExtractFileName(lUnitname)]),
                        mtConfirmation, [{mbYes, mbYesToAll} mbCancel, mbIgnore], 0) of
            mrCancel: Abort();
            mrIgnore: begin
                result := true;
                exit;
              end;
            mrYes: begin
                FileSetAttr(lUnitname, lAttributes xor faReadOnly);
                //ToDo: need to turn buffer non-readonly, too.
                exit;
              end;
            mrYesToAll: //ToDo.
          end;
        end;
      end;
      {$ENDIF}

      // Converts the RODL file

      if (not assigned(lModule)) or (lLanguage = cglCppWin32) then begin // going via the Module doesn't work for .H files :(

        GenerateUnitToFile(aLibrary, aService, aType, lLanguage, lClassname);

        {$IFDEF BDS}
        Project.AddFile(lUnitname, true); // false
        if lLanguage = cglCppWin32 then
          Project.AddFileWithParent(ChangeFileExt(lUnitname,'.h'), true, lUnitname);
        {$ELSE}
        Project.AddFile(lUnitname, true);
        {$ENDIF}

        if (aType <> cgtInvk) then
          ActionServices.OpenFile(lUnitName);

      end
      else begin

        lCodeStream := TStringStream.Create('');
        lHeaderStream := TStringStream.Create(''); // C++ only
        GenerateUnitToStream(aLibrary, aService, aType, lLanguage, lCodeStream, lHeaderStream, lClassname);
        WriteModuleSource(lModule, Trim(lCodeStream.DataString), Trim(lHeaderStream.DataString));
      end;

      {if SkipIfPresent then
        aMessageList.Add(mInfo, Format(aShortRodlFilename+': Implementation unit for service %s generated',
                                       [lServiceName]));}


      result := TRUE;
    end;

    procedure ProcessRodl(aFilename: string; aNested: boolean);
    var
      lShortRodlFilename: string;
      lib : TRODLLibrary;
      i : integer;
    begin
      if (aFileName = '') then exit;
      if not FileExists(aFilename) then begin
        aMessageList.Add(mError,Format('RODL file %s does not exist.',[aFilename]));
        exit;
      end;

      lShortRodlFilename := ExtractFileName(aFilename);

      // Processes RODL
      lib := ReadRODLFromFile(TXMLToRODL, aFilename);
      try
        //aMessageList.Add(mInfo, rodlname+' has been loaded');

        {$IFNDEF REMOBJECTS_CODEGEN2}
        if CodeGenLanuageFromProjectPersonality(Project) = cglCppWin32 then begin
        {$ENDIF}

          if utIntf in aTypes then begin
            if not GenUnit(cgtIntf, lib, lShortRodlFilename) then begin
              result := FALSE;
              Exit;
            end
            else aMessageList.Add(mInfo, lShortRodlFilename+': Interface unit generated');
          end;

          if utAsync in aTypes then begin
            if not GenUnit(cgtAsync, lib, lShortRodlFilename) then begin
              result := FALSE;
              Exit;
            end
            else aMessageList.Add(mInfo, lShortRodlFilename+': Async Interface unit generated');
          end;

          if utInvk in aTypes then begin
            if not GenUnit(cgtInvk, lib, lShortRodlFilename) then begin
              result := FALSE;
              Exit;
            end
            else aMessageList.Add(mInfo, lShortRodlFilename+': Invoker unit generated');
          end;

          if utImpl in aTypes then begin
            for i := 0 to (lib.ServiceCount-1) do if (not lib.Services[i].IsFromUsedRodl) then begin

              if not GenUnit(cgtImpl, lib, lShortRodlFilename, lib.Services[i], true) then begin
                result := FALSE;
                Exit;
              end
            end;
          end;

        {$IFNDEF REMOBJECTS_CODEGEN2}
        end
        else begin

          // Generates the units
          if utIntf in aTypes then begin
            if not GenUnit(TRODLToIntf, lib, lShortRodlFilename) then begin
              result := FALSE;
              Exit;
            end
            else aMessageList.Add(mInfo, lShortRodlFilename+': Interface unit generated');
          end;

          if utAsync in aTypes then begin
            if not GenUnit(TRODLToPascalAsync, lib, lShortRodlFilename) then begin
              result := FALSE;
              Exit;
            end
            else aMessageList.Add(mInfo, lShortRodlFilename+': Async Interface unit generated');
          end;

          if utInvk in aTypes then begin
            if not GenUnit(TRODLToInvk, lib, lShortRodlFilename) then begin
              result := FALSE;
              Exit;
            end
            else aMessageList.Add(mInfo, lShortRodlFilename+': Invoker unit generated');
          end;

          if utImpl in aTypes then begin
            for i := 0 to (lib.ServiceCount-1) do if (not lib.Services[i].IsFromUsedRodl) then begin

              if not GenUnit(TRODLToImpl, lib, lShortRodlFilename, lib.Services[i], true) then begin
                result := FALSE;
                Exit;
              end
            end;
          end;

        end;
        {$ENDIF not REMOBJECTS_CODEGEN2}

        for i := 0 to lib.UseCount-1 do begin
          if (lib.Use[i].GenerateCode) then begin
            if FileExists(ExpandVariables(lib.Use[i].RodlFile)) then
              ProcessRodl(lib.Use[i].RodlFile, true)
            else
              ProcessRodl(lib.Use[i].AbsoluteRodlFile, true);
          end;
        end;

        if (utRes in aTypes) and (not aNested) then begin

          // flatten RODL if needed
          if lib.UseCount > 0 then begin
            aFilename := ExtractFilePath(aFilename)+'temp_'+NewStrippedGuidAsString()+'.rodl';

            with TRODLToXML.Create(lib,true) do try
              Buffer.SaveToFile(aFilename);
              aMessageList.Add(mInfo,Format(lShortRodlFilename+': Flattening RODL to %s',[ExtractFileName(aFilename)]));
            finally
              Free;
            end;
          end;

          // generate RES
          if GenerateRESFromRODL(aFilename, aMessageList) then begin
            aMessageList.Add(mInfo, lShortRodlFilename+': RODL resource generated.')
          end
          else begin
            aMessageList.Add(mError, lShortRodlFilename+': RODL resource could not be generated.');
            result := FALSE
          end;

          // delete temp file
          if lib.UseCount > 0 then begin
            DeleteFile(aFilename);
          end;

        end;

      finally
        FreeAndNil(lib);
      end;
    end;


var prjname,
    source,
    rodlname : string;
begin
  result := TRUE;

  // Only processes DPRs
  prjname := Project.FileName;
  {$IFDEF BDS}
  if (CompareText(ExtractFileExt(prjname), '.bdsproj')<>0) and (CompareText(ExtractFileExt(prjname), '.dproj')<>0) then Exit;
  {$ELSE}
  if (CompareText(ExtractFileExt(prjname), '.dpr')<>0) then Exit;
  {$ENDIF}

  // Extract useful data and exists if the file does not reference a RODL file
  source := ReadModuleSource(Project);
  rodlname := ExtractRODLFileName(source);

  if (rodlname='') then exit
  else if (ExtractFilePath(rodlname)='') then
    rodlname := ExtractFilePath(prjname)+rodlname; // If there's no path specified assumes the file is in the DPR folder

  ProcessRodl(rodlname, false);

end;

{ TRORODLNotifier }

procedure TRORODLNotifier.AfterCompile(Succeeded, IsCodeInsight: Boolean);
begin
end;

procedure TRORODLNotifier.AfterCompile(Succeeded: Boolean);
begin

end;

procedure TRORODLNotifier.BeforeCompile(const Project: IOTAProject;
  var Cancel: Boolean);
begin

end;

procedure TRORODLNotifier.BeforeCompile(const Project: IOTAProject;
  IsCodeInsight: Boolean; var Cancel: Boolean);
begin
  if IsCodeInsight then Exit;

  fMessages.ClearMessages();

  try
    Cancel := not ProcessProject(Project, fMessages);
  except
    on E:Exception do begin
      { mh: for some reason, this message doesn't get displayed. So let's add a message box too, for now. }
      fMessages.Add(mInfo, E.Message);
      Cancel := TRUE;
      raise;
    end;
  end;

  if Cancel then begin
    DisplayIDEMessageForm := TRUE;
  end;
  if (fMessages.Count>0)
    then fMessages.FlushMessages;
end;

procedure TRORODLNotifier.GenerateUnits(const aProject: IOTAProject; aTypes: TROUnitTypes);
begin
  ProcessProject(aProject, fMessages, aTypes);
end;

constructor TRORODLNotifier.Create;
begin
  fMessages := TIDEMessageList.Create(str_ProductName);
end;

destructor TRORODLNotifier.Destroy;
begin
  fMessages.Free;
  inherited;
end;

procedure TRORODLNotifier.FileNotification(
  NotifyCode: TOTAFileNotification; const FileName: string;
  var Cancel: Boolean);
begin

end;

initialization

finalization
  RemoveNotifier;

end.