diff --git a/converter/convertdelphi.pas b/converter/convertdelphi.pas index 7897aec936..55b57c3d35 100644 --- a/converter/convertdelphi.pas +++ b/converter/convertdelphi.pas @@ -51,7 +51,6 @@ type TConvertUnitFlag = ( cdtlufRenameLowercase, // rename the unit lowercase - cdtlufIsSubProc, // this is part of a big conversion -> add Abort button to all questions cdtlufCanAbort // show 'Cancel all' button in error messages using mrAbort ); TConvertUnitFlags = set of TConvertUnitFlag; @@ -84,7 +83,7 @@ type function MissingUnitToMsg(MissingUnit: string): string; function CommentAutomatically(MissingUnits: TStrings): integer; function AskUnitPathFromUser(MissingUnits: TStrings): TModalResult; - function FixMissingUnits(IsSubProc, ShowAbort: boolean): TModalResult; + function FixMissingUnits(ShowAbort: boolean): TModalResult; protected public constructor Create(AOwnerConverter: TConvertDelphiPBase; const AFilename: string; @@ -587,16 +586,15 @@ begin // add {$i unit.lrs} directive // TODO: fix delphi ambiguousities like incomplete proc implementation headers MainResFilename:=ChangeFileExt(fLazUnitFilename, '.res'); - if fLazUnitFilename='/Extra/SW/LazConvertTests/deled/trunk/Forms/frmMainForm.pas' then - Result:=mrOk; + Result:=mrOk; if not CodeToolBoss.ConvertDelphiToLazarusSource(fUnitCode, - {FileExistsUTF8(MainResFilename),} LrsFilename<>'') - then begin - Result:=mrCancel; - exit; + {FileExistsUTF8(MainResFilename),} LrsFilename<>'') then begin + Result:=JumpToCodetoolErrorAndAskToAbort(Assigned(fOwnerConverter)); + if Result=mrAbort then exit; end; + // Fix or comment missing units, FixMissingUnits shows error messages. - Result:=FixMissingUnits(cdtlufIsSubProc in fFlags,true); + Result:=FixMissingUnits(true); end; function TConvertDelphiUnit.ConvertFormFile: TModalResult; @@ -771,7 +769,7 @@ begin until not TryAgain; end; -function TConvertDelphiUnit.FixMissingUnits(IsSubProc, ShowAbort: boolean): TModalResult; +function TConvertDelphiUnit.FixMissingUnits(ShowAbort: boolean): TModalResult; var CTResult: Boolean; i: Integer; @@ -856,8 +854,8 @@ begin fSettings.MainFilename:=fOrigPFilename; fAllMissingUnits:=TStringList.Create; fAllMissingUnits.Sorted:=true; - // Scan unit files one level above project path. Used later for missing units. - CacheUnitsInPath(TrimFilename(fSettings.MainPath+'../'), fSettings.MainPath); + // Scan unit files a level above project path. Used later for missing units. + CacheUnitsInPath(TrimFilename(fSettings.MainPath+'../')); end; destructor TConvertDelphiPBase.Destroy; @@ -1172,10 +1170,9 @@ begin PasFile:=PasFileList[i]; RelPath:=FileUtil.CreateRelativePath(PasFile, ABasePath); SubPath:=ExtractFilePath(RelPath); - sUnitName:=ExtractFileName(RelPath); - sUnitName:=ExtractFileNameWithoutExt(sUnitName); + sUnitName:=ExtractFileNameOnly(RelPath); if (SubPath<>'') and (sUnitName<>'') then - fCachedUnitNames.Values[sUnitName]:=SubPath; + fCachedUnitNames.Values[UpperCase(sUnitName)]:=SubPath; end; end; @@ -1187,7 +1184,7 @@ end; function TConvertDelphiPBase.GetCachedUnitPath(const AUnitName: string): string; begin - Result:=fCachedUnitNames.Values[AUnitName]; + Result:=fCachedUnitNames.Values[UpperCase(AUnitName)]; end; function TConvertDelphiPBase.CreateMainSourceFile: TModalResult; @@ -1252,7 +1249,7 @@ var MainUnitInfo: TUnitInfo; begin // Converter for main LPR file. - fMainUnitConverter:=TConvertDelphiUnit.Create(Self,fOrigPFilename,[cdtlufIsSubProc]); + fMainUnitConverter:=TConvertDelphiUnit.Create(Self,fOrigPFilename,[]); fMainUnitConverter.LazFileExt:=LprExt; fMainUnitConverter.CopyAndLoadFile; if LazProject.MainUnitInfo=nil then begin @@ -1401,7 +1398,7 @@ begin // Main LPR file was converted earlier. if CurUnitInfo.IsPartOfProject and (CurUnitInfo<>LazProject.MainUnitInfo) then begin - Converter:=TConvertDelphiUnit.Create(Self, CurUnitInfo.Filename, [cdtlufIsSubProc]); + Converter:=TConvertDelphiUnit.Create(Self, CurUnitInfo.Filename, []); Converter.fUnitInfo:=CurUnitInfo; ConvUnits.Add(Converter); Result:=Converter.CopyAndLoadFile; @@ -1550,7 +1547,7 @@ begin // convert all units and fix .lfm files for i:=0 to LazPackage.FileCount-1 do begin PkgFile:=LazPackage.Files[i]; - Converter:=TConvertDelphiUnit.Create(Self, PkgFile.Filename, [cdtlufIsSubProc]); + Converter:=TConvertDelphiUnit.Create(Self, PkgFile.Filename, []); ConvUnits.Add(Converter); Result:=Converter.CopyAndLoadFile; Result:=Converter.CheckFailed(Result); diff --git a/converter/convertsettings.lfm b/converter/convertsettings.lfm index 3352dc50e5..5833fc49f0 100644 --- a/converter/convertsettings.lfm +++ b/converter/convertsettings.lfm @@ -1,7 +1,7 @@ object ConvertSettingsForm: TConvertSettingsForm - Left = 319 + Left = 265 Height = 350 - Top = 122 + Top = 248 Width = 558 Caption = 'Convert Delphi unit, project or package ' ClientHeight = 350 diff --git a/converter/delphiproject2laz.pas b/converter/delphiproject2laz.pas index fd7267ecaa..8610148bb8 100644 --- a/converter/delphiproject2laz.pas +++ b/converter/delphiproject2laz.pas @@ -43,11 +43,11 @@ unit DelphiProject2Laz; interface -uses +uses ConvertDelphi, // LCL+FCL - Classes, SysUtils, LCLProc, Forms, Controls, Dialogs, FileProcs, FileUtil, + Classes, SysUtils, LCLProc, Forms, Controls, Dialogs, FileProcs, FileUtil; // codetools - ExprEval, DefineTemplates, CodeCache, CodeToolManager, CodeToolsStructs, +{ ExprEval, DefineTemplates, CodeCache, CodeToolManager, CodeToolsStructs, LinkScanner, // IDEIntf SrcEditorIntf, ComponentReg, IDEMsgIntf, MainIntf, LazIDEIntf, PackageIntf, @@ -56,7 +56,7 @@ uses IDEProcs, DelphiUnit2Laz, Project, DialogProcs, CheckLFMDlg, EditorOptions, ProjectInspector, CompilerOptions, PackageDefs, PackageSystem, PackageEditor, - BasePkgManager, PkgManager; + BasePkgManager, PkgManager; } const SettingDelphiModeTemplName = 'Setting Delphi Mode'; @@ -72,889 +72,53 @@ type ); TConvertDelphiToLazarusUnitFlags = set of TConvertDelphiToLazarusUnitFlag; -// project +function ConvertDelphiToLazarusUnit(const DelphiFilename: string; + Flags: TConvertDelphiToLazarusUnitFlags): TModalResult; function ConvertDelphiToLazarusProject(const ProjectFilename: string ): TModalResult; -function FindAllDelphiProjectUnits(AProject: TProject): TModalResult; -function ConvertAllDelphiProjectUnits(AProject: TProject; - Flags: TConvertDelphiToLazarusUnitFlags): TModalResult; - -// package function ConvertDelphiToLazarusPackage(const PackageFilename: string ): TModalResult; -function FindDPKFilename(const LPKFilename: string): string; -function FindAllDelphiPackageUnits(APackage: TLazPackage; - ShowAbort: boolean): TModalResult; -function LoadDPKFile(APackage: TLazPackage; out DPKCode: TCodeBuffer; - ShowAbort: boolean): TModalResult; -function ConvertAllDelphiPackageUnits(APackage: TLazPackage; - Flags: TConvertDelphiToLazarusUnitFlags): TModalResult; - -// unit -function ConvertDelphiToLazarusUnit(const DelphiFilename: string; - Flags: TConvertDelphiToLazarusUnitFlags): TModalResult; - -// project parts -function CreateDelphiToLazarusProjectInstance(const LPIFilename: string; - out AProject: TProject): TModalResult; -function CreateDelphiToLazarusMainSourceFile(AProject: TProject; - const DPRFilename, MainSourceFilename: string; - out LPRCode: TCodeBuffer): TModalResult; -function FindDPRFilename(const StartFilename: string): string; -function ReadDelphiProjectConfigFiles(AProject: TProject): TModalResult; - -// package parts -function CreateDelphiToLazarusPackageInstance(const LPKFilename: string; - out APackage: TLazPackage): TModalResult; -function ReadDelphiPackageConfigFiles(APackage: TLazPackage): TModalResult; - -// project/package -procedure CleanUpCompilerOptionsSearchPaths(Options: TBaseCompilerOptions); -procedure SetCompilerModeForDefineTempl(DefTempl: TDefineTemplate); -procedure UnsetCompilerModeForDefineTempl(DefTempl: TDefineTemplate); implementation -function ConvertDelphiToLazarusProject(const ProjectFilename: string - ): TModalResult; -{ Creates or updates a lazarus project (.lpi+.lpr) - This function can be invoked on a delphi project .dpr file, or a lazarus - project (.lpi/.lpr) file. - It will use, whatever it finds and will make it more lazarus-like. - It can be aborted and called again. -} -var - LPRCode: TCodeBuffer; - LPIFilename: String; - DPRFilename: String; - MainSourceFilename: String; - ConvertUnitFlags: TConvertDelphiToLazarusUnitFlags; - AProject: TProject; -begin - debugln('ConvertDelphiToLazarusProject ProjectFilename="',ProjectFilename,'"'); - IDEMessagesWindow.Clear; - - // create/open lazarus project file - LPIFilename:=ChangeFileExt(ProjectFilename,'.lpi'); - Result:=CreateDelphiToLazarusProjectInstance(LPIFilename,AProject); - if Result<>mrOk then begin - DebugLn('ConvertDelphiToLazarusProject failed to create/open project LPIFilename="',LPIFilename,'"'); - exit; - end; - - // create main source file (.lpr) (only copy, no conversion) - DPRFilename:=FindDPRFilename(ProjectFilename); - DebugLn('ConvertDelphiToLazarusProject DPRFilename="',DPRFilename,'"'); - MainSourceFilename:=ChangeFileExt(LPIFilename,'.lpr'); - Result:=CreateDelphiToLazarusMainSourceFile(AProject,DPRFilename, - MainSourceFilename,LPRCode); - if Result<>mrOk then exit; - - // read config files (they often contain clues about paths, switches and defines) - Result:=ReadDelphiProjectConfigFiles(AProject); - if Result<>mrOk then begin - DebugLn('ConvertDelphiToLazarusProject failed reading Delphi configs'); - exit; - end; - - // clean up project - AProject.RemoveNonExistingFiles(false); - CleanUpCompilerOptionsSearchPaths(AProject.CompilerOptions); - - // load required packages - AProject.AddPackageDependency('LCL');// Nearly all Delphi projects require it - PkgBoss.AddDefaultDependencies(AProject); - - // we have now enough information to parse the .dpr file, - // but not enough to parse the units - - // set Delphi mode for all project source directories - AProject.DefineTemplates.CustomDefinesChanged; - SetCompilerModeForDefineTempl(AProject.DefineTemplates.CustomDefines); - try - - // sync IDE and codetools - if not LazarusIDE.BeginCodeTools then begin - DebugLn('ConvertDelphiToLazarusProject failed BeginCodeTools'); - Result:=mrCancel; - exit; - end; - - // fix .lpr - ConvertUnitFlags:=[cdtlufIsSubProc,cdtlufDoNotSetDelphiMode]; - Result:=ConvertDelphiToLazarusUnit(LPRCode.Filename,ConvertUnitFlags); - if Result=mrAbort then begin - DebugLn('ConvertDelphiToLazarusProject failed converting unit ',LPRCode.Filename); - exit; - end; - - // get all options from .lpr (the former .dpr) - Result:=ExtractOptionsFromDelphiSource(LPRCode.Filename,AProject); - if Result<>mrOk then exit; - - // find and convert all project files - Result:=FindAllDelphiProjectUnits(AProject); - if Result<>mrOk then exit; - - // convert all project files - Result:=ConvertAllDelphiProjectUnits(AProject,[cdtlufIsSubProc,cdtlufCheckLFM]); - if Result<>mrOk then exit; - finally - UnsetCompilerModeForDefineTempl(AProject.DefineTemplates.CustomDefines); - end; - - debugln('ConvertDelphiToLazarusProject Done'); - Result:=mrOk; -end; - -function FindAllDelphiProjectUnits(AProject: TProject): TModalResult; -var - FoundInUnits, MissingInUnits, NormalUnits: TStrings; - LPRCode: TCodeBuffer; - NotFoundUnits: String; - i: Integer; - CurUnitInfo: TUnitInfo; - NewSearchPath: String; - CurFilename: string; - p: LongInt; - OffendingUnit: TUnitInfo; -begin - LPRCode:=AProject.MainUnitInfo.Source; - - FoundInUnits:=nil; - MissingInUnits:=nil; - NormalUnits:=nil; - try - debugln('FindAllDelphiProjectUnits gathering all project units ...'); - if not CodeToolBoss.FindDelphiProjectUnits(LPRCode,FoundInUnits, - MissingInUnits, NormalUnits) then - begin - LazarusIDE.DoJumpToCodeToolBossError; - Result:=mrCancel; - exit; - end; - debugln('FindAllDelphiProjectUnits FoundInUnits=[',FoundInUnits.Text,']', - ' MissingInUnits=[',MissingInUnits.Text,']', - ' NormalUnits=[',NormalUnits.Text,']'); - // warn about missing units - if (MissingInUnits<>nil) and (MissingInUnits.Count>0) then begin - NotFoundUnits:=MissingInUnits.Text; - Result:=QuestionDlg('Units not found', - 'Some units of the delphi project are missing:'#13 - +NotFoundUnits,mtWarning,[mrIgnore,mrAbort],0); - if Result<>mrIgnore then exit; - end; - - try - // add all units to the project - debugln('FindAllDelphiProjectUnits adding all project units to project ...'); - - for i:=0 to FoundInUnits.Count-1 do begin - CurFilename:=FoundInUnits[i]; - p:=System.Pos(' in ',CurFilename); - if p>0 then - CurFilename:=copy(CurFilename,p+4,length(CurFilename)); - if CurFilename='' then continue; - if not FilenameIsAbsolute(CurFilename) then - CurFilename:=AppendPathDelim(AProject.ProjectDirectory)+CurFilename; - CurFilename:=TrimFilename(CurFilename); - if not FileExistsUTF8(CurFilename) then begin - DebugLn('FindAllDelphiProjectUnits file not found: "',CurFilename,'"'); - continue; - end; - CurUnitInfo:=AProject.UnitInfoWithFilename(CurFilename); - if CurUnitInfo<>nil then begin - CurUnitInfo.IsPartOfProject:=true; - end else begin - if FilenameIsPascalUnit(CurFilename) then begin - // check unitname - OffendingUnit:=AProject.UnitWithUnitname( - ExtractFileNameOnly(CurFilename)); - if OffendingUnit<>nil then begin - Result:=QuestionDlg('Unitname exists twice', - 'There are two units with the same unitname:'#13 - +OffendingUnit.Filename+#13 - +CurFilename+#13, - mtWarning,[mrYes,'Remove first',mrNo,'Remove second', - mrIgnore,'Keep both',mrAbort],0); - case Result of - mrYes: OffendingUnit.IsPartOfProject:=false; - mrNo: continue; - mrIgnore: ; - else - Result:=mrAbort; - exit; - end; - end; - end; - - // add new unit to project - CurUnitInfo:=TUnitInfo.Create(nil); - CurUnitInfo.Filename:=CurFilename; - CurUnitInfo.IsPartOfProject:=true; - AProject.AddFile(CurUnitInfo,false); - end; - end; - - finally - // set unit paths to find all project units - NewSearchPath:=MergeSearchPaths(AProject.CompilerOptions.OtherUnitFiles, - AProject.SourceDirectories.CreateSearchPathFromAllFiles); - NewSearchPath:=RemoveSearchPaths(NewSearchPath, - '.;'+VirtualDirectory+';'+VirtualTempDir - +';'+AProject.ProjectDirectory); - AProject.CompilerOptions.OtherUnitFiles:=MinimizeSearchPath( - RemoveNonExistingPaths(NewSearchPath,AProject.ProjectDirectory)); - // set include path - NewSearchPath:=MergeSearchPaths(AProject.CompilerOptions.IncludePath, - AProject.SourceDirectories.CreateSearchPathFromAllFiles); - NewSearchPath:=RemoveSearchPaths(NewSearchPath, - '.;'+VirtualDirectory+';'+VirtualTempDir - +';'+AProject.ProjectDirectory); - AProject.CompilerOptions.IncludePath:=MinimizeSearchPath( - RemoveNonExistingPaths(NewSearchPath,AProject.ProjectDirectory)); - // clear caches - AProject.DefineTemplates.SourceDirectoriesChanged; - CodeToolBoss.DefineTree.ClearCache; - DebugLn('FindAllDelphiProjectUnits UnitPath="',AProject.CompilerOptions.OtherUnitFiles,'"'); - end; - - // save project - debugln('FindAllDelphiProjectUnits Saving project ...'); - // Add interfaces unit silently, no question dialogs. - Result:=LazarusIDE.DoSaveProject([sfQuietUnitCheck]); - if Result<>mrOk then begin - DebugLn('FindAllDelphiProjectUnits failed saving project'); - exit; - end; - - finally - FoundInUnits.Free; - MissingInUnits.Free; - NormalUnits.Free; - end; - - Result:=mrOk; -end; - -function ConvertAllDelphiProjectUnits(AProject: TProject; - Flags: TConvertDelphiToLazarusUnitFlags): TModalResult; - - function Convert(CurFlags: TConvertDelphiToLazarusUnitFlags): TModalResult; - var - i: Integer; - CurUnitInfo: TUnitInfo; - begin - // convert all units - i:=0; - while imrOk then exit; - // now the unit interdependencies can be checked - // now convert the lfm files - if cdtlufCheckLFM in Flags then begin - // fix the .lfm files - Result:=Convert(Flags); - if Result<>mrOk then exit; - end; -end; - -function FindDPKFilename(const LPKFilename: string): string; -begin - Result:=ChangeFileExt(LPKFilename,'.dpk'); - Result:=CodeToolBoss.DirectoryCachePool.FindDiskFilename(Result); -end; - -function ConvertDelphiToLazarusPackage(const PackageFilename: string - ): TModalResult; -var - APackage: TLazPackage; - LPKFilename: String; - DPKFilename: String; -begin - debugln('ConvertDelphiToLazarusPackage PackageFilename="',PackageFilename,'"'); - IDEMessagesWindow.Clear; - - // create/open lazarus package file - LPKFilename:=ChangeFileExt(PackageFilename,'.lpk'); - Result:=CreateDelphiToLazarusPackageInstance(LPKFilename,APackage); - if Result<>mrOk then begin - DebugLn('ConvertDelphiToLazarusPackage failed to create/open package LPKFilename="',LPKFilename,'"'); - exit; - end; - - // read config files (they often contain clues about paths, switches and defines) - Result:=ReadDelphiPackageConfigFiles(APackage); - if Result<>mrOk then begin - DebugLn('ConvertDelphiToLazarusProject failed reading Delphi configs'); - exit; - end; - - // clean up package - APackage.RemoveNonExistingFiles; - CleanUpCompilerOptionsSearchPaths(APackage.CompilerOptions); - - // load required packages - APackage.AddPackageDependency('LCL');// Nearly all Delphi packages require it - - // we have now enough information to parse the .dpk file, - // but not enough to parse the units - - // set Delphi mode for all package source directories - APackage.DefineTemplates.CustomDefinesChanged; - SetCompilerModeForDefineTempl(APackage.DefineTemplates.CustomDefines); - try - // init codetools - if not LazarusIDE.BeginCodeTools then begin - DebugLn('ConvertDelphiToLazarusPackage failed BeginCodeTools'); - Result:=mrCancel; - exit; - end; - - // get all options from the .dpk - DPKFilename:=FindDPKFilename(PackageFilename); - if DPKFilename<>'' then begin - Result:=ExtractOptionsFromDPK(DPKFilename,APackage); - if Result<>mrOk then exit; - end; - - // find and convert all project files - Result:=FindAllDelphiPackageUnits(APackage,true); - if Result<>mrOk then exit; - - // convert all package files - Result:=ConvertAllDelphiPackageUnits(APackage,[cdtlufIsSubProc,cdtlufCheckLFM]); - if Result<>mrOk then exit; - finally - UnsetCompilerModeForDefineTempl(APackage.DefineTemplates.CustomDefines); - end; - - debugln('ConvertDelphiToLazarusProject Done'); - Result:=mrOk; -end; - -function FindAllDelphiPackageUnits(APackage: TLazPackage; - ShowAbort: boolean): TModalResult; -var - FoundInUnits, MissingInUnits, NormalUnits: TStrings; - DPKCode: TCodeBuffer; - NotFoundUnits: String; - i: Integer; - NewSearchPath: String; - CurFilename: string; - p: LongInt; - OffendingUnit: TPkgFile; - PkgFile: TPkgFile; -begin - Result:=LoadDPKFile(APackage,DPKCode,ShowAbort); - if Result<>mrOk then exit; - - FoundInUnits:=nil; - MissingInUnits:=nil; - NormalUnits:=nil; - try - debugln('FindAllDelphiPackageUnits gathering all units ...'); - if not CodeToolBoss.FindDelphiPackageUnits(DPKCode,FoundInUnits, - MissingInUnits, NormalUnits) then - begin - LazarusIDE.DoJumpToCodeToolBossError; - Result:=mrCancel; - exit; - end; - debugln('FindAllDelphiPackageUnits FoundInUnits=[',FoundInUnits.Text,']', - ' MissingInUnits=[',MissingInUnits.Text,']', - ' NormalUnits=[',NormalUnits.Text,']'); - // warn about missing units - if (MissingInUnits<>nil) and (MissingInUnits.Count>0) then begin - NotFoundUnits:=MissingInUnits.Text; - Result:=QuestionDlg('Units not found', - 'Some units of the delphi package are missing:'#13 - +NotFoundUnits,mtWarning,[mrIgnore,mrAbort],0); - if Result<>mrIgnore then exit; - end; - - try - // add all units to the package - debugln('FindAllDelphiPackageUnits adding all units to package ...'); - - for i:=0 to FoundInUnits.Count-1 do begin - CurFilename:=FoundInUnits[i]; - p:=System.Pos(' in ',CurFilename); - if p>0 then - CurFilename:=copy(CurFilename,p+4,length(CurFilename)); - if CurFilename='' then continue; - if not FilenameIsAbsolute(CurFilename) then - CurFilename:=AppendPathDelim(APackage.Directory)+CurFilename; - CurFilename:=TrimFilename(CurFilename); - if not FileExistsUTF8(CurFilename) then begin - DebugLn('FindAllDelphiPackageUnits file not found: "',CurFilename,'"'); - continue; - end; - PkgFile:=APackage.FindPkgFile(CurFilename,true,false); - if PkgFile=nil then begin - if FilenameIsPascalUnit(CurFilename) then begin - // check unitname - OffendingUnit:=APackage.FindUnit(ExtractFileNameOnly(CurFilename)); - if OffendingUnit<>nil then begin - Result:=QuestionDlg('Unitname exists twice', - 'There are two units with the same unitname:'#13 - +OffendingUnit.Filename+#13 - +CurFilename+#13, - mtWarning,[mrNo,'Remove second',mrAbort],0); - case Result of - mrNo: continue; - mrIgnore: ; - else - Result:=mrAbort; - exit; - end; - end; - end; - - // add new unit to package - APackage.AddFile(CurFilename,ExtractFileNameOnly(CurFilename), - pftUnit,[pffAddToPkgUsesSection],cpNormal); - end; - end; - - finally - // set unit paths to find all project units - NewSearchPath:=MergeSearchPaths(APackage.CompilerOptions.OtherUnitFiles, - APackage.SourceDirectories.CreateSearchPathFromAllFiles); - NewSearchPath:=RemoveSearchPaths(NewSearchPath, - '.;'+VirtualDirectory+';'+VirtualTempDir - +';'+APackage.Directory); - APackage.CompilerOptions.OtherUnitFiles:=MinimizeSearchPath( - RemoveNonExistingPaths(NewSearchPath,APackage.Directory)); - // set include path - NewSearchPath:=MergeSearchPaths(APackage.CompilerOptions.IncludePath, - APackage.SourceDirectories.CreateSearchPathFromAllFiles); - NewSearchPath:=RemoveSearchPaths(NewSearchPath, - '.;'+VirtualDirectory+';'+VirtualTempDir - +';'+APackage.Directory); - APackage.CompilerOptions.IncludePath:=MinimizeSearchPath( - RemoveNonExistingPaths(NewSearchPath,APackage.Directory)); - // clear caches - APackage.DefineTemplates.SourceDirectoriesChanged; - CodeToolBoss.DefineTree.ClearCache; - DebugLn('FindAllDelphiPackageUnits UnitPath="',APackage.CompilerOptions.OtherUnitFiles,'"'); - end; - - // save package - debugln('FindAllDelphiPackageUnits Saving package ...'); - Result:=PackageEditors.SavePackage(APackage,false); - if Result<>mrOk then begin - DebugLn('FindAllDelphiPackageUnits failed saving package'); - exit; - end; - - finally - FoundInUnits.Free; - MissingInUnits.Free; - NormalUnits.Free; - end; - - Result:=mrOk; -end; - -function LoadDPKFile(APackage: TLazPackage; out DPKCode: TCodeBuffer; - ShowAbort: boolean): TModalResult; -var - DPKFilename: String; -begin - DPKFilename:=FindDPKFilename(APackage.Filename); - if not FileExistsCached(DPKFilename) then begin - Result:=MessageDlg('File not found', - 'Delphi package main source (.dpk) file not found for package'#13 - +APackage.Filename,mtError,[mbAbort],0); - exit; - end; - Result:=LoadCodeBuffer(DPKCode,DPKFilename,[],ShowAbort); -end; - -function ConvertAllDelphiPackageUnits(APackage: TLazPackage; - Flags: TConvertDelphiToLazarusUnitFlags): TModalResult; - - function Convert(CurFlags: TConvertDelphiToLazarusUnitFlags): TModalResult; - var - i: Integer; - PkgFile: TPkgFile; - begin - // convert all units - i:=0; - while imrOk then exit; - // now the unit interdependencies can be checked - // now convert the lfm files - if cdtlufCheckLFM in Flags then begin - // fix the .lfm files - Result:=Convert(Flags); - if Result<>mrOk then exit; - end; -end; - function ConvertDelphiToLazarusUnit(const DelphiFilename: string; Flags: TConvertDelphiToLazarusUnitFlags): TModalResult; var - DFMFilename: String; - LazarusUnitFilename: String; - LRSFilename: String; - UnitCode, LFMCode: TCodeBuffer; - HasDFMFile: boolean; - LFMFilename: String; + Converter: TConvertDelphiUnit; begin - // check file and directory - DebugLn('ConvertDelphiToLazarusUnit A ',DelphiFilename,' FixLFM=',dbgs(cdtlufCheckLFM in Flags),' IgnoreUsedUnits=',dbgs(cdtlufIgnoreUsedUnits in Flags)); - Result:=CheckFileIsWritable(DelphiFilename,[mbAbort]); - if Result<>mrOk then exit; - - // close Delphi files in editor - DebugLn('ConvertDelphiToLazarusUnit Close files in editor .pas/.dfm'); - Result:=LazarusIDE.DoCloseEditorFile(DelphiFilename,[cfSaveFirst]); - if Result<>mrOk then exit; - DFMFilename:=FindDFMFileForDelphiUnit(DelphiFilename); - DebugLn('ConvertDelphiToLazarusUnit DFM file="',DFMFilename,'"'); - HasDFMFile:=DFMFilename<>''; - if HasDFMFile then begin - Result:=LazarusIDE.DoCloseEditorFile(DFMFilename,[cfSaveFirst]); - if Result<>mrOk then exit; + Converter := TConvertDelphiUnit.Create(nil, DelphiFilename, []); + try + Result:=Converter.Convert; + finally + Converter.Free; end; - - // rename files (.pas,.dfm) lowercase - // TODO: rename files in project - DebugLn('ConvertDelphiToLazarusUnit Rename files'); - LazarusUnitFilename:=''; - LFMFilename:=''; - Result:=RenameDelphiUnitToLazarusUnit(DelphiFilename,true, - cdtlufRenameLowercase in Flags, - LazarusUnitFilename,LFMFilename); - if Result<>mrOk then exit; - if LFMFilename='' then LFMFilename:=ChangeFileExt(LazarusUnitFilename,'.lfm'); - HasDFMFile:=FileExistsUTF8(LFMFilename); - - // convert .dfm file to .lfm file (without context type checking) - if HasDFMFile then begin - DebugLn('ConvertDelphiToLazarusUnit Rename dfm to lfm "',LFMFilename,'"'); - Result:=ConvertDFMFileToLFMFile(LFMFilename); - if Result<>mrOk then exit; - end; - // create empty .lrs file - DebugLn('ConvertDelphiToLazarusUnit Create empty lrs'); - if HasDFMFile then begin - LRSFilename:=ChangeFileExt(LazarusUnitFilename,'.lrs'); - DebugLn('ConvertDelphiToLazarusUnit Create ',LRSFilename); - Result:=CreateEmptyFile(LRSFilename,[mbAbort,mbRetry]); - if Result<>mrOk then exit; - end else - LRSFilename:=''; - - DebugLn('ConvertDelphiToLazarusUnit Convert delphi source'); - if not LazarusIDE.BeginCodeTools then begin - Result:=mrCancel; - exit; - end; - - // check LCL path - Result:=CheckFilenameForLCLPaths(LazarusUnitFilename); - if Result<>mrOk then exit; - - // add {$mode delphi} directive - // remove windows unit and add LResources, LCLIntf - // remove {$R *.dfm} or {$R *.xfm} directive - // add initialization - // add {$i unit.lrs} directive - // TODO: fix delphi ambiguousities like incomplete proc implementation headers - Result:=ConvertDelphiSourceToLazarusSource(LazarusUnitFilename, - LRSFilename<>'',true); - if not IfNotOkJumpToCodetoolErrorAndAskToAbort(Result=mrOk, - cdtlufIsSubProc in Flags,Result) - then exit; - - // fix or comment missing units - DebugLn('ConvertDelphiToLazarusUnit FixMissingUnits'); - Result:=FixMissingUnits(LazarusUnitFilename,cdtlufIsSubProc in Flags,true); - if Result=mrAbort then exit; - if (Result<>mrOk) then begin - Result:=JumpToCodetoolErrorAndAskToAbort(cdtlufIsSubProc in Flags); - exit; - end; - - if (cdtlufCheckLFM in Flags) and (not (cdtlufIgnoreUsedUnits in Flags)) then - begin - // check the LFM file and the pascal unit - DebugLn('ConvertDelphiToLazarusUnit Check new .lfm and .pas file'); - Result:=LoadUnitAndLFMFile(LazarusUnitFilename,UnitCode,LFMCode,HasDFMFile,true); - if Result<>mrOk then exit; - if HasDFMFile and (LFMCode=nil) then - DebugLn('WARNING: ConvertDelphiToLazarusUnit unable to load LFMCode'); - if (LFMCode<>nil) - and (RepairLFMBuffer(UnitCode,LFMCode,@IDEMessagesWindow.AddMsg,true,true)<>mrOk) - then begin - LazarusIDE.DoJumpToCompilerMessage(-1,true); - exit(mrAbort); - end; - - if LFMCode<>nil then begin - // save LFM file - DebugLn('ConvertDelphiToLazarusUnit Save LFM'); - Result:=SaveCodeBufferToFile(LFMCode,LFMCode.Filename); - if Result<>mrOk then exit; - - // convert lfm to lrs - DebugLn('ConvertDelphiToLazarusUnit Convert lfm to lrs'); - Result:=ConvertLFMtoLRSfile(LFMCode.Filename); - if Result<>mrOk then exit; - end; - end; - - Result:=mrOk; end; -function CreateDelphiToLazarusProjectInstance(const LPIFilename: string; - out AProject: TProject): TModalResult; -// If .lpi does not exist, create it -// open new project -begin - DebugLn('CreateDelphiToLazarusProjectInstance LPIFilename="',LPIFilename,'"'); - AProject:=Project1; - if FileExistsUTF8(LPIFilename) then begin - // there is already a lazarus project -> open it, if not already open - if (AProject=nil) or - (CompareFilenames(AProject.ProjectInfoFile,LPIFilename)<>0) then - begin - DebugLn('CreateDelphiToLazarusProject open "',LPIFilename,'"'); - Result:=LazarusIDE.DoOpenProjectFile(LPIFilename,[]); - AProject:=Project1; - if Result<>mrOk then exit; - end; - end else begin - // create a new lazarus project - Result:=LazarusIDE.DoNewProject(ProjectDescriptorEmptyProject); - AProject:=Project1; - if Result<>mrOk then begin - DebugLn('CreateDelphiToLazarusProjectInstance failed to create a new project'); - exit; - end; - AProject.ProjectInfoFile:=LPIFilename; - end; - // save to disk (this makes sure, all editor changes are saved too) - DebugLn('CreateDelphiToLazarusProjectInstance saving project ...'); - Result:=LazarusIDE.DoSaveProject([]); -end; - -function CreateDelphiToLazarusMainSourceFile(AProject: TProject; - const DPRFilename, MainSourceFilename: string; - out LPRCode: TCodeBuffer): TModalResult; -// if .lpr does not exists, copy the .dpr file to the .lpr -// adds the .lpr as main unit to the project, if not already done +function ConvertDelphiToLazarusProject(const ProjectFilename: string): TModalResult; var - MainUnitInfo: TUnitInfo; + Converter: TConvertDelphiProject; begin - LPRCode:=nil; - Result:=CreateLPRFileForDPRFile(DPRFilename,MainSourceFilename,LPRCode,true); - if Result<>mrOk then begin - DebugLn('CreateDelphiToLazarusMainSourceFile CreateLPRFileForDPRFile failed DPRFilename="',DPRFilename,'" MainSourceFilename="',MainSourceFilename,'"'); - exit; - end; - if AProject.MainUnitInfo=nil then begin - // add .lpr file to project as main unit - DebugLn('CreateDelphiToLazarusMainSourceFile adding .lpr file to project as main unit ',LPRCode.Filename); - MainUnitInfo:=TUnitInfo.Create(LPRCode); - MainUnitInfo.SyntaxHighlighter:= - ExtensionToLazSyntaxHighlighter(ExtractFileExt(LPRCode.Filename)); - MainUnitInfo.IsPartOfProject:=true; - AProject.AddFile(MainUnitInfo,false); - AProject.MainFileID:=0; - end else begin - // replace main unit in project - AProject.MainUnitInfo.Source:=LPRCode; + Converter := TConvertDelphiProject.Create(ProjectFilename); + try + Result:=Converter.Convert; + finally + Converter.Free; end; end; -function FindDPRFilename(const StartFilename: string): string; -// searches the corresponding .dpr file -begin - if CompareFileExt(StartFilename,'.dpr',false)=0 then - Result:=StartFilename - else - Result:=ChangeFileExt(StartFilename,'.dpr'); - if not FileExistsUTF8(Result) then - Result:=FindDiskFileCaseInsensitive(StartFilename); -end; - -function ReadDelphiProjectConfigFiles(AProject: TProject): TModalResult; +function ConvertDelphiToLazarusPackage(const PackageFilename: string): TModalResult; var - MainSourceFilename: String; - DOFFilename: String; - CFGFilename: String; + Converter: TConvertDelphiPackage; begin - if AProject.MainUnitInfo=nil then exit(mrOk); - MainSourceFilename:=AProject.MainUnitInfo.Filename; - - // read .dof file - DOFFilename:=FindDelphiDOF(MainSourceFilename); - Result:=ExtractOptionsFromDOF(DOFFilename,Project1); - if Result<>mrOk then exit; - - // read .cfg file - CFGFilename:=FindDelphiCFG(MainSourceFilename); - Result:=ExtractOptionsFromCFG(CFGFilename,Project1); -end; - -procedure SetCompilerModeForDefineTempl(DefTempl: TDefineTemplate); -begin - if DefTempl.FindChildByName(SettingDelphiModeTemplName)<>nil then exit; - DefTempl.ReplaceChild(CreateDefinesForFPCMode(SettingDelphiModeTemplName,cmDELPHI)); - CodeToolBoss.DefineTree.ClearCache; -end; - -procedure UnsetCompilerModeForDefineTempl(DefTempl: TDefineTemplate); -begin - if DefTempl.FindChildByName(SettingDelphiModeTemplName)=nil then exit; - DefTempl.DeleteChild(SettingDelphiModeTemplName); - CodeToolBoss.DefineTree.ClearCache; -end; - -function CreateDelphiToLazarusPackageInstance(const LPKFilename: string; out - APackage: TLazPackage): TModalResult; -// If .lpk does not exist, create it -// open new package -var - PkgName: String; - CurEditor: TPackageEditorForm; -begin - DebugLn('CreateDelphiToLazarusPackageInstance LPKFilename="',LPKFilename,'"'); - APackage:=nil; - if FileExistsUTF8(LPKFilename) then begin - // there is already a lazarus package file - // open the package editor - DebugLn('CreateDelphiToLazarusPackageInstance OPEN ',LPKFilename); - Result:=PackageEditingInterface.DoOpenPackageFile(LPKFilename,[pofAddToRecent],true); - if Result<>mrOk then exit; - end; - - // search package in graph - PkgName:=ExtractFileNameOnly(LPKFilename); - APackage:=PackageGraph.FindAPackageWithName(PkgName,nil); - if APackage<>nil then begin - // there is already a package loaded with this name ... - if CompareFilenames(APackage.Filename,LPKFilename)<>0 then begin - // ... but it is not the package file we want -> stop - MessageDlg('Package name exists', - 'There is already a package with the name "'+PkgName+'"'#13 - +'Please close this package first.',mtError,[mbAbort],0); - PackageEditingInterface.DoOpenPackageFile(APackage.Filename, - [pofAddToRecent],true); - Result:=mrAbort; - exit; - end else begin - Result:=mrOk; - end; - end else begin - // there is not yet a package with this name - // -> create a new package with LCL as dependency - APackage:=PackageGraph.CreateNewPackage(PkgName); - DebugLn('CreateDelphiToLazarusPackageInstance CREATED ',APackage.Name); - PackageGraph.AddDependencyToPackage(APackage, - PackageGraph.LCLPackage.CreateDependencyWithOwner(APackage)); - APackage.Filename:=LPKFilename; - - // open a package editor - CurEditor:=PackageEditors.OpenEditor(APackage); - CurEditor.Show; - - // save .lpk file - PackageEditors.SavePackage(APackage,false); - - Result:=mrOk; + Converter := TConvertDelphiPackage.Create(PackageFilename); + try + Result:=Converter.Convert; + finally + Converter.Free; end; end; -function ReadDelphiPackageConfigFiles(APackage: TLazPackage): TModalResult; -var - DOFFilename: String; - CFGFilename: String; -begin - // read .dof file - DOFFilename:=FindDelphiDOF(APackage.Filename); - Result:=ExtractOptionsFromDOF(DOFFilename,APackage); - if Result<>mrOk then exit; - - // read .cfg file - CFGFilename:=FindDelphiCFG(APackage.Filename); - Result:=ExtractOptionsFromCFG(CFGFilename,APackage); -end; - -procedure CleanUpCompilerOptionsSearchPaths(Options: TBaseCompilerOptions); -var - BasePath: String; - - function CleanProjectSearchPath(const SearchPath: string): string; - begin - Result:=RemoveNonExistingPaths(SearchPath,BasePath); - Result:=MinimizeSearchPath(Result); - end; - -begin - BasePath:=Options.BaseDirectory; - Options.OtherUnitFiles:=CleanProjectSearchPath(Options.OtherUnitFiles); - Options.IncludePath:=CleanProjectSearchPath(Options.IncludePath); - Options.Libraries:=CleanProjectSearchPath(Options.Libraries); - Options.ObjectPath:=CleanProjectSearchPath(Options.ObjectPath); - Options.SrcPath:=CleanProjectSearchPath(Options.SrcPath); -end; end. diff --git a/ide/checklfmdlg.lfm b/ide/checklfmdlg.lfm index 24151a43e3..73c4ef5884 100644 --- a/ide/checklfmdlg.lfm +++ b/ide/checklfmdlg.lfm @@ -11,7 +11,7 @@ object CheckLFMDialog: TCheckLFMDialog LCLVersion = '0.9.29' object NoteLabel: TLabel Left = 0 - Height = 14 + Height = 16 Top = 0 Width = 552 Align = alTop @@ -21,19 +21,19 @@ object CheckLFMDialog: TCheckLFMDialog end object LFMGroupBox: TGroupBox Left = 0 - Height = 424 - Top = 14 + Height = 412 + Top = 16 Width = 552 Align = alClient Caption = 'LFM file' - ClientHeight = 406 - ClientWidth = 548 + ClientHeight = 390 + ClientWidth = 542 TabOrder = 0 inline LFMSynEdit: TSynEdit Left = 0 - Height = 406 + Height = 390 Top = 0 - Width = 548 + Width = 542 Align = alClient Font.Height = -15 Font.Name = 'courier' @@ -42,7 +42,6 @@ object CheckLFMDialog: TCheckLFMDialog ParentColor = False ParentFont = False TabOrder = 0 - BookMarkOptions.OnChange = nil Gutter.Width = 59 Gutter.MouseActions = < item @@ -629,18 +628,18 @@ object CheckLFMDialog: TCheckLFMDialog object ErrorsGroupBox: TGroupBox Left = 0 Height = 104 - Top = 438 + Top = 428 Width = 552 Align = alBottom Caption = 'Errors' - ClientHeight = 86 - ClientWidth = 548 + ClientHeight = 82 + ClientWidth = 542 TabOrder = 1 object ErrorsListBox: TListBox Left = 0 - Height = 86 + Height = 82 Top = 0 - Width = 548 + Width = 542 Align = alClient ItemHeight = 0 OnClick = ErrorsListBoxClick @@ -649,20 +648,20 @@ object CheckLFMDialog: TCheckLFMDialog end object BtnPanel: TPanel Left = 0 - Height = 38 - Top = 542 + Height = 48 + Top = 532 Width = 552 Align = alBottom AutoSize = True BevelOuter = bvNone - ClientHeight = 38 + ClientHeight = 48 ClientWidth = 552 TabOrder = 2 object CancelButton: TBitBtn - Left = 469 - Height = 26 + Left = 465 + Height = 36 Top = 6 - Width = 77 + Width = 81 Align = alRight AutoSize = True BorderSpacing.Around = 6 @@ -674,10 +673,10 @@ object CheckLFMDialog: TCheckLFMDialog TabOrder = 0 end object RemoveAllButton: TBitBtn - Left = 300 - Height = 26 + Left = 284 + Height = 36 Top = 6 - Width = 163 + Width = 175 Align = alRight AutoSize = True BorderSpacing.Around = 6 diff --git a/ide/lazarus.lpi b/ide/lazarus.lpi index 295e5fac62..ef8ac893b3 100644 --- a/ide/lazarus.lpi +++ b/ide/lazarus.lpi @@ -21,6 +21,7 @@ + @@ -117,7 +118,7 @@ - +