implemented updating lrs files from lfm files

git-svn-id: trunk@6866 -

ide/dialogprocs.pas

@@ -37,8 +37,8 @@ unit DialogProcs;
 interface
 
 uses
-  Classes, SysUtils, Forms, Controls, Dialogs, FileUtil, CodeCache,
-  CodeToolManager, {$IFNDEF VER1_0}AVL_Tree{$ELSE}OldAvLTree{$ENDIF},
+  Classes, SysUtils, LCLProc, LResources, Forms, Controls, Dialogs, FileUtil,
+  CodeCache, CodeToolManager, {$IFNDEF VER1_0}AVL_Tree{$ELSE}OldAvLTree{$ENDIF},
   IDEProcs, LazarusIDEStrConsts;
 
 type
@@ -58,6 +58,7 @@ function CopyFileWithErrorDialogs(const SrcFilename, DestFilename: string;
   ExtraButtons: TMsgDlgButtons): TModalResult;
 function LoadCodeBuffer(var ACodeBuffer: TCodeBuffer; const AFilename: string;
   Flags: TLoadBufferFlags): TModalResult;
+function SaveCodeBuffer(var ACodeBuffer: TCodeBuffer): TModalResult;
 function CreateEmptyFile(const Filename: string;
   ErrorButtons: TMsgDlgButtons): TModalResult;
 function CheckFileIsWritable(const Filename: string;
@@ -68,6 +69,8 @@ function DeleteFileInteractive(const Filename: string;
   ErrorButtons: TMsgDlgButtons): TModalResult;
 function SaveStringToFile(const Filename, Content: string;
   ErrorButtons: TMsgDlgButtons): TModalResult;
+function ConvertLFMToLRSFileInteractive(const LFMFilename,
+  LRSFilename: string): TModalResult;
 
 
 implementation
@@ -166,6 +169,19 @@ begin
   end;
 end;
 
+function SaveCodeBuffer(var ACodeBuffer: TCodeBuffer): TModalResult;
+begin
+  repeat
+    if ACodeBuffer.Save then begin
+      Result:=mrOk;
+    end else begin
+      Result:=MessageDlg('Write error',
+        'Unable to write "'+ACodeBuffer.Filename+'"',
+        mtError,[mbAbort,mbRetry,mbIgnore],0);
+    end;
+  until Result<>mrRetry;
+end;
+
 function CreateEmptyFile(const Filename: string; ErrorButtons: TMsgDlgButtons
   ): TModalResult;
 var
@@ -271,5 +287,50 @@ begin
   end;
 end;
 
+function ConvertLFMToLRSFileInteractive(const LFMFilename,
+  LRSFilename: string): TModalResult;
+var
+  LFMMemStream, LRSMemStream: TMemoryStream;
+  LFMBuffer: TCodeBuffer;
+  LRSBuffer: TCodeBuffer;
+begin
+  // read lfm file
+  Result:=LoadCodeBuffer(LFMBuffer,LFMFilename,[lbfUpdateFromDisk]);
+  if Result<>mrOk then exit;
+  LFMMemStream:=nil;
+  LRSMemStream:=nil;
+  try
+    LFMMemStream:=TMemoryStream.Create;
+    LFMBuffer.SaveToStream(LFMMemStream);
+    LFMMemStream.Position:=0;
+    LRSMemStream:=TMemoryStream.Create;
+    // convert
+    if not LFMtoLRSstream(LFMMemStream,LRSMemStream) then begin
+      Result:=MessageDlg('Stream Error',
+        'Unable to update the binary resource file'#13
+        +LRSFilename+#13
+        +'from file the text resource file'#13
+        +LFMFilename+#13
+        +#13
+        +'Probably the text file is corrupt.',
+        mtError,[mbCancel,mbAbort,mbIgnore],0);
+      exit;
+    end;
+    LRSMemStream.Position:=0;
+    // save lrs file
+    LRSBuffer:=CodeToolBoss.CreateFile(LRSFilename);
+    if (LRSBuffer<>nil) then begin
+      LRSBuffer.LoadFromStream(LRSMemStream);
+      Result:=SaveCodeBuffer(LRSBuffer);
+    end else begin
+      Result:=mrCancel;
+      debugln('ConvertLFMToLRSFileInteractive unable to create codebuffer ',LRSFilename);
+    end;
+  finally
+    LFMMemStream.Free;
+    LRSMemStream.Free;
+  end;
+end;
+
 end.
 

ide/main.pp

@@ -531,6 +531,7 @@ type
     procedure SaveSrcEditorProjectSpecificSettings(AnUnitInfo: TUnitInfo);
     procedure SaveSourceEditorProjectSpecificSettings;
     function DoShowSaveProjectAsDialog: TModalResult;
+    function DoUpdateLRSFromLFM(const LRSFilename: string): TModalResult;
 
     // methods for open project, create project from source
     function DoCompleteLoadingProjectInfo: TModalResult;
@@ -3283,12 +3284,12 @@ begin
   ResourceCode:=nil;
   if AnUnitInfo.HasResources then begin
     //writeln('TMainIDE.DoLoadResourceFile A "',AnUnitInfo.Filename,'" "',AnUnitInfo.ResourceFileName,'"');
-    // first try to find the resource file via the unit source
+    // first try to find the resource file (.lrs) via the unit source
     LinkIndex:=-1;
     ResourceCode:=CodeToolBoss.FindNextResourceFile(
       AnUnitInfo.Source,LinkIndex);
     // if unit source has errors, then show the error and try the last resource
-    // file
+    // file (.lrs)
     if (ResourceCode=nil) and (CodeToolBoss.ErrorMessage<>'') then begin
       if not IgnoreSourceErrors then
         DoJumpToCodeToolBossError;
@@ -4510,6 +4511,27 @@ begin
   Result:=mrOk;
 end;
 
+function TMainIDE.DoUpdateLRSFromLFM(const LRSFilename: string): TModalResult;
+var
+  LFMFilename: String;
+begin
+  Result:=mrOk;
+  // check if there is a .lrs file
+  if LRSFilename='' then exit;
+  if not FilenameIsAbsolute(LRSFilename) then exit;
+  LFMFilename:=ChangeFileExt(LRSFilename,'.lfm');
+  if LRSFilename=LFMFilename then exit;
+  // check if there is a .lfm file
+  if not FileExists(LFMFilename) then exit;
+  // check if .lrs file is newer than .lfm file
+  if FileExists(LRSFilename) and (FileAge(LFMFilename)<=FileAge(LRSFilename))
+  then exit;
+  debugln('TMainIDE.DoUpdateLRSFromLFM ',LRSFilename,' ',dbgs(FileAge(LFMFilename)),' ',dbgs(FileAge(LRSFilename)));
+  // the .lrs file does not exists, or is older than the .lfm file
+  // -> update .lrs file
+  Result:=ConvertLFMToLRSFileInteractive(LFMFilename,LRSFilename);
+end;
+
 function TMainIDE.DoCompleteLoadingProjectInfo: TModalResult;
 begin
   UpdateCaption;
@@ -5630,6 +5652,7 @@ var
   i: integer;
   DestFilename: string;
   SkipSavingMainSource: Boolean;
+  AnUnitInfo: TUnitInfo;
 begin
   Result:=mrCancel;
   if not (ToolStatus in [itNone,itDebugger]) then begin
@@ -5646,9 +5669,10 @@ begin
   // check that all new units are saved first to get valid filenames
   // (this can alter the mainunit: e.g. used unit names)
   for i:=0 to Project1.UnitCount-1 do begin
-    if (Project1.Units[i].Loaded) and (Project1.Units[i].IsVirtual)
+    AnUnitInfo:=Project1.Units[i];
+    if (AnUnitInfo.Loaded) and (AnUnitInfo.IsVirtual)
     and (Project1.MainUnitID<>i) then begin
-      Result:=DoSaveEditorFile(Project1.Units[i].EditorIndex,
+      Result:=DoSaveEditorFile(AnUnitInfo.EditorIndex,
            [sfSaveAs,sfProjectSaving]
            +[sfSaveToTestDir,sfCheckAmbigiousFiles]*Flags);
       if (Result=mrAbort) or (Result=mrCancel) then exit;
@@ -5729,8 +5753,19 @@ begin
       end;
     end;
   end;
+  
+  // update all lrs files
+  AnUnitInfo:=Project1.FirstPartOfProject;
+  while AnUnitInfo<>nil do begin
+    if AnUnitInfo.HasResources then begin
+      Result:=DoUpdateLRSFromLFM(AnUnitInfo.ResourceFileName);
+      if Result=mrIgnore then Result:=mrOk;
+      if Result<>mrOk then exit;
+    end;
+    AnUnitInfo:=AnUnitInfo.NextPartOfProject;
+  end;
 
-DebugLn('TMainIDE.DoSaveProject End');
+  DebugLn('TMainIDE.DoSaveProject End');
 end;
 
 function TMainIDE.DoCloseProject: TModalResult;
@@ -11422,6 +11457,9 @@ end.
 
 { =============================================================================
   $Log$
+  Revision 1.851  2005/02/28 22:43:48  mattias
+  implemented updating lrs files from lfm files
+
   Revision 1.850  2005/02/28 17:24:18  mattias
   replaced save as auto rename checkboxes with radiogroup  from smace and mg