Componentes.Terceros.RemObj.../official/5.0.35.741/RemObjects SDK for Delphi/Source/IDE/uRORODLNotifier.pas
2009-02-27 15:16:56 +00:00

614 lines
20 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. }
{----------------------------------------------------------------------------}
{$IFNDEF MSWINDOWS}
{$I ../RemObjects.inc}
{$ELSE}
{$I ..\RemObjects.inc}
{$ENDIF}
interface
uses
{$IFDEF FPC}
LazIDEIntf, ProjectIntf, uROIDETools_laz,
{$ELSE}
ToolsApi, uROIDETools,
{$ENDIF}
Classes;
type
TROUnitType = (utIntf, utInvk, utImpl, utAsync, utRes);
TROUnitTypes = set of TROUnitType;
{ TRORODLNotifier }
{$IFDEF FPC}
IOTAProject = TLazProject;
IOTAModule = TLazProjectFile;
TRORODLNotifier = class
{$ELSE}
TRORODLNotifier = class(TNotifierObject, IOTAIDENotifier, IOTAIDENotifier50)
{$ENDIF}
private
fMessages : TIDEMessageList;
protected
{$IFNDEF FPC}
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;
{$ENDIF}
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
{$IFDEF MSWINDOWS}
{$WARN SYMBOL_PLATFORM OFF}
{$ENDIF}
uses
Controls, SysUtils, Dialogs,
uRODLGenTools, uRORes, uROServer, uROClasses,uRODLToXML, uRODL,
uRODLConvertersUtils,
{.$IFNDEF REMOBJECTS_CODEGEN2}
uRODLToPascalInvk, uRODLToPascalIntf, uRODLToPascalImpl, uRODLToPascalAsync,
{.$ENDIF}
{$IFDEF FPC}
uEWMenuManager_laz, uEWOTAHelpers_laz,
{$ELSE}
uEWMenuManager, uEWOTAHelpers,
{$ENDIF}
fCustomIDEMessagesForm, fROServerClassForm;
{$IFNDEF FPC}
var
notifieridx : integer = -1;
{$ENDIF}
procedure Register;
begin
{$IFNDEF FPC}
notifieridx := Services.AddNotifier(TRORODLNotifier.Create);
{$ENDIF}
end;
procedure RemoveNotifier;
begin
{$IFNDEF FPC}
if (notifieridx<>-1)
then Services.RemoveNotifier(notifieridx);
{$ENDIF FPC}
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;
{$IFDEF FPC}
lunit : TLazProjectFile;
{$ENDIF}
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 := '';
{$IFDEF FPC}
unitname := ExtractFilePath(Project.MainFile.Filename)+conv.GetTargetFileName(aLibrary, lServiceName);
{$ELSE}
unitname := ExtractFilePath(Project.FileName)+conv.GetTargetFileName(aLibrary, lServiceName);
{$ENDIF}
// 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
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;
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;
// 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
if TRODLToImpl(conv).WriteDataModule then
TRODLToImpl(conv).WriteDFM(aLibrary, lServiceName, ChangeFileExt(unitname, '.dfm'));
conv.Buffer.SaveToFile(unitname);
end;
{$IFDEF FPC}
lunit:= Project.CreateProjectFile(unitname);
Project.AddFile(lUnit, False);
if (aConverterClass=TRODLToImpl) and TRODLToImpl(conv).WriteDataModule then
lUnit.IsPartOfProject := True;
{$ELSE}
Project.AddFile(unitname, (aConverterClass=TRODLToImpl) and TRODLToImpl(conv).WriteDataModule);
{$ENDIF}
if (aConverterClass <> TRODLToInvk) then begin
{$IFDEF FPC}
LazarusIDE.DoOpenEditorFile(unitname,-1,[ofOnlyIfExists]);
{$ELSE}
ActionServices.OpenFile(unitname);
{$ENDIF}
end;
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;
{$IFDEF FPC}
lunit : TLazProjectFile;
{$ENDIF}
lClassname, lRequiredUnits: string;
lCodeStream, lHeaderStream: TStringStream;
begin
result := FALSE;
lLanguage := CodeGenLanuageFromProjectPersonality(Project);
if Assigned(aService) then lServiceName := aService.Info.Name else lServiceName := '';
{$IFDEF FPC}
lUnitname := ExtractFilePath(Project.MainFile.FileName)+GetTargetFileName(aLibrary, aService, aType, lLanguage);
{$ELSE}
lUnitname := ExtractFilePath(Project.FileName)+GetTargetFileName(aLibrary, aService, aType, lLanguage);
{$ENDIF}
// 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
if not SelectROServerClassType(lServiceName, lClassname, lRequiredUnits) then Abort;
end;
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;
// Converts the RODL file
if (not assigned(lModule)) or (lLanguage = cglCppBuilder) then begin // going via the Module doesn't work for .H files :(
GenerateUnitToFile(aLibrary, aService, aType, lLanguage, lClassname, ExtractFilePath(lUnitname) + GetTargetFileName(aLibrary, aService, aType, lLanguage), lRequiredUnits);
{$IFDEF FPC}
lunit:= Project.CreateProjectFile(lUnitName);
Project.AddFile(lUnit, False);
lUnit.IsPartOfProject := True;
{$ELSE}
Project.AddFile(lUnitname, true);
{$ENDIF}
if (aType <> cgtInvk) then
{$IFDEF FPC}
LazarusIDE.DoOpenEditorFile(lUnitName,-1,[ofOnlyIfExists]);
LazarusIDE.DoRevertEditorFile(lUnitName);
{$ELSE}
ActionServices.OpenFile(lUnitName);
ActionServices.ReloadFile(lUnitname);
{$ENDIF}
end
else begin
lCodeStream := TStringStream.Create('');
lHeaderStream := TStringStream.Create(''); // C++ only
GenerateUnitToStream(aLibrary, aService, aType, lLanguage, lCodeStream, lHeaderStream, lClassname, '', lRequiredUnits);
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) = cglCppBuilder 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
{$IFDEF FPC}
aMessageList.FlushMessages;
{$ENDIF}
result := TRUE;
// Only processes DPRs
{$IFDEF FPC}
prjname := Project.MainFile.FileName;
if (CompareText(ExtractFileExt(prjname), '.lpr')<>0) then Exit;
{$ELSE}
prjname := Project.FileName;
{$IFDEF BDS}
if (CompareText(ExtractFileExt(prjname), '.bdsproj')<>0) and (CompareText(ExtractFileExt(prjname), '.dproj')<>0) and (CompareText(ExtractFileExt(prjname), '.cbproj')<>0) then Exit;
{$ELSE}
if (CompareText(ExtractFileExt(prjname), '.dpr')<>0) then Exit;
{$ENDIF}
{$ENDIF}
// Extract useful data and exists if the file does not reference a RODL file
source := ReadModuleSource({$IFDEF FPC}Project.MainFile{$ELSE}Project{$ENDIF});
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 }
{$IFNDEF FPC}
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;
{$ENDIF FPC}
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;
{$IFNDEF FPC}
procedure TRORODLNotifier.FileNotification(
NotifyCode: TOTAFileNotification; const FileName: string;
var Cancel: Boolean);
begin
end;
{$ENDIF FPC}
initialization
finalization
RemoveNotifier;
end.