lazarus/converter/convertdelphi.pas
2010-09-10 15:04:48 +00:00

1840 lines
62 KiB
ObjectPascal

{
***************************************************************************
* *
* 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 / Juha Manninen
Abstract:
Convert Delphi projects/packages to lazarus projects/packages.
This was refactored and cleaned from code in unit DelphiProject2Laz.
Now it is objects oriented and easier to maintain / improve.
}
unit ConvertDelphi;
{$mode objfpc}{$H+}
interface
uses
// LCL+FCL
Classes, SysUtils, LCLProc, Forms, Controls, Dialogs, LResources,
FileUtil, contnrs, IniFiles, AVL_Tree,
// codetools
CodeToolManager, DefineTemplates, CodeAtom, CodeCache, LinkScanner,
FileProcs, CodeToolsStructs, FindDeclarationTool,
// IDEIntf
ComponentReg, IDEMsgIntf, MainIntf, LazIDEIntf, PackageIntf, ProjectIntf,
// IDE
IDEProcs, Project, DialogProcs,
EditorOptions, CompilerOptions, PackageDefs, PackageSystem,
PackageEditor, BasePkgManager, LazarusIDEStrConsts,
// Converter
ConvertSettings, ConvCodeTool, MissingUnits, MissingPropertiesDlg, ReplaceNamesUnit;
const
SettingDelphiModeTemplName = 'Setting Delphi Mode';
type
TConvertUnitFlag = (
cdtlufRenameLowercase, // rename the unit lowercase
cdtlufCanAbort // show 'Cancel all' button in error messages using mrAbort
);
TConvertUnitFlags = set of TConvertUnitFlag;
TConvertDelphiPBase = class;
{ TConvertDelphiUnit }
TConvertDelphiUnit = class
private
// Converter for the project or package this unit belongs to.
// Nil if converting single unit.
fOwnerConverter: TConvertDelphiPBase;
// Original pascal unit's file name, .pas
fOrigUnitFilename: string;
fLazUnitFilename: string;
// Extension of the new Lazarus file. If empty, gets the original file's ext.
fLazFileExt: string;
// Unit's info. Actually TUnitInfo, for projects only.
fUnitInfo: TObject;
// Actual code for unit and form file.
fPascalBuffer: TCodeBuffer;
fLFMBuffer: TCodeBuffer;
fFlags: TConvertUnitFlags;
// Units not found in project dir or packages.
fMissingUnits: TStrings;
// List of units to remove (or keep in IFDEF when Delphi is supported).
fUnitsToRemove: TStringList;
// Units to rename. Map of unit name -> real unit name.
fUnitsToRename: TStringToStringTree;
// Units to be commented later.
fUnitsToComment: TStringList;
fSettings: TConvertSettings;
function GetDfmFileName: string;
function CopyAndLoadFile: TModalResult;
function ConvertUnitFile: TModalResult;
function ConvertFormFile: TModalResult;
function MissingUnitToMsg(MissingUnit: string): string;
function CommentAutomatically: integer;
function AskUnitPathFromUser: TModalResult;
function FixIncludeFiles: TModalResult;
function FixMissingUnits: TModalResult;
protected
public
constructor Create(AOwnerConverter: TConvertDelphiPBase; const AFilename: string;
aFlags: TConvertUnitFlags);
destructor Destroy; override;
// This should be used only when converting a single unit.
function Convert: TModalResult;
function CheckFailed(PrevResult: TModalResult): TModalResult;
public
property LazFileExt: string read fLazFileExt write fLazFileExt;
end;
// Base class for Delphi project and package conversion.
// Code would be cleaner if TProject and TLazPackage inherited from same class.
// Now they can't share much code.
{ TConvertDelphiPBase }
TConvertDelphiPBase = class
private
// Either Project or LazPackage. Typecasted to right types in property getter.
fProjPack: TObject;
// Original project's or package's file name, .lpi .lpk .dpr .dpk
fOrigPFilename: string;
fLazPFilename: string; // .lpi or .lpk file name
fDelphiPFilename: string; // .dpr or .dpk file name
fLazPSuffix: string; // '.lpi' or '.lpk'
fDelphiPSuffix: string; // '.dpr' or '.dpk'
fIsConsoleApp: Boolean;
// Units found in user defined paths.
fCachedUnitNames: TStringToStringTree;
// Map of case incorrect unit name -> real unit name.
fCachedRealFileNames: TStringToStringTree;
// The user selected path when searching missing units.
fPrevSelectedPath: string;
// Missing units that are commented automatically in all units.
fAllMissingUnits: TStringList;
// Units that are found and will be added to project and converted.
fUnitsToAddToProject: TStringList;
fSettings: TConvertSettings;
function ConvertSub: TModalResult;
procedure CleanUpCompilerOptionsSearchPaths(Options: TBaseCompilerOptions);
procedure SetCompilerModeForDefineTempl(DefTempl: TDefineTemplate);
procedure UnsetCompilerModeForDefineTempl(DefTempl: TDefineTemplate);
function ConvertAllFormFiles(ConverterList: TObjectList): TModalResult;
function ReadDelphiConfigFiles: TModalResult;
function ExtractOptionsFromDOF(const DOFFilename: string): TModalResult;
function ExtractOptionsFromCFG(const CFGFilename: string): TModalResult;
function DoMissingUnits(MissingUnits: TStrings;
UnitsToRename: TStringToStringTree): integer;
procedure CacheUnitsInPath(const APath, ABasePath: string);
procedure CacheUnitsInPath(const APath: string);
function GetCachedUnitPath(const AUnitName: string): string;
protected
function CreateInstance: TModalResult; virtual; abstract;
function CreateMainSourceFile: TModalResult; virtual;
function ScanMainSourceFile: TModalResult; virtual;
function ConvertMainSourceFile: TModalResult; virtual;
function FindAllUnits: TModalResult; virtual; abstract;
function ConvertAllUnits: TModalResult; virtual; abstract;
function ExtractOptionsFromDelphiSource: TModalResult; virtual; abstract;
// The following protected funcs are needed only because Project and LazPackage
// don't inherit from the same class.
function GetCompOpts: TBaseCompilerOptions; virtual; abstract;
function GetCustomDefines: TDefineTemplate; virtual; abstract;
procedure CustomDefinesChanged; virtual; abstract;
function GetMainName: string; virtual; abstract;
procedure AddPackageDependency(const PackageName: string); virtual; abstract;
function FindDependencyByName(const PackageName: string): TPkgDependency; virtual; abstract;
procedure RemoveNonExistingFiles(RemoveFromUsesSection: boolean); virtual; abstract;
public
constructor Create(const AFilename, ADescription: string);
destructor Destroy; override;
function Convert: TModalResult;
public
property CompOpts: TBaseCompilerOptions read GetCompOpts;
property CustomDefines: TDefineTemplate read GetCustomDefines;
property MainName: string read GetMainName;
end;
// Delphi project conversion.
{ TConvertDelphiProject }
TConvertDelphiProject = class(TConvertDelphiPBase)
private
// Resource code
fMainUnitConverter: TConvertDelphiUnit;
function AddUnit(AUnitName: string; out OutUnitInfo: TUnitInfo): TModalResult;
function GetLazProject: TProject;
procedure SetLazProject(const AValue: TProject);
protected
function CreateInstance: TModalResult; override;
function CreateMainSourceFile: TModalResult; override;
function ScanMainSourceFile: TModalResult; override;
function ConvertMainSourceFile: TModalResult; override;
function FindAllUnits: TModalResult; override;
function ConvertAllUnits: TModalResult; override;
function ExtractOptionsFromDelphiSource: TModalResult; override;
// Fake Project / Package virtual methods.
function GetCompOpts: TBaseCompilerOptions; override;
function GetCustomDefines: TDefineTemplate; override;
procedure CustomDefinesChanged; override;
function GetMainName: string; override;
procedure AddPackageDependency(const PackageName: string); override;
function FindDependencyByName(const PackageName: string): TPkgDependency; override;
procedure RemoveNonExistingFiles(RemoveFromUsesSection: boolean); override;
public
constructor Create(const aProjectFilename: string);
destructor Destroy; override;
public
property LazProject: TProject read GetLazProject write SetLazProject;
end;
// Delphi package conversion.
{ TConvertDelphiPackage }
TConvertDelphiPackage = class(TConvertDelphiPBase)
private
// Delphi package code.
fDpkCode: TCodeBuffer;
function LoadDPKFile: TModalResult;
function GetLazPackage: TLazPackage;
procedure SetLazPackage(const AValue: TLazPackage);
protected
function CreateInstance: TModalResult; override;
function FindAllUnits: TModalResult; override;
function ConvertAllUnits: TModalResult; override;
function ExtractOptionsFromDelphiSource: TModalResult; override;
// Fake Project / Package virtual methods.
function GetCompOpts: TBaseCompilerOptions; override;
function GetCustomDefines: TDefineTemplate; override;
procedure CustomDefinesChanged; override;
function GetMainName: string; override;
procedure AddPackageDependency(const PackageName: string); override;
function FindDependencyByName(const PackageName: string): TPkgDependency; override;
procedure RemoveNonExistingFiles(RemoveFromUsesSection: boolean); override;
public
constructor Create(const aPackageFilename: string);
destructor Destroy; override;
public
property LazPackage: TLazPackage read GetLazPackage write SetLazPackage;
end;
// Some global functions from delphiunit2laz are not (yet) converted to class methods.
function CheckDelphiFileExt(const Filename: string): TModalResult;
function CheckFilenameForLCLPaths(const Filename: string): TModalResult;
// projects
function CheckDelphiProjectExt(const Filename: string): TModalResult;
// file names / search paths
function ConvertDelphiAbsoluteToRelativeFile(const Filename: string;
AProject: TProject): string;
function ExpandDelphiFilename(const Filename: string; AProject: TProject): string;
function ExpandDelphiSearchPath(const SearchPath: string;
AProject: TProject): string;
implementation
function CheckDelphiFileExt(const Filename: string): TModalResult;
begin
if CompareFileExt(Filename,'.pas',false)<>0 then begin
Result:=QuestionDlg(lisNotADelphiUnit,
Format(lisTheFileIsNotADelphiUnit, ['"', Filename, '"']),
mtError,[mrCancel,'Skip this file',mbAbort,'Abort'],0);
exit;
end;
Result:=mrOk;
end;
function CheckFilenameForLCLPaths(const Filename: string): TModalResult;
// check if the unitpath of the directory of filename contains the path to the LCL
var
Directory: String;
UnitPath: String;
LazarusSrcDir: string;
LCLPath: String;
NextStartPos: Integer;
begin
// get directory of filename
Directory:=ExtractFilePath(Filename);
// get unitpath definition of directory
UnitPath:=CodeToolBoss.GetUnitPathForDirectory(Directory);
// get lazarus source directory
LazarusSrcDir:=CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'LazarusDir'];
// create base path to LCL compiled units <LazarusSrcDir>/lcl/units/
LCLPath:=TrimFilename(LazarusSrcDir+SetDirSeparators('/lcl/units/'));
NextStartPos:=1;
if GetNextUsedDirectoryInSearchPath(UnitPath,LCLPath,NextStartPos)='' then
begin
LCLPath:=LCLPath+'$(TargetCPU)-$(TargetOS)';
Result:=QuestionDlg(lisLCLUnitPathMissing,
Format(lisTheCurrentUnitPathForTheFileIsThePathToTheLCLUnits, [#13, '"',
Filename, '"', #13, '"', UnitPath, '"', #13, #13, '"', LCLPath, '"',
#13, #13, #13]),
mtError,[mrCancel,'Skip this step',mrAbort,'Abort'],0);
exit;
end;
Result:=mrOk;
end;
function CheckDelphiProjectExt(const Filename: string): TModalResult;
begin
if CompareFileExt(Filename,'.dpr',false)<>0 then begin
Result:=QuestionDlg(lisNotADelphiProject,
Format(lisTheFileIsNotADelphiProjectDpr, ['"', Filename, '"']),
mtError,[mrCancel,'Skipt this step',mbAbort],0);
exit;
end;
Result:=mrOk;
end;
function ConvertDelphiAbsoluteToRelativeFile(const Filename: string;
AProject: TProject): string;
var
ProjectDir: String;
ShortProjectDir: String;
p: LongInt;
begin
// often projects use paths near to their project directory
// For example:
// A project /somewhere/MyProjects/project1.dpr
// and a path C:\Delphi\MyProject\folder
// can mean, that the relative path is 'folder'
ProjectDir:=AProject.ProjectDirectory;
ShortProjectDir:=PathDelim+ExtractFileName(ChompPathDelim(ProjectDir))+PathDelim;
p:=System.Pos(ShortProjectDir,Filename);
if (p>0) then begin
Result:=copy(Filename,p+length(ShortProjectDir),length(Filename));
exit;
end;
// ignore all other absolute paths
Result:='';
end;
function ExpandDelphiFilename(const Filename: string; AProject: TProject): string;
var
p: LongInt;
begin
Result:=Filename;
if Result='' then exit;
Result:=TrimFilename(SetDirSeparators(Result));
// check for $(Delphi) macro
p:=System.Pos('$(DELPHI)',Result);
if p>0 then begin
// Delphi features are provided by FPC and Lazarus -> ignore
Result:='';
end;
// check for other macros
p:=System.Pos('$(',Result);
if p>0 then begin
// path macros are not supported -> ignore
Result:='';
end;
if FilenameIsWinAbsolute(Result) then begin
// absolute filenames are not portable
Result:=ConvertDelphiAbsoluteToRelativeFile(Result,AProject);
end;
// change PathDelim
Result:=TrimFilename(SetDirSeparators(Result));
end;
function ExpandDelphiSearchPath(const SearchPath: string;
AProject: TProject): string;
var
Paths: TStrings;
i: Integer;
CurPath: String;
j: Integer;
begin
Result:='';
Paths:=SplitString(SearchPath,';');
if Paths=nil then exit;
try
// expand Delphi paths
for i:=0 to Paths.Count-1 do
Paths[i]:=ExpandDelphiFilename(Paths[i],AProject);
// remove doubles
for i:=Paths.Count-1 downto 0 do begin
CurPath:=Paths[i];
if (CurPath='') then
Paths.Delete(i)
else begin
j:=i-1;
while (j>=0) and (CompareText(CurPath,Paths[i])<>0) do dec(j);
if j>=0 then
Paths.Delete(i);
end;
end;
Result:='';
for i:=0 to Paths.Count-1 do begin
if i>0 then Result:=Result+';';
Result:=Result+Paths[i];
end;
finally
Paths.Free;
end;
end;
{ TConvertDelphiUnit }
constructor TConvertDelphiUnit.Create(AOwnerConverter: TConvertDelphiPBase;
const AFilename: string; AFlags: TConvertUnitFlags);
begin
fOwnerConverter:=AOwnerConverter;
fOrigUnitFilename:=AFilename;
fFlags:=AFlags;
fLazFileExt:='';
if fOwnerConverter=nil then begin
fSettings:=TConvertSettings.Create('Convert Delphi Unit');
fSettings.MainFilename:=fOrigUnitFilename;
end
else
fSettings:=fOwnerConverter.fSettings;
fUnitInfo:=nil;
if not LazarusIDE.BeginCodeTools then
IDEMessagesWindow.AddMsg('BeginCodeTools failed!','',-1);
end;
destructor TConvertDelphiUnit.Destroy;
begin
if fOwnerConverter=nil then
fSettings.Free;
inherited Destroy;
end;
function TConvertDelphiUnit.Convert: TModalResult;
begin
IDEMessagesWindow.Clear;
Result:=fSettings.RunForm;
if Result=mrOK then begin
Result:=CopyAndLoadFile;
if Result=mrOK then begin
Result:=ConvertUnitFile;
if Result=mrOk then
Result:=ConvertFormFile;
end;
end;
if Result=mrOk then
IDEMessagesWindow.AddMsg('Ready.','',-1)
else
IDEMessagesWindow.AddMsg('Aborted.','',-1)
end;
function TConvertDelphiUnit.GetDfmFileName: string;
begin
Result:=ChangeFileExt(fOrigUnitFilename,'.dfm');
if FileExistsUTF8(Result) then exit;
Result:=ChangeFileExt(fOrigUnitFilename,'.DFM');
if FileExistsUTF8(Result) then exit;
Result:=ChangeFileExt(fOrigUnitFilename,'.xfm');
if FileExistsUTF8(Result) then exit;
Result:=ChangeFileExt(fOrigUnitFilename,'.XFM');
if not FileExistsUTF8(Result) then
Result:='';
end;
function TConvertDelphiUnit.CopyAndLoadFile: TModalResult;
begin
// Convert in place. File must be writable.
Result:=CheckFileIsWritable(fOrigUnitFilename,[mbAbort]);
if Result<>mrOk then exit;
// close Delphi unit file in editor.
Result:=LazarusIDE.DoCloseEditorFile(fOrigUnitFilename,[cfSaveFirst]);
if Result<>mrOk then exit;
// Copy/rename fLazUnitFilename based on fOrigUnitFilename.
Result:=fSettings.RenameDelphiToLazFile(fOrigUnitFilename, fLazFileExt,
fLazUnitFilename, cdtlufRenameLowercase in fFlags);
if Result<>mrOK then exit;
// Read the code in.
fPascalBuffer:=nil;
Result:=LoadCodeBuffer(fPascalBuffer,fLazUnitFilename,
[lbfCheckIfText,lbfUpdateFromDisk],true);
end;
function TConvertDelphiUnit.ConvertUnitFile: TModalResult;
var
DfmFilename: string; // Delphi .DFM file name.
LfmFilename: string; // Lazarus .LFM file name.
ConsApp: Boolean;
ConvTool: TConvDelphiCodeTool;
begin
fUnitsToRemove:=TStringList.Create;
fUnitsToRename:=TStringToStringTree.Create(false);
fUnitsToComment:=TStringList.Create;
IDEMessagesWindow.AddMsg('Converting unit file '+fOrigUnitFilename,'',-1);
Application.ProcessMessages;
ConvTool:=TConvDelphiCodeTool.Create(fPascalBuffer);
try
fLFMBuffer:=nil;
// Get DFM file name and close it in editor.
DfmFilename:=GetDfmFileName;
if DfmFilename<>'' then begin
Result:=LazarusIDE.DoCloseEditorFile(DfmFilename,[cfSaveFirst]);
if Result<>mrOk then exit;
end;
// Create a form file name based on the unit file name.
LfmFilename:=fSettings.DelphiToLazFilename(fOrigUnitFilename, '.lfm',
cdtlufRenameLowercase in fFlags);
if DfmFilename<>'' then begin
if FileExistsUTF8(LfmFilename) then
if (FileAgeUTF8(LfmFilename)<FileAgeUTF8(DfmFilename)) then
DeleteFileUTF8(LfmFilename); // .lfm is older than .dfm -> remove .lfm
if not FileExistsUTF8(LfmFilename) then begin
// TODO: update project
if fSettings.Target=ctLazarusAndDelphi then
Result:=CopyFileWithErrorDialogs(DfmFilename,LfmFilename,[mbAbort])
else
Result:=fSettings.RenameFile(DfmFilename,LfmFilename);
if Result<>mrOK then exit;
end;
end;
// convert .dfm file to .lfm file (without context type checking)
if FileExistsUTF8(LfmFilename) then begin
Result:=ConvertDfmToLfm(LfmFilename);
if Result<>mrOk then exit;
// Read form file code in.
Result:=LoadCodeBuffer(fLFMBuffer,LfmFilename,
[lbfCheckIfText,lbfUpdateFromDisk],true);
if Result<>mrOk then exit;
end;
// Check LCL path for single files. They are correct when converting projects.
if not Assigned(fOwnerConverter) then begin
Result:=CheckFilenameForLCLPaths(fLazUnitFilename);
if Result<>mrOk then exit;
end;
// Fix include file names.
Result:=FixIncludeFiles;
if Result<>mrOk then exit;
// Fix or comment missing units, show error messages.
Result:=FixMissingUnits;
if Result<>mrOk then exit;
// Check from the project if this is a console application.
ConsApp:=Assigned(fOwnerConverter) and fOwnerConverter.fIsConsoleApp;
// Do the actual code conversion.
ConvTool.Ask:=Assigned(fOwnerConverter);
ConvTool.LowerCaseRes:=FileExistsUTF8(ChangeFileExt(fLazUnitFilename, '.res'));
ConvTool.HasFormFile:=DfmFilename<>'';
ConvTool.Settings:=fSettings;
ConvTool.UnitsToRemove:=fUnitsToRemove;
ConvTool.UnitsToRename:=fUnitsToRename;
ConvTool.UnitsToComment:=fUnitsToComment;
Result:=ConvTool.Convert(ConsApp);
finally
ConvTool.Free;
fUnitsToComment.Free;
fUnitsToRename.Free;
fUnitsToRemove.Free;
end;
end;
function TConvertDelphiUnit.ConvertFormFile: TModalResult;
var
LfmFixer: TLFMFixer;
begin
// Fix the LFM file and the pascal unit, updates fPascalBuffer and fLFMBuffer.
if fLFMBuffer<>nil then begin
IDEMessagesWindow.AddMsg('Repairing form file '+fLFMBuffer.Filename,'',-1);
Application.ProcessMessages;
LfmFixer:=TLFMFixer.Create(fPascalBuffer,fLFMBuffer,@IDEMessagesWindow.AddMsg);
try
LfmFixer.Settings:=fSettings;
LfmFixer.RootMustBeClassInIntf:=true;
LfmFixer.ObjectsMustExists:=true;
if LfmFixer.Repair<>mrOk then begin
LazarusIDE.DoJumpToCompilerMessage(-1,true);
exit(mrAbort);
end;
finally
LfmFixer.Free;
end;
// save LFM file
Result:=SaveCodeBufferToFile(fLFMBuffer,fLFMBuffer.Filename);
if Result<>mrOk then exit;
end;
Result:=mrOk;
end;
function TConvertDelphiUnit.MissingUnitToMsg(MissingUnit: string): string;
var
p: Integer;
NamePos, InPos: Integer;
Line, Col: Integer;
ShortFilename: string;
begin
ShortFilename:=ExtractFileName(fPascalBuffer.Filename);
// cut 'in' extension
p:=System.Pos(' ',MissingUnit);
if p>0 then
MissingUnit:=copy(MissingUnit,1,p-1);
Line:=1;
Col:=1;
if CodeToolBoss.FindUnitInAllUsesSections(fPascalBuffer,MissingUnit,NamePos,InPos)
then begin
if InPos=0 then ;
fPascalBuffer.AbsoluteToLineCol(NamePos,Line,Col);
end;
Result:=ShortFilename+'('+IntToStr(Line)+','+IntToStr(Col)+') Error: '
+'Can''t find unit '+MissingUnit;
end;
function TConvertDelphiUnit.CommentAutomatically: integer;
// Comment automatically unit names that were commented in other files.
// Return the number of missing units still left.
var
i, x: Integer;
s: string;
begin
for i:=fMissingUnits.Count-1 downto 0 do begin
s:=fMissingUnits[i];
if fOwnerConverter.fAllMissingUnits.Find(s, x) then begin
fUnitsToComment.Append(s);
fMissingUnits.Delete(i);
end;
end;
Result:=fMissingUnits.Count;
end;
function TConvertDelphiUnit.AskUnitPathFromUser: TModalResult;
var
TryAgain: Boolean;
UnitDirDialog: TSelectDirectoryDialog;
begin
// ask user what to do
repeat
TryAgain:=False;
Result:=AskMissingUnits(fMissingUnits, ExtractFileName(fLazUnitFilename),
fSettings.Target=ctLazarusAndDelphi);
case Result of
// mrOK means: comment out.
mrOK: begin
// These units will be commented automatically in this project/package.
if Assigned(fOwnerConverter) then
fOwnerConverter.fAllMissingUnits.AddStrings(fMissingUnits);
fUnitsToComment.AddStrings(fMissingUnits);
end;
// mrYes means: Search for unit path.
mrYes: begin
UnitDirDialog:=TSelectDirectoryDialog.Create(nil);
try
UnitDirDialog.InitialDir:=fOwnerConverter.fPrevSelectedPath;
UnitDirDialog.Title:='All sub-directories will be scanned for unit files';
if UnitDirDialog.Execute then begin
if Assigned(fOwnerConverter) then begin
fOwnerConverter.fPrevSelectedPath:=ExtractFilePath(UnitDirDialog.Filename);
// Add the new path to project if missing units are found.
fOwnerConverter.CacheUnitsInPath(UnitDirDialog.Filename);
TryAgain:=fOwnerConverter.DoMissingUnits(fMissingUnits, fUnitsToRename)>0;
end;
end
else
TryAgain:=true; // User canceled. Stay with the same unit.
finally
UnitDirDialog.Free;
end;
Result:=mrOK; // Caller will check for Result<>mrOK
end;
// User wants to abort.
mrAbort: Exit;
end;
until not TryAgain;
end;
function TConvertDelphiUnit.FixIncludeFiles: TModalResult;
// fix include filenames
var
MissingIncludeFilesCodeXYPos: TFPList;
CodePos: PCodeXYPosition;
Msg: string;
i: Integer;
begin
Result:=mrOk;
MissingIncludeFilesCodeXYPos:=nil;
try
if not CodeToolBoss.FixIncludeFilenames(fPascalBuffer,true,MissingIncludeFilesCodeXYPos)
then begin
if MissingIncludeFilesCodeXYPos<>nil then begin
for i:=0 to MissingIncludeFilesCodeXYPos.Count-1 do begin
CodePos:=PCodeXYPosition(MissingIncludeFilesCodeXYPos[i]);
Msg:=CodePos^.Code.Filename
+'('+IntToStr(CodePos^.y)+','+IntToStr(CodePos^.x)+')'
+' missing include file';
IDEMessagesWindow.AddMsg(Msg, '', -1);
end;
end;
IDEMessagesWindow.AddMsg('Error="'+CodeToolBoss.ErrorMessage+'"', '', -1);
Application.ProcessMessages;
exit;
end;
finally
CodeToolBoss.FreeListOfPCodeXYPosition(MissingIncludeFilesCodeXYPos);
end;
end;
function TConvertDelphiUnit.FixMissingUnits: TModalResult;
var
UnitNames: TStringList;
procedure RenameOrRemoveUnit(AOldName, ANewName: string);
// Replace a unit name with a new name or remove it if there is no new name.
var
x: Integer;
begin
if (ANewName<>'') and not UnitNames.Find(ANewName, x) then begin
fUnitsToRename[AOldName]:=ANewName;
IDEMessagesWindow.AddMsg(Format(
'Replaced unit "%s" with "%s" in uses section.',[AOldName, ANewName]),'',-1);
end
else begin
fUnitsToRemove.Append(AOldName);
IDEMessagesWindow.AddMsg(Format(
'Removed used unit "%s" in uses section.',[AOldName]),'',-1);
end;
end;
function GetMissingUnits: TModalResult;
// Get missing unit by codetools.
var
CTResult: Boolean;
i: Integer;
begin
Result:=mrOk;
CTResult:=CodeToolBoss.FindMissingUnits(fPascalBuffer,fMissingUnits,true);
if not CTResult then begin
IDEMessagesWindow.AddMsg('Error="'+CodeToolBoss.ErrorMessage+'"','',-1);
Result:=mrCancel;
exit;
end;
// Remove Windows unit from the list if target is "Windows only".
if fSettings.Target=ctLazarusWin then begin
for i:=fMissingUnits.Count-1 downto 0 do
if LowerCase(fMissingUnits[i])='windows' then begin
fMissingUnits.Delete(i);
Break;
end;
end;
end;
var
UnitUpdater: TStringMapUpdater;
MapToEdit: TStringToStringTree;
Node: TAVLTreeNode;
Item: PStringToStringTreeItem;
ConvTool: TConvDelphiCodeTool;
i: Integer;
UnitN, s: string;
begin
Result:=mrOk;
UnitUpdater:=TStringMapUpdater.Create(fSettings.ReplaceUnits);
ConvTool:=TConvDelphiCodeTool.Create(fPascalBuffer);
if not fSettings.AutoReplaceUnits then
MapToEdit:=TStringToStringTree.Create(false);
UnitNames:=nil; // Will be created in ConvTool.UsesSectionsToUnitnames.
fMissingUnits:=nil; // Will be created in CodeToolBoss.FindMissingUnits.
try
Result:=GetMissingUnits;
if (Result<>mrOK) or (fMissingUnits=nil) or (fMissingUnits.Count=0) then exit;
// Collect all unit names from uses sections.
UnitNames:=ConvTool.UsesSectionsToUnitnames;
UnitNames.Sorted:=true;
// Find replacements for missing units from settings.
for i:=fMissingUnits.Count-1 downto 0 do begin
UnitN:=fMissingUnits[i];
if UnitUpdater.FindReplacement(UnitN, s) then begin
// Don't replace Windows unit with LCL units in a console application.
if (LowerCase(UnitN)='windows') and
Assigned(fOwnerConverter) and fOwnerConverter.fIsConsoleApp then
s:='';
if fSettings.AutoReplaceUnits then
RenameOrRemoveUnit(UnitN, s) // Automatic rename / remove.
else
MapToEdit[UnitN]:=s; // Add for interactive editing.
end;
end;
if not fSettings.AutoReplaceUnits then begin
// Edit, then remove or replace units.
Result:=EditMap(MapToEdit, 'Units to replace in '+ExtractFileName(fOrigUnitFilename),
lisConvDelphiName, lisConvNewName);
if Result<>mrOK then exit;
// Iterate the map and rename / remove.
Node:=MapToEdit.Tree.FindLowest;
while Node<>nil do begin
Item:=PStringToStringTreeItem(Node.Data);
RenameOrRemoveUnit(Item^.Name, Item^.Value);
Node:=MapToEdit.Tree.FindSuccessor(Node);
end;
end;
// Remove and rename missing units. More of them may be added later.
ConvTool.UnitsToRename:=fUnitsToRename;
ConvTool.RenameUnits;
ConvTool.UnitsToRemove:=fUnitsToRemove;
ConvTool.RemoveUnits;
// Find missing units again. Some replacements may not be valid.
fMissingUnits.Clear;
Result:=GetMissingUnits;
if (Result<>mrOK) or (fMissingUnits.Count=0) then exit;
if Assigned(fOwnerConverter) then begin
// Try to find from subdirectories scanned earlier.
if fOwnerConverter.DoMissingUnits(fMissingUnits, fUnitsToRename)=0 then exit;
// Comment out automatically units that were commented in other files.
if CommentAutomatically=0 then exit;
end;
// Interactive dialog for searching unit.
Result:=AskUnitPathFromUser;
if Result<>mrOK then exit;
// add error messages, so the user can click on them
for i:=0 to fMissingUnits.Count-1 do
IDEMessagesWindow.AddMsg(MissingUnitToMsg(fMissingUnits[i]),'',-1);
Application.ProcessMessages;
finally
if not fSettings.AutoReplaceUnits then
MapToEdit.Free;
fMissingUnits.Free;
UnitNames.Free;
ConvTool.Free;
UnitUpdater.Free;
end;
end;
function TConvertDelphiUnit.CheckFailed(PrevResult: TModalResult): TModalResult;
begin
Result:=PrevResult;
if Result=mrCancel then begin
Result:=QuestionDlg('Failed converting unit',
'Failed to convert unit'+#13+fOrigUnitFilename+#13,
mtWarning,[mrIgnore,'Ignore and continue',mrAbort],0);
if Result=mrIgnore then
Result:=mrOK;
end;
end;
{ TConvertDelphiPBase }
constructor TConvertDelphiPBase.Create(const AFilename, ADescription: string);
begin
fOrigPFilename:=AFilename;
fIsConsoleApp:=False; // Default = GUI app.
fCachedUnitNames:=TStringToStringTree.Create(false);
fCachedRealFileNames:=TStringToStringTree.Create(true);
fSettings:=TConvertSettings.Create('Convert Delphi '+ADescription);
fSettings.MainFilename:=fOrigPFilename;
fAllMissingUnits:=TStringList.Create;
fAllMissingUnits.Sorted:=true;
fUnitsToAddToProject:=TStringList.Create;
fPrevSelectedPath:=fSettings.MainPath;
// Scan unit files a level above project path. Used later for missing units.
CacheUnitsInPath(TrimFilename(fSettings.MainPath+'../'));
end;
destructor TConvertDelphiPBase.Destroy;
begin
fUnitsToAddToProject.Free;
fAllMissingUnits.Free;
fCachedRealFileNames.Free;
fCachedUnitNames.Free;
FreeAndNil(fSettings);
inherited Destroy;
end;
// Creates or updates a lazarus project (.lpi+.lpr) or package.
function TConvertDelphiPBase.Convert: TModalResult;
begin
IDEMessagesWindow.Clear;
// Get settings from user.
Result:=fSettings.RunForm;
if Result=mrOK then begin
// create/open lazarus project or package file
fLazPFilename:=fSettings.DelphiToLazFilename(fOrigPFilename, fLazPSuffix, false);
// Find Delphi project / package file name
if CompareFileExt(fOrigPFilename,fDelphiPSuffix,false)=0 then
fDelphiPFilename:=fOrigPFilename
else
fDelphiPFilename:=ChangeFileExt(fOrigPFilename,fDelphiPSuffix);
if not FileExistsUTF8(fDelphiPFilename) then
fDelphiPFilename:=FindDiskFileCaseInsensitive(fOrigPFilename);
// ? fDelphiPFilename:=CodeToolBoss.DirectoryCachePool.FindDiskFilename(fDelphiPFilename);
// Actual conversion.
Result:=ConvertSub;
end;
if Result=mrOk then
IDEMessagesWindow.AddMsg('Conversion Ready.','',-1)
else
IDEMessagesWindow.AddMsg('Conversion Aborted.','',-1)
end;
function TConvertDelphiPBase.ConvertSub: TModalResult;
begin
// Project / package instance.
Result:=CreateInstance;
if Result<>mrOK then exit;
// create main source file (.lpr for project) (only copy, no conversion)
Result:=CreateMainSourceFile; // Create project's LPR file.
if Result<>mrOK then exit;
// read config files (they often contain clues about paths, switches and defines)
Result:=ReadDelphiConfigFiles;
if Result<>mrOK then exit;
RemoveNonExistingFiles(false);
CleanUpCompilerOptionsSearchPaths(CompOpts);
// Scan LPR file for directives. Sets fIsConsoleApp flag.
Result:=ScanMainSourceFile;
if Result<>mrOK then exit;
// LCL dependency is added automatically later for GUI applications.
// AddPackageDependency('LCL');
// ToDo: make an option to add NoGUI to Project.CompilerOptions.LCLWidgetType.
if fProjPack is TProject then
PkgBoss.AddDefaultDependencies(fProjPack as TProject);
CustomDefinesChanged;
SetCompilerModeForDefineTempl(CustomDefines);
try
Result:=ConvertMainSourceFile; // Convert project's LPR file.
if Result<>mrOK then exit;
// get all options from the .dpr or .dpk file
Result:=ExtractOptionsFromDelphiSource;
if Result<>mrOK then exit;
Result:=FindAllUnits; // find all files and save the project.
if Result<>mrOK then exit;
Result:=ConvertAllUnits; // convert all files.
finally
UnsetCompilerModeForDefineTempl(CustomDefines);
end;
end;
function TConvertDelphiPBase.ConvertAllFormFiles(ConverterList: TObjectList): TModalResult;
// Call Convert.ConvertFormFile for all units.
var
Converter: TConvertDelphiUnit;
i: Integer;
begin
IDEMessagesWindow.AddMsg('*** Repairing form files... ***','',-1);
Application.ProcessMessages;
Screen.Cursor:=crHourGlass;
try
for i:=0 to ConverterList.Count-1 do begin
Converter:=TConvertDelphiUnit(ConverterList[i]); // Converter created in cycle1.
with Converter do begin
Result:=ConvertFormFile;
Result:=CheckFailed(Result);
if Result<>mrOK then exit;
// Loading the form makes it appear in forms list. (Is there a better way?)
// fUnitInfo is set for projects only.
if Assigned(fUnitInfo) then
LazarusIDE.GetDesignerWithProjectFile(TUnitInfo(fUnitInfo), true);
// Close unit file after processing.
Result:=LazarusIDE.DoCloseEditorFile(fLazUnitFilename,[cfSaveFirst,cfQuiet]);
if Result<>mrOK then exit;
end;
end;
finally
Screen.Cursor:=crDefault;
end;
Result:=mrOK;
end;
function TConvertDelphiPBase.ReadDelphiConfigFiles: TModalResult;
var
FN, s: String;
begin
Result:=mrOk;
FN:=MainName;
if FN<>'' then begin
// read .dof file
s:=FindDiskFileCaseInsensitive(ChangeFileExt(FN,'.dof'));
if s<>'' then begin
Result:=ExtractOptionsFromDOF(s);
if Result<>mrOk then exit;
end;
// read .cfg file
s:=FindDiskFileCaseInsensitive(ChangeFileExt(FN,'.cfg'));
if s<>'' then
Result:=ExtractOptionsFromCFG(s);
end;
end;
function TConvertDelphiPBase.ExtractOptionsFromDOF(const DOFFilename: string): TModalResult;
// parse .dof file and put options into Project/LazPackage
var
IniFile: TIniFile;
function ReadDirectory(const Section, Ident: string): string;
begin
Result:=IniFile.ReadString(Section,Ident,'');
Result:=ExpandDelphiFilename(Result,fProjPack as TProject);
end;
function ReadSearchPath(const Section, Ident: string): string;
var
SearchPath: String;
begin
SearchPath:=IniFile.ReadString(Section,Ident,'');
Result:=ExpandDelphiSearchPath(SearchPath,fProjPack as TProject);
end;
procedure AddPackDep(const DelphiPkgName, DelphiPkgNames, LazarusPkgName: string);
begin
if DelphiPkgName='' then exit;
if System.Pos(';'+lowercase(DelphiPkgName)+';',
';'+lowercase(DelphiPkgNames)+';')>0 then
AddPackageDependency(LazarusPkgName);
end;
procedure ReadDelphiPackages;
var
DelphiPackages: String;
Pkgs: TStrings;
i: Integer;
begin
DelphiPackages:=IniFile.ReadString('Directories','Packages','');
Pkgs:=SplitString(DelphiPackages,';');
if Pkgs=nil then exit;
try
for i:=0 to Pkgs.Count-1 do
AddPackDep(Pkgs[i],'rtl,dbrtl','FCL');
finally
Pkgs.Free;
end;
end;
procedure AddSearchPath(const SearchPath: string);
begin
CompOpts.IncludePath:=MergeSearchPaths(CompOpts.IncludePath,SearchPath);
CompOpts.Libraries:=MergeSearchPaths(CompOpts.Libraries,SearchPath);
CompOpts.OtherUnitFiles:=MergeSearchPaths(CompOpts.OtherUnitFiles,SearchPath);
CompOpts.ObjectPath:=MergeSearchPaths(CompOpts.ObjectPath,SearchPath);
CompOpts.DebugPath:=MergeSearchPaths(CompOpts.DebugPath,SearchPath);
end;
var
OutputDir: String;
SearchPath: String;
DebugSourceDirs: String;
begin
try
IniFile:=TIniFile.Create(UTF8ToSys(DOFFilename));
try
// output directory
if fProjPack is TProject then begin
OutputDir:=ReadDirectory('Directories','OutputDir');
if (OutputDir<>'') then
CompOpts.UnitOutputDirectory:=OutputDir;
end;
// search path
SearchPath:=ReadSearchPath('Directories','SearchPath');
if (SearchPath<>'') then
AddSearchPath(SearchPath);
// debug source dirs
DebugSourceDirs:=ReadSearchPath('Directories','DebugSourceDirs');
if DebugSourceDirs<>'' then
CompOpts.DebugPath:=MergeSearchPaths(CompOpts.DebugPath,DebugSourceDirs);
// packages
ReadDelphiPackages;
if fProjPack is TProject then begin
if IniFile.ReadString('Linker','ConsoleApp','')='0' then
// does not need a windows console
(fProjPack as TProject).LazCompilerOptions.Win32GraphicApp:=true;
end;
finally
IniFile.Free;
end;
except
on E: Exception do begin
DebugLn('ExtractOptionsFromDOF failed reading "'+DOFFilename+'" '+E.Message);
end;
end;
Result:=mrOk;
end;
function TConvertDelphiPBase.ExtractOptionsFromCFG(const CFGFilename: string): TModalResult;
var
sl: TStringList;
i: Integer;
Line, s: string;
c: char;
begin
try
sl:=TStringList.Create;
try
sl.LoadFromFile(UTF8ToSys(CFGFilename));
for i:=0 to sl.Count-1 do begin
Line:=sl[i];
if Line='' then continue;
if (Line[1]<>'-') or (length(Line)<2) then continue;
c:=Line[2];
if (c='U') or (c='I') then begin
s:=ExpandDelphiSearchPath(copy(Line,4,length(Line)-4),fProjPack as TProject);
if s<>'' then
case c of
'U': CompOpts.OtherUnitFiles:=MergeSearchPaths(CompOpts.OtherUnitFiles,s);
'I': CompOpts.IncludePath:=MergeSearchPaths(CompOpts.IncludePath,s);
end;
end
end;
finally
sl.Free;
end;
except
on E: Exception do begin
DebugLn('ExtractOptionsFromDOF failed reading "'+CFGFilename+'" '+E.Message);
end;
end;
Result:=mrOk;
end;
procedure TConvertDelphiPBase.SetCompilerModeForDefineTempl(DefTempl: TDefineTemplate);
begin
if DefTempl.FindChildByName(SettingDelphiModeTemplName)<>nil then exit;
DefTempl.ReplaceChild(CreateDefinesForFPCMode(SettingDelphiModeTemplName,cmDELPHI));
CodeToolBoss.DefineTree.ClearCache;
end;
procedure TConvertDelphiPBase.UnsetCompilerModeForDefineTempl(DefTempl: TDefineTemplate);
begin
if DefTempl.FindChildByName(SettingDelphiModeTemplName)=nil then exit;
DefTempl.DeleteChild(SettingDelphiModeTemplName);
CodeToolBoss.DefineTree.ClearCache;
end;
procedure TConvertDelphiPBase.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;
function TConvertDelphiPBase.DoMissingUnits(MissingUnits: TStrings;
UnitsToRename: TStringToStringTree): integer;
// Locate unit names from earlier cached list or from packages.
// Return the number of units still missing.
var
Pack: TPkgFile;
Dep: TPkgDependency;
mUnit, sUnitPath, RealFileName, RealUnitName: string;
i: Integer;
begin
for i:=MissingUnits.Count-1 downto 0 do begin
mUnit:=MissingUnits[i];
sUnitPath:=GetCachedUnitPath(mUnit);
if sUnitPath<>'' then begin
// Found from cached paths: add unit path to project's settings.
with CompOpts do
OtherUnitFiles:=MergeSearchPaths(OtherUnitFiles,sUnitPath);
// Rename a unit with different casing if needed.
RealFileName:=fCachedRealFileNames[UpperCase(mUnit)];
RealUnitName:=ExtractFileNameOnly(RealFileName);
if (RealUnitName<>'') and (RealUnitName<>mUnit) then
UnitsToRename[mUnit]:=RealUnitName;
// Will be added later to project.
fUnitsToAddToProject.Add(sUnitPath+RealFileName);
MissingUnits.Delete(i); // No more missing, delete from list.
end
else begin
Pack:=PackageGraph.FindUnitInAllPackages(mUnit, True);
if Assigned(Pack) then begin
// Found from package: add package to project dependencies and open it.
AddPackageDependency(Pack.LazPackage.Name);
Dep:=FindDependencyByName(Pack.LazPackage.Name);
if Assigned(Dep) then
PackageGraph.OpenDependency(Dep,false);
MissingUnits.Delete(i);
end;
end;
end;
Result:=MissingUnits.Count;
end;
procedure TConvertDelphiPBase.CacheUnitsInPath(const APath, ABasePath: string);
// Search all pascal units in APath and store them in fCachedUnitNames
// with a path relative to ABasePath.
var
PasFileList: TStringList;
i: Integer;
PasFile, RelPath, SubPath, sUnitName, FileName: String;
begin
PasFileList:=FindAllFiles(APath,'*.pas',true);
try
for i:=0 to PasFileList.Count-1 do begin
PasFile:=PasFileList[i];
RelPath:=FileUtil.CreateRelativePath(PasFile, ABasePath);
SubPath:=ExtractFilePath(RelPath);
FileName:=ExtractFileName(RelPath);
sUnitName:=ExtractFileNameOnly(FileName);
if (SubPath<>'') and (sUnitName<>'') then begin
// Map path by unit name.
fCachedUnitNames[sUnitName]:=SubPath;
// Map real unit name by uppercase unit name.
fCachedRealFileNames[UpperCase(sUnitName)]:=FileName;
end;
end;
finally
PasFileList.Free;
end;
end;
procedure TConvertDelphiPBase.CacheUnitsInPath(const APath: string);
// Same as above but uses fSettings.MainPath as base path.
begin
CacheUnitsInPath(APath, fSettings.MainPath);
end;
function TConvertDelphiPBase.GetCachedUnitPath(const AUnitName: string): string;
begin
Result:=fCachedUnitNames[AUnitName];
end;
function TConvertDelphiPBase.CreateMainSourceFile: TModalResult;
begin
Result:=mrOK; // Do nothing. Overridden in project.
end;
function TConvertDelphiPBase.ScanMainSourceFile: TModalResult;
begin
Result:=mrOK; // Do nothing. Overridden in project.
end;
function TConvertDelphiPBase.ConvertMainSourceFile: TModalResult;
begin
Result:=mrOK; // Do nothing. Overridden in project.
end;
{ TConvertDelphiProject }
constructor TConvertDelphiProject.Create(const aProjectFilename: string);
begin
inherited Create(aProjectFilename, 'Project');
fLazPSuffix:='.lpi';
fDelphiPSuffix:='.dpr';
fMainUnitConverter:=nil;
end;
destructor TConvertDelphiProject.Destroy;
begin
if Assigned(fMainUnitConverter) then
fMainUnitConverter.Free;
inherited Destroy;
end;
function TConvertDelphiProject.CreateInstance: TModalResult;
// If .lpi does not exist, create it
// open new project
begin
LazProject:=Project1;
if FileExistsUTF8(fLazPFilename) then begin
// there is already a lazarus project -> open it, if not already open
if (LazProject=nil) or
(CompareFilenames(LazProject.ProjectInfoFile,fLazPFilename)<>0) then
begin
Result:=LazarusIDE.DoOpenProjectFile(fLazPFilename,[]);
LazProject:=Project1;
if Result<>mrOk then exit;
end;
end else begin
// create a new lazarus project
Result:=LazarusIDE.DoNewProject(ProjectDescriptorEmptyProject);
LazProject:=Project1;
if Result<>mrOk then exit;
LazProject.ProjectInfoFile:=fLazPFilename;
end;
// save to disk (this makes sure, all editor changes are saved too)
Result:=LazarusIDE.DoSaveProject([]);
end;
function TConvertDelphiProject.CreateMainSourceFile: 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
const
LprExt='.lpr';
var
MainUnitInfo: TUnitInfo;
begin
// Converter for main LPR file.
fMainUnitConverter:=TConvertDelphiUnit.Create(Self,fOrigPFilename,[]);
fMainUnitConverter.LazFileExt:=LprExt;
fMainUnitConverter.CopyAndLoadFile;
if LazProject.MainUnitInfo=nil then begin
// add .lpr file to project as main unit
MainUnitInfo:=TUnitInfo.Create(fMainUnitConverter.fPascalBuffer);
MainUnitInfo.DefaultSyntaxHighlighter:=ExtensionToLazSyntaxHighlighter(LprExt);
MainUnitInfo.IsPartOfProject:=true;
LazProject.AddFile(MainUnitInfo,false);
LazProject.MainFileID:=0;
end else begin
// replace main unit in project
LazProject.MainUnitInfo.Source:=fMainUnitConverter.fPascalBuffer;
end;
Result:=mrOk;
end;
function TConvertDelphiProject.ScanMainSourceFile: TModalResult;
var
ConvTool: TConvDelphiCodeTool;
begin
Result:=mrOK;
ConvTool:=TConvDelphiCodeTool.Create(fMainUnitConverter.fPascalBuffer);
try
fIsConsoleApp:=ConvTool.FindApptypeConsole;
finally
ConvTool.Free;
end;
end;
function TConvertDelphiProject.ConvertMainSourceFile: TModalResult;
begin
// Loading was done earlier. Now just convert.
Result:=fMainUnitConverter.ConvertUnitFile;
if Result<>mrOk then exit;
Result:=fMainUnitConverter.ConvertFormFile;
end;
function TConvertDelphiProject.AddUnit(AUnitName: string;
out OutUnitInfo: TUnitInfo): TModalResult;
// add new unit to project
var
CurUnitInfo: TUnitInfo;
begin
Result:=mrOK;
OutUnitInfo:=nil;
if not FilenameIsAbsolute(AUnitName) then
AUnitName:=AppendPathDelim(LazProject.ProjectDirectory)+AUnitName;
AUnitName:=TrimFilename(AUnitName);
if not FileExistsUTF8(AUnitName) then
exit(mrNo);
CurUnitInfo:=LazProject.UnitInfoWithFilename(AUnitName);
if CurUnitInfo=nil then begin
if FilenameIsPascalUnit(AUnitName) then begin
// check unitname
CurUnitInfo:=LazProject.UnitWithUnitname(ExtractFileNameOnly(AUnitName));
if CurUnitInfo<>nil then begin
Result:=QuestionDlg('Unitname exists twice',
'There are two units with the same unitname:'#13
+CurUnitInfo.Filename+#13+AUnitName+#13,
mtWarning,[mrYes,'Remove first',mrNo,'Remove second',
mrIgnore,'Keep both',mrAbort],0);
case Result of
mrYes: CurUnitInfo.IsPartOfProject:=false;
mrNo: exit(mrNo);
mrIgnore: ;
else
exit(mrAbort);
end;
end;
end;
CurUnitInfo:=TUnitInfo.Create(nil);
CurUnitInfo.Filename:=AUnitName;
LazProject.AddFile(CurUnitInfo,false);
end;
CurUnitInfo.IsPartOfProject:=true;
OutUnitInfo:=CurUnitInfo;
end;
function TConvertDelphiProject.FindAllUnits: TModalResult;
var
FoundUnits, MisUnits, NormalUnits: TStrings;
i: Integer;
CurFilename: string;
NewSearchPath, AllPath, UselessPath: string;
p: LongInt;
ui: TUnitInfo;
begin
Screen.Cursor:=crHourGlass;
FoundUnits:=nil;
MisUnits:=nil;
NormalUnits:=nil;
try
IDEMessagesWindow.AddMsg('*** Find all unit files... ***','',-1);
Application.ProcessMessages;
if not CodeToolBoss.FindDelphiProjectUnits(fMainUnitConverter.fPascalBuffer,
FoundUnits, MisUnits, NormalUnits) then
begin
LazarusIDE.DoJumpToCodeToolBossError;
Result:=mrCancel;
exit;
end;
if (MisUnits<>nil) and (MisUnits.Count>0) then
raise Exception.Create('At this point there should be no missing units!');
try
// add all units to the project
for i:=0 to FoundUnits.Count-1 do begin
CurFilename:=FoundUnits[i];
p:=System.Pos(' in ',CurFilename);
if p>0 then
CurFilename:=copy(CurFilename,p+4,length(CurFilename));
if CurFilename='' then continue;
Result:=AddUnit(CurFilename, ui);
if Result=mrAbort then exit;
end;
finally
AllPath:=LazProject.SourceDirectories.CreateSearchPathFromAllFiles;
UselessPath:='.;'+VirtualDirectory+';'+VirtualTempDir+';'+LazProject.ProjectDirectory;
// set unit paths to find all project units
NewSearchPath:=MergeSearchPaths(LazProject.CompilerOptions.OtherUnitFiles,AllPath);
NewSearchPath:=RemoveSearchPaths(NewSearchPath,UselessPath);
LazProject.CompilerOptions.OtherUnitFiles:=MinimizeSearchPath(
RemoveNonExistingPaths(NewSearchPath,LazProject.ProjectDirectory));
// set include path
NewSearchPath:=MergeSearchPaths(LazProject.CompilerOptions.IncludePath,AllPath);
NewSearchPath:=RemoveSearchPaths(NewSearchPath,UselessPath);
LazProject.CompilerOptions.IncludePath:=MinimizeSearchPath(
RemoveNonExistingPaths(NewSearchPath,LazProject.ProjectDirectory));
// clear caches
LazProject.DefineTemplates.SourceDirectoriesChanged;
end;
// save project
Result:=LazarusIDE.DoSaveProject([sfQuietUnitCheck]);
if Result<>mrOk then exit;
finally
FoundUnits.Free;
MisUnits.Free;
NormalUnits.Free;
Screen.Cursor:=crDefault;
end;
Result:=mrOk;
end;
function TConvertDelphiProject.ConvertAllUnits: TModalResult;
var
ConvUnits: TObjectList; // List of ConvertDelphiUnits.
function ConvertOne(AUnitInfo: TUnitInfo): TModalResult;
var
Converter: TConvertDelphiUnit;
begin
Converter:=TConvertDelphiUnit.Create(Self, AUnitInfo.Filename,[]);
Converter.fUnitInfo:=AUnitInfo;
ConvUnits.Add(Converter);
Result:=Converter.CopyAndLoadFile;
Result:=Converter.CheckFailed(Result);
if Result<>mrOK then exit;
Result:=Converter.ConvertUnitFile;
end;
var
CurUnitInfo: TUnitInfo;
i: Integer;
begin
Result:=mrOk;
ConvUnits:=TObjectList.create;
try
// convert all units and fix .lfm files
IDEMessagesWindow.AddMsg('*** Converting unit files... ***','',-1);
Application.ProcessMessages;
for i:=0 to LazProject.UnitCount-1 do begin
CurUnitInfo:=LazProject.Units[i];
// Main LPR file was converted earlier.
if CurUnitInfo.IsPartOfProject and (CurUnitInfo<>LazProject.MainUnitInfo) then begin
Result:=ConvertOne(CurUnitInfo);
if Result<>mrOK then Break;
end;
end;
// During conversion there were more units added to be converted.
for i:=0 to fUnitsToAddToProject.Count-1 do begin
Result:=AddUnit(fUnitsToAddToProject[i], CurUnitInfo);
if Result=mrNo then continue;
if Result=mrAbort then Break;
Result:=ConvertOne(CurUnitInfo);
if Result<>mrOK then Break;
end;
if Result=mrOK then
Result:=ConvertAllFormFiles(ConvUnits);
finally
ConvUnits.Free; // Owns and frees converter objects.
end;
end;
function TConvertDelphiProject.ExtractOptionsFromDelphiSource: TModalResult;
begin
// TODO: remove compiler directives and put them into project/package
if fDelphiPFilename<>'' then begin
end;
Result:=mrOk;
end;
// The following funcs are needed only because Project and LazPackage
// don't inherit from the same class.
function TConvertDelphiProject.GetLazProject: TProject;
begin
Result:=fProjPack as TProject;
end;
procedure TConvertDelphiProject.SetLazProject(const AValue: TProject);
begin
fProjPack:=AValue;
end;
function TConvertDelphiProject.GetCompOpts: TBaseCompilerOptions;
begin
Result:=(fProjPack as TProject).CompilerOptions;
end;
function TConvertDelphiProject.GetCustomDefines: TDefineTemplate;
begin
Result:=(fProjPack as TProject).DefineTemplates.CustomDefines;
end;
procedure TConvertDelphiProject.CustomDefinesChanged;
begin
(fProjPack as TProject).DefineTemplates.CustomDefinesChanged;
end;
function TConvertDelphiProject.GetMainName: string;
begin
Result:='';
if Assigned(LazProject.MainUnitInfo) then
Result:=(fProjPack as TProject).MainUnitInfo.Filename;
end;
procedure TConvertDelphiProject.AddPackageDependency(const PackageName: string);
begin
(fProjPack as TProject).AddPackageDependency(PackageName);
end;
function TConvertDelphiProject.FindDependencyByName(const PackageName: string): TPkgDependency;
begin
Result:=(fProjPack as TProject).FindDependencyByName(PackageName);
end;
procedure TConvertDelphiProject.RemoveNonExistingFiles(RemoveFromUsesSection: boolean);
begin
(fProjPack as TProject).RemoveNonExistingFiles(RemoveFromUsesSection);
end;
{ TConvertDelphiPackage }
constructor TConvertDelphiPackage.Create(const aPackageFilename: string);
begin
inherited Create(aPackageFilename, 'Package');
fLazPSuffix:='.lpk';
fDelphiPSuffix:='.dpk';
end;
destructor TConvertDelphiPackage.Destroy;
begin
inherited Destroy;
end;
function TConvertDelphiPackage.CreateInstance: TModalResult;
// open new package. If .lpk does not exist, create it
var
PkgName: String;
CurEditor: TPackageEditorForm;
begin
LazPackage:=nil;
if FileExistsUTF8(fLazPFilename) then begin
// there is already a lazarus package file
// open the package editor
Result:=PackageEditingInterface.DoOpenPackageFile(fLazPFilename,
[pofAddToRecent],true);
if Result<>mrOk then exit;
end;
// search package in graph
PkgName:=ExtractFileNameOnly(fLazPFilename);
LazPackage:=PackageGraph.FindAPackageWithName(PkgName,nil);
if LazPackage<>nil then begin
// there is already a package loaded with this name ...
if CompareFilenames(LazPackage.Filename,fLazPFilename)<>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(LazPackage.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
LazPackage:=PackageGraph.CreateNewPackage(PkgName);
PackageGraph.AddDependencyToPackage(LazPackage,
PackageGraph.LCLPackage.CreateDependencyWithOwner(LazPackage));
LazPackage.Filename:=fLazPFilename;
// open a package editor
CurEditor:=PackageEditors.OpenEditor(LazPackage);
CurEditor.Show;
// save .lpk file
PackageEditors.SavePackage(LazPackage,false);
Result:=mrOk;
end;
end;
function TConvertDelphiPackage.ConvertAllUnits: TModalResult;
var
i: Integer;
PkgFile: TPkgFile;
Converter: TConvertDelphiUnit;
ConvUnits: TObjectList; // List of ConvertDelphiUnits.
begin
Result:=mrOk;
ConvUnits:=TObjectList.create;
try
// convert all units and fix .lfm files
IDEMessagesWindow.AddMsg('*** Converting unit files... ***','',-1);
Application.ProcessMessages;
for i:=0 to LazPackage.FileCount-1 do begin
PkgFile:=LazPackage.Files[i];
Converter:=TConvertDelphiUnit.Create(Self, PkgFile.Filename,[]);
ConvUnits.Add(Converter);
Result:=Converter.CopyAndLoadFile;
Result:=Converter.CheckFailed(Result);
if Result<>mrOK then Break;
Result:=Converter.ConvertUnitFile;
Result:=Converter.CheckFailed(Result);
if Result<>mrOK then Break;
end;
if Result=mrOK then
Result:=ConvertAllFormFiles(ConvUnits);
finally
ConvUnits.Free; // Owns and frees converter objects.
end;
end;
function TConvertDelphiPackage.FindAllUnits: TModalResult;
var
FoundInUnits, MissingInUnits, NormalUnits: TStrings;
NotFoundUnits: String;
i: Integer;
NewSearchPath, AllPath, UselessPath: String;
CurFilename: string;
p: LongInt;
OffendingUnit: TPkgFile;
PkgFile: TPkgFile;
begin
Result:=LoadDPKFile;
if Result<>mrOk then exit;
FoundInUnits:=nil;
MissingInUnits:=nil;
NormalUnits:=nil;
try
if not CodeToolBoss.FindDelphiPackageUnits(fDpkCode,FoundInUnits,
MissingInUnits, NormalUnits) then
begin
LazarusIDE.DoJumpToCodeToolBossError;
Result:=mrCancel;
exit;
end;
// 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
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(LazPackage.Directory)+CurFilename;
CurFilename:=TrimFilename(CurFilename);
if not FileExistsUTF8(CurFilename) then begin
continue;
end;
PkgFile:=LazPackage.FindPkgFile(CurFilename,true,false);
if PkgFile=nil then begin
if FilenameIsPascalUnit(CurFilename) then begin
// check unitname
OffendingUnit:=LazPackage.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
LazPackage.AddFile(CurFilename,ExtractFileNameOnly(CurFilename),
pftUnit,[pffAddToPkgUsesSection],cpNormal);
end;
end;
finally
AllPath:=LazPackage.SourceDirectories.CreateSearchPathFromAllFiles;
UselessPath:='.;'+VirtualDirectory+';'+VirtualTempDir+';'+LazPackage.Directory;
// set unit paths to find all project units
NewSearchPath:=MergeSearchPaths(LazPackage.CompilerOptions.OtherUnitFiles,AllPath);
NewSearchPath:=RemoveSearchPaths(NewSearchPath,UselessPath);
LazPackage.CompilerOptions.OtherUnitFiles:=MinimizeSearchPath(
RemoveNonExistingPaths(NewSearchPath,LazPackage.Directory));
// set include path
NewSearchPath:=MergeSearchPaths(LazPackage.CompilerOptions.IncludePath,AllPath);
NewSearchPath:=RemoveSearchPaths(NewSearchPath,UselessPath);
LazPackage.CompilerOptions.IncludePath:=MinimizeSearchPath(
RemoveNonExistingPaths(NewSearchPath,LazPackage.Directory));
// clear caches
LazPackage.DefineTemplates.SourceDirectoriesChanged;
CodeToolBoss.DefineTree.ClearCache;
end;
// save package
Result:=PackageEditors.SavePackage(LazPackage,false);
if Result<>mrOk then exit;
finally
FoundInUnits.Free;
MissingInUnits.Free;
NormalUnits.Free;
end;
Result:=mrOk;
end;
function TConvertDelphiPackage.LoadDPKFile: TModalResult;
var
DPKFilename: String;
begin
DPKFilename:=ChangeFileExt(LazPackage.Filename,'.dpk');
DPKFilename:=CodeToolBoss.DirectoryCachePool.FindDiskFilename(DPKFilename);
if not FileExistsCached(DPKFilename) then begin
Result:=MessageDlg('File not found',
'Delphi package main source (.dpk) file not found for package'#13
+LazPackage.Filename,mtError,[mbAbort],0);
exit;
end;
Result:=LoadCodeBuffer(fDpkCode,DPKFilename,[],true);
end;
function TConvertDelphiPackage.ExtractOptionsFromDelphiSource: TModalResult;
begin
// TODO: use fDelphiPFilename and LazPackage to get options.
if fDelphiPFilename<>'' then begin
end;
Result:=mrOk;
end;
// The following funcs are needed only because Project and LazPackage
// don't inherit from the same class.
function TConvertDelphiPackage.GetLazPackage: TLazPackage;
begin
Result:=fProjPack as TLazPackage;
end;
procedure TConvertDelphiPackage.SetLazPackage(const AValue: TLazPackage);
begin
fProjPack:=AValue;
end;
function TConvertDelphiPackage.GetCompOpts: TBaseCompilerOptions;
begin
Result:=(fProjPack as TLazPackage).CompilerOptions;
end;
function TConvertDelphiPackage.GetCustomDefines: TDefineTemplate;
begin
Result:=(fProjPack as TLazPackage).DefineTemplates.CustomDefines;
end;
procedure TConvertDelphiPackage.CustomDefinesChanged;
begin
(fProjPack as TLazPackage).DefineTemplates.CustomDefinesChanged;
end;
function TConvertDelphiPackage.GetMainName: string;
begin
Result:=(fProjPack as TLazPackage).Filename;
end;
procedure TConvertDelphiPackage.AddPackageDependency(const PackageName: string);
begin
(fProjPack as TLazPackage).AddPackageDependency(PackageName);
end;
function TConvertDelphiPackage.FindDependencyByName(const PackageName: string): TPkgDependency;
begin
Result:=(fProjPack as TLazPackage).FindDependencyByName(PackageName);
end;
procedure TConvertDelphiPackage.RemoveNonExistingFiles(RemoveFromUsesSection: boolean);
begin
(fProjPack as TLazPackage).RemoveNonExistingFiles;
end;
end.