paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-08 08:38:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

moved IDE functions to convert delphi projects to unit of its own

Browse Source 
git-svn-id: trunk@8853 -
This commit is contained in:
mattias 2006-03-01 12:12:42 +00:00
parent 56d7f70ef6
commit 17f7100bdb
8 changed files with 1063 additions and 567 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -495,6 +495,7 @@ components/turbopower_ipro/iputils.pas svneol=native#text/pascal
components/turbopower_ipro/tiphtmlpanel.xpm -text svneol=native#image/x-xpixmap
components/turbopower_ipro/turbopoweripro.lpk svneol=native#text/pascal
components/turbopower_ipro/turbopoweripro.pas svneol=native#text/plain
converter/delphiproject2laz.pas svneol=native#text/plain
converter/delphiunit2laz.lfm svneol=native#text/plain
converter/delphiunit2laz.lrs svneol=native#text/pascal
converter/delphiunit2laz.pas svneol=native#text/pascal

347
converter/delphiproject2laz.pas Normal file
View File

@ -0,0 +1,347 @@
{ $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 to lazarus projects.
}
unit DelphiProject2Laz;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLProc, Forms, Controls, Dialogs,
ExprEval, CodeCache, CodeToolManager,
SrcEditorIntf, MsgIntf, MainIntf, LazIDEIntf, ProjectIntf,
DelphiUnit2Laz, Project, DialogProcs, CheckLFMDlg,
EditorOptions, ProjectInspector, CompilerOptions,
BasePkgManager, PkgManager;
function ConvertDelphiToLazarusProject(const DelphiFilename: string
): TModalResult;
function ConvertDelphiToLazarusUnit(const DelphiFilename: string
): TModalResult;
implementation
function ConvertDelphiToLazarusProject(const DelphiFilename: string): TModalResult;
var
DPRCode: TCodeBuffer;
FoundInUnits, MissingInUnits, NormalUnits: TStrings;
NotFoundUnits: String;
LPRCode: TCodeBuffer;
NewProjectDesc: TProjectEmptyProgramDescriptor;
i: Integer;
CurUnitInfo: TUnitInfo;
MainUnitInfo: TUnitInfo;
DOFFilename: String;
CFGFilename: String;
begin
debugln('ConvertDelphiToLazarusProject DelphiFilename="',DelphiFilename,'"');
IDEMessagesWindow.Clear;
// check Delphi project file
Result:=CheckDelphiProjectExt(DelphiFilename);
if Result<>mrOk then exit;
// close Delphi file in editor
debugln('ConvertDelphiToLazarusProject closing in editor dpr ...');
Result:=LazarusIDE.DoCloseEditorFile(DelphiFilename,[cfSaveFirst]);
if Result<>mrOk then exit;
// commit source editor changes to codetools
if not LazarusIDE.BeginCodeTools then begin
Result:=mrCancel;
exit;
end;
// load Delphi project file .dpr
debugln('ConvertDelphiToLazarusProject loading dpr ...');
Result:=LoadCodeBuffer(DPRCode,DelphiFilename,
[lbfCheckIfText,lbfUpdateFromDisk]);
if Result<>mrOk then exit;
// create .lpr file
debugln('ConvertDelphiToLazarusProject creating lpr ...');
Result:=CreateLPRFileForDPRFile(DelphiFilename,false,LPRCode);
if Result<>mrOk then begin
if CodeToolBoss.ErrorMessage<>'' then LazarusIDE.DoJumpToCodeToolBossError;
exit;
end;
// close old project
debugln('ConvertDelphiToLazarusProject closing current project ...');
If Project1<>nil then begin
if LazarusIDE.DoCloseProject=mrAbort then begin
Result:=mrAbort;
exit;
end;
end;
// switch codetools to new project directory
CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'ProjPath']:=
ExpandFilename(ExtractFilePath(LPRCode.Filename));
// create a new project
debugln('ConvertDelphiToLazarusProject creating new project ...');
NewProjectDesc:=TProjectEmptyProgramDescriptor.Create;
Project1:=MainIDEInterface.CreateProjectObject(NewProjectDesc,
ProjectDescriptorApplication);
Project1.BeginUpdate(true);
try
if ProjInspector<>nil then ProjInspector.LazProject:=Project1;
MainUnitInfo:=TUnitInfo.Create(LPRCode);
MainUnitInfo.SyntaxHighlighter:=
ExtensionToLazSyntaxHighlighter(ExtractFileExt(LPRCode.Filename));
MainUnitInfo.IsPartOfProject:=true;
Project1.AddFile(MainUnitInfo,false);
Project1.MainFileID:=0;
Project1.ProjectInfoFile:=ChangeFileExt(LPRCode.Filename,'.lpi');
Project1.CompilerOptions.CompilerPath:='$(CompPath)';
MainIDEInterface.UpdateCaption;
IncreaseCompilerParseStamp;
// TODO: get all compiler options from .dpr
Result:=ExtractOptionsFromDPR(LPRCode,Project1);
if Result<>mrOk then exit;
// TODO: read .dof file
DOFFilename:=FindDelphiDOF(DelphiFilename);
if FileExists(DOFFilename) then begin
Result:=ExtractOptionsFromDOF(DOFFilename,Project1);
if Result<>mrOk then exit;
end;
// TODO: read .cfg file
CFGFilename:=FindDelphiCFG(DelphiFilename);
if FileExists(CFGFilename) then begin
Result:=ExtractOptionsFromCFG(CFGFilename,Project1);
if Result<>mrOk then exit;
end;
// TODO: get all needed packages
// add and load default required packages
// TODO: add packages
// WORKAROUND: add LCL
// add lcl pp/pas dirs to source search path
Project1.AddSrcPath('$(LazarusDir)/lcl;'
+'$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)');
Project1.AddPackageDependency('LCL');
Project1.LazCompilerOptions.Win32GraphicApp:=true;
PkgBoss.AddDefaultDependencies(Project1);
finally
Project1.EndUpdate;
NewProjectDesc.Free;
end;
// show program unit
debugln('ConvertDelphiToLazarusProject open lpr in editor ...');
Result:=LazarusIDE.DoOpenEditorFile(LPRCode.Filename,-1,
[ofAddToRecent,ofRegularFile]);
if Result=mrAbort then exit;
// find all project files
FoundInUnits:=nil;
MissingInUnits:=nil;
NormalUnits:=nil;
try
debugln('ConvertDelphiToLazarusProject gathering all project units ...');
if not CodeToolBoss.FindDelphiProjectUnits(LPRCode,FoundInUnits,
MissingInUnits, NormalUnits) then
begin
LazarusIDE.DoJumpToCodeToolBossError;
Result:=mrCancel;
exit;
end;
debugln('ConvertDelphiToLazarusProject 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:=MessageDlg('Units not found',
'Some units of the delphi project were not found:'#13
+NotFoundUnits,mtWarning,[mbIgnore,mbAbort],0);
if Result<>mrIgnore then exit;
end;
// add all units to the project
debugln('ConvertDelphiToLazarusProject adding all project units to project ...');
for i:=0 to FoundInUnits.Count-1 do begin
CurUnitInfo:=TUnitInfo.Create(nil);
TUnitInfo(CurUnitInfo).Filename:=FoundInUnits[i];
Project1.AddFile(CurUnitInfo,false);
end;
// set search paths to find all project units
Project1.CompilerOptions.OtherUnitFiles:=
Project1.SourceDirectories.CreateSearchPathFromAllFiles;
DebugLn('ConvertDelphiToLazarusProject UnitPath="',Project1.CompilerOptions.OtherUnitFiles,'"');
// save project
debugln('ConvertDelphiToLazarusProject Saving new project ...');
Result:=LazarusIDE.DoSaveProject([]);
if Result<>mrOk then exit;
// convert all units
i:=0;
while i<Project1.UnitCount do begin
CurUnitInfo:=Project1.Units[i];
if CurUnitInfo.IsPartOfProject and not (CurUnitInfo.IsMainUnit) then begin
Result:=ConvertDelphiToLazarusUnit(CurUnitInfo.Filename);
if Result=mrAbort then exit;
end;
inc(i);
end;
finally
FoundInUnits.Free;
MissingInUnits.Free;
NormalUnits.Free;
end;
debugln('ConvertDelphiToLazarusProject Done');
Result:=mrOk;
end;
function ConvertDelphiToLazarusUnit(const DelphiFilename: string): TModalResult;
var
DFMFilename: String;
LazarusUnitFilename: String;
LRSFilename: String;
ActiveSrcEdit: TSourceEditorInterface;
ActiveUnitInfo: TUnitInfo;
UnitCode, LFMCode: TCodeBuffer;
HasDFMFile: boolean;
LFMFilename: String;
begin
// check file and directory
DebugLn('ConvertDelphiToLazarusUnit A ',DelphiFilename);
Result:=CheckDelphiFileExt(DelphiFilename);
if Result<>mrOk then exit;
Result:=CheckFileIsWritable(DelphiFilename,[mbAbort]);
if Result<>mrOk then exit;
Result:=CheckFilenameForLCLPaths(DelphiFilename);
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,
LazarusUnitFilename,LFMFilename);
if Result<>mrOk then exit;
if LFMFilename='' then LFMFilename:=ChangeFIleExt(LazarusUnitFilename,'.lfm');
HasDFMFile:=FileExists(LFMFilename);
// convert .dfm file to .lfm file
if HasDFMFile then begin
DebugLn('ConvertDelphiToLazarusUnit Convert dfm format 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;
// add {$mode delphi} directive
// remove windows unit and add LResources, LCLIntf
// remove {$R *.dfm} or {$R *.xfm} directive
// add initialization
// add {$i unit.lrs} directive
// TODO: fix delphi ambiguousities like incomplete proc implementation headers
Result:=ConvertDelphiSourceToLazarusSource(LazarusUnitFilename,
LRSFilename<>'');
if Result<>mrOk then begin
LazarusIDE.DoJumpToCodeToolBossError;
exit;
end;
// comment missing units
DebugLn('ConvertDelphiToLazarusUnit FixMissingUnits');
Result:=FixMissingUnits(LazarusUnitFilename);
if Result<>mrOk then begin
LazarusIDE.DoJumpToCodeToolBossError;
exit;
end;
// check the LFM file and the pascal unit
DebugLn('ConvertDelphiToLazarusUnit Check new .lfm and .pas file');
Result:=LoadUnitAndLFMFile(LazarusUnitFilename,UnitCode,LFMCode,HasDFMFile);
if Result<>mrOk then exit;
if HasDFMFile and (LFMCode=nil) then
DebugLn('WARNING: ConvertDelphiToLazarusUnit unable to load LFMCode');
if (LFMCode<>nil)
and (CheckLFMBuffer(UnitCode,LFMCode,@IDEMessagesWindow.AddMsg,true,true)<>mrOk)
then begin
LazarusIDE.DoJumpToCompilerMessage(-1,true);
exit;
end;
if LFMCode<>nil then begin
// save LFM file
DebugLn('ConvertDelphiToLazarusUnit Save LFM');
Result:=MainIDEInterface.DoSaveCodeBufferToFile(LFMCode,LFMCode.Filename,false);
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;
Result:=mrOk;
end;
end.

301
ide/main.pp
View File

@ -113,8 +113,8 @@ uses
BuildLazDialog, MiscOptions, InputHistory, UnitDependencies, ClipBoardHistory,
ProcessList, InitialSetupDlgs, NewDialog, MakeResStrDlg, ToDoList,
DialogProcs, FindReplaceDialog, FindInFilesDlg, CodeExplorer, BuildFileDlg,
ExtractProcDlg, FindRenameIdentifier, DelphiUnit2Laz, CleanDirDlg,
CodeContextForm, AboutFrm,
ExtractProcDlg, FindRenameIdentifier, DelphiProject2Laz, DelphiUnit2Laz,
CleanDirDlg, CodeContextForm, AboutFrm,
// main ide
MainBar, MainIntf, MainBase;
@ -551,7 +551,7 @@ type
// methods for creating a project
function CreateProjectObject(ProjectDesc,
FallbackProjectDesc: TProjectDescriptor): TProject;
FallbackProjectDesc: TProjectDescriptor): TProject; override;
procedure OnLoadProjectInfoFromXMLConfig(TheProject: TProject;
XMLConfig: TXMLConfig;
Merge: boolean);
@ -603,9 +603,9 @@ type
function DoSaveEditorFile(PageIndex:integer;
Flags: TSaveFlags): TModalResult;
function DoCloseEditorFile(PageIndex:integer;
Flags: TCloseFlags):TModalResult;
Flags: TCloseFlags):TModalResult; override;
function DoCloseEditorFile(const Filename: string;
Flags: TCloseFlags): TModalResult;
Flags: TCloseFlags): TModalResult; override;
function DoOpenEditorFile(AFileName: string; PageIndex: integer;
Flags: TOpenFlags): TModalResult; override;
function DoOpenFileAtCursor(Sender: TObject): TModalResult;
@ -788,9 +788,9 @@ type
// message view
function DoJumpToCompilerMessage(Index:integer;
FocusEditor: boolean): boolean;
procedure DoJumpToNextError(DirectionDown: boolean);
procedure DoShowMessagesView;
FocusEditor: boolean): boolean; override;
procedure DoJumpToNextError(DirectionDown: boolean); override;
procedure DoShowMessagesView; override;
procedure DoArrangeSourceEditorAndMessageView(PutOnTop: boolean);
// methods for debugging, compiling and external tools
@ -8090,295 +8090,14 @@ end;
function TMainIDE.DoConvertDelphiUnit(const DelphiFilename: string
): TModalResult;
var
DFMFilename: String;
LazarusUnitFilename: String;
LRSFilename: String;
ActiveSrcEdit: TSourceEditor;
ActiveUnitInfo: TUnitInfo;
UnitCode, LFMCode: TCodeBuffer;
HasDFMFile: boolean;
LFMFilename: String;
OldOpenEditorsOnCodeToolChange: Boolean;
begin
// check file and directory
DebugLn('TMainIDE.DoConvertDelphiUnit A ',DelphiFilename);
Result:=CheckDelphiFileExt(DelphiFilename);
if Result<>mrOk then exit;
Result:=CheckFileIsWritable(DelphiFilename,[mbAbort]);
if Result<>mrOk then exit;
Result:=CheckFilenameForLCLPaths(DelphiFilename);
if Result<>mrOk then exit;
// close Delphi files in editor
DebugLn('TMainIDE.DoConvertDelphiUnit Close files in editor .pas/.dfm');
Result:=DoCloseEditorFile(DelphiFilename,[cfSaveFirst]);
if Result<>mrOk then exit;
DFMFilename:=FindDFMFileForDelphiUnit(DelphiFilename);
DebugLn('TMainIDE.DoConvertDelphiUnit DFM file="',DFMFilename,'"');
HasDFMFile:=DFMFilename<>'';
if HasDFMFile then begin
Result:=DoCloseEditorFile(DFMFilename,[cfSaveFirst]);
if Result<>mrOk then exit;
end;
// rename files (.pas,.dfm) lowercase
// TODO: rename files in project
DebugLn('TMainIDE.DoConvertDelphiUnit Rename files');
LazarusUnitFilename:='';
LFMFilename:='';
Result:=RenameDelphiUnitToLazarusUnit(DelphiFilename,true,
LazarusUnitFilename,LFMFilename);
if Result<>mrOk then exit;
if LFMFilename='' then LFMFilename:=ChangeFIleExt(LazarusUnitFilename,'.lfm');
HasDFMFile:=FileExists(LFMFilename);
// convert .dfm file to .lfm file
if HasDFMFile then begin
DebugLn('TMainIDE.DoConvertDelphiUnit Convert dfm format to lfm "',LFMFilename,'"');
Result:=ConvertDFMFileToLFMFile(LFMFilename);
if Result<>mrOk then exit;
end;
// create empty .lrs file
DebugLn('TMainIDE.DoConvertDelphiUnit Create empty lrs');
if HasDFMFile then begin
LRSFilename:=ChangeFileExt(LazarusUnitFilename,'.lrs');
DebugLn('TMainIDE.DoConvertDelphiUnit Create ',LRSFilename);
Result:=CreateEmptyFile(LRSFilename,[mbAbort,mbRetry]);
if Result<>mrOk then exit;
end else
LRSFilename:='';
DebugLn('TMainIDE.DoConvertDelphiUnit Convert delphi source');
OldOpenEditorsOnCodeToolChange:=FOpenEditorsOnCodeToolChange;
FOpenEditorsOnCodeToolChange:=true;
try
if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,[]) then begin
Result:=mrCancel;
exit;
end;
// add {$mode delphi} directive
// remove windows unit and add LResources, LCLIntf
// remove {$R *.dfm} or {$R *.xfm} directive
// add initialization
// add {$i unit.lrs} directive
// TODO: fix delphi ambiguousities like incomplete proc implementation headers
Result:=ConvertDelphiSourceToLazarusSource(LazarusUnitFilename,
LRSFilename<>'');
if Result<>mrOk then begin
DoJumpToCodeToolBossError;
exit;
end;
// comment missing units
DebugLn('TMainIDE.DoConvertDelphiUnit FixMissingUnits');
Result:=FixMissingUnits(LazarusUnitFilename);
if Result<>mrOk then begin
DoJumpToCodeToolBossError;
exit;
end;
// check the LFM file and the pascal unit
DebugLn('TMainIDE.DoConvertDelphiUnit Check new .lfm and .pas file');
Result:=LoadUnitAndLFMFile(LazarusUnitFilename,UnitCode,LFMCode,HasDFMFile);
if Result<>mrOk then exit;
if HasDFMFile and (LFMCode=nil) then
DebugLn('WARNING: TMainIDE.DoConvertDelphiUnit unable to load LFMCode');
if (LFMCode<>nil)
and (CheckLFMBuffer(UnitCode,LFMCode,@MessagesView.AddMsg,true,true)<>mrOk)
then begin
DoJumpToCompilerMessage(-1,true);
exit;
end;
if LFMCode<>nil then begin
// save LFM file
DebugLn('TMainIDE.DoConvertDelphiUnit Save LFM');
Result:=DoSaveCodeBufferToFile(LFMCode,LFMCode.Filename,false);
if Result<>mrOk then exit;
// convert lfm to lrs
DebugLn('TMainIDE.DoConvertDelphiUnit Convert lfm to lrs');
Result:=ConvertLFMtoLRSfile(LFMCode.Filename);
if Result<>mrOk then exit;
end;
finally
FOpenEditorsOnCodeToolChange:=OldOpenEditorsOnCodeToolChange;
end;
Result:=mrOk;
Result:=DelphiProject2Laz.ConvertDelphiToLazarusUnit(DelphiFilename);
end;
function TMainIDE.DoConvertDelphiProject(const DelphiFilename: string
): TModalResult;
var
DPRCode: TCodeBuffer;
ActiveSrcEdit: TSourceEditor;
ActiveUnitInfo: TUnitInfo;
FoundInUnits, MissingInUnits, NormalUnits: TStrings;
NotFoundUnits: String;
LPRCode: TCodeBuffer;
NewProjectDesc: TProjectEmptyProgramDescriptor;
i: Integer;
CurUnitInfo: TUnitInfo;
MainUnitInfo: TUnitInfo;
DOFFilename: String;
CFGFilename: String;
begin
debugln('TMainIDE.DoConvertDelphiProject DelphiFilename="',DelphiFilename,'"');
if MessagesView<>nil then MessagesView.Clear;
// check Delphi project file
Result:=CheckDelphiProjectExt(DelphiFilename);
if Result<>mrOk then exit;
// close Delphi file in editor
debugln('TMainIDE.DoConvertDelphiProject closing in editor dpr ...');
Result:=DoCloseEditorFile(DelphiFilename,[cfSaveFirst]);
if Result<>mrOk then exit;
// commit source editor changes to codetools
if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,[]) then begin
Result:=mrCancel;
exit;
end;
// load Delphi project file .dpr
debugln('TMainIDE.DoConvertDelphiProject loading dpr ...');
Result:=LoadCodeBuffer(DPRCode,DelphiFilename,
[lbfCheckIfText,lbfUpdateFromDisk]);
if Result<>mrOk then exit;
// create .lpr file
debugln('TMainIDE.DoConvertDelphiProject creating lpr ...');
Result:=CreateLPRFileForDPRFile(DelphiFilename,false,LPRCode);
if Result<>mrOk then begin
if CodeToolBoss.ErrorMessage<>'' then DoJumpToCodeToolBossError;
exit;
end;
// close old project
debugln('TMainIDE.DoConvertDelphiProject closing current project ...');
If Project1<>nil then begin
if DoCloseProject=mrAbort then begin
Result:=mrAbort;
exit;
end;
end;
// switch codetools to new project directory
CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'ProjPath']:=
ExpandFilename(ExtractFilePath(LPRCode.Filename));
// create a new project
debugln('TMainIDE.DoConvertDelphiProject creating new project ...');
NewProjectDesc:=TProjectEmptyProgramDescriptor.Create;
Project1:=CreateProjectObject(NewProjectDesc,ProjectDescriptorApplication);
Project1.BeginUpdate(true);
try
if ProjInspector<>nil then ProjInspector.LazProject:=Project1;
MainUnitInfo:=TUnitInfo.Create(LPRCode);
MainUnitInfo.SyntaxHighlighter:=
ExtensionToLazSyntaxHighlighter(ExtractFileExt(LPRCode.Filename));
MainUnitInfo.IsPartOfProject:=true;
Project1.AddFile(MainUnitInfo,false);
Project1.MainFileID:=0;
Project1.ProjectInfoFile:=ChangeFileExt(LPRCode.Filename,'.lpi');
Project1.CompilerOptions.CompilerPath:='$(CompPath)';
UpdateCaption;
IncreaseCompilerParseStamp;
// TODO: get all compiler options from .dpr
Result:=ExtractOptionsFromDPR(LPRCode,Project1);
if Result<>mrOk then exit;
// TODO: read .dof file
DOFFilename:=FindDelphiDOF(DelphiFilename);
if FileExists(DOFFilename) then begin
Result:=ExtractOptionsFromDOF(DOFFilename,Project1);
if Result<>mrOk then exit;
end;
// TODO: read .cfg file
CFGFilename:=FindDelphiCFG(DelphiFilename);
if FileExists(CFGFilename) then begin
Result:=ExtractOptionsFromCFG(CFGFilename,Project1);
if Result<>mrOk then exit;
end;
// TODO: get all needed packages
// add and load default required packages
// TODO: add packages
// WORKAROUND: add LCL
// add lcl pp/pas dirs to source search path
Project1.AddSrcPath('$(LazarusDir)/lcl;'
+'$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)');
Project1.AddPackageDependency('LCL');
Project1.LazCompilerOptions.Win32GraphicApp:=true;
PkgBoss.AddDefaultDependencies(Project1);
finally
Project1.EndUpdate;
NewProjectDesc.Free;
end;
// show program unit
debugln('TMainIDE.DoConvertDelphiProject open lpr in editor ...');
Result:=DoOpenEditorFile(LPRCode.Filename,-1,[ofAddToRecent,ofRegularFile]);
if Result=mrAbort then exit;
// find all project files
FoundInUnits:=nil;
MissingInUnits:=nil;
NormalUnits:=nil;
try
debugln('TMainIDE.DoConvertDelphiProject gathering all project units ...');
if not CodeToolBoss.FindDelphiProjectUnits(LPRCode,FoundInUnits,
MissingInUnits, NormalUnits) then
begin
DoJumpToCodeToolBossError;
exit;
end;
debugln('TMainIDE.DoConvertDelphiProject 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:=MessageDlg('Units not found',
'Some units of the delphi project were not found:'#13
+NotFoundUnits,mtWarning,[mbIgnore,mbAbort],0);
if Result<>mrIgnore then exit;
end;
// add all units to the project
debugln('TMainIDE.DoConvertDelphiProject adding all project units to project ...');
for i:=0 to FoundInUnits.Count-1 do begin
CurUnitInfo:=TUnitInfo.Create(nil);
TUnitInfo(CurUnitInfo).Filename:=FoundInUnits[i];
Project1.AddFile(CurUnitInfo,false);
end;
// set search paths to find all project units
Project1.CompilerOptions.OtherUnitFiles:=
Project1.SourceDirectories.CreateSearchPathFromAllFiles;
DebugLn('TMainIDE.DoConvertDelphiProject UnitPath="',Project1.CompilerOptions.OtherUnitFiles,'"');
// save project
debugln('TMainIDE.DoConvertDelphiProject Saving new project ...');
Result:=DoSaveProject([]);
if Result<>mrOk then exit;
// convert all units
i:=0;
while i<Project1.UnitCount do begin
CurUnitInfo:=Project1.Units[i];
if CurUnitInfo.IsPartOfProject and not (CurUnitInfo.IsMainUnit) then begin
Result:=DoConvertDelphiUnit(CurUnitInfo.Filename);
if Result=mrAbort then exit;
end;
inc(i);
end;
finally
FoundInUnits.Free;
MissingInUnits.Free;
NormalUnits.Free;
end;
debugln('TMainIDE.DoConvertDelphiProject Done');
Result:=mrOk;
Result:=DelphiProject2Laz.ConvertDelphiToLazarusProject(DelphiFilename);
end;
{-------------------------------------------------------------------------------

9
ide/mainintf.pas
View File

@ -102,13 +102,6 @@ type
);
TRevertFlags = set of TRevertFlag;
// close file flags
TCloseFlag = (
cfSaveFirst, // check if modified and save
cfProjectClosing
);
TCloseFlags = set of TCloseFlag;
// codetools flags
TCodeToolsFlag = (
ctfSwitchToFormSource, // bring source notebook to front and show source of
@ -161,6 +154,8 @@ type
function DoShowProjectInspector: TModalResult; virtual; abstract;
function DoImExportCompilerOptions(Sender: TObject): TModalResult; virtual; abstract;
function CreateProjectObject(ProjectDesc,
FallbackProjectDesc: TProjectDescriptor): TProject; virtual; abstract;
function PrepareForCompile: TModalResult; virtual; abstract;
function DoSaveBuildIDEConfigs(Flags: TBuildLazarusFlags): TModalResult; virtual; abstract;
function DoBuildLazarus(Flags: TBuildLazarusFlags): TModalResult; virtual; abstract;

9
ide/msgview.pp
View File

@ -79,7 +79,7 @@ type
{ TMessagesView }
TMessagesView = class(TForm)
TMessagesView = class(TIDEMessagesWindowInterface)
MessageListBox: TListBox;
MainPopupMenu: TPopupMenu;
procedure CopyAllMenuItemClick(Sender: TObject);
@ -126,13 +126,13 @@ type
procedure DeleteLine(Index: integer);
procedure Add(const Msg, CurDir: string;
ProgressLine, VisibleLine: boolean; OriginalIndex: integer);
procedure AddMsg(const Msg, CurDir: string; OriginalIndex: integer);
procedure AddMsg(const Msg, CurDir: string; OriginalIndex: integer); override;
procedure AddProgress(const Msg, CurDir: string; OriginalIndex: integer);
procedure AddSeparator;
procedure CollectLineParts(Sender: TObject; SrcLines: TIDEMessageLineList);
procedure ClearTillLastSeparator;
procedure ShowTopMessage;
procedure Clear;
procedure Clear; override;
procedure GetVisibleMessageAt(Index: integer; var Msg, MsgDirectory: string);
procedure BeginBlock;
procedure EndBlock;
@ -280,6 +280,7 @@ end;
------------------------------------------------------------------------------}
constructor TMessagesView.Create(TheOwner: TComponent);
begin
IDEMessagesWindow:=Self;
inherited Create(TheOwner);
Name := NonModalIDEWindowNames[nmiwMessagesViewName];
FItems := TFPList.Create;
@ -315,6 +316,7 @@ begin
FreeThenNil(FVisibleItems);
FreeThenNil(FQuickFixItems);
inherited Destroy;
IDEMessagesWindow:=nil;
end;
procedure TMessagesView.DeleteLine(Index: integer);
@ -629,6 +631,7 @@ end;
------------------------------------------------------------------------------}
procedure TMessagesView.Clear;
begin
if Self=nil then exit;
if fBlockCount > 0 then
exit;
FLastLineIsProgress := False;

16
ideintf/lazideintf.pas
View File

@ -68,6 +68,14 @@ type
);
TSaveFlags = set of TSaveFlag;
// close file flags
TCloseFlag = (
cfSaveFirst, // check if modified and save
cfProjectClosing
);
TCloseFlags = set of TCloseFlag;
// build project flags
TProjectBuildFlag = (
pbfCleanCompile, // append -B to the compiler options
pbfDoNotCompileDependencies,
@ -116,6 +124,10 @@ type
function DoNewFile(NewFileDescriptor: TProjectFileDescriptor;
var NewFilename: string; const NewSource: string;
NewFlags: TNewFlags; NewOwner: TObject): TModalResult; virtual; abstract;
function DoCloseEditorFile(PageIndex:integer;
Flags: TCloseFlags):TModalResult; virtual; abstract;
function DoCloseEditorFile(const Filename: string;
Flags: TCloseFlags): TModalResult; virtual; abstract;
function DoOpenEditorFile(AFileName:string; PageIndex: integer;
Flags: TOpenFlags): TModalResult; virtual; abstract;
function DoOpenFileAndJumpToIdentifier(const AFilename, AnIdentifier: string;
@ -148,6 +160,10 @@ type
function ShowProgress(const SomeText: string;
Step, MaxStep: integer): boolean; virtual; abstract; // False if canceled by user
function DoJumpToCompilerMessage(Index:integer;
FocusEditor: boolean): boolean; virtual; abstract;
procedure DoJumpToNextError(DirectionDown: boolean); virtual; abstract;
procedure DoShowMessagesView; virtual; abstract;
public
property ActiveProject: TLazProject read GetActiveProject;
end;

9
ideintf/msgintf.pas
View File

@ -22,7 +22,7 @@ unit MsgIntf;
interface
uses
Classes, SysUtils, LCLProc, TextTools, IDECommands;
Classes, SysUtils, Forms, LCLProc, TextTools, IDECommands;
type
@ -172,8 +172,15 @@ type
property Items[Index: integer]: TIDEMsgQuickFixItem read GetItems; default;
end;
TIDEMessagesWindowInterface = class(TForm)
public
procedure Clear; virtual; abstract;
procedure AddMsg(const Msg, CurDir: string; OriginalIndex: integer); virtual; abstract;
end;
var
IDEMsgQuickFixes: TIDEMsgQuickFixItems; // initialized by the IDE
IDEMessagesWindow: TIDEMessagesWindowInterface;// initialized by the IDE
procedure RegisterIDEMsgQuickFix(Item: TIDEMsgQuickFixItem);
function RegisterIDEMsgQuickFix(const Name, Caption, RegExpr: string;

938
images/components_images.lrs
View File

File diff suppressed because it is too large Load Diff