david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
558 lines
18 KiB
ObjectPascal
558 lines
18 KiB
ObjectPascal
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.
|