Refactored and improved converter files.

git-svn-id: trunk@23727 -

.gitattributes

@@ -2201,10 +2201,15 @@ components/turbopower_ipro/turbopoweripro.lpk svneol=native#text/pascal
 components/turbopower_ipro/turbopoweripro.pas svneol=native#text/plain
 converter/chgencodingdlg.lfm svneol=native#text/plain
 converter/chgencodingdlg.pas svneol=native#text/plain
+converter/convertdelphi.pas svneol=native#text/plain
+converter/convertsettings.lfm svneol=native#text/plain
+converter/convertsettings.pas svneol=native#text/plain
 converter/delphiproject2laz.pas svneol=native#text/plain
 converter/delphiunit2laz.lfm svneol=native#text/plain
 converter/delphiunit2laz.pas svneol=native#text/pascal
 converter/lazxmlforms.pas svneol=native#text/plain
+converter/missingunitsunit.lfm svneol=native#text/plain
+converter/missingunitsunit.pas svneol=native#text/plain
 debian/README.Debian svneol=native#text/plain
 debian/README.source svneol=native#text/plain
 debian/changelog svneol=native#text/plain

converter/convertsettings.lfm

@@ -0,0 +1,180 @@
+object ConvertSettingsForm: TConvertSettingsForm
+  Left = 319
+  Height = 350
+  Top = 122
+  Width = 558
+  Caption = 'Convert Delphi unit, project or package '
+  ClientHeight = 350
+  ClientWidth = 558
+  Constraints.MinHeight = 350
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  LCLVersion = '0.9.29'
+  object MissingStuffGroupBox: TGroupBox
+    AnchorSideTop.Control = SettingsGroupBox
+    AnchorSideTop.Side = asrBottom
+    Left = 0
+    Height = 161
+    Top = 131
+    Width = 558
+    Anchors = [akTop, akLeft, akRight, akBottom]
+    BorderSpacing.Top = 3
+    Caption = 'Missing Properties and Components'
+    ClientHeight = 139
+    ClientWidth = 548
+    TabOrder = 0
+    object MissingComponentCheckBox: TCheckBox
+      Left = 11
+      Height = 23
+      Top = 28
+      Width = 326
+      Caption = 'Automatic conversion of missing components (ToDo...)'
+      Enabled = False
+      TabOrder = 0
+      Visible = False
+    end
+    object MissingPropertyCheckBox: TCheckBox
+      Left = 11
+      Height = 23
+      Top = 10
+      Width = 297
+      Caption = 'Automatic removal of missing properties (ToDo...)'
+      Enabled = False
+      TabOrder = 1
+    end
+    object MissingStuffLabel: TLabel
+      Left = 11
+      Height = 16
+      Top = 65
+      Width = 417
+      Caption = 'If unchecked, there will be interactive dialogs for editing / accepting changes.'
+      ParentColor = False
+    end
+    object ReplacementCompsButton: TBitBtn
+      Left = 11
+      Height = 30
+      Top = 97
+      Width = 272
+      Caption = 'Replacement components (ToDo...)'
+      Enabled = False
+      OnClick = ReplacementCompsButtonClick
+      TabOrder = 2
+    end
+  end
+  object SettingsGroupBox: TGroupBox
+    Left = 0
+    Height = 128
+    Top = 0
+    Width = 558
+    Anchors = [akTop, akLeft, akRight]
+    Caption = 'Conversion Settings'
+    ClientHeight = 106
+    ClientWidth = 548
+    TabOrder = 1
+    object BackupCheckBox: TCheckBox
+      Left = 11
+      Height = 23
+      Top = 39
+      Width = 189
+      Caption = 'Make backup of changed files'
+      Checked = True
+      State = cbChecked
+      TabOrder = 0
+    end
+    object DelphiCompatibleCheckBox: TCheckBox
+      Left = 11
+      Height = 23
+      Top = 71
+      Width = 264
+      Caption = 'Try to keep files Delphi compatible (ToDo...)'
+      Enabled = False
+      TabOrder = 1
+    end
+    object MainPathEdit: TLabeledEdit
+      Left = 35
+      Height = 17
+      Top = 15
+      Width = 477
+      Anchors = [akTop, akLeft, akRight]
+      BorderStyle = bsNone
+      Color = clBtnFace
+      EditLabel.AnchorSideLeft.Control = MainPathEdit
+      EditLabel.AnchorSideTop.Control = MainPathEdit
+      EditLabel.AnchorSideTop.Side = asrCenter
+      EditLabel.AnchorSideRight.Control = MainPathEdit
+      EditLabel.AnchorSideBottom.Control = MainPathEdit
+      EditLabel.Left = 35
+      EditLabel.Height = 16
+      EditLabel.Top = -1
+      EditLabel.Width = 55
+      EditLabel.Caption = 'Main Path'
+      EditLabel.ParentColor = False
+      LabelSpacing = 0
+      ReadOnly = True
+      TabOrder = 2
+    end
+  end
+  object BtnPanel: TPanel
+    Left = 0
+    Height = 48
+    Top = 302
+    Width = 558
+    Align = alBottom
+    AutoSize = True
+    BevelOuter = bvNone
+    ClientHeight = 48
+    ClientWidth = 558
+    TabOrder = 2
+    object HelpButton: TBitBtn
+      AnchorSideBottom.Side = asrBottom
+      Left = 6
+      Height = 36
+      Top = 6
+      Width = 75
+      Align = alLeft
+      AutoSize = True
+      BorderSpacing.Around = 6
+      Constraints.MinHeight = 25
+      Constraints.MinWidth = 75
+      Kind = bkHelp
+      NumGlyphs = 0
+      TabOrder = 0
+    end
+    object btnOK: TBitBtn
+      AnchorSideBottom.Side = asrBottom
+      Left = 390
+      Height = 36
+      Top = 6
+      Width = 75
+      Align = alRight
+      AutoSize = True
+      BorderSpacing.Around = 6
+      Caption = '&OK'
+      Constraints.MinHeight = 25
+      Constraints.MinWidth = 75
+      Kind = bkOK
+      NumGlyphs = 0
+      OnClick = btnOKClick
+      TabOrder = 1
+    end
+    object btnCancel: TBitBtn
+      AnchorSideRight.Side = asrBottom
+      AnchorSideBottom.Side = asrBottom
+      Left = 471
+      Height = 36
+      Top = 6
+      Width = 81
+      Align = alRight
+      AutoSize = True
+      BorderSpacing.Around = 6
+      Cancel = True
+      Caption = 'Cancel'
+      Constraints.MinHeight = 25
+      Constraints.MinWidth = 75
+      Kind = bkCancel
+      ModalResult = 2
+      NumGlyphs = 0
+      TabOrder = 2
+    end
+  end
+end

converter/convertsettings.pas

@@ -0,0 +1,251 @@
+unit ConvertSettings;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
+  StdCtrls, EditBtn, Buttons, ExtCtrls, DialogProcs;
+
+type
+
+  { TConvertSettings }
+
+  TConvertSettings = class
+  private
+    fTitle: String;       // Used for form caption.
+    // Unit, Project or Package top file and path.
+    fMainFilename: String;
+    fMainPath: String;
+    // Actual user settings.
+    fBackupFiles: boolean;
+    fKeepDelphiCompatible: boolean;
+    fAutoMissingProperties: boolean;
+    fAutoMissingComponents: boolean;
+    function GetBackupPath: String;
+    procedure SetMainFilename(const AValue: String);
+  public
+    constructor Create(const ATitle: string);
+    destructor Destroy; override;
+    function RunForm: TModalResult;
+
+    // Lazarus file name based on Delphi file name, keep suffix.
+    function DelphiToLazFilename(const DelphiFilename: string;
+      LowercaseFilename: boolean): string; overload;
+    // Lazarus file name based on Delphi file name with new suffix.
+    function DelphiToLazFilename(const DelphiFilename, LazExt: string;
+      LowercaseFilename: boolean): string; overload;
+
+    // Create Lazarus file name and copy/rename from Delphi file, keep suffix.
+    function RenameDelphiToLazFile(const DelphiFilename: string;
+      out LazFilename: string; LowercaseFilename: boolean): TModalResult; overload;
+    // Create Lazarus file name and copy/rename from Delphi file with new suffix.
+    function RenameDelphiToLazFile(const DelphiFilename, LazExt: string;
+      out LazFilename: string; LowercaseFilename: boolean): TModalResult; overload;
+
+    function RenameFile(const SrcFilename, DestFilename: string): TModalResult;
+    function BackupFile(const AFilename: string): TModalResult;
+  public
+    property MainFilename: String read fMainFilename write SetMainFilename;
+    property MainPath: String read fMainPath;
+    property BackupPath: String read GetBackupPath;
+
+    property BackupFiles: boolean read fBackupFiles;
+    property KeepDelphiCompatible: boolean read fKeepDelphiCompatible;
+    property AutoMissingProperties: boolean read fAutoMissingProperties;
+    property AutoMissingComponents: boolean read fAutoMissingComponents;
+  end;
+
+
+  { TConvertSettingsForm }
+
+  TConvertSettingsForm = class(TForm)
+    BackupCheckBox: TCheckBox;
+    ReplacementCompsButton: TBitBtn;
+    btnCancel: TBitBtn;
+    btnOK: TBitBtn;
+    BtnPanel: TPanel;
+    DelphiCompatibleCheckBox: TCheckBox;
+    HelpButton: TBitBtn;
+    MainPathEdit: TLabeledEdit;
+    SettingsGroupBox: TGroupBox;
+    MissingStuffGroupBox: TGroupBox;
+    MissingStuffLabel: TLabel;
+    MissingComponentCheckBox: TCheckBox;
+    MissingPropertyCheckBox: TCheckBox;
+    procedure btnOKClick(Sender: TObject);
+    procedure ReplacementCompsButtonClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+  private
+  public
+
+  end; 
+
+var
+  ConvertSettingsForm: TConvertSettingsForm;
+
+implementation
+
+
+{$R *.lfm}
+
+{ TConvertSettings }
+
+constructor TConvertSettings.Create(const ATitle: string);
+begin
+  fTitle:=ATitle;
+  fMainFilename:='';
+  fMainPath:='';
+end;
+
+destructor TConvertSettings.Destroy;
+begin
+  inherited Destroy;
+end;
+
+function TConvertSettings.RunForm: TModalResult;
+var
+  SettingsForm: TConvertSettingsForm;
+begin
+  SettingsForm:=TConvertSettingsForm.Create(nil);
+  with SettingsForm do
+  try
+    Caption:=fTitle;
+    MainPathEdit.Text:=fMainPath;
+{
+    // ToDo: Load from XML.
+    // Settings --> UI.
+    BackupCheckBox.Checked          :=fBackupFiles;
+    DelphiCompatibleCheckBox.Checked:=fKeepDelphiCompatible;
+    MissingPropertyCheckBox.Checked :=fAutoMissingProperties;
+    MissingComponentCheckBox.Checked:=fAutoMissingComponents;
+}
+    Result:=ShowModal;
+    if Result=mrOK then begin
+      // UI --> Settings.
+      fBackupFiles:=BackupCheckBox.Checked;
+      fKeepDelphiCompatible:=DelphiCompatibleCheckBox.Checked;
+      fAutoMissingProperties:=MissingPropertyCheckBox.Checked;
+      fAutoMissingComponents:=MissingComponentCheckBox.Checked;
+      // ToDo: Save to XML.
+    end;
+  finally
+    Free;
+  end;
+end;
+
+function TConvertSettings.DelphiToLazFilename(const DelphiFilename: string;
+                                              LowercaseFilename: boolean): string;
+begin
+  Result:=DelphiToLazFilename(DelphiFilename,'',LowercaseFilename);
+end;
+
+function TConvertSettings.DelphiToLazFilename(const DelphiFilename, LazExt: string;
+                                              LowercaseFilename: boolean): string;
+var
+  RelPath, SubPath, fn: string;
+begin
+  RelPath:=FileUtil.CreateRelativePath(DelphiFilename, fMainPath);
+  SubPath:=ExtractFilePath(RelPath);
+  if LazExt='' then                 // Include ext in filename if not defined.
+    fn:=ExtractFileName(RelPath)
+  else
+    fn:=ExtractFileNameOnly(RelPath);
+  if LowercaseFilename then
+    fn:=LowerCase(fn);
+  Result:=fMainPath+SubPath+fn+LazExt;
+end;
+
+function TConvertSettings.RenameDelphiToLazFile(const DelphiFilename: string;
+  out LazFilename: string; LowercaseFilename: boolean): TModalResult;
+begin
+  Result:=RenameDelphiToLazFile(DelphiFilename,'',LazFilename,LowercaseFilename);
+end;
+
+function TConvertSettings.RenameDelphiToLazFile(const DelphiFilename, LazExt: string;
+  out LazFilename: string; LowercaseFilename: boolean): TModalResult;
+var
+  RelPath, SubPath, fn: string;
+begin
+  RelPath:=FileUtil.CreateRelativePath(DelphiFilename, fMainPath);
+  SubPath:=ExtractFilePath(RelPath);
+  if LazExt='' then                 // Include ext in filename if not defined.
+    fn:=ExtractFileName(RelPath)
+  else
+    fn:=ExtractFileNameOnly(RelPath);
+  if LowercaseFilename then
+    fn:=LowerCase(fn);
+  // Rename in the same directory.
+  if fBackupFiles then begin
+    Result:=BackupFile(DelphiFilename); // Save before rename.
+    if Result<>mrOK then exit;
+  end;
+  LazFilename:=fMainPath+SubPath+fn+LazExt;
+  Result:=RenameFileWithErrorDialogs(DelphiFilename,LazFilename,[mbAbort]);
+end;
+
+function TConvertSettings.RenameFile(const SrcFilename, DestFilename: string): TModalResult;
+begin
+  Result:=mrOK;
+  // Convert in place.
+  if fBackupFiles then
+    BackupFile(SrcFilename); // Save before rename.
+  Result:=RenameFileWithErrorDialogs(SrcFilename,DestFilename,[mbAbort]);
+end;
+
+function TConvertSettings.BackupFile(const AFilename: string): TModalResult;
+var
+  bp, fn: String;
+begin
+  bp:=BackupPath;
+  fn:=ExtractFileName(AFilename);
+  Result:=CopyFileWithErrorDialogs(AFilename,bp+fn,[mbAbort]);
+end;
+
+procedure TConvertSettings.SetMainFilename(const AValue: String);
+begin
+  fMainFilename:=AValue;
+  fMainPath:=ExtractFilePath(AValue);
+end;
+
+function TConvertSettings.GetBackupPath: String;
+const
+  BackupPathName='ConverterBackup';
+begin
+  Result:='';
+  if fBackupFiles then begin
+    Result:=fMainPath+BackupPathName+PathDelim;
+    // Create backup path if needed.
+    if not DirectoryExistsUTF8(Result) then
+      CreateDirUTF8(Result);
+  end;
+end;
+
+
+{ TConvertSettingsForm }
+
+procedure TConvertSettingsForm.FormCreate(Sender: TObject);
+begin
+  MainPathEdit.Text:='';
+end;
+
+procedure TConvertSettingsForm.FormDestroy(Sender: TObject);
+begin
+  ;
+end;
+
+procedure TConvertSettingsForm.btnOKClick(Sender: TObject);
+begin
+  ModalResult:=mrOk;
+end;
+
+procedure TConvertSettingsForm.ReplacementCompsButtonClick(Sender: TObject);
+begin
+  ShowMessage('Sorry, not implemented yet!');
+end;
+
+
+end.
+

converter/missingunitsunit.lfm

@@ -0,0 +1,113 @@
+object MissingUnitsDialog: TMissingUnitsDialog
+  Left = 283
+  Height = 219
+  Top = 127
+  Width = 562
+  HorzScrollBar.Page = 411
+  VertScrollBar.Page = 342
+  Caption = 'Units not Found'
+  ClientHeight = 219
+  ClientWidth = 562
+  LCLVersion = '0.9.29'
+  object MissingUnitsInfoLabel: TLabel
+    Left = 16
+    Height = 16
+    Top = 16
+    Width = 538
+    Anchors = [akTop, akLeft, akRight]
+    Caption = 'Missing Units Info'
+    ParentColor = False
+  end
+  object CommentButton: TBitBtn
+    Left = 16
+    Height = 30
+    Top = 170
+    Width = 152
+    Anchors = [akLeft, akBottom]
+    Caption = 'Comment'
+    Default = True
+    ModalResult = 1
+    OnClick = CommentButtonClick
+    TabOrder = 0
+  end
+  object SearchButton: TBitBtn
+    Left = 209
+    Height = 30
+    Top = 170
+    Width = 152
+    Anchors = [akBottom]
+    Caption = 'Search'
+    ModalResult = 6
+    OnClick = SearchButtonClick
+    TabOrder = 1
+  end
+  object AbortButton: TBitBtn
+    Left = 402
+    Height = 30
+    Top = 170
+    Width = 152
+    Anchors = [akRight, akBottom]
+    Caption = 'Abort'
+    Kind = bkAbort
+    ModalResult = 3
+    OnClick = AbortButtonClick
+    TabOrder = 2
+  end
+  object ChoicesLabel: TLabel
+    AnchorSideTop.Control = UnitNamesLabel
+    Left = 16
+    Height = 16
+    Top = 62
+    Width = 538
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Top = 23
+    Caption = 'Choices:'
+    ParentColor = False
+  end
+  object Info1Label: TLabel
+    AnchorSideTop.Control = ChoicesLabel
+    Left = 16
+    Height = 16
+    Top = 85
+    Width = 538
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Top = 23
+    Caption = 'Info1'
+    ParentColor = False
+  end
+  object Info2Label: TLabel
+    AnchorSideTop.Control = Info1Label
+    Left = 16
+    Height = 16
+    Top = 108
+    Width = 538
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Top = 23
+    Caption = 'Info2'
+    ParentColor = False
+  end
+  object Info3Label: TLabel
+    AnchorSideTop.Control = Info2Label
+    Left = 16
+    Height = 16
+    Top = 131
+    Width = 538
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Top = 23
+    Caption = 'Info3'
+    ParentColor = False
+  end
+  object UnitNamesLabel: TLabel
+    AnchorSideTop.Control = MissingUnitsInfoLabel
+    Left = 24
+    Height = 16
+    Top = 39
+    Width = 530
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Top = 23
+    Caption = 'UnitNames'
+    Font.Style = [fsBold]
+    ParentColor = False
+    ParentFont = False
+  end
+end

converter/missingunitsunit.pas

@@ -0,0 +1,147 @@
+{
+ ***************************************************************************
+ *                                                                         *
+ *   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:
+    Functions to convert delphi units to lcl units.
+}
+unit MissingUnitsUnit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  // FCL+LCL
+  Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics,
+  Dialogs, Buttons, StdCtrls, FileUtil,
+  // Components
+  SynEdit, CodeAtom, CodeCache, CodeToolManager, DefineTemplates,
+  // IDEIntf
+  LazIDEIntf, IDEMsgIntf,
+  // IDE
+  CompilerOptions,
+  PackageDefs, Project, DialogProcs, IDEProcs, LazarusIDEStrConsts;
+
+const
+  // Copied from LazarusIDEStrConsts, remove later...
+  lisMissingUnitsComment = 'Comment Out';
+  lisMissingUnitsSearch = 'Search Unit Path';
+  lisTheseUnitsWereNotFound = 'These units were not found:';
+  lisMissingUnitsChoices = 'Your choices are:';
+  lisMissingUnitsInfo1 = '1) Comment out the missing units (ignore them).';
+  lisMissingUnitsInfo2 = '2) Select a unit path which will be added to project settings.';
+  lisMissingUnitsInfo3 = '3) Abort now, fix the unit path or install packages and try again.';
+  lisUnitNotFound = 'A unit not found in';
+  lisUnitsNotFound2 = 'Units not found in';
+
+
+type
+
+  { TMissingUnitsDialog }
+
+  TMissingUnitsDialog = class(TForm)
+    CommentButton: TBitBtn;
+    ChoicesLabel: TLabel;
+    UnitNamesLabel: TLabel;
+    Info1Label: TLabel;
+    Info2Label: TLabel;
+    Info3Label: TLabel;
+    SearchButton: TBitBtn;
+    AbortButton: TBitBtn;
+    MissingUnitsInfoLabel: TLabel;
+    procedure AbortButtonClick(Sender: TObject);
+    procedure CommentButtonClick(Sender: TObject);
+    procedure SearchButtonClick(Sender: TObject);
+  private
+
+  public
+
+  end;
+
+var
+  MissingUnitsDialog: TMissingUnitsDialog;
+
+function AskMissingUnits(AMissingUnits: TStrings; AMainUnitName: string): TModalResult;
+
+
+implementation
+
+{$R *.lfm}
+
+function AskMissingUnits(AMissingUnits: TStrings; AMainUnitName: string): TModalResult;
+var
+  UNFDialog: TMissingUnitsDialog;
+  UnitsTitle, UnitsCommaList: string;
+  i: Integer;
+begin
+  Result:=mrCancel;
+
+  // A title text containing filename.
+  if AMissingUnits.Count=1 then
+    UnitsTitle:=lisUnitNotFound+' '+AMainUnitName
+  else
+    UnitsTitle:=lisUnitsNotFound2+' '+AMainUnitName;
+
+  // A comma separated list of missing units.
+  UnitsCommaList:='';
+  for i:=0 to AMissingUnits.Count-1 do begin
+    if UnitsCommaList<>'' then
+      UnitsCommaList:=UnitsCommaList+', ';
+    UnitsCommaList:=UnitsCommaList+AMissingUnits[i];
+  end;
+
+  UNFDialog:=TMissingUnitsDialog.Create(nil);
+  with UNFDialog do begin
+    Caption:=UnitsTitle;
+    CommentButton.Caption:=lisMissingUnitsComment;
+    SearchButton.Caption:=lisMissingUnitsSearch;
+    MissingUnitsInfoLabel.Caption:=lisTheseUnitsWereNotFound;
+    UnitNamesLabel.Caption:=UnitsCommaList;
+    ChoicesLabel.Caption:=lisMissingUnitsChoices;
+    Info1Label.Caption:=lisMissingUnitsInfo1;
+    Info2Label.Caption:=lisMissingUnitsInfo2;
+    Info3Label.Caption:=lisMissingUnitsInfo3;
+    Result:=ShowModal;
+    Free;
+  end;
+end;
+
+{ TMissingUnitsDialog }
+
+procedure TMissingUnitsDialog.CommentButtonClick(Sender: TObject);
+begin
+
+end;
+
+procedure TMissingUnitsDialog.SearchButtonClick(Sender: TObject);
+begin
+
+end;
+
+procedure TMissingUnitsDialog.AbortButtonClick(Sender: TObject);
+begin
+
+end;
+
+
+end.
+