mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-01 17:12:41 +02:00
956 lines
34 KiB
ObjectPascal
956 lines
34 KiB
ObjectPascal
{ $Id: delphiunit2laz.pas 8788 2006-02-20 23:48:13Z mattias $ }
|
|
{
|
|
/***************************************************************************
|
|
delphiunit2laz.pas
|
|
------------------
|
|
|
|
***************************************************************************/
|
|
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
|
* *
|
|
***************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
Functions to convert delphi projects/packages to lazarus projects/packages.
|
|
|
|
The process of converting a delphi project/package/unit to lazarus contains
|
|
some monotone and boring work. These functions try to help here.
|
|
Because any conversion step can fail and can need manual fix before
|
|
continuing, the functions are written to recognize, what have been done.
|
|
So, you can call the delphi conversion, abort at any step, fix a few things,
|
|
and invoke it again.
|
|
}
|
|
unit DelphiProject2Laz;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
// LCL+FCL
|
|
Classes, SysUtils, LCLProc, Forms, Controls, Dialogs, FileProcs, FileUtil,
|
|
// codetools
|
|
ExprEval, DefineTemplates, CodeCache, CodeToolManager, CodeToolsStructs,
|
|
LinkScanner,
|
|
// IDEIntf
|
|
SrcEditorIntf, ComponentReg, IDEMsgIntf, MainIntf, LazIDEIntf, PackageIntf,
|
|
ProjectIntf,
|
|
// IDE
|
|
IDEProcs, DelphiUnit2Laz, Project, DialogProcs, CheckLFMDlg,
|
|
EditorOptions, ProjectInspector, CompilerOptions, PackageDefs, PackageSystem,
|
|
PackageEditor,
|
|
BasePkgManager, PkgManager;
|
|
|
|
const
|
|
SettingDelphiModeTemplName = 'Setting Delphi Mode';
|
|
|
|
type
|
|
TConvertDelphiToLazarusUnitFlag = (
|
|
cdtlufRenameLowercase, // rename the unit lowercase
|
|
cdtlufIsSubProc, // this is part of a big conversion -> add Abort button to all questions
|
|
cdtlufCheckLFM, // check and fix LFM
|
|
cdtlufDoNotSetDelphiMode // do not set delphi mode for project directories
|
|
);
|
|
TConvertDelphiToLazarusUnitFlags = set of TConvertDelphiToLazarusUnitFlag;
|
|
|
|
// project
|
|
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): TModalResult;
|
|
function LoadDPKFile(APackage: TLazPackage; out DPKCode: TCodeBuffer): 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 ...');
|
|
Result:=LazarusIDE.DoSaveProject([]);
|
|
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 i<AProject.UnitCount do begin
|
|
CurUnitInfo:=AProject.Units[i];
|
|
if CurUnitInfo.IsPartOfProject then begin
|
|
Result:=ConvertDelphiToLazarusUnit(CurUnitInfo.Filename,
|
|
CurFlags+[cdtlufIsSubProc]);
|
|
if Result=mrAbort then exit;
|
|
if Result=mrCancel then begin
|
|
Result:=QuestionDlg('Failed converting unit',
|
|
'Failed to convert unit'+#13
|
|
+CurUnitInfo.Filename+#13,
|
|
mtWarning,[mrIgnore,'Ignore and continue',mrAbort],0);
|
|
if Result=mrAbort then exit;
|
|
end;
|
|
if LazarusIDE.DoCloseEditorFile(CurUnitInfo.Filename,
|
|
[cfSaveFirst,cfQuiet]) = mrAbort
|
|
then
|
|
exit;
|
|
end;
|
|
inc(i);
|
|
end;
|
|
Result:=mrOk;
|
|
end;
|
|
|
|
begin
|
|
// first convert all units
|
|
Result:=Convert(Flags-[cdtlufCheckLFM]);
|
|
if Result<>mrOk then exit;
|
|
// now the units can be parsed
|
|
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);
|
|
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): 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);
|
|
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
|
|
): 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,[]);
|
|
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 i<APackage.FileCount do begin
|
|
PkgFile:=APackage.Files[i];
|
|
Result:=ConvertDelphiToLazarusUnit(PkgFile.Filename,
|
|
CurFlags+[cdtlufIsSubProc]);
|
|
if Result=mrAbort then exit;
|
|
if Result=mrCancel then begin
|
|
Result:=QuestionDlg('Failed converting unit',
|
|
'Failed to convert unit'+#13
|
|
+PkgFile.Filename+#13,
|
|
mtWarning,[mrIgnore,'Ignore and continue',mrAbort],0);
|
|
if Result=mrAbort then exit;
|
|
end;
|
|
if LazarusIDE.DoCloseEditorFile(PkgFile.Filename,
|
|
[cfSaveFirst,cfQuiet]) = mrAbort
|
|
then
|
|
exit;
|
|
inc(i);
|
|
end;
|
|
Result:=mrOk;
|
|
end;
|
|
|
|
begin
|
|
// first convert all units
|
|
Result:=Convert(Flags-[cdtlufCheckLFM]);
|
|
if Result<>mrOk then exit;
|
|
// now the units can be parsed
|
|
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;
|
|
begin
|
|
// check file and directory
|
|
DebugLn('ConvertDelphiToLazarusUnit A ',DelphiFilename,' FixLFM=',dbgs(cdtlufCheckLFM 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;
|
|
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;
|
|
|
|
// fix or comment missing units
|
|
DebugLn('ConvertDelphiToLazarusUnit FixMissingUnits');
|
|
Result:=FixMissingUnits(LazarusUnitFilename,cdtlufIsSubProc in Flags);
|
|
if Result=mrAbort then exit;
|
|
if (Result<>mrOk) then begin
|
|
Result:=JumpToCodetoolErrorAndAskToAbort(cdtlufIsSubProc in Flags);
|
|
exit;
|
|
end;
|
|
|
|
// 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<>'');
|
|
if not IfNotOkJumpToCodetoolErrorAndAskToAbort(Result=mrOk,
|
|
cdtlufIsSubProc in Flags,Result)
|
|
then exit;
|
|
|
|
if cdtlufCheckLFM 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);
|
|
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 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
|
|
var
|
|
MainUnitInfo: TUnitInfo;
|
|
begin
|
|
LPRCode:=nil;
|
|
Result:=CreateLPRFileForDPRFile(DPRFilename,MainSourceFilename,LPRCode);
|
|
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;
|
|
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;
|
|
var
|
|
MainSourceFilename: String;
|
|
DOFFilename: String;
|
|
CFGFilename: String;
|
|
begin
|
|
if AProject.MainUnitInfo=nil then exit(mrOk);
|
|
MainSourceFilename:=AProject.MainUnitInfo.Filename;
|
|
|
|
// read .dof file
|
|
DOFFilename:=FindDelphiDOF(MainSourceFilename);
|
|
if FileExistsUTF8(DOFFilename) then begin
|
|
Result:=ExtractOptionsFromDOF(DOFFilename,Project1);
|
|
if Result<>mrOk then exit;
|
|
end;
|
|
|
|
// read .cfg file
|
|
CFGFilename:=FindDelphiCFG(MainSourceFilename);
|
|
if FileExistsUTF8(CFGFilename) then begin
|
|
Result:=ExtractOptionsFromCFG(CFGFilename,Project1);
|
|
if Result<>mrOk then exit;
|
|
end;
|
|
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]);
|
|
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]);
|
|
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;
|
|
end;
|
|
end;
|
|
|
|
function ReadDelphiPackageConfigFiles(APackage: TLazPackage): TModalResult;
|
|
var
|
|
DOFFilename: String;
|
|
CFGFilename: String;
|
|
begin
|
|
// read .dof file
|
|
DOFFilename:=FindDelphiDOF(APackage.Filename);
|
|
if FileExistsUTF8(DOFFilename) then begin
|
|
Result:=ExtractOptionsFromDOF(DOFFilename,APackage);
|
|
if Result<>mrOk then exit;
|
|
end;
|
|
|
|
// read .cfg file
|
|
CFGFilename:=FindDelphiCFG(APackage.Filename);
|
|
if FileExistsUTF8(CFGFilename) then begin
|
|
Result:=ExtractOptionsFromCFG(CFGFilename,APackage);
|
|
if Result<>mrOk then exit;
|
|
end;
|
|
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.
|
|
|