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

ide: improve resources code (use less hacks?)

Browse Source 
git-svn-id: trunk@16958 -
This commit is contained in:
paul 2008-10-11 13:15:24 +00:00
parent 795657b0a7
commit be2f3116a5
3 changed files with 47 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
ide/buildmanager.pas
View File

@ -1020,14 +1020,18 @@ function TBuildManager.UpdateProjectAutomaticFiles: TModalResult;
var
AnUnitInfo: TUnitInfo;
begin
AnUnitInfo:=Project1.FirstPartOfProject;
while AnUnitInfo<>nil do begin
if AnUnitInfo.HasResources then begin
Result:=UpdateLRSFromLFM(AnUnitInfo.ResourceFileName);
if Result=mrIgnore then Result:=mrOk;
if Result<>mrOk then exit;
// update project resource
Project1.Resources.Regenerate(Project1.MainFileName);
AnUnitInfo := Project1.FirstPartOfProject;
while AnUnitInfo<>nil do
begin
if AnUnitInfo.HasResources then
begin
Result := UpdateLRSFromLFM(AnUnitInfo.ResourceFileName);
if Result = mrIgnore then Result:=mrOk;
if Result <> mrOk then exit;
end;
AnUnitInfo:=AnUnitInfo.NextPartOfProject;
AnUnitInfo := AnUnitInfo.NextPartOfProject;
end;
end;

39
ide/main.pp
View File

@ -705,7 +705,6 @@ type
function DoOpenComponent(const UnitFilename: string; OpenFlags: TOpenFlags;
CloseFlags: TCloseFlags;
out Component: TComponent): TModalResult; override;
function DoSaveAllResources: Boolean;
function DoSaveAll(Flags: TSaveFlags): TModalResult;
procedure DoRestart;
procedure DoExecuteRemoteControl;
@ -8335,9 +8334,6 @@ begin
exit;
end;
if not DoSaveAllResources then
Exit;
SaveSourceEditorChangesToCodeCache(-1);
SkipSavingMainSource:=false;
@ -8408,13 +8404,16 @@ begin
end;
// save main source
if (MainUnitInfo<>nil) and (not (sfDoNotSaveVirtualFiles in flags)) then begin
if MainUnitInfo.Loaded then begin
if (MainUnitInfo<>nil) and (not (sfDoNotSaveVirtualFiles in flags)) then
begin
if MainUnitInfo.Loaded then
begin
// loaded in source editor
Result:=DoSaveEditorFile(MainUnitInfo.EditorIndex,
[sfProjectSaving]+[sfSaveToTestDir,sfCheckAmbiguousFiles]*Flags);
if Result=mrAbort then exit;
end else begin
end else
begin
// not loaded in source editor (hidden)
if not (sfSaveToTestDir in Flags) then begin
DestFilename:=MainUnitInfo.Filename;
@ -8422,13 +8421,18 @@ begin
SkipSavingMainSource:=true;
end else
DestFilename:=MainBuildBoss.GetTestUnitFilename(MainUnitInfo);
if (not SkipSavingMainSource) and (MainUnitInfo.Source<>nil) then begin
if (not SkipSavingMainSource) and (MainUnitInfo.Source<>nil) then
begin
Result:=SaveCodeBufferToFile(MainUnitInfo.Source, DestFilename);
if Result=mrAbort then exit;
end;
end;
Project1.Resources.Regenerate(DestFileName);
// clear modified flags
if not (sfSaveToTestDir in Flags) then begin
if not (sfSaveToTestDir in Flags) then
begin
if (Result=mrOk) then begin
if MainUnitInfo<>nil then MainUnitInfo.ClearModifieds;
if MainUnitSrcEdit<>nil then MainUnitSrcEdit.Modified:=false;
@ -9547,23 +9551,6 @@ begin
or SourceNotebook.SomethingModified);
end;
function TMainIDE.DoSaveAllResources: Boolean;
var
WorkingDir, SrcFilename: String;
begin
if not Project1.IsVirtual then
begin
WorkingDir:=Project1.ProjectDirectory;
SrcFilename:=CreateRelativePath(Project1.MainUnitInfo.Filename,WorkingDir);
end else
begin
WorkingDir:=GetTestBuildDirectory;
SrcFilename:=MainBuildBoss.GetTestUnitFilename(Project1.MainUnitInfo);
end;
Result := Project1.Resources.Regenerate(WorkingDir, SrcFileName);
end;
function TMainIDE.DoSaveAll(Flags: TSaveFlags): TModalResult;
var
CurResult: TModalResult;

51
ide/projectresources.pas
View File

@ -37,9 +37,9 @@ unit ProjectResources;
interface
uses
Classes, SysUtils, LCLProc, LResources, FileUtil, Laz_XMLCfg,
Classes, SysUtils, Controls, LCLProc, LResources, FileUtil, Laz_XMLCfg,
ProjectResourcesIntf,
W32VersionInfo, W32Manifest, ProjectIcon, IDEProcs,
W32VersionInfo, W32Manifest, ProjectIcon, IDEProcs, DialogProcs,
BasicCodeTools, CodeToolManager, CodeCache, CodeAtom;
type
@ -62,7 +62,7 @@ type
FXPManifest: TProjectXPManifest;
FProjectIcon: TProjectIcon;
procedure SetFileNames(const AWorkingDir, MainFileName: String);
procedure SetFileNames(const MainFileName: String);
procedure SetModified(const AValue: Boolean);
function Update: Boolean;
procedure EmbeddedObjectModified(Sender: TObject);
@ -74,7 +74,7 @@ type
procedure AddLazarusResource(AResource: TStream; const ResourceName, ResourceType: String); override;
procedure Clear;
function Regenerate(const AWorkingDir, MainFileName: String): Boolean;
function Regenerate(const MainFileName: String): Boolean;
function UpdateMainSourceFile(const AFileName: string): Boolean;
function HasSystemResources(CheckLists: Boolean): Boolean;
@ -95,14 +95,10 @@ implementation
{ TProjectResources }
procedure TProjectResources.SetFileNames(const AWorkingDir, MainFileName: String);
var
BasePart: String;
procedure TProjectResources.SetFileNames(const MainFileName: String);
begin
BasePart := AWorkingDir + ExtractFileNameWithoutExt(ExtractFileName(MainFileName));
rcFileName := BasePart + '.rc';
lrsFileName := BasePart + '.lrs';
rcFileName := ChangeFileExt(MainFileName, '.rc');
lrsFileName := ChangeFileExt(MainFileName, '.lrs');
end;
procedure TProjectResources.SetModified(const AValue: Boolean);
@ -205,34 +201,33 @@ begin
FMessages.Clear;
end;
function TProjectResources.Regenerate(const AWorkingDir, MainFileName: String): Boolean;
function TProjectResources.Regenerate(const MainFileName: String): Boolean;
var
AStream: TStream;
CodeBuf: TCodeBuffer;
begin
Result := False;
SetFileNames(AWorkingDir, MainFileName);
if (MainFileName = '') or not FilenameIsAbsolute(MainFileName) then
Exit;
SetFileNames(MainFileName);
if not Update then
Exit;
AStream := nil;
if HasSystemResources(True) then
begin
try
AStream := TFileStream.Create(UTF8ToSys(rcFileName), fmCreate);
FSystemResources.SaveToStream(AStream);
finally
AStream.Free;
end;
CodeBuf := CodeToolBoss.CreateFile(rcFileName);
CodeBuf.Source:= FSystemResources.Text;
if SaveCodeBufferToFile(CodeBuf, CodeBuf.Filename) = mrAbort then
Exit;
end;
if HasLazarusResources(True) then
begin
try
AStream := TFileStream.Create(UTF8ToSys(lrsFileName), fmCreate);
FLazarusResources.SaveToStream(AStream);
finally
AStream.Free;
end;
CodeBuf := CodeToolBoss.CreateFile(lrsFileName);
CodeBuf.Source := FLazarusResources.Text;
if SaveCodeBufferToFile(CodeBuf, CodeBuf.Filename) = mrAbort then
Exit;
end;
Result := True;
end;
@ -325,7 +320,7 @@ begin
CodeBuf := CodeToolBoss.LoadFile(AFilename, False, False);
if CodeBuf <> nil then
begin
SetFileNames('', AFileName);
SetFileNames(AFileName);
Filename := ExtractFileName(rcFileName);
//debugln(['TProjectResources.UpdateMainSourceFile HasSystemResources=',HasSystemResources,' Filename=',Filename,' HasLazarusResources=',HasLazarusResources]);