mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-14 14:52:44 +02:00
1840 lines
62 KiB
ObjectPascal
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.
|
|
|