ide: improve resource handling

git-svn-id: trunk@17019 -

ide/buildmanager.pas

@@ -1021,7 +1021,7 @@ var
   AnUnitInfo: TUnitInfo;
 begin
   // update project resource
-  Project1.Resources.Regenerate(Project1.MainFileName);
+  Project1.Resources.Regenerate(Project1.MainFileName, False, True);
   AnUnitInfo := Project1.FirstPartOfProject;
   while AnUnitInfo<>nil do 
   begin

ide/main.pp

@@ -8296,8 +8296,8 @@ begin
       // rebuild codetools defines
       MainBuildBoss.RescanCompilerDefines(true,true);
 
-      if not Project1.Resources.UpdateMainSourceFile(Project1.MainFilename) then
+      if not Project1.Resources.Regenerate(Project1.MainFilename, True, False) then
-        DebugLn('TMainIDE.DoNewProject Project1.Resources.UpdateMainSourceFile failed');
+        DebugLn('TMainIDE.DoNewProject Project1.Resources.Regenerate failed');
 
       // (i.e. remove old project specific things and create new)
       IncreaseCompilerParseStamp;
@@ -8434,7 +8434,7 @@ begin
       end;
     end;
     
-    Project1.Resources.Regenerate(DestFileName);
+    Project1.Resources.Regenerate(DestFileName, False, True);
 
     // clear modified flags
     if not (sfSaveToTestDir in Flags) then 

ide/project.pp

@@ -4085,11 +4085,13 @@ begin
 end;
 
 procedure TProject.OnUnitNameChange(AnUnitInfo: TUnitInfo;
-  const OldUnitName, NewUnitName: string;  CheckIfAllowed: boolean;
+  const OldUnitName, NewUnitName: string; CheckIfAllowed: boolean;
   var Allowed: boolean);
-var i:integer;
+var
+  i:integer;
 begin
-  if AnUnitInfo.IsPartOfProject then begin
+  if AnUnitInfo.IsPartOfProject then
+  begin
     if CheckIfAllowed then begin
       // check if no other project unit has this name
       for i:=0 to UnitCount-1 do begin
@@ -4101,11 +4103,19 @@ begin
         end;
       end;
     end;
-    if (OldUnitName<>'') and (pfMainUnitHasUsesSectionForAllUnits in Flags) then
+    if (OldUnitName<>'') then
     begin
-      // rename unit in program uses section
+      if (pfMainUnitHasUsesSectionForAllUnits in Flags) then
-      CodeToolBoss.RenameUsedUnit(MainUnitInfo.Source
+      begin
-        ,OldUnitName,NewUnitName,'');
+        // rename unit in program uses section
+        CodeToolBoss.RenameUsedUnit(MainUnitInfo.Source, OldUnitName,
+          NewUnitName, '');
+      end;
+      if MainUnitInfo = AnUnitInfo then
+      begin
+        // we are renaming a project => update resource directives
+        Resources.RenameDirectives(OldUnitName, NewUnitName);
+      end;
     end;
   end;
 end;

ide/projecticon.pas

@@ -148,9 +148,8 @@ begin
   // RCIcon := sIcon + #$D#$A + GetAsHex;
   // but it does not work
 
-  if CreateIconFile then
+  if not FilenameIsAbsolute(icoFileName) or CreateIconFile then
   begin
-    //IconName := StringReplace(icoFileName, '\', '\\', [rfReplaceAll]);
     IconName := ExtractFileName(icoFileName);
     AResources.AddSystemResource(sIcon + ' "' + IconName + '"');
   end

ide/projectopts.pp

@@ -554,7 +554,7 @@ begin
     //debugln(['TProjectOptionsDialog.ProjectOptionsClose Project.Resources.Modified=',Project.Resources.Modified]);
     if Project.Resources.Modified and (Project.MainUnitID >= 0) then
     begin
-      if not Project.Resources.UpdateMainSourceFile(Project.MainFilename) then
+      if not Project.Resources.Regenerate(Project.MainFilename, True, False) then
         MessageDlg(Project.Resources.Messages.Text, mtWarning, [mbOk], 0);
     end;
   end;

ide/projectresources.pas

@@ -61,11 +61,15 @@ type
     FVersionInfo: TProjectVersionInfo;
     FXPManifest: TProjectXPManifest;
     FProjectIcon: TProjectIcon;
+    rcCodeBuf: TCodeBuffer;
+    lrsCodeBuf: TCodeBuffer;
 
     procedure SetFileNames(const MainFileName: String);
     procedure SetModified(const AValue: Boolean);
-    function Update: Boolean;
     procedure EmbeddedObjectModified(Sender: TObject);
+    function Update: Boolean;
+    function UpdateMainSourceFile(const AFileName: string): Boolean;
+    function Save(const MainFileName: String): Boolean;
   public
     constructor Create; override;
     destructor Destroy; override;
@@ -74,8 +78,8 @@ type
     procedure AddLazarusResource(AResource: TStream; const ResourceName, ResourceType: String); override;
 
     procedure Clear;
-    function Regenerate(const MainFileName: String): Boolean;
+    function Regenerate(const MainFileName: String; UpdateSource, PerformSave: Boolean): Boolean;
-    function UpdateMainSourceFile(const AFileName: string): Boolean;
+    function RenameDirectives(const OldFileName, NewFileName: String): Boolean;
 
     function HasSystemResources(CheckLists: Boolean): Boolean;
     function HasLazarusResources(CheckLists: Boolean): Boolean;
@@ -92,6 +96,8 @@ type
   end;
 
 implementation
+const
+  LazResourcesUnit = 'LResources';
 
 { TProjectResources }
 
@@ -153,6 +159,9 @@ begin
 
   FInModified := False;
 
+  rcCodeBuf := nil;
+  lrsCodeBuf := nil;
+
   FSystemResources := TStringList.Create;
   FLazarusResources := TStringList.Create;
 
@@ -176,6 +185,9 @@ begin
   FSystemResources.Free;
   FLazarusResources.Free;
   FMessages.Free;
+
+  rcCodeBuf.Free;
+  lrsCodeBuf.Free;
 end;
 
 procedure TProjectResources.AddSystemResource(const AResource: String);
@@ -201,13 +213,11 @@ begin
   FMessages.Clear;
 end;
 
-function TProjectResources.Regenerate(const MainFileName: String): Boolean;
+function TProjectResources.Regenerate(const MainFileName: String; UpdateSource, PerformSave: Boolean): Boolean;
-var
-  CodeBuf: TCodeBuffer;
 begin
   Result := False;
 
-  if (MainFileName = '') or not FilenameIsAbsolute(MainFileName) then
+  if (MainFileName = '') then
     Exit;
 
   SetFileNames(MainFileName);
@@ -217,18 +227,28 @@ begin
 
   if HasSystemResources(True) then
   begin
-    CodeBuf := CodeToolBoss.CreateFile(rcFileName);
+    if rcCodeBuf = nil then
-    CodeBuf.Source:= FSystemResources.Text;
+      rcCodeBuf := CodeToolBoss.CreateFile(ExtractFileName(rcFileName));
-    if SaveCodeBufferToFile(CodeBuf, CodeBuf.Filename) = mrAbort then
+    rcCodeBuf.Source:= FSystemResources.Text;
-      Exit;
+  end
-  end;
+  else
+    FreeAndNil(rcCodeBuf);
+
   if HasLazarusResources(True) then
   begin
-    CodeBuf := CodeToolBoss.CreateFile(lrsFileName);
+    if lrsCodeBuf = nil then
-    CodeBuf.Source := FLazarusResources.Text;
+      lrsCodeBuf := CodeToolBoss.CreateFile(ExtractFileName(lrsFileName));
-    if SaveCodeBufferToFile(CodeBuf, CodeBuf.Filename) = mrAbort then
+    lrsCodeBuf.Source := FLazarusResources.Text;
+  end
+  else
+    FreeAndNil(lrsCodeBuf);
+
+  if UpdateSource and not UpdateMainSourceFile(MainFileName) then
       Exit;
-  end;
+
+  if PerformSave and not Save(MainFileName) then
+    Exit;
+
   Result := True;
 end;
 
@@ -307,8 +327,6 @@ begin
 end;
 
 function TProjectResources.UpdateMainSourceFile(const AFileName: string): Boolean;
-const
-  LazResourcesUnit = 'LResources';
 var
   NewX, NewY, NewTopLine: integer;
   CodeBuf, NewCode: TCodeBuffer;
@@ -356,7 +374,7 @@ begin
       // there is a resource directive in the source
       if not HasSystemResources(False) then
       begin
-        if not CodeToolBoss.RemoveDirective(NewCode, NewX,NewY,true) then
+        if not CodeToolBoss.RemoveDirective(NewCode, NewX, NewY, true) then
         begin
           Result := False;
           Messages.Add('Could not remove "{$R '+ Filename +'"} from main source!');
@@ -386,7 +404,7 @@ begin
       //debugln(['TProjectResources.UpdateMainSourceFile include directive found']);
       if not HasLazarusResources(False) then
       begin
-        if not CodeToolBoss.RemoveDirective(NewCode, NewX,NewY,true) then
+        if not CodeToolBoss.RemoveDirective(NewCode, NewX, NewY, true) then
         begin
           Result := False;
           Messages.Add('Could not remove "{$I '+ Filename +'"} from main source!');
@@ -411,5 +429,85 @@ begin
   end;
 end;
 
+function TProjectResources.RenameDirectives(const OldFileName,
+  NewFileName: String): Boolean;
+var
+  NewX, NewY, NewTopLine: integer;
+  CodeBuf, NewCode: TCodeBuffer;
+
+  oldRcFileName, oldLrsFileName,
+  newRcFileName, newLrsFileName: String;
+begin
+  Result := True;
+
+  CodeBuf := CodeToolBoss.LoadFile(OldFileName, False, False);
+  if CodeBuf <> nil then
+  begin
+    SetFileNames(OldFileName);
+    oldRcFilename := ExtractFileName(rcFileName);
+    oldLrsFileName := ExtractFileName(lrsFileName);
+    SetFileNames(NewFileName);
+    newRcFilename := ExtractFileName(rcFileName);
+    newLrsFileName := ExtractFileName(lrsFileName);
+
+    // update {$R filename} directive
+    if CodeToolBoss.FindResourceDirective(CodeBuf, 1, 1,
+                               NewCode, NewX, NewY,
+                               NewTopLine, oldRcFileName, false) then
+    begin
+      // there is a resource directive in the source
+      if not CodeToolBoss.RemoveDirective(NewCode, NewX, NewY, true) then
+      begin
+        Result := False;
+        Messages.Add('Could not remove "{$R '+ oldRcFileName +'"} from main source!');
+        debugln(['TProjectResources.UpdateMainSourceFile failed: removing resource directive']);
+      end;
+      if not CodeToolBoss.AddResourceDirective(CodeBuf,
+        newRcFileName, false, '{$IFDEF WINDOWS}{$R '+ newRcFileName +'}{$ENDIF}') then
+      begin
+        Result := False;
+        Messages.Add('Could not add "{$R '+ newRcFileName +'"} to main source!');
+        debugln(['TProjectResources.UpdateMainSourceFile failed: adding resource directive']);
+      end;
+    end;
+
+    // update {$I filename} directive
+    if CodeToolBoss.FindIncludeDirective(CodeBuf, 1, 1,
+                               NewCode, NewX, NewY,
+                               NewTopLine, oldLrsFileName, false) then
+    begin
+      // there is a resource directive in the source
+      if not CodeToolBoss.RemoveDirective(NewCode, NewX, NewY, true) then
+      begin
+        Result := False;
+        Messages.Add('Could not remove "{$I '+ oldLrsFileName +'"} from main source!');
+        debugln(['TProjectResources.UpdateMainSourceFile removing include directive from main source failed']);
+        Exit;
+      end;
+      if not CodeToolBoss.AddIncludeDirective(CodeBuf, newLrsFileName, '') then
+      begin
+        Result := False;
+        Messages.Add('Could not add "{$I '+ newLrsFileName +'"} to main source!');
+        debugln(['TProjectResources.UpdateMainSourceFile adding include directive to main source failed']);
+        Exit;
+      end;
+    end
+  end;
+end;
+
+function TProjectResources.Save(const MainFileName: String): Boolean;
+begin
+  if (MainFileName = '') or not FilenameIsAbsolute(MainFileName) then
+    Exit;
+
+  SetFileNames(MainFileName);
+
+  if (rcCodeBuf <> nil) and (SaveCodeBufferToFile(rcCodeBuf, rcFileName) = mrAbort) then
+    Exit;
+
+  if (lrsCodeBuf <> nil) and (SaveCodeBufferToFile(lrsCodeBuf, lrsFileName) = mrAbort) then
+    Exit;
+end;
+
 end.