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: 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 var
AnUnitInfo: TUnitInfo; AnUnitInfo: TUnitInfo;
begin begin
AnUnitInfo:=Project1.FirstPartOfProject; // update project resource
while AnUnitInfo<>nil do begin Project1.Resources.Regenerate(Project1.MainFileName);
if AnUnitInfo.HasResources then begin AnUnitInfo := Project1.FirstPartOfProject;
Result:=UpdateLRSFromLFM(AnUnitInfo.ResourceFileName); while AnUnitInfo<>nil do
if Result=mrIgnore then Result:=mrOk; begin
if Result<>mrOk then exit; if AnUnitInfo.HasResources then
begin
Result := UpdateLRSFromLFM(AnUnitInfo.ResourceFileName);
if Result = mrIgnore then Result:=mrOk;
if Result <> mrOk then exit;
end; end;
AnUnitInfo:=AnUnitInfo.NextPartOfProject; AnUnitInfo := AnUnitInfo.NextPartOfProject;
end; end;
end; end;

39
ide/main.pp
View File

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

51
ide/projectresources.pas
View File

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