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

implemented Delphi package conversion of .cfg and .dof

Browse Source 
git-svn-id: trunk@8974 -
This commit is contained in:
mattias 2006-03-21 17:48:11 +00:00
parent ed108e7e99
commit 93f2393650
8 changed files with 335 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/codetools/finddeclarationtool.pas
View File

@ -262,6 +262,7 @@ type
xtShortInt, // shortint
xtByte, // byte
xtCompilerFunc,// SUCC, PREC, LOW, HIGH, ORD, LENGTH, COPY (1.1)
xtVariant, // variant
xtNil // nil = pointer, class, procedure, method, ...
);
// Do not use this: TExpressionTypeDescs = set of TExpressionTypeDesc;
@ -305,6 +306,7 @@ const
'ShortInt',
'Byte',
'CompilerFunc',
'Variant',
'Nil'
);
@ -892,6 +894,8 @@ begin
Result:=xtConstOrdInteger
else if CompareIdentifiers(Identifier,'ORD')=0 then
Result:=xtConstOrdInteger
else if CompareIdentifiers(Identifier,'VARIANT')=0 then
Result:=xtVariant
else if IsWordBuiltInFunc.DoIt(Identifier) then
Result:=xtCompilerFunc

2
components/codetools/keywordfunclists.pas
View File

@ -1268,13 +1268,13 @@ begin
Add('EXIT' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('BREAK' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('CONTINUE' ,{$ifdef FPC}@{$endif}AllwaysTrue);
// only fpc 1.1
Add('LONGWORD' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('WORD' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('LONGINT' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('SMALLINT' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('SHORTINT' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('BYTE' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('VARIANT' ,{$ifdef FPC}@{$endif}AllwaysTrue);
end;
WordIsPredefinedFPCIdentifier.Add(IsWordBuiltInFunc);

205
converter/delphiproject2laz.pas
View File

@ -44,12 +44,17 @@ unit DelphiProject2Laz;
interface
uses
// LCL+FCL
Classes, SysUtils, LCLProc, Forms, Controls, Dialogs, FileProcs, FileUtil,
// codetools
ExprEval, DefineTemplates, CodeCache, CodeToolManager, CodeToolsStructs,
LinkScanner,
// IDEIntf
SrcEditorIntf, MsgIntf, MainIntf, LazIDEIntf, PackageIntf, ProjectIntf,
// IDE
IDEProcs, DelphiUnit2Laz, Project, DialogProcs, CheckLFMDlg,
EditorOptions, ProjectInspector, CompilerOptions, PackageDefs,
EditorOptions, ProjectInspector, CompilerOptions, PackageDefs, PackageSystem,
PackageEditor,
BasePkgManager, PkgManager;
const
@ -87,13 +92,16 @@ function CreateDelphiToLazarusMainSourceFile(AProject: TProject;
out LPRCode: TCodeBuffer): TModalResult;
function FindDPRFilename(const StartFilename: string): string;
function ReadDelphiProjectConfigFiles(AProject: TProject): TModalResult;
procedure CleanUpProjectSearchPaths(AProject: TProject);
procedure SetCompilerModeForProjectSrcDirs(AProject: TProject);
procedure UnsetCompilerModeForProjectSrcDirs(AProject: TProject);
// 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
@ -142,7 +150,7 @@ begin
// clean up project
AProject.RemoveNonExistingFiles(false);
CleanUpProjectSearchPaths(AProject);
CleanUpCompilerOptionsSearchPaths(AProject.CompilerOptions);
// load required packages
AProject.AddPackageDependency('LCL');// Nearly all Delphi projects require it
@ -152,7 +160,7 @@ begin
// but not enough to parse the units
// set Delphi mode for all project source directories
SetCompilerModeForProjectSrcDirs(AProject);
SetCompilerModeForDefineTempl(AProject.DefineTemplates.CustomDefines);
try
// init codetools
@ -182,7 +190,7 @@ begin
Result:=ConvertAllDelphiProjectUnits(AProject,[cdtlufIsSubProc,cdtlufCheckLFM]);
if Result<>mrOk then exit;
finally
UnsetCompilerModeForProjectSrcDirs(AProject);
UnsetCompilerModeForDefineTempl(AProject.DefineTemplates.CustomDefines);
end;
debugln('ConvertDelphiToLazarusProject Done');
@ -368,11 +376,12 @@ function ConvertDelphiToLazarusPackage(const PackageFilename: string
var
APackage: TLazPackage;
LPKFilename: String;
ConvertUnitFlags: TConvertDelphiToLazarusUnitFlags;
begin
debugln('ConvertDelphiToLazarusPackage PackageFilename="',PackageFilename,'"');
IDEMessagesWindow.Clear;
// create/open lazarus project file
// create/open lazarus package file
LPKFilename:=ChangeFileExt(PackageFilename,'.lpk');
Result:=CreateDelphiToLazarusPackageInstance(LPKFilename,APackage);
if Result<>mrOk then begin
@ -380,6 +389,59 @@ begin
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
SetCompilerModeForDefineTempl(APackage.DefineTemplates.CustomDefines);
try
// init codetools
if not LazarusIDE.BeginCodeTools then begin
DebugLn('ConvertDelphiToLazarusProject failed BeginCodeTools');
Result:=mrCancel;
exit;
end;
// fix .lpr
ConvertUnitFlags:=[cdtlufIsSubProc,cdtlufDoNotSetDelphiMode];
NotImplementedDialog('Converting .dpk and units');
//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 .dpk)
//Result:=ExtractOptionsFromDPK(LPRCode,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(APackage.DefineTemplates.CustomDefines);
end;
debugln('ConvertDelphiToLazarusProject Done');
Result:=mrOk;
end;
@ -593,43 +655,17 @@ begin
end;
end;
procedure CleanUpProjectSearchPaths(AProject: TProject);
function CleanProjectSearchPath(const SearchPath: string): string;
begin
Result:=RemoveNonExistingPaths(SearchPath,Project1.ProjectDirectory);
Result:=MinimizeSearchPath(Result);
end;
procedure SetCompilerModeForDefineTempl(DefTempl: TDefineTemplate);
begin
AProject.CompilerOptions.OtherUnitFiles:=
CleanProjectSearchPath(AProject.CompilerOptions.OtherUnitFiles);
AProject.CompilerOptions.IncludeFiles:=
CleanProjectSearchPath(AProject.CompilerOptions.IncludeFiles);
AProject.CompilerOptions.Libraries:=
CleanProjectSearchPath(AProject.CompilerOptions.Libraries);
AProject.CompilerOptions.ObjectPath:=
CleanProjectSearchPath(AProject.CompilerOptions.ObjectPath);
AProject.CompilerOptions.SrcPath:=
CleanProjectSearchPath(AProject.CompilerOptions.SrcPath);
end;
procedure SetCompilerModeForProjectSrcDirs(AProject: TProject);
begin
if AProject.DefineTemplates.CustomDefines.FindChildByName(
SettingDelphiModeTemplName)<>nil
then exit;
AProject.DefineTemplates.CustomDefines.ReplaceChild(
CreateDefinesForFPCMode(SettingDelphiModeTemplName,cmDELPHI));
if DefTempl.FindChildByName(SettingDelphiModeTemplName)<>nil then exit;
DefTempl.ReplaceChild(CreateDefinesForFPCMode(SettingDelphiModeTemplName,cmDELPHI));
CodeToolBoss.DefineTree.ClearCache;
end;
procedure UnsetCompilerModeForProjectSrcDirs(AProject: TProject);
procedure UnsetCompilerModeForDefineTempl(DefTempl: TDefineTemplate);
begin
if AProject.DefineTemplates.CustomDefines.FindChildByName(
SettingDelphiModeTemplName)=nil
then exit;
AProject.DefineTemplates.CustomDefines.DeleteChild(SettingDelphiModeTemplName);
if DefTempl.FindChildByName(SettingDelphiModeTemplName)=nil then exit;
DefTempl.DeleteChild(SettingDelphiModeTemplName);
CodeToolBoss.DefineTree.ClearCache;
end;
@ -637,25 +673,94 @@ 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 FileExists(LPKFilename) then begin
// there is already a lazarus package file
// open the package editor
DebugLn('CreateDelphiToLazarusPackageInstance OPEN ',LPKFilename);
Result:=PackageEditingInterface.DoOpenPackageFile(LPKFilename,[pofAddToRecent]);
// TODO: get package
Result:=mrAbort;
if Result<>mrOk then exit;
end else begin
// create a new lazarus package
// TODO: get package
Result:=mrAbort;
if Result<>mrOk then exit;
end;
// save to disk (this makes sure, all editor changes are saved too)
DebugLn('CreateDelphiToLazarusProject saving project ...');
Result:=PackageEditingInterface.DoSaveAllPackages([]);
// 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]);
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 FileExists(DOFFilename) then begin
Result:=ExtractOptionsFromDOF(DOFFilename,APackage);
if Result<>mrOk then exit;
end;
// read .cfg file
CFGFilename:=FindDelphiCFG(APackage.Filename);
if FileExists(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.IncludeFiles:=CleanProjectSearchPath(Options.IncludeFiles);
Options.Libraries:=CleanProjectSearchPath(Options.Libraries);
Options.ObjectPath:=CleanProjectSearchPath(Options.ObjectPath);
Options.SrcPath:=CleanProjectSearchPath(Options.SrcPath);
end;
end.

101
converter/delphiunit2laz.pas
View File

@ -46,7 +46,8 @@ uses
// IDEIntf
LazIDEIntf, MsgIntf,
// IDE
Project, DialogProcs, IDEProcs, LazarusIDEStrConsts;
CompilerOptions,
PackageDefs, Project, DialogProcs, IDEProcs, LazarusIDEStrConsts;
type
TDelphi2LazarusDialog = class(TForm)
@ -84,10 +85,10 @@ function ExtractOptionsFromDPR(DPRCode: TCodeBuffer;
function FindDelphiDOF(const DelphiFilename: string): string;
function ExtractOptionsFromDOF(const DOFFilename: string;
AProject: TProject): TModalResult;
AProjPkg: TObject): TModalResult;
function FindDelphiCFG(const DelphiFilename: string): string;
function ExtractOptionsFromCFG(const CFGFilename: string;
AProject: TProject): TModalResult;
AProjPkg: TObject): TModalResult;
function ConvertDelphiAbsoluteToRelativeFile(const Filename: string;
AProject: TProject): string;
@ -482,12 +483,15 @@ begin
Result:=Filename;
end;
function ExtractOptionsFromDOF(const DOFFilename: string; AProject: TProject
function ExtractOptionsFromDOF(const DOFFilename: string; AProjPkg: TObject
): TModalResult;
// parse .dof file and put options into AProject
var
IniFile: TIniFile;
AProject: TProject;
APackage: TLazPackage;
CompOpts: TBaseCompilerOptions;
function ReadDirectory(const Section, Ident: string): string;
begin
Result:=IniFile.ReadString(Section,Ident,'');
@ -504,6 +508,14 @@ var
Result:=ExpandDelphiSearchPath(SearchPath,AProject);
end;
procedure AddPackageDependency(const LazarusPkgName: string);
begin
if AProject<>nil then
AProject.AddPackageDependency(LazarusPkgName)
else if APackage<>nil then
APackage.AddPackageDependency(LazarusPkgName);
end;
procedure AddPackageDependency(const DelphiPkgName, DelphiPkgNames,
LazarusPkgName: string);
begin
@ -511,7 +523,7 @@ var
if System.Pos(';'+lowercase(DelphiPkgName)+';',
';'+lowercase(DelphiPkgNames)+';')>0 then begin
DebugLn('AddPackageDependency adding package dependency ',LazarusPkgName);
AProject.AddPackageDependency(LazarusPkgName);
AddPackageDependency(LazarusPkgName);
end;
end;
@ -530,9 +542,18 @@ var
Pkg:=Pkgs[i];
DebugLn('ReadDelphiPackages Pkg=',Pkg);
AddPackageDependency(Pkg,'rtl,dbrtl','FCL');
AProject.AddPackageDependency('LCL');
AddPackageDependency('LCL');
end;
end;
procedure AddSearchPath(const SearchPath: string);
begin
CompOpts.IncludeFiles:=MergeSearchPaths(CompOpts.IncludeFiles,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;
@ -540,47 +561,50 @@ var
DebugSourceDirs: String;
begin
if not FileExists(DOFFilename) then exit(mrOk);
if AProjPkg is TProject then begin
AProject:=TProject(AProjPkg);
CompOpts:=AProject.CompilerOptions;
end else if AProjPkg is TLazPackage then begin
APackage:=TLazPackage(AProjPkg);
CompOpts:=APackage.CompilerOptions;
end else
RaiseGDBException('invalid AProjPkg');
try
IniFile:=TIniFile.Create(DOFFilename);
try
// output directory
OutputDir:=ReadDirectory('Directories','OutputDir');
if (OutputDir<>'') then begin
DebugLn('ExtractOptionsFromDOF setting unit output directory to "',OutputDir,'"');
AProject.CompilerOptions.UnitOutputDirectory:=OutputDir;
if AProject<>nil then begin
OutputDir:=ReadDirectory('Directories','OutputDir');
if (OutputDir<>'') then begin
DebugLn('ExtractOptionsFromDOF setting unit output directory to "',OutputDir,'"');
AProject.CompilerOptions.UnitOutputDirectory:=OutputDir;
end;
end;
// search path
SearchPath:=ReadSearchPath('Directories','SearchPath');
if (SearchPath<>'') then begin
DebugLn('ExtractOptionsFromDOF Adding to search paths: "',SearchPath,'"');
AProject.CompilerOptions.IncludeFiles:=
MergeSearchPaths(AProject.CompilerOptions.IncludeFiles,SearchPath);
AProject.CompilerOptions.Libraries:=
MergeSearchPaths(AProject.CompilerOptions.Libraries,SearchPath);
AProject.CompilerOptions.OtherUnitFiles:=
MergeSearchPaths(AProject.CompilerOptions.OtherUnitFiles,SearchPath);
AProject.CompilerOptions.ObjectPath:=
MergeSearchPaths(AProject.CompilerOptions.ObjectPath,SearchPath);
AProject.CompilerOptions.DebugPath:=
MergeSearchPaths(AProject.CompilerOptions.DebugPath,SearchPath);
AddSearchPath(SearchPath);
end;
// debug source dirs
DebugSourceDirs:=ReadSearchPath('Directories','DebugSourceDirs');
if DebugSourceDirs<>'' then begin
DebugLn('ExtractOptionsFromDOF Adding to debug paths: "',DebugSourceDirs,'"');
AProject.CompilerOptions.DebugPath:=
MergeSearchPaths(AProject.CompilerOptions.DebugPath,DebugSourceDirs);
CompOpts.DebugPath:=MergeSearchPaths(CompOpts.DebugPath,DebugSourceDirs);
end;
// packages
ReadDelphiPackages;
if IniFile.ReadString('Linker','ConsoleApp','')='0' then begin
// does not need a windows console
DebugLn('ExtractOptionsFromDOF ConsoleApp=0');
AProject.LazCompilerOptions.Win32GraphicApp:=true;
if AProject<>nil then begin
if IniFile.ReadString('Linker','ConsoleApp','')='0' then begin
// does not need a windows console
DebugLn('ExtractOptionsFromDOF ConsoleApp=0');
AProject.LazCompilerOptions.Win32GraphicApp:=true;
end;
end;
finally
IniFile.Free;
@ -603,7 +627,7 @@ begin
Result:=Filename;
end;
function ExtractOptionsFromCFG(const CFGFilename: string; AProject: TProject
function ExtractOptionsFromCFG(const CFGFilename: string; AProjPkg: TObject
): TModalResult;
var
sl: TStringList;
@ -611,8 +635,19 @@ var
Line: string;
UnitPath: String;
IncludePath: String;
AProject: TProject;
CompOpts: TBaseCompilerOptions;
APackage: TLazPackage;
begin
if not FileExists(CFGFilename) then exit(mrOk);
if AProjPkg is TProject then begin
AProject:=TProject(AProjPkg);
CompOpts:=AProject.CompilerOptions;
end else if AProjPkg is TLazPackage then begin
APackage:=TLazPackage(AProjPkg);
CompOpts:=APackage.CompilerOptions;
end else
RaiseGDBException('invalid AProjPkg');
try
sl:=TStringList.Create;
try
@ -625,15 +660,15 @@ begin
UnitPath:=ExpandDelphiSearchPath(copy(Line,4,length(Line)-4),AProject);
if UnitPath<>'' then begin
DebugLn('ExtractOptionsFromCFG adding unitpath "',UnitPath,'"');
AProject.CompilerOptions.OtherUnitFiles:=
MergeSearchPaths(AProject.CompilerOptions.OtherUnitFiles,UnitPath);
CompOpts.OtherUnitFiles:=
MergeSearchPaths(CompOpts.OtherUnitFiles,UnitPath);
end;
end else if Line[2]='I' then begin
IncludePath:=ExpandDelphiSearchPath(copy(Line,4,length(Line)-4),AProject);
if IncludePath<>'' then begin
DebugLn('ExtractOptionsFromCFG adding IncludePath "',IncludePath,'"');
AProject.CompilerOptions.IncludeFiles:=
MergeSearchPaths(AProject.CompilerOptions.IncludeFiles,IncludePath);
CompOpts.IncludeFiles:=
MergeSearchPaths(CompOpts.IncludeFiles,IncludePath);
end;
end;
end;

27
ide/dialogprocs.pas
View File

@ -53,27 +53,28 @@ type
TLoadBufferFlags = set of TLoadBufferFlag;
function RenameFileWithErrorDialogs(const SrcFilename, DestFilename: string;
ExtraButtons: TMsgDlgButtons): TModalResult;
ExtraButtons: TMsgDlgButtons): TModalResult;
function CopyFileWithErrorDialogs(const SrcFilename, DestFilename: string;
ExtraButtons: TMsgDlgButtons): TModalResult;
ExtraButtons: TMsgDlgButtons): TModalResult;
function LoadCodeBuffer(var ACodeBuffer: TCodeBuffer; const AFilename: string;
Flags: TLoadBufferFlags): TModalResult;
Flags: TLoadBufferFlags): TModalResult;
function SaveCodeBuffer(var ACodeBuffer: TCodeBuffer): TModalResult;
function CreateEmptyFile(const Filename: string;
ErrorButtons: TMsgDlgButtons): TModalResult;
ErrorButtons: TMsgDlgButtons): TModalResult;
function CheckFileIsWritable(const Filename: string;
ErrorButtons: TMsgDlgButtons): TModalResult;
ErrorButtons: TMsgDlgButtons): TModalResult;
function ForceDirectoryInteractive(Directory: string;
ErrorButtons: TMsgDlgButtons): TModalResult;
ErrorButtons: TMsgDlgButtons): TModalResult;
function DeleteFileInteractive(const Filename: string;
ErrorButtons: TMsgDlgButtons): TModalResult;
ErrorButtons: TMsgDlgButtons): TModalResult;
function SaveStringToFile(const Filename, Content: string;
ErrorButtons: TMsgDlgButtons): TModalResult;
ErrorButtons: TMsgDlgButtons): TModalResult;
function ConvertLFMToLRSFileInteractive(const LFMFilename,
LRSFilename: string): TModalResult;
LRSFilename: string): TModalResult;
function IfNotOkJumpToCodetoolErrorAndAskToAbort(Ok: boolean;
Ask: boolean; out NewResult: TModalResult): boolean;
Ask: boolean; out NewResult: TModalResult): boolean;
function JumpToCodetoolErrorAndAskToAbort(Ask: boolean): TModalResult;
procedure NotImplementedDialog(const Feature: string);
implementation
@ -381,5 +382,11 @@ begin
end;
end;
procedure NotImplementedDialog(const Feature: string);
begin
MessageDlg('Not implemented','Not implemented yet:'#13
+Feature,mtError,[mbCancel],0);
end;
end.

2
ide/project.pp
View File

@ -3800,8 +3800,6 @@ begin
end else
FMain.Name:=Project.IDAsWord;
// ClearCache is here unnessary, because it is only a block
end;
procedure TProjectDefineTemplates.UpdateSrcDirIfDef;

125
packager/packagedefs.pas
View File

@ -464,11 +464,13 @@ type
FMain: TDefineTemplate;
FOutputDir: TDefineTemplate;
FOutPutSrcPath: TDefineTemplate;
FSrcDirectories: TDefineTemplate;
FUpdateLock: integer;
procedure SetActive(const AValue: boolean);
procedure UpdateMain;
procedure UpdateDefinesForOutputDirectory;
procedure UpdateDefinesForSourceDirectories;
procedure UpdateSrcDirIfDef;
procedure UpdateOutputDirectory;
procedure UpdateSourceDirectories;
procedure UpdateDefinesForCustomDefines;
public
constructor Create(OwnerPackage: TLazPackage);
@ -484,6 +486,7 @@ type
public
property LazPackage: TLazPackage read FLazPackage;
property Main: TDefineTemplate read FMain;
property SrcDirectories: TDefineTemplate read FSrcDirectories;
property OutputDir: TDefineTemplate read FOutputDir;
property OutPutSrcPath: TDefineTemplate read FOutPutSrcPath;
property CustomDefines: TDefineTemplate read FCustomDefines;
@ -672,6 +675,7 @@ type
CompPriorityCat: TComponentPriorityCategory): TPkgFile;
procedure RemoveFile(PkgFile: TPkgFile);
procedure UnremovePkgFile(PkgFile: TPkgFile);
procedure RemoveNonExistingFiles;
function GetFileDialogInitialDir(const DefaultDirectory: string): string;
procedure MoveFile(CurIndex, NewIndex: integer);
procedure SortFiles;
@ -681,6 +685,7 @@ type
function RequiredDepByIndex(Index: integer): TPkgDependency;
function RemovedDepByIndex(Index: integer): TPkgDependency;
procedure AddRequiredDependency(Dependency: TPkgDependency);
procedure AddPackageDependency(const PkgName: string);
procedure RemoveRequiredDependency(Dependency: TPkgDependency);
procedure DeleteRequiredDependency(Dependency: TPkgDependency);
procedure DeleteRemovedDependency(Dependency: TPkgDependency);
@ -2739,6 +2744,18 @@ begin
PkgFile.Removed:=false;
end;
procedure TLazPackage.RemoveNonExistingFiles;
var
i: Integer;
begin
i:=FileCount-1;
while i>=0 do begin
if i>=FileCount then continue;
if not FileExistsCached(Files[i].Filename) then
RemoveFile(Files[i]);
end;
end;
function TLazPackage.GetFileDialogInitialDir(const DefaultDirectory: string
): string;
begin
@ -2885,6 +2902,16 @@ begin
Modified:=true;
end;
procedure TLazPackage.AddPackageDependency(const PkgName: string);
var
Dependency: TPkgDependency;
begin
if FindDependencyByName(PkgName)<>nil then exit;
Dependency:=TPkgDependency.Create;
Dependency.PackageName:=PkgName;
AddRequiredDependency(Dependency);
end;
procedure TLazPackage.RemoveRequiredDependency(Dependency: TPkgDependency);
begin
Dependency.RemoveFromList(FFirstRequiredDependency,pdlRequires);
@ -3485,6 +3512,7 @@ begin
FMain:=nil;
FOutputDir:=nil;
FOutPutSrcPath:=nil;
FSrcDirectories:=nil;
fLastOutputDirSrcPathIDAsString:='';
FLastCustomOptions:='';
FFlags:=FFlags+[pdtIDChanged,pdtOutputDirChanged,pdtSourceDirsChanged,
@ -3517,8 +3545,8 @@ begin
end;
Exclude(FFlags,pdtIDChanged);
UpdateMain;
UpdateDefinesForOutputDirectory;
UpdateDefinesForSourceDirectories;
UpdateOutputDirectory;
UpdateSourceDirectories;
UpdateDefinesForCustomDefines;
end;
@ -3529,7 +3557,7 @@ begin
exit;
end;
Exclude(FFlags,pdtSourceDirsChanged);
UpdateDefinesForSourceDirectories;
UpdateSourceDirectories;
CodeToolBoss.DefineTree.ClearCache;
end;
@ -3540,7 +3568,7 @@ begin
exit;
end;
Exclude(FFlags,pdtOutputDirChanged);
UpdateDefinesForOutputDirectory;
UpdateOutputDirectory;
CodeToolBoss.DefineTree.ClearCache;
end;
@ -3577,6 +3605,54 @@ begin
// ClearCache is here unnessary, because it is only a block
end;
procedure TLazPackageDefineTemplates.UpdateSrcDirIfDef;
var
NewValue: String;
Changed: Boolean;
UnitPathDefTempl: TDefineTemplate;
IncPathDefTempl: TDefineTemplate;
begin
// create custom options
// The custom options are enclosed by an IFDEF #PkgSrcMark<PckId> template.
// Each source directory defines this variable, so that the settings can be
// activated for each source directory by a simple DEFINE.
if (FMain=nil) then UpdateMain;
if FSrcDirectories=nil then begin
FSrcDirectories:=TDefineTemplate.Create('Source Directories',
'Source Directories','','',
da_Block);
FMain.AddChild(FSrcDirectories);
end;
if FCustomDefines=nil then begin
FCustomDefines:=TDefineTemplate.Create('Source Directory Additions',
'Additional defines for package source directories',
'#PkgSrcMark'+LazPackage.IDAsWord,'',
da_IfDef);
FMain.AddChild(FCustomDefines);
// create unit path template for this directory
UnitPathDefTempl:=TDefineTemplate.Create('UnitPath', lisPkgDefsUnitPath,
'#UnitPath','$(#UnitPath);$PkgUnitPath('+LazPackage.IDAsString+')',
da_Define);
FCustomDefines.AddChild(UnitPathDefTempl);
// create include path template for this directory
IncPathDefTempl:=TDefineTemplate.Create('IncPath','Include Path',
'#IncPath','$(#IncPath);$PkgIncPath('+LazPackage.IDAsString+')',
da_Define);
FCustomDefines.AddChild(IncPathDefTempl);
Changed:=true;
end else begin
NewValue:='#PkgSrcMark'+LazPackage.IDAsWord;
if NewValue<>FCustomDefines.Value then begin
FCustomDefines.Value:=NewValue;
Changed:=true;
end;
end;
if Changed then
CodeToolBoss.DefineTree.ClearCache;
end;
procedure TLazPackageDefineTemplates.SetActive(const AValue: boolean);
begin
if FActive=AValue then exit;
@ -3584,7 +3660,7 @@ begin
if not FActive then Clear else AllChanged;
end;
procedure TLazPackageDefineTemplates.UpdateDefinesForOutputDirectory;
procedure TLazPackageDefineTemplates.UpdateOutputDirectory;
begin
if (not LazPackage.NeedsDefineTemplates) or (not Active) then exit;
if FMain=nil then UpdateMain;
@ -3615,13 +3691,11 @@ begin
end;
end;
procedure TLazPackageDefineTemplates.UpdateDefinesForSourceDirectories;
procedure TLazPackageDefineTemplates.UpdateSourceDirectories;
var
NewSourceDirs: TStringList;
i: Integer;
SrcDirDefTempl: TDefineTemplate;
UnitPathDefTempl: TDefineTemplate;
IncPathDefTempl: TDefineTemplate;
IDHasChanged: Boolean;
SrcDirMarkDefTempl: TDefineTemplate;
begin
@ -3662,7 +3736,8 @@ begin
// build source directory define templates
fLastSourceDirectories.Assign(NewSourceDirs);
if (FMain=nil) and (fLastSourceDirectories.Count>0) then UpdateMain;
if (FCustomDefines=nil) and (fLastSourceDirectories.Count>0) then
UpdateSrcDirIfDef;
for i:=0 to fLastSourceDirectories.Count-1 do begin
// create directory template
SrcDirDefTempl:=TDefineTemplate.Create('Source Directory '+IntToStr(i+1),
@ -3672,20 +3747,11 @@ begin
SrcDirMarkDefTempl:=TDefineTemplate.Create('PkgSrcDirMark',
lisPkgDefsSrcDirMark,'#PkgSrcMark'+LazPackage.IDAsWord,'',da_Define);
SrcDirDefTempl.AddChild(SrcDirMarkDefTempl);
// create unit path template for this directory
UnitPathDefTempl:=TDefineTemplate.Create('UnitPath', lisPkgDefsUnitPath,
'#UnitPath','$(#UnitPath);$PkgUnitPath('+LazPackage.IDAsString+')',
da_Define);
SrcDirDefTempl.AddChild(UnitPathDefTempl);
// create include path template for this directory
IncPathDefTempl:=TDefineTemplate.Create('IncPath','Include Path',
'#IncPath','$(#IncPath);$PkgIncPath('+LazPackage.IDAsString+')',
da_Define);
SrcDirDefTempl.AddChild(IncPathDefTempl);
SrcDirDefTempl.SetDefineOwner(LazPackage,false);
SrcDirDefTempl.SetFlags([dtfAutoGenerated],[],false);
// add directory
FMain.AddChild(SrcDirDefTempl);
FSrcDirectories.AddChild(SrcDirDefTempl);
end;
CodeToolBoss.DefineTree.ClearCache;
@ -3718,20 +3784,7 @@ begin
exit;
end;
// create custom options
// The custom options are enclosed by an IFDEF #PkgSrcMark<PckId> template.
// Each source directory defines this variable, so that the settings can be
// activated for each source directory by a simple DEFINE.
if (FMain=nil) then UpdateMain;
if FCustomDefines=nil then begin
FCustomDefines:=TDefineTemplate.Create('Source Directory Additions',
'Additional defines for package source directories',
'#PkgSrcMark'+LazPackage.IDAsWord,'',
da_IfDef);
FMain.AddChild(FCustomDefines);
end else begin
FCustomDefines.Value:='#PkgSrcMark'+LazPackage.IDAsWord;
end;
UpdateSrcDirIfDef;
FCustomDefines.ReplaceChild(OptionsDefTempl);
CodeToolBoss.DefineTree.ClearCache;

2
packager/packagesystem.pas
View File

@ -716,7 +716,7 @@ function TLazPackageGraph.CreateNewPackage(const Prefix: string): TLazPackage;
begin
BeginUpdate(true);
Result:=TLazPackage.Create;
Result.Name:=CreateUniquePkgName(lisPkgMangNewPackage, nil);
Result.Name:=CreateUniquePkgName(Prefix,nil);
AddPackage(Result);
EndUpdate;
end;