{  $Id: delphiunit2laz.pas 8788 2006-02-20 23:48:13Z mattias $  }
{
 /***************************************************************************
                          delphiunit2laz.pas
                          ------------------

 ***************************************************************************/

 ***************************************************************************
 *                                                                         *
 *   This source is free software; you can redistribute it and/or modify   *
 *   it under the terms of the GNU General Public License as published by  *
 *   the Free Software Foundation; either version 2 of the License, or     *
 *   (at your option) any later version.                                   *
 *                                                                         *
 *   This code is distributed in the hope that it will be useful, but      *
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 *   General Public License for more details.                              *
 *                                                                         *
 *   A copy of the GNU General Public License is available on the World    *
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 *   obtain it by writing to the Free Software Foundation,                 *
 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 *                                                                         *
 ***************************************************************************

  Author: Mattias Gaertner

  Abstract:
    Functions to convert delphi projects/packages to lazarus projects/packages.

    The process of converting a delphi project/package/unit to lazarus contains
    some monotone and boring work. These functions try to help here.
    Because any conversion step can fail and can need manual fix before
    continuing, the functions are written to recognize, what have been done.
    So, you can call the delphi conversion, abort at any step, fix a few things,
    and invoke it again.
}
unit DelphiProject2Laz;

{$mode objfpc}{$H+}

interface

uses
  // LCL+FCL
  Classes, SysUtils, LCLProc, Forms, Controls, Dialogs, FileProcs, FileUtil,
  // codetools
  ExprEval, DefineTemplates, CodeCache, CodeToolManager, CodeToolsStructs,
  LinkScanner,
  // IDEIntf
  SrcEditorIntf, ComponentReg, IDEMsgIntf, MainIntf, LazIDEIntf, PackageIntf,
  ProjectIntf,
  // IDE
  IDEProcs, DelphiUnit2Laz, Project, DialogProcs, CheckLFMDlg,
  EditorOptions, ProjectInspector, CompilerOptions, PackageDefs, PackageSystem,
  PackageEditor,
  BasePkgManager, PkgManager;
  
const
  SettingDelphiModeTemplName = 'Setting Delphi Mode';
  
type
  TConvertDelphiToLazarusUnitFlag = (
    cdtlufRenameLowercase, // rename the unit lowercase
    cdtlufIsSubProc, // this is part of a big conversion -> add Abort button to all questions
    cdtlufCheckLFM,  // check and fix LFM
    cdtlufDoNotSetDelphiMode, // do not set delphi mode for project directories
    cdtlufCanAbort   // show 'Cancel all' button in error messages using mrAbort
    );
  TConvertDelphiToLazarusUnitFlags = set of TConvertDelphiToLazarusUnitFlag;

// project
function ConvertDelphiToLazarusProject(const ProjectFilename: string
                                       ): TModalResult;
function FindAllDelphiProjectUnits(AProject: TProject): TModalResult;
function ConvertAllDelphiProjectUnits(AProject: TProject;
                         Flags: TConvertDelphiToLazarusUnitFlags): TModalResult;

// package
function ConvertDelphiToLazarusPackage(const PackageFilename: string
                                       ): TModalResult;
function FindDPKFilename(const LPKFilename: string): string;
function FindAllDelphiPackageUnits(APackage: TLazPackage;
                                   ShowAbort: boolean): TModalResult;
function LoadDPKFile(APackage: TLazPackage; out DPKCode: TCodeBuffer;
                     ShowAbort: boolean): TModalResult;
function ConvertAllDelphiPackageUnits(APackage: TLazPackage;
                         Flags: TConvertDelphiToLazarusUnitFlags): TModalResult;

// unit
function ConvertDelphiToLazarusUnit(const DelphiFilename: string;
  Flags: TConvertDelphiToLazarusUnitFlags): TModalResult;

// project parts
function CreateDelphiToLazarusProjectInstance(const LPIFilename: string;
                                          out AProject: TProject): TModalResult;
function CreateDelphiToLazarusMainSourceFile(AProject: TProject;
                                  const DPRFilename, MainSourceFilename: string;
                                  out LPRCode: TCodeBuffer): TModalResult;
function FindDPRFilename(const StartFilename: string): string;
function ReadDelphiProjectConfigFiles(AProject: TProject): TModalResult;

// package parts
function CreateDelphiToLazarusPackageInstance(const LPKFilename: string;
                                       out APackage: TLazPackage): TModalResult;
function ReadDelphiPackageConfigFiles(APackage: TLazPackage): TModalResult;

// project/package
procedure CleanUpCompilerOptionsSearchPaths(Options: TBaseCompilerOptions);
procedure SetCompilerModeForDefineTempl(DefTempl: TDefineTemplate);
procedure UnsetCompilerModeForDefineTempl(DefTempl: TDefineTemplate);


implementation

function ConvertDelphiToLazarusProject(const ProjectFilename: string
  ): TModalResult;
{ Creates or updates a lazarus project (.lpi+.lpr)
  This function can be invoked on a delphi project .dpr file, or a lazarus
  project (.lpi/.lpr) file.
  It will use, whatever it finds and will make it more lazarus-like.
  It can be aborted and called again.
}
var
  LPRCode: TCodeBuffer;
  LPIFilename: String;
  DPRFilename: String;
  MainSourceFilename: String;
  ConvertUnitFlags: TConvertDelphiToLazarusUnitFlags;
  AProject: TProject;
begin
  debugln('ConvertDelphiToLazarusProject ProjectFilename="',ProjectFilename,'"');
  IDEMessagesWindow.Clear;

  // create/open lazarus project file
  LPIFilename:=ChangeFileExt(ProjectFilename,'.lpi');
  Result:=CreateDelphiToLazarusProjectInstance(LPIFilename,AProject);
  if Result<>mrOk then begin
    DebugLn('ConvertDelphiToLazarusProject failed to create/open project LPIFilename="',LPIFilename,'"');
    exit;
  end;
  
  // create main source file (.lpr) (only copy, no conversion)
  DPRFilename:=FindDPRFilename(ProjectFilename);
  DebugLn('ConvertDelphiToLazarusProject DPRFilename="',DPRFilename,'"');
  MainSourceFilename:=ChangeFileExt(LPIFilename,'.lpr');
  Result:=CreateDelphiToLazarusMainSourceFile(AProject,DPRFilename,
                                              MainSourceFilename,LPRCode);
  if Result<>mrOk then exit;

  // read config files (they often contain clues about paths, switches and defines)
  Result:=ReadDelphiProjectConfigFiles(AProject);
  if Result<>mrOk then begin
    DebugLn('ConvertDelphiToLazarusProject failed reading Delphi configs');
    exit;
  end;

  // clean up project
  AProject.RemoveNonExistingFiles(false);
  CleanUpCompilerOptionsSearchPaths(AProject.CompilerOptions);

  // load required packages
  AProject.AddPackageDependency('LCL');// Nearly all Delphi projects require it
  PkgBoss.AddDefaultDependencies(AProject);

  // we have now enough information to parse the .dpr file,
  // but not enough to parse the units
  
  // set Delphi mode for all project source directories
  AProject.DefineTemplates.CustomDefinesChanged;
  SetCompilerModeForDefineTempl(AProject.DefineTemplates.CustomDefines);
  try

    // sync IDE and codetools
    if not LazarusIDE.BeginCodeTools then begin
      DebugLn('ConvertDelphiToLazarusProject failed BeginCodeTools');
      Result:=mrCancel;
      exit;
    end;

    // fix .lpr
    ConvertUnitFlags:=[cdtlufIsSubProc,cdtlufDoNotSetDelphiMode];
    Result:=ConvertDelphiToLazarusUnit(LPRCode.Filename,ConvertUnitFlags);
    if Result=mrAbort then begin
      DebugLn('ConvertDelphiToLazarusProject failed converting unit ',LPRCode.Filename);
      exit;
    end;

    // get all options from .lpr (the former .dpr)
    Result:=ExtractOptionsFromDelphiSource(LPRCode.Filename,AProject);
    if Result<>mrOk then exit;

    // find and convert all project files
    Result:=FindAllDelphiProjectUnits(AProject);
    if Result<>mrOk then exit;

    // convert all project files
    Result:=ConvertAllDelphiProjectUnits(AProject,[cdtlufIsSubProc,cdtlufCheckLFM]);
    if Result<>mrOk then exit;
  finally
    UnsetCompilerModeForDefineTempl(AProject.DefineTemplates.CustomDefines);
  end;

  debugln('ConvertDelphiToLazarusProject Done');
  Result:=mrOk;
end;

function FindAllDelphiProjectUnits(AProject: TProject): TModalResult;
var
  FoundInUnits, MissingInUnits, NormalUnits: TStrings;
  LPRCode: TCodeBuffer;
  NotFoundUnits: String;
  i: Integer;
  CurUnitInfo: TUnitInfo;
  NewSearchPath: String;
  CurFilename: string;
  p: LongInt;
  OffendingUnit: TUnitInfo;
begin
  LPRCode:=AProject.MainUnitInfo.Source;

  FoundInUnits:=nil;
  MissingInUnits:=nil;
  NormalUnits:=nil;
  try
    debugln('FindAllDelphiProjectUnits gathering all project units ...');
    if not CodeToolBoss.FindDelphiProjectUnits(LPRCode,FoundInUnits,
                                               MissingInUnits, NormalUnits) then
    begin
      LazarusIDE.DoJumpToCodeToolBossError;
      Result:=mrCancel;
      exit;
    end;
    debugln('FindAllDelphiProjectUnits FoundInUnits=[',FoundInUnits.Text,']',
      ' MissingInUnits=[',MissingInUnits.Text,']',
      ' NormalUnits=[',NormalUnits.Text,']');
    // warn about missing units
    if (MissingInUnits<>nil) and (MissingInUnits.Count>0) then begin
      NotFoundUnits:=MissingInUnits.Text;
      Result:=QuestionDlg('Units not found',
        'Some units of the delphi project are missing:'#13
        +NotFoundUnits,mtWarning,[mrIgnore,mrAbort],0);
      if Result<>mrIgnore then exit;
    end;

    try
      // add all units to the project
      debugln('FindAllDelphiProjectUnits adding all project units to project ...');

      for i:=0 to FoundInUnits.Count-1 do begin
        CurFilename:=FoundInUnits[i];
        p:=System.Pos(' in ',CurFilename);
        if p>0 then
          CurFilename:=copy(CurFilename,p+4,length(CurFilename));
        if CurFilename='' then continue;
        if not FilenameIsAbsolute(CurFilename) then
          CurFilename:=AppendPathDelim(AProject.ProjectDirectory)+CurFilename;
        CurFilename:=TrimFilename(CurFilename);
        if not FileExistsUTF8(CurFilename) then begin
          DebugLn('FindAllDelphiProjectUnits file not found: "',CurFilename,'"');
          continue;
        end;
        CurUnitInfo:=AProject.UnitInfoWithFilename(CurFilename);
        if CurUnitInfo<>nil then begin
          CurUnitInfo.IsPartOfProject:=true;
        end else begin
          if FilenameIsPascalUnit(CurFilename) then begin
            // check unitname
            OffendingUnit:=AProject.UnitWithUnitname(
                                                ExtractFileNameOnly(CurFilename));
            if OffendingUnit<>nil then begin
              Result:=QuestionDlg('Unitname exists twice',
                'There are two units with the same unitname:'#13
                +OffendingUnit.Filename+#13
                +CurFilename+#13,
                mtWarning,[mrYes,'Remove first',mrNo,'Remove second',
                           mrIgnore,'Keep both',mrAbort],0);
              case Result of
              mrYes: OffendingUnit.IsPartOfProject:=false;
              mrNo:  continue;
              mrIgnore: ;
              else
                Result:=mrAbort;
                exit;
              end;
            end;
          end;

          // add new unit to project
          CurUnitInfo:=TUnitInfo.Create(nil);
          CurUnitInfo.Filename:=CurFilename;
          CurUnitInfo.IsPartOfProject:=true;
          AProject.AddFile(CurUnitInfo,false);
        end;
      end;

    finally
      // set unit paths to find all project units
      NewSearchPath:=MergeSearchPaths(AProject.CompilerOptions.OtherUnitFiles,
                       AProject.SourceDirectories.CreateSearchPathFromAllFiles);
      NewSearchPath:=RemoveSearchPaths(NewSearchPath,
                                     '.;'+VirtualDirectory+';'+VirtualTempDir
                                     +';'+AProject.ProjectDirectory);
      AProject.CompilerOptions.OtherUnitFiles:=MinimizeSearchPath(
               RemoveNonExistingPaths(NewSearchPath,AProject.ProjectDirectory));
      // set include path
      NewSearchPath:=MergeSearchPaths(AProject.CompilerOptions.IncludePath,
                       AProject.SourceDirectories.CreateSearchPathFromAllFiles);
      NewSearchPath:=RemoveSearchPaths(NewSearchPath,
                                     '.;'+VirtualDirectory+';'+VirtualTempDir
                                     +';'+AProject.ProjectDirectory);
      AProject.CompilerOptions.IncludePath:=MinimizeSearchPath(
               RemoveNonExistingPaths(NewSearchPath,AProject.ProjectDirectory));
      // clear caches
      AProject.DefineTemplates.SourceDirectoriesChanged;
      CodeToolBoss.DefineTree.ClearCache;
      DebugLn('FindAllDelphiProjectUnits UnitPath="',AProject.CompilerOptions.OtherUnitFiles,'"');
    end;

    // save project
    debugln('FindAllDelphiProjectUnits Saving project ...');
    Result:=LazarusIDE.DoSaveProject([]);
    if Result<>mrOk then begin
      DebugLn('FindAllDelphiProjectUnits failed saving project');
      exit;
    end;

  finally
    FoundInUnits.Free;
    MissingInUnits.Free;
    NormalUnits.Free;
  end;

  Result:=mrOk;
end;

function ConvertAllDelphiProjectUnits(AProject: TProject;
  Flags: TConvertDelphiToLazarusUnitFlags): TModalResult;
  
  function Convert(CurFlags: TConvertDelphiToLazarusUnitFlags): TModalResult;
  var
    i: Integer;
    CurUnitInfo: TUnitInfo;
  begin
    // convert all units
    i:=0;
    while i<AProject.UnitCount do begin
      CurUnitInfo:=AProject.Units[i];
      if CurUnitInfo.IsPartOfProject then begin
        Result:=ConvertDelphiToLazarusUnit(CurUnitInfo.Filename,
                                           CurFlags+[cdtlufIsSubProc]);
        if Result=mrAbort then exit;
        if Result=mrCancel then begin
          Result:=QuestionDlg('Failed converting unit',
            'Failed to convert unit'+#13
            +CurUnitInfo.Filename+#13,
            mtWarning,[mrIgnore,'Ignore and continue',mrAbort],0);
          if Result=mrAbort then exit;
        end;
        if LazarusIDE.DoCloseEditorFile(CurUnitInfo.Filename,
          [cfSaveFirst,cfQuiet]) = mrAbort
        then
          exit;
      end;
      inc(i);
    end;
    Result:=mrOk;
  end;
  
begin
  // first convert all units
  Result:=Convert(Flags-[cdtlufCheckLFM]);
  if Result<>mrOk then exit;
  // now the units can be parsed
  if cdtlufCheckLFM in Flags then begin
    // fix the .lfm files
    Result:=Convert(Flags);
    if Result<>mrOk then exit;
  end;
end;

function FindDPKFilename(const LPKFilename: string): string;
begin
  Result:=ChangeFileExt(LPKFilename,'.dpk');
  Result:=CodeToolBoss.DirectoryCachePool.FindDiskFilename(Result);
end;

function ConvertDelphiToLazarusPackage(const PackageFilename: string
  ): TModalResult;
var
  APackage: TLazPackage;
  LPKFilename: String;
  DPKFilename: String;
begin
  debugln('ConvertDelphiToLazarusPackage PackageFilename="',PackageFilename,'"');
  IDEMessagesWindow.Clear;

  // create/open lazarus package file
  LPKFilename:=ChangeFileExt(PackageFilename,'.lpk');
  Result:=CreateDelphiToLazarusPackageInstance(LPKFilename,APackage);
  if Result<>mrOk then begin
    DebugLn('ConvertDelphiToLazarusPackage failed to create/open package LPKFilename="',LPKFilename,'"');
    exit;
  end;

  // read config files (they often contain clues about paths, switches and defines)
  Result:=ReadDelphiPackageConfigFiles(APackage);
  if Result<>mrOk then begin
    DebugLn('ConvertDelphiToLazarusProject failed reading Delphi configs');
    exit;
  end;

  // clean up package
  APackage.RemoveNonExistingFiles;
  CleanUpCompilerOptionsSearchPaths(APackage.CompilerOptions);

  // load required packages
  APackage.AddPackageDependency('LCL');// Nearly all Delphi packages require it

  // we have now enough information to parse the .dpk file,
  // but not enough to parse the units

  // set Delphi mode for all package source directories
  APackage.DefineTemplates.CustomDefinesChanged;
  SetCompilerModeForDefineTempl(APackage.DefineTemplates.CustomDefines);
  try
    // init codetools
    if not LazarusIDE.BeginCodeTools then begin
      DebugLn('ConvertDelphiToLazarusPackage failed BeginCodeTools');
      Result:=mrCancel;
      exit;
    end;

    // get all options from the .dpk
    DPKFilename:=FindDPKFilename(PackageFilename);
    if DPKFilename<>'' then begin
      Result:=ExtractOptionsFromDPK(DPKFilename,APackage);
      if Result<>mrOk then exit;
    end;

    // find and convert all project files
    Result:=FindAllDelphiPackageUnits(APackage,true);
    if Result<>mrOk then exit;

    // convert all package files
    Result:=ConvertAllDelphiPackageUnits(APackage,[cdtlufIsSubProc,cdtlufCheckLFM]);
    if Result<>mrOk then exit;
  finally
    UnsetCompilerModeForDefineTempl(APackage.DefineTemplates.CustomDefines);
  end;

  debugln('ConvertDelphiToLazarusProject Done');
  Result:=mrOk;
end;

function FindAllDelphiPackageUnits(APackage: TLazPackage;
  ShowAbort: boolean): TModalResult;
var
  FoundInUnits, MissingInUnits, NormalUnits: TStrings;
  DPKCode: TCodeBuffer;
  NotFoundUnits: String;
  i: Integer;
  NewSearchPath: String;
  CurFilename: string;
  p: LongInt;
  OffendingUnit: TPkgFile;
  PkgFile: TPkgFile;
begin
  Result:=LoadDPKFile(APackage,DPKCode,ShowAbort);
  if Result<>mrOk then exit;

  FoundInUnits:=nil;
  MissingInUnits:=nil;
  NormalUnits:=nil;
  try
    debugln('FindAllDelphiPackageUnits gathering all units ...');
    if not CodeToolBoss.FindDelphiPackageUnits(DPKCode,FoundInUnits,
                                               MissingInUnits, NormalUnits) then
    begin
      LazarusIDE.DoJumpToCodeToolBossError;
      Result:=mrCancel;
      exit;
    end;
    debugln('FindAllDelphiPackageUnits FoundInUnits=[',FoundInUnits.Text,']',
      ' MissingInUnits=[',MissingInUnits.Text,']',
      ' NormalUnits=[',NormalUnits.Text,']');
    // warn about missing units
    if (MissingInUnits<>nil) and (MissingInUnits.Count>0) then begin
      NotFoundUnits:=MissingInUnits.Text;
      Result:=QuestionDlg('Units not found',
        'Some units of the delphi package are missing:'#13
        +NotFoundUnits,mtWarning,[mrIgnore,mrAbort],0);
      if Result<>mrIgnore then exit;
    end;

    try
      // add all units to the package
      debugln('FindAllDelphiPackageUnits adding all units to package ...');

      for i:=0 to FoundInUnits.Count-1 do begin
        CurFilename:=FoundInUnits[i];
        p:=System.Pos(' in ',CurFilename);
        if p>0 then
          CurFilename:=copy(CurFilename,p+4,length(CurFilename));
        if CurFilename='' then continue;
        if not FilenameIsAbsolute(CurFilename) then
          CurFilename:=AppendPathDelim(APackage.Directory)+CurFilename;
        CurFilename:=TrimFilename(CurFilename);
        if not FileExistsUTF8(CurFilename) then begin
          DebugLn('FindAllDelphiPackageUnits file not found: "',CurFilename,'"');
          continue;
        end;
        PkgFile:=APackage.FindPkgFile(CurFilename,true,false);
        if PkgFile=nil then begin
          if FilenameIsPascalUnit(CurFilename) then begin
            // check unitname
            OffendingUnit:=APackage.FindUnit(ExtractFileNameOnly(CurFilename));
            if OffendingUnit<>nil then begin
              Result:=QuestionDlg('Unitname exists twice',
                'There are two units with the same unitname:'#13
                +OffendingUnit.Filename+#13
                +CurFilename+#13,
                mtWarning,[mrNo,'Remove second',mrAbort],0);
              case Result of
              mrNo:  continue;
              mrIgnore: ;
              else
                Result:=mrAbort;
                exit;
              end;
            end;
          end;

          // add new unit to package
          APackage.AddFile(CurFilename,ExtractFileNameOnly(CurFilename),
                           pftUnit,[pffAddToPkgUsesSection],cpNormal);
        end;
      end;

    finally
      // set unit paths to find all project units
      NewSearchPath:=MergeSearchPaths(APackage.CompilerOptions.OtherUnitFiles,
                       APackage.SourceDirectories.CreateSearchPathFromAllFiles);
      NewSearchPath:=RemoveSearchPaths(NewSearchPath,
                                     '.;'+VirtualDirectory+';'+VirtualTempDir
                                     +';'+APackage.Directory);
      APackage.CompilerOptions.OtherUnitFiles:=MinimizeSearchPath(
               RemoveNonExistingPaths(NewSearchPath,APackage.Directory));
      // set include path
      NewSearchPath:=MergeSearchPaths(APackage.CompilerOptions.IncludePath,
                       APackage.SourceDirectories.CreateSearchPathFromAllFiles);
      NewSearchPath:=RemoveSearchPaths(NewSearchPath,
                                     '.;'+VirtualDirectory+';'+VirtualTempDir
                                     +';'+APackage.Directory);
      APackage.CompilerOptions.IncludePath:=MinimizeSearchPath(
               RemoveNonExistingPaths(NewSearchPath,APackage.Directory));
      // clear caches
      APackage.DefineTemplates.SourceDirectoriesChanged;
      CodeToolBoss.DefineTree.ClearCache;
      DebugLn('FindAllDelphiPackageUnits UnitPath="',APackage.CompilerOptions.OtherUnitFiles,'"');
    end;

    // save package
    debugln('FindAllDelphiPackageUnits Saving package ...');
    Result:=PackageEditors.SavePackage(APackage,false);
    if Result<>mrOk then begin
      DebugLn('FindAllDelphiPackageUnits failed saving package');
      exit;
    end;

  finally
    FoundInUnits.Free;
    MissingInUnits.Free;
    NormalUnits.Free;
  end;

  Result:=mrOk;
end;

function LoadDPKFile(APackage: TLazPackage; out DPKCode: TCodeBuffer;
  ShowAbort: boolean): TModalResult;
var
  DPKFilename: String;
begin
  DPKFilename:=FindDPKFilename(APackage.Filename);
  if not FileExistsCached(DPKFilename) then begin
    Result:=MessageDlg('File not found',
      'Delphi package main source (.dpk) file not found for package'#13
      +APackage.Filename,mtError,[mbAbort],0);
    exit;
  end;
  Result:=LoadCodeBuffer(DPKCode,DPKFilename,[],ShowAbort);
end;

function ConvertAllDelphiPackageUnits(APackage: TLazPackage;
  Flags: TConvertDelphiToLazarusUnitFlags): TModalResult;

  function Convert(CurFlags: TConvertDelphiToLazarusUnitFlags): TModalResult;
  var
    i: Integer;
    PkgFile: TPkgFile;
  begin
    // convert all units
    i:=0;
    while i<APackage.FileCount do begin
      PkgFile:=APackage.Files[i];
      Result:=ConvertDelphiToLazarusUnit(PkgFile.Filename,
                                         CurFlags+[cdtlufIsSubProc]);
      if Result=mrAbort then exit;
      if Result=mrCancel then begin
        Result:=QuestionDlg('Failed converting unit',
          'Failed to convert unit'+#13
          +PkgFile.Filename+#13,
          mtWarning,[mrIgnore,'Ignore and continue',mrAbort],0);
        if Result=mrAbort then exit;
      end;
      if LazarusIDE.DoCloseEditorFile(PkgFile.Filename,
        [cfSaveFirst,cfQuiet]) = mrAbort
      then
        exit;
      inc(i);
    end;
    Result:=mrOk;
  end;

begin
  // first convert all units
  Result:=Convert(Flags-[cdtlufCheckLFM]);
  if Result<>mrOk then exit;
  // now the units can be parsed
  if cdtlufCheckLFM in Flags then begin
    // fix the .lfm files
    Result:=Convert(Flags);
    if Result<>mrOk then exit;
  end;
end;

function ConvertDelphiToLazarusUnit(const DelphiFilename: string;
  Flags: TConvertDelphiToLazarusUnitFlags): TModalResult;
var
  DFMFilename: String;
  LazarusUnitFilename: String;
  LRSFilename: String;
  UnitCode, LFMCode: TCodeBuffer;
  HasDFMFile: boolean;
  LFMFilename: String;
begin
  // check file and directory
  DebugLn('ConvertDelphiToLazarusUnit A ',DelphiFilename,' FixLFM=',dbgs(cdtlufCheckLFM in Flags));
  Result:=CheckFileIsWritable(DelphiFilename,[mbAbort]);
  if Result<>mrOk then exit;

  // close Delphi files in editor
  DebugLn('ConvertDelphiToLazarusUnit Close files in editor .pas/.dfm');
  Result:=LazarusIDE.DoCloseEditorFile(DelphiFilename,[cfSaveFirst]);
  if Result<>mrOk then exit;
  DFMFilename:=FindDFMFileForDelphiUnit(DelphiFilename);
  DebugLn('ConvertDelphiToLazarusUnit DFM file="',DFMFilename,'"');
  HasDFMFile:=DFMFilename<>'';
  if HasDFMFile then begin
    Result:=LazarusIDE.DoCloseEditorFile(DFMFilename,[cfSaveFirst]);
    if Result<>mrOk then exit;
  end;

  // rename files (.pas,.dfm) lowercase
  // TODO: rename files in project
  DebugLn('ConvertDelphiToLazarusUnit Rename files');
  LazarusUnitFilename:='';
  LFMFilename:='';
  Result:=RenameDelphiUnitToLazarusUnit(DelphiFilename,true,
                                        cdtlufRenameLowercase in Flags,
                                        LazarusUnitFilename,LFMFilename);
  if Result<>mrOk then exit;
  if LFMFilename='' then LFMFilename:=ChangeFileExt(LazarusUnitFilename,'.lfm');
  HasDFMFile:=FileExistsUTF8(LFMFilename);
  
  // convert .dfm file to .lfm file (without context type checking)
  if HasDFMFile then begin
    DebugLn('ConvertDelphiToLazarusUnit Rename dfm to lfm "',LFMFilename,'"');
    Result:=ConvertDFMFileToLFMFile(LFMFilename);
    if Result<>mrOk then exit;
  end;
  // create empty .lrs file
  DebugLn('ConvertDelphiToLazarusUnit Create empty lrs');
  if HasDFMFile then begin
    LRSFilename:=ChangeFileExt(LazarusUnitFilename,'.lrs');
    DebugLn('ConvertDelphiToLazarusUnit Create ',LRSFilename);
    Result:=CreateEmptyFile(LRSFilename,[mbAbort,mbRetry]);
    if Result<>mrOk then exit;
  end else
    LRSFilename:='';

  DebugLn('ConvertDelphiToLazarusUnit Convert delphi source');
  if not LazarusIDE.BeginCodeTools then begin
    Result:=mrCancel;
    exit;
  end;

  // check LCL path
  Result:=CheckFilenameForLCLPaths(LazarusUnitFilename);
  if Result<>mrOk then exit;

  // fix or comment missing units
  DebugLn('ConvertDelphiToLazarusUnit FixMissingUnits');
  Result:=FixMissingUnits(LazarusUnitFilename,cdtlufIsSubProc in Flags,true);
  if Result=mrAbort then exit;
  if (Result<>mrOk) then begin
    Result:=JumpToCodetoolErrorAndAskToAbort(cdtlufIsSubProc in Flags);
    exit;
  end;

  // add {$mode delphi} directive
  // remove windows unit and add LResources, LCLIntf
  // remove {$R *.dfm} or {$R *.xfm} directive
  // add initialization
  // add {$i unit.lrs} directive
  // TODO: fix delphi ambiguousities like incomplete proc implementation headers
  Result:=ConvertDelphiSourceToLazarusSource(LazarusUnitFilename,
                                             LRSFilename<>'',true);
  if not IfNotOkJumpToCodetoolErrorAndAskToAbort(Result=mrOk,
                                                cdtlufIsSubProc in Flags,Result)
  then exit;

  if cdtlufCheckLFM in Flags then begin
    // check the LFM file and the pascal unit
    DebugLn('ConvertDelphiToLazarusUnit Check new .lfm and .pas file');
    Result:=LoadUnitAndLFMFile(LazarusUnitFilename,UnitCode,LFMCode,HasDFMFile,true);
    if Result<>mrOk then exit;
    if HasDFMFile and (LFMCode=nil) then
      DebugLn('WARNING: ConvertDelphiToLazarusUnit unable to load LFMCode');
    if (LFMCode<>nil)
    and (RepairLFMBuffer(UnitCode,LFMCode,@IDEMessagesWindow.AddMsg,true,true)<>mrOk)
    then begin
      LazarusIDE.DoJumpToCompilerMessage(-1,true);
      exit(mrAbort);
    end;

    if LFMCode<>nil then begin
      // save LFM file
      DebugLn('ConvertDelphiToLazarusUnit Save LFM');
      Result:=SaveCodeBufferToFile(LFMCode,LFMCode.Filename);
      if Result<>mrOk then exit;

      // convert lfm to lrs
      DebugLn('ConvertDelphiToLazarusUnit Convert lfm to lrs');
      Result:=ConvertLFMtoLRSfile(LFMCode.Filename);
      if Result<>mrOk then exit;
    end;
  end;

  Result:=mrOk;
end;

function CreateDelphiToLazarusProjectInstance(const LPIFilename: string;
  out AProject: TProject): TModalResult;
// If .lpi does not exist, create it
// open new project
begin
  DebugLn('CreateDelphiToLazarusProjectInstance LPIFilename="',LPIFilename,'"');
  AProject:=Project1;
  if FileExistsUTF8(LPIFilename) then begin
    // there is already a lazarus project -> open it, if not already open
    if CompareFilenames(AProject.ProjectInfoFile,LPIFilename)<>0 then begin
      DebugLn('CreateDelphiToLazarusProject open "',LPIFilename,'"');
      Result:=LazarusIDE.DoOpenProjectFile(LPIFilename,[]);
      AProject:=Project1;
      if Result<>mrOk then exit;
    end;
  end else begin
    // create a new lazarus project
    Result:=LazarusIDE.DoNewProject(ProjectDescriptorEmptyProject);
    AProject:=Project1;
    if Result<>mrOk then begin
      DebugLn('CreateDelphiToLazarusProjectInstance failed to create a new project');
      exit;
    end;
    AProject.ProjectInfoFile:=LPIFilename;
  end;
  // save to disk (this makes sure, all editor changes are saved too)
  DebugLn('CreateDelphiToLazarusProjectInstance saving project ...');
  Result:=LazarusIDE.DoSaveProject([]);
end;

function CreateDelphiToLazarusMainSourceFile(AProject: TProject;
  const DPRFilename, MainSourceFilename: string;
  out LPRCode: TCodeBuffer): TModalResult;
// if .lpr does not exists, copy the .dpr file to the .lpr
// adds the .lpr as main unit to the project, if not already done
var
  MainUnitInfo: TUnitInfo;
begin
  LPRCode:=nil;
  Result:=CreateLPRFileForDPRFile(DPRFilename,MainSourceFilename,LPRCode,true);
  if Result<>mrOk then begin
    DebugLn('CreateDelphiToLazarusMainSourceFile CreateLPRFileForDPRFile failed DPRFilename="',DPRFilename,'" MainSourceFilename="',MainSourceFilename,'"');
    exit;
  end;
  if AProject.MainUnitInfo=nil then begin
    // add .lpr file to project as main unit
    DebugLn('CreateDelphiToLazarusMainSourceFile adding .lpr file to project as main unit ',LPRCode.Filename);
    MainUnitInfo:=TUnitInfo.Create(LPRCode);
    MainUnitInfo.SyntaxHighlighter:=
              ExtensionToLazSyntaxHighlighter(ExtractFileExt(LPRCode.Filename));
    MainUnitInfo.IsPartOfProject:=true;
    AProject.AddFile(MainUnitInfo,false);
    AProject.MainFileID:=0;
  end else begin
    // replace main unit in project
    AProject.MainUnitInfo.Source:=LPRCode;
  end;
end;

function FindDPRFilename(const StartFilename: string): string;
// searches the corresponding .dpr file
begin
  if CompareFileExt(StartFilename,'.dpr',false)=0 then
    Result:=StartFilename
  else
    Result:=ChangeFileExt(StartFilename,'.dpr');
  if not FileExistsUTF8(Result) then
    Result:=FindDiskFileCaseInsensitive(StartFilename);
end;

function ReadDelphiProjectConfigFiles(AProject: TProject): TModalResult;
var
  MainSourceFilename: String;
  DOFFilename: String;
  CFGFilename: String;
begin
  if AProject.MainUnitInfo=nil then exit(mrOk);
  MainSourceFilename:=AProject.MainUnitInfo.Filename;

  // read .dof file
  DOFFilename:=FindDelphiDOF(MainSourceFilename);
  if FileExistsUTF8(DOFFilename) then begin
    Result:=ExtractOptionsFromDOF(DOFFilename,Project1);
    if Result<>mrOk then exit;
  end;

  // read .cfg file
  CFGFilename:=FindDelphiCFG(MainSourceFilename);
  if FileExistsUTF8(CFGFilename) then begin
    Result:=ExtractOptionsFromCFG(CFGFilename,Project1);
    if Result<>mrOk then exit;
  end;
end;

procedure SetCompilerModeForDefineTempl(DefTempl: TDefineTemplate);
begin
  if DefTempl.FindChildByName(SettingDelphiModeTemplName)<>nil then exit;
  DefTempl.ReplaceChild(CreateDefinesForFPCMode(SettingDelphiModeTemplName,cmDELPHI));
  CodeToolBoss.DefineTree.ClearCache;
end;

procedure UnsetCompilerModeForDefineTempl(DefTempl: TDefineTemplate);
begin
  if DefTempl.FindChildByName(SettingDelphiModeTemplName)=nil then exit;
  DefTempl.DeleteChild(SettingDelphiModeTemplName);
  CodeToolBoss.DefineTree.ClearCache;
end;

function CreateDelphiToLazarusPackageInstance(const LPKFilename: string; out
  APackage: TLazPackage): TModalResult;
// If .lpk does not exist, create it
// open new package
var
  PkgName: String;
  CurEditor: TPackageEditorForm;
begin
  DebugLn('CreateDelphiToLazarusPackageInstance LPKFilename="',LPKFilename,'"');
  APackage:=nil;
  if FileExistsUTF8(LPKFilename) then begin
    // there is already a lazarus package file
    // open the package editor
    DebugLn('CreateDelphiToLazarusPackageInstance OPEN ',LPKFilename);
    Result:=PackageEditingInterface.DoOpenPackageFile(LPKFilename,[pofAddToRecent],true);
    if Result<>mrOk then exit;
  end;
  
  // search package in graph
  PkgName:=ExtractFileNameOnly(LPKFilename);
  APackage:=PackageGraph.FindAPackageWithName(PkgName,nil);
  if APackage<>nil then begin
    // there is already a package loaded with this name ...
    if CompareFilenames(APackage.Filename,LPKFilename)<>0 then begin
      // ... but it is not the package file we want -> stop
      MessageDlg('Package name exists',
        'There is already a package with the name "'+PkgName+'"'#13
        +'Please close this package first.',mtError,[mbAbort],0);
      PackageEditingInterface.DoOpenPackageFile(APackage.Filename,
                                                        [pofAddToRecent],true);
      Result:=mrAbort;
      exit;
    end else begin
      Result:=mrOk;
    end;
  end else begin
    // there is not yet a package with this name
    // -> create a new package with LCL as dependency
    APackage:=PackageGraph.CreateNewPackage(PkgName);
    DebugLn('CreateDelphiToLazarusPackageInstance CREATED ',APackage.Name);
    PackageGraph.AddDependencyToPackage(APackage,
                   PackageGraph.LCLPackage.CreateDependencyWithOwner(APackage));
    APackage.Filename:=LPKFilename;

    // open a package editor
    CurEditor:=PackageEditors.OpenEditor(APackage);
    CurEditor.Show;
    
    // save .lpk file
    PackageEditors.SavePackage(APackage,false);

    Result:=mrOk;
  end;
end;

function ReadDelphiPackageConfigFiles(APackage: TLazPackage): TModalResult;
var
  DOFFilename: String;
  CFGFilename: String;
begin
  // read .dof file
  DOFFilename:=FindDelphiDOF(APackage.Filename);
  if FileExistsUTF8(DOFFilename) then begin
    Result:=ExtractOptionsFromDOF(DOFFilename,APackage);
    if Result<>mrOk then exit;
  end;

  // read .cfg file
  CFGFilename:=FindDelphiCFG(APackage.Filename);
  if FileExistsUTF8(CFGFilename) then begin
    Result:=ExtractOptionsFromCFG(CFGFilename,APackage);
    if Result<>mrOk then exit;
  end;
end;

procedure CleanUpCompilerOptionsSearchPaths(Options: TBaseCompilerOptions);
var
  BasePath: String;

  function CleanProjectSearchPath(const SearchPath: string): string;
  begin
    Result:=RemoveNonExistingPaths(SearchPath,BasePath);
    Result:=MinimizeSearchPath(Result);
  end;

begin
  BasePath:=Options.BaseDirectory;
  Options.OtherUnitFiles:=CleanProjectSearchPath(Options.OtherUnitFiles);
  Options.IncludePath:=CleanProjectSearchPath(Options.IncludePath);
  Options.Libraries:=CleanProjectSearchPath(Options.Libraries);
  Options.ObjectPath:=CleanProjectSearchPath(Options.ObjectPath);
  Options.SrcPath:=CleanProjectSearchPath(Options.SrcPath);
end;

end.

