paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-24 22:19:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: creating manifest file only for win32/win64 and where the exe is, which can differ from the project directory

Browse Source 
git-svn-id: trunk@22849 -
This commit is contained in:
mattias 2009-11-28 12:55:38 +00:00
parent 133e54ac19
commit 830714131b
7 changed files with 63 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
ide/main.pp
View File

@ -9594,11 +9594,11 @@ begin
DebugLn('TMainIDE.DoSaveForBuild Project1.IsVirtual=',dbgs(Project1.IsVirtual));
{$ENDIF}
Project1.Resources.DoBeforeBuild;
if not Project1.IsVirtual then
Result:=DoSaveAll([sfCheckAmbiguousFiles])
else
Result:=DoSaveProjectToTestDirectory([sfSaveNonProjectFiles]);
Project1.Resources.DoBeforeBuild(Project1.IsVirtual);
Project1.UpdateExecutableType;
if Result<>mrOk then begin
{$IFDEF VerboseSaveForBuild}
@ -9832,6 +9832,7 @@ var
TargetExeName: String;
err : TFPCErrorType;
TargetExeDirectory: String;
TargetOS: String;
begin
if Project1.MainUnitInfo=nil then begin
// this project has not source to compile
@ -9973,7 +9974,7 @@ begin
// create application bundle
if Project1.UseAppBundle and (Project1.MainUnitID>=0)
and (MainBuildBoss.GetLCLWidgetType(true)='carbon')
and (MainBuildBoss.GetLCLWidgetType(true)=LCLPlatformDirNames[lpCarbon])
then begin
Result:=CreateApplicationBundle(TargetExeName, Project1.Title);
if not (Result in [mrOk,mrIgnore]) then exit;
@ -9981,6 +9982,16 @@ begin
if not (Result in [mrOk,mrIgnore]) then exit;
end;
// create manifest
if Project1.Resources.XPManifest.UseManifest and (Project1.MainUnitID>=0)
then begin
TargetOS:=MainBuildBoss.GetTargetOS(true);
if (TargetOS='win32') or (TargetOS='win64') then begin
Result:=Project1.Resources.XPManifest.CreateManifestFile(TargetExeName);
if not (Result in [mrOk,mrIgnore]) then exit;
end;
end;
// execute compilation tool 'Before'
if not (pbfSkipTools in Flags) then begin
ToolBefore:=TProjectCompilationToolOptions(

2
ide/mainintf.pas
View File

@ -153,7 +153,7 @@ type
function DoShowProjectInspector: TModalResult; virtual; abstract;
function DoImExportCompilerOptions(Sender: TObject): TModalResult; virtual; abstract;
function PrepareForCompile: TModalResult; virtual; abstract;
function PrepareForCompile: TModalResult; virtual; abstract; // stop things that interfere with compilation, like debugging
function DoSaveBuildIDEConfigs(Flags: TBuildLazarusFlags): TModalResult; virtual; abstract;
function DoBuildLazarus(Flags: TBuildLazarusFlags): TModalResult; virtual; abstract;
function DoSaveForBuild: TModalResult; virtual; abstract;

2
ide/project.pp
View File

@ -1925,7 +1925,7 @@ begin
Title := '';
FUnitList := TFPList.Create; // list of TUnitInfo
FResources := TProjectResources.Create;
FResources := TProjectResources.Create(Self);
FResources.OnModified := @EmbeddedObjectModified;
end;

19
ide/projectresources.pas
View File

@ -38,7 +38,7 @@ interface
uses
Classes, SysUtils, Controls, LCLProc, LResources, FileUtil, Laz_XMLCfg,
ProjectResourcesIntf, LazarusIDEStrConsts,
ProjectIntf, ProjectResourcesIntf, LazarusIDEStrConsts,
W32VersionInfo, W32Manifest, ProjectIcon, IDEProcs, DialogProcs,
CodeToolManager, CodeCache;
@ -75,13 +75,13 @@ type
procedure UpdateCodeBuffers;
procedure DeleteLastCodeBuffers;
public
constructor Create; override;
constructor Create(AProject: TLazProject); override;
destructor Destroy; override;
procedure AddSystemResource(const AResource: String); override;
procedure AddLazarusResource(AResource: TStream; const ResourceName, ResourceType: String); override;
procedure DoBeforeBuild;
procedure DoBeforeBuild(SaveToTestDir: boolean);
procedure Clear;
function Regenerate(const MainFileName: String;
UpdateSource, PerformSave: boolean;
@ -160,9 +160,9 @@ begin
ProjectIcon.Modified;
end;
constructor TProjectResources.Create;
constructor TProjectResources.Create(AProject: TLazProject);
begin
inherited Create;
inherited Create(AProject);
FInModified := False;
FLrsIncludeAllowed := False;
@ -214,11 +214,11 @@ begin
end;
end;
procedure TProjectResources.DoBeforeBuild;
procedure TProjectResources.DoBeforeBuild(SaveToTestDir: boolean);
begin
VersionInfo.DoBeforeBuild(Self);
XPManifest.DoBeforeBuild(Self);
ProjectIcon.DoBeforeBuild(Self);
VersionInfo.DoBeforeBuild(Self,SaveToTestDir);
XPManifest.DoBeforeBuild(Self,SaveToTestDir);
ProjectIcon.DoBeforeBuild(Self,SaveToTestDir);
end;
procedure TProjectResources.Clear;
@ -307,7 +307,6 @@ begin
with AConfig do
begin
ProjectIcon.IcoFileName := ChangeFileExt(FileName, '.ico');
XPManifest.ManifestFileName := ChangeFileExt(FileName, '.manifest');
ProjectIcon.IsEmpty := StrToBoolDef(GetValue(Path+'General/Icon/Value', '-1'), False);
XPManifest.UseManifest := GetValue(Path+'General/UseXPManifest/Value', False);

51
ide/w32manifest.pas
View File

@ -26,6 +26,9 @@
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
The manifest file is needed for windows XP themes.
The file is created in the directory, where the project exe is created.
}
unit W32Manifest;
@ -35,23 +38,24 @@ interface
uses
Classes, SysUtils, FileUtil, Process, LCLProc, Controls, Forms,
CodeToolManager, LazConf, LResources, projectresourcesintf;
CodeToolManager, CodeCache, LazConf, DialogProcs, LResources,
ProjectResourcesIntf;
type
{ TProjectXPManifest }
TProjectXPManifest = class(TAbstractProjectResource)
private
FManifestName: string;
FUseManifest: boolean;
FManifestFileName: string;
procedure SetFileNames(const MainFilename: string);
procedure SetUseManifest(const AValue: boolean);
public
function UpdateResources(AResources: TAbstractProjectResources; const MainFilename: string): Boolean; override;
function CreateManifestFile: Boolean;
function CreateManifestFile(ExeFilename: string): TModalResult;
property UseManifest: boolean read FUseManifest write SetUseManifest;
property ManifestFileName: String read FManifestFileName write FManifestFileName;
property ManifestName: string read FManifestName;
end;
implementation
@ -84,7 +88,7 @@ const
procedure TProjectXPManifest.SetFileNames(const MainFilename: string);
begin
FManifestFileName := ChangeFileExt(MainFilename, '.manifest');
FManifestName := ExtractFileNameOnly(MainFilename)+'.manifest';
end;
procedure TProjectXPManifest.SetUseManifest(const AValue: boolean);
@ -96,8 +100,6 @@ end;
function TProjectXPManifest.UpdateResources(AResources: TAbstractProjectResources;
const MainFilename: string): Boolean;
var
ManifestName: String;
begin
Result := True;
@ -106,28 +108,27 @@ begin
SetFileNames(MainFilename);
if not FilenameIsAbsolute(FManifestFileName) or CreateManifestFile then
begin
ManifestName := ExtractFileName(FManifestFileName);
AResources.AddSystemResource(sManifest + ' "' + ManifestName + '"');
end
else
Result := False;
AResources.AddSystemResource(sManifest + ' "' + ManifestName + '"');
Result:=true;
end;
function TProjectXPManifest.CreateManifestFile: Boolean;
function TProjectXPManifest.CreateManifestFile(ExeFilename: string): TModalResult;
var
FileStream: TStream;
ManifestFileName: String;
Code: TCodeBuffer;
begin
Result := False;
FileStream := nil;
try
FileStream := TFileStream.Create(UTF8ToSys(FManifestFileName), fmCreate);
FileStream.Write(sManifestFileData[1], Length(sManifestFileData));
Result := True;
finally
FileStream.Free;
end;
Result := mrCancel;
if not FilenameIsAbsolute(ExeFilename) then exit(mrOk);
ManifestFileName:=ChangeFileExt(ExeFilename,'.manifest');
// check if manifest file is uptodate
// (needed for readonly files and for version control systems)
Code:=CodeToolBoss.LoadFile(ManifestFileName,true,true);
if (Code<>nil) and (Code.Source=sManifestFileData) then exit(mrOk);
// save
if Code=nil then
Code:=CodeToolBoss.CreateFile(ManifestFileName);
Code.Source:=sManifestFileData;
Result:=SaveCodeBuffer(Code);
end;

5
ide/w32versioninfo.pas
View File

@ -84,7 +84,8 @@ type
procedure SetUseVersionInfo(const AValue: boolean);
procedure SetVersionNr(const AValue: integer);
public
procedure DoBeforeBuild(AResources: TAbstractProjectResources); override;
procedure DoBeforeBuild(AResources: TAbstractProjectResources;
SaveToTestDir: boolean); override;
function UpdateResources(AResources: TAbstractProjectResources; const MainFilename: string): Boolean; override;
property UseVersionInfo: boolean read FUseVersionInfo write SetUseVersionInfo;
@ -511,7 +512,7 @@ begin
end;
procedure TProjectVersionInfo.DoBeforeBuild(
AResources: TAbstractProjectResources);
AResources: TAbstractProjectResources; SaveToTestDir: boolean);
begin
if AutoIncrementBuild then // project indicate to use autoincrementbuild
BuildNr := BuildNr + 1;

15
ideintf/projectresourcesintf.pas
View File

@ -17,7 +17,7 @@ unit ProjectResourcesIntf;
interface
uses
Classes, SysUtils;
Classes, SysUtils, ProjectIntf;
type
TAbstractProjectResources = class;
@ -31,7 +31,7 @@ type
public
constructor Create; virtual;
procedure DoBeforeBuild(AResources: TAbstractProjectResources); virtual;
procedure DoBeforeBuild(AResources: TAbstractProjectResources; SaveToTestDir: boolean); virtual;
function UpdateResources(AResources: TAbstractProjectResources; const MainFilename: string): Boolean; virtual; abstract;
property Modified: boolean read FModified write SetModified;
@ -41,10 +41,12 @@ type
{ TAbstractProjectResources }
TAbstractProjectResources = class
private
FProject: TLazProject;
protected
FMessages: TStringList;
public
constructor Create; virtual;
constructor Create(AProject: TLazProject); virtual;
destructor Destroy; override;
procedure AddSystemResource(const AResource: String); virtual; abstract;
@ -52,6 +54,7 @@ type
const ResourceName, ResourceType: String); virtual; abstract;
property Messages: TStringList read FMessages;
property Project: TLazProject read FProject;
end;
implementation
@ -70,15 +73,17 @@ begin
FModified := False;
end;
procedure TAbstractProjectResource.DoBeforeBuild(AResources: TAbstractProjectResources);
procedure TAbstractProjectResource.DoBeforeBuild(
AResources: TAbstractProjectResources; SaveToTestDir: boolean);
begin
// nothing
end;
{ TAbstractProjectResources }
constructor TAbstractProjectResources.Create;
constructor TAbstractProjectResources.Create(AProject: TLazProject);
begin
FProject:=AProject;
FMessages := TStringList.Create;
end;