fixed delphi2lazarus unit R directive

git-svn-id: trunk@5128 -

components/codetools/stdcodetools.pas

@@ -2166,7 +2166,7 @@ function TStandardCodeTool.ConvertDelphiToLazarusSource(AddLRSCode: boolean;
   end;
 
   function RemoveDFMResourceDirective: boolean;
-  // remove {$R *.dfm} directive
+  // remove {$R *.dfm} or {$R *.xfm} directive
   var
     ParamPos: Integer;
     ACleanPos: Integer;
@@ -2180,12 +2180,15 @@ function TStandardCodeTool.ConvertDelphiToLazarusSource(AddLRSCode: boolean;
         Scanner.NestedComments,ParamPos);
       if (ACleanPos<1) or (ACleanPos>SrcLen) or (ParamPos>SrcLen) then break;
       if (Src[ACleanPos]='{')
-      and (copy(UpperSrc,ParamPos,6)='*.DFM}') then begin
+      and ((copy(UpperSrc,ParamPos,6)='*.DFM}')
+        or (copy(UpperSrc,ParamPos,6)='*.XFM}'))
+      then begin
         StartPos:=FindLineEndOrCodeInFrontOfPosition(ACleanPos,true);
         if not SourceChangeCache.Replace(gtNone,gtNone,StartPos,ParamPos+6,'')
         then exit;
         break;
       end;
+      ACleanPos:=FindCommentEnd(Src,ACleanPos,Scanner.NestedComments);
     until false;
     Result:=true;
   end;

ide/delphiunit2laz.pas

@@ -62,12 +62,13 @@ function ConvertDFMToLFMFilename(const DFMFilename: string;
   KeepCase: boolean): string;
 function FindDFMFileForDelphiUnit(const DelphiFilename: string): string;
 function RenameDelphiUnitToLazarusUnit(const DelphiFilename: string;
-  RenameDFMFile: boolean): TModalResult;
+  RenameDFMFile: boolean;
+  var LazarusFilename, LFMFilename: string): TModalResult;
 function ConvertDFMFileToLFMFile(const DFMFilename: string): TModalResult;
 function ConvertDelphiSourceToLazarusSource(const LazarusUnitFilename: string;
   AddLRSCode: boolean): TModalResult;
 function LoadUnitAndLFMFile(const UnitFileName: string;
-  var UnitCode, LFMCode: TCodeBuffer): TModalResult;
+  var UnitCode, LFMCode: TCodeBuffer; LFMMustExist: boolean): TModalResult;
 function ConvertLFMtoLRSfile(const LFMFilename: string): TModalResult;
 
 implementation
@@ -107,15 +108,10 @@ begin
   if GetNextUsedDirectoryInSearchPath(UnitPath,LCLPath,NextStartPos)='' then
   begin
     LCLPath:=LCLPath+'$(TargetCPU)'+PathDelim+'$(TargetOS)';
-    Result:=MessageDlg('LCL unit path missing',
-      'The current unit path for the file'#13
-      +'"'+Filename+'" is'#13
-      +'"'+UnitPath+'".'#13
-      +#13
-      +'The path to the LCL units "'+LCLPath+'" is missing.'#13
-      +#13
-      +'Hint for newbies:'#13
-      +'Create a lazarus application and put the file into the project directory.',
+    Result:=MessageDlg(lisLCLUnitPathMissing,
+      Format(lisTheCurrentUnitPathForTheFileIsThePathToTheLCLUnits, [#13, '"',
+        Filename, '"', #13, '"', UnitPath, '"', #13, #13, '"', LCLPath, '"',
+        #13, #13, #13]),
       mtError,[mbCancel,mbAbort],0);
     exit;
   end;
@@ -147,24 +143,29 @@ begin
   if FileExists(Result) then exit;
   Result:=ChangeFileExt(DelphiFilename,'.DFM');
   if FileExists(Result) then exit;
+  Result:=ChangeFileExt(DelphiFilename,'.xfm');
+  if FileExists(Result) then exit;
+  Result:=ChangeFileExt(DelphiFilename,'.XFM');
+  if FileExists(Result) then exit;
   Result:='';
 end;
 
 function RenameDelphiUnitToLazarusUnit(const DelphiFilename: string;
-  RenameDFMFile: boolean): TModalResult;
+  RenameDFMFile: boolean;
+  var LazarusFilename, LFMFilename: string): TModalResult;
 var
-  LazarusFilename: String;
   DFMFilename: String;
-  LFMFilename: String;
 begin
   LazarusFilename:=ConvertDelphiToLazarusFilename(DelphiFilename);
   LFMFilename:='';
+  writeln('RenameDelphiUnitToLazarusUnit Unit "',DelphiFilename,'" -> "',LazarusFilename,'"');
   Result:=RenameFileWithErrorDialogs(DelphiFilename,LazarusFilename,[mbAbort]);
   if Result<>mrOK then exit;
   if RenameDFMFile then begin
     DFMFilename:=FindDFMFileForDelphiUnit(DelphiFilename);
     if DFMFilename<>'' then begin
       LFMFilename:=ConvertDFMToLFMFilename(DFMFilename,false);
+      writeln('RenameDelphiUnitToLazarusUnit Unit "',DFMFilename,'" -> "',LFMFilename,'"');
       Result:=RenameFileWithErrorDialogs(DFMFilename,LFMFilename,[mbAbort]);
       if Result<>mrOK then exit;
     end;
@@ -204,6 +205,7 @@ begin
     end;
     // converting dfm file, without renaming unit -> keep case
     LFMFilename:=ConvertDFMToLFMFilename(DFMFilename,true);
+    writeln('ConvertDFMFileToLFMFile LFMFilename="',LFMFilename,'"');
     try
       LFMStream.SaveToFile(LFMFilename);
     except
@@ -239,7 +241,7 @@ begin
 end;
 
 function LoadUnitAndLFMFile(const UnitFileName: string;
-  var UnitCode, LFMCode: TCodeBuffer): TModalResult;
+  var UnitCode, LFMCode: TCodeBuffer; LFMMustExist: boolean): TModalResult;
 var
   LFMFilename: string;
 begin
@@ -253,14 +255,19 @@ begin
     Result:=LoadCodeBuffer(LFMCode,LFMFilename,
                            [lbfCheckIfText,lbfUpdateFromDisk]);
     if Result<>mrOk then exit;
+  end else if LFMMustExist then begin
+    Result:=MessageDlg('LFM file not found',
+                       'Unit: '+UnitFileName+#13
+                       +'LFM file: '+LFMFilename,
+                       mtError,[mbCancel,mbAbort],0);
   end;
 end;
 
 function ConvertLFMtoLRSfile(const LFMFilename: string): TModalResult;
 begin
   if not LFMtoLRSfile(LFMFilename) then begin
-    Result:=MessageDlg('Error creating lrs',
-      'Unable to convert lfm to lrs and write lrs file.',
+    Result:=MessageDlg(lisErrorCreatingLrs,
+      lisUnableToConvertLfmToLrsAndWriteLrsFile,
       mtError,[mbCancel],0);
     exit;
   end;

ide/lazarusidestrconsts.pas

@@ -262,6 +262,9 @@ resourcestring
   lisFormatError = 'Format error';
   lisUnableToConvertFileError = 'Unable to convert file %s%s%s%sError: %s';
   lisUnableToWriteFileError = 'Unable to write file %s%s%s%sError: %s';
+  lisErrorCreatingLrs = 'Error creating lrs';
+  lisUnableToConvertLfmToLrsAndWriteLrsFile = 'Unable to convert lfm to lrs '
+    +'and write lrs file.';
   lisUnableToLoadOldResourceFileTheResourceFileIs = 'Unable to load old '
     +'resource file.%sThe resource file is the first include file in the%'
     +'sinitialization section.%sFor example {$I %s.lrs}.%sProbably a syntax '
@@ -1358,6 +1361,11 @@ resourcestring
   lisCodeToolsDefsErrorWhileWritingProjectInfoFile = 'Error while writing '
     +'project info file %s%s%s%s%s';
   lisCodeToolsDefsReadError = 'Read error';
+  lisTheCurrentUnitPathForTheFileIsThePathToTheLCLUnits = 'The current unit '
+    +'path for the file%s%s%s%s is%s%s%s%s.%s%sThe path to the LCL units %s%s%'
+    +'s is missing.%s%sHint for newbies:%sCreate a lazarus application and '
+    +'put the file into the project directory.';
+  lisLCLUnitPathMissing = 'LCL unit path missing';
   lisCodeToolsDefsErrorReading = 'Error reading %s%s%s%s%s';
   lisCodeToolsDefsErrorReadingProjectInfoFile = 'Error reading project info '
     +'file %s%s%s%s%s';

ide/main.pp

@@ -6488,6 +6488,8 @@ var
   ActiveSrcEdit: TSourceEditor;
   ActiveUnitInfo: TUnitInfo;
   UnitCode, LFMCode: TCodeBuffer;
+  HasDFMFile: boolean;
+  LFMFilename: String;
 begin
   // check file and directory
   writeln('TMainIDE.DoConvertDelphiUnit A ',DelphiFilename);
@@ -6500,30 +6502,37 @@ begin
   Result:=DoCloseEditorFile(DelphiFilename,[cfSaveFirst]);
   if Result<>mrOk then exit;
   DFMFilename:=FindDFMFileForDelphiUnit(DelphiFilename);
-  Result:=DoCloseEditorFile(DFMFilename,[cfSaveFirst]);
-  if Result<>mrOk then exit;
+  writeln('TMainIDE.DoConvertDelphiUnit DFM file="',DFMFilename,'"');
+  HasDFMFile:=DFMFilename<>'';
+  if HasDFMFile then begin
+    Result:=DoCloseEditorFile(DFMFilename,[cfSaveFirst]);
+    if Result<>mrOk then exit;
+  end;
   // rename files (.pas,.dfm) lowercase
   writeln('TMainIDE.DoConvertDelphiUnit Rename files');
-  Result:=RenameDelphiUnitToLazarusUnit(DelphiFilename,false);
+  LazarusUnitFilename:='';
+  LFMFilename:='';
+  Result:=RenameDelphiUnitToLazarusUnit(DelphiFilename,true,
+                       LazarusUnitFilename,LFMFilename);
   if Result<>mrOk then exit;
   // convert .dfm file to .lfm file
-  writeln('TMainIDE.DoConvertDelphiUnit Convert dfm to lfm');
-  if DFMFilename<>'' then begin
-    Result:=ConvertDFMFileToLFMFile(DFMFilename);
+  if HasDFMFile then begin
+    writeln('TMainIDE.DoConvertDelphiUnit Convert dfm format to lfm "',LFMFilename,'"');
+    Result:=ConvertDFMFileToLFMFile(LFMFilename);
     if Result<>mrOk then exit;
   end;
   // create empty .lrs file
   writeln('TMainIDE.DoConvertDelphiUnit Create empty lrs');
-  LazarusUnitFilename:=ConvertDelphiToLazarusFilename(DelphiFilename);
-  if DFMFilename<>'' then begin
+  if HasDFMFile then begin
     LRSFilename:=ChangeFileExt(LazarusUnitFilename,'.lrs');
+    writeln('TMainIDE.DoConvertDelphiUnit Create ',LRSFilename);
     Result:=CreateEmptyFile(LRSFilename,[mbAbort,mbRetry]);
     if Result<>mrOk then exit;
   end else
     LRSFilename:='';
   // add {$mode delphi} directive
   // remove windows unit and add LResources, LCLIntf
-  // remove {$R *.dfm} directive
+  // remove {$R *.dfm} or {$R *.xfm} directive
   // add initialization
   // add {$i unit.lrs} directive
   writeln('TMainIDE.DoConvertDelphiUnit Convert delphi source');
@@ -6542,10 +6551,12 @@ begin
 
     // check the LFM file and the pascal unit
     writeln('TMainIDE.DoConvertDelphiUnit Check new .lfm and .pas file');
-    Result:=LoadUnitAndLFMFile(LazarusUnitFilename,UnitCode,LFMCode);
+    Result:=LoadUnitAndLFMFile(LazarusUnitFilename,UnitCode,LFMCode,HasDFMFile);
     if Result<>mrOk then exit;
-    if not CheckLFMBuffer(UnitCode,LFMCode,@MessagesView.AddMsg) then
-    begin
+    if HasDFMFile and (LFMCode=nil) then
+      writeln('WARNING: TMainIDE.DoConvertDelphiUnit unable to load LFMCode');
+    if (LFMCode<>nil)
+    and (not CheckLFMBuffer(UnitCode,LFMCode,@MessagesView.AddMsg)) then begin
       DoJumpToCompilerMessage(-1,true);
       exit;
     end;
@@ -10301,6 +10312,9 @@ end.
 
 { =============================================================================
   $Log$
+  Revision 1.705  2004/02/01 09:19:08  mattias
+  fixed delphi2lazarus unit  R directive
+
   Revision 1.704  2004/01/27 13:00:16  mattias
   increased realease number to 0.9.0.10