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

Converter: Add project's unit search paths as relative paths.

Browse Source 
git-svn-id: trunk@27544 -
This commit is contained in:
juha 2010-10-02 14:00:39 +00:00
parent 207ed46b7d
commit 21f7b82baf
1 changed files with 21 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
converter/convertdelphi.pas
View File

@ -41,9 +41,8 @@ uses
// IDEIntf // IDEIntf
ComponentReg, IDEMsgIntf, MainIntf, LazIDEIntf, PackageIntf, ProjectIntf, ComponentReg, IDEMsgIntf, MainIntf, LazIDEIntf, PackageIntf, ProjectIntf,
// IDE // IDE
IDEProcs, Project, DialogProcs, IDEProcs, Project, DialogProcs, EditorOptions, CompilerOptions,
EditorOptions, CompilerOptions, PackageDefs, PackageSystem, PackageDefs, PackageSystem, PackageEditor, BasePkgManager, LazarusIDEStrConsts,
PackageEditor, BasePkgManager, LazarusIDEStrConsts,
// Converter // Converter
ConvertSettings, ConvCodeTool, MissingUnits, MissingPropertiesDlg, ReplaceNamesUnit; ConvertSettings, ConvCodeTool, MissingUnits, MissingPropertiesDlg, ReplaceNamesUnit;
@ -127,6 +126,8 @@ type
fLazPSuffix: string; // '.lpi' or '.lpk' fLazPSuffix: string; // '.lpi' or '.lpk'
fDelphiPSuffix: string; // '.dpr' or '.dpk' fDelphiPSuffix: string; // '.dpr' or '.dpk'
fIsConsoleApp: Boolean; fIsConsoleApp: Boolean;
// Unit search path for project settings.
fUnitSearchPaths: TStringList;
// Units found in user defined paths. // Units found in user defined paths.
fCachedUnitNames: TStringToStringTree; fCachedUnitNames: TStringToStringTree;
// Map of case incorrect unit name -> real unit name. // Map of case incorrect unit name -> real unit name.
@ -882,6 +883,9 @@ constructor TConvertDelphiPBase.Create(const AFilename, ADescription: string);
begin begin
fOrigPFilename:=AFilename; fOrigPFilename:=AFilename;
fIsConsoleApp:=False; // Default = GUI app. fIsConsoleApp:=False; // Default = GUI app.
fUnitSearchPaths:=TStringList.Create;
fUnitSearchPaths.Delimiter:=';';
fUnitSearchPaths.StrictDelimiter:=True;
fCachedUnitNames:=TStringToStringTree.Create(false); fCachedUnitNames:=TStringToStringTree.Create(false);
fCachedRealFileNames:=TStringToStringTree.Create(true); fCachedRealFileNames:=TStringToStringTree.Create(true);
fSettings:=TConvertSettings.Create('Convert Delphi '+ADescription); fSettings:=TConvertSettings.Create('Convert Delphi '+ADescription);
@ -896,9 +900,10 @@ destructor TConvertDelphiPBase.Destroy;
begin begin
fUnitsToAddToProject.Free; fUnitsToAddToProject.Free;
fAllMissingUnits.Free; fAllMissingUnits.Free;
fSettings.Free;
fCachedRealFileNames.Free; fCachedRealFileNames.Free;
fCachedUnitNames.Free; fCachedUnitNames.Free;
FreeAndNil(fSettings); fUnitSearchPaths.Free;
inherited Destroy; inherited Destroy;
end; end;
@ -1387,6 +1392,7 @@ function TConvertDelphiProject.AddUnit(AUnitName: string;
// add new unit to project // add new unit to project
var var
CurUnitInfo: TUnitInfo; CurUnitInfo: TUnitInfo;
RP: String;
begin begin
Result:=mrOK; Result:=mrOK;
OutUnitInfo:=nil; OutUnitInfo:=nil;
@ -1395,10 +1401,14 @@ begin
AUnitName:=TrimFilename(AUnitName); AUnitName:=TrimFilename(AUnitName);
if not FileExistsUTF8(AUnitName) then if not FileExistsUTF8(AUnitName) then
exit(mrNo); exit(mrNo);
// Create relative search path for project settings.
RP:=ExtractFilePath(CreateRelativePath(AUnitName, LazProject.ProjectDirectory));
if (RP<>'') and (fUnitSearchPaths.IndexOf(RP)<0) then
fUnitSearchPaths.Add(RP);
// Check unitname and create UnitInfo.
CurUnitInfo:=LazProject.UnitInfoWithFilename(AUnitName); CurUnitInfo:=LazProject.UnitInfoWithFilename(AUnitName);
if CurUnitInfo=nil then begin if CurUnitInfo=nil then begin
if FilenameIsPascalUnit(AUnitName) then begin if FilenameIsPascalUnit(AUnitName) then begin
// check unitname
CurUnitInfo:=LazProject.UnitWithUnitname(ExtractFileNameOnly(AUnitName)); CurUnitInfo:=LazProject.UnitWithUnitname(ExtractFileNameOnly(AUnitName));
if CurUnitInfo<>nil then begin if CurUnitInfo<>nil then begin
Result:=QuestionDlg('Unitname exists twice', Result:=QuestionDlg('Unitname exists twice',
@ -1428,7 +1438,7 @@ var
FoundUnits, MisUnits, NormalUnits: TStrings; FoundUnits, MisUnits, NormalUnits: TStrings;
i: Integer; i: Integer;
CurFilename: string; CurFilename: string;
NewSearchPath, AllPath, UselessPath: string; AllPath: string;
p: LongInt; p: LongInt;
ui: TUnitInfo; ui: TUnitInfo;
begin begin
@ -1459,28 +1469,20 @@ begin
Result:=AddUnit(CurFilename, ui); Result:=AddUnit(CurFilename, ui);
if Result=mrAbort then exit; if Result=mrAbort then exit;
end; end;
finally finally
AllPath:=LazProject.SourceDirectories.CreateSearchPathFromAllFiles; AllPath:=fUnitSearchPaths.DelimitedText;
UselessPath:='.;'+VirtualDirectory+';'+VirtualTempDir+';'+LazProject.ProjectDirectory;
// set unit paths to find all project units // set unit paths to find all project units
NewSearchPath:=MergeSearchPaths(LazProject.CompilerOptions.OtherUnitFiles,AllPath); LazProject.CompilerOptions.OtherUnitFiles:=
NewSearchPath:=RemoveSearchPaths(NewSearchPath,UselessPath); MergeSearchPaths(LazProject.CompilerOptions.OtherUnitFiles,AllPath);
LazProject.CompilerOptions.OtherUnitFiles:=MinimizeSearchPath(
RemoveNonExistingPaths(NewSearchPath,LazProject.ProjectDirectory));
// set include path // set include path
NewSearchPath:=MergeSearchPaths(LazProject.CompilerOptions.IncludePath,AllPath); LazProject.CompilerOptions.IncludePath:=
NewSearchPath:=RemoveSearchPaths(NewSearchPath,UselessPath); MergeSearchPaths(LazProject.CompilerOptions.IncludePath,AllPath);
LazProject.CompilerOptions.IncludePath:=MinimizeSearchPath(
RemoveNonExistingPaths(NewSearchPath,LazProject.ProjectDirectory));
// clear caches // clear caches
LazProject.DefineTemplates.SourceDirectoriesChanged; LazProject.DefineTemplates.SourceDirectoriesChanged;
end; end;
// save project // save project
Result:=LazarusIDE.DoSaveProject([sfQuietUnitCheck]); Result:=LazarusIDE.DoSaveProject([sfQuietUnitCheck]);
if Result<>mrOk then exit; if Result<>mrOk then exit;
finally finally
FoundUnits.Free; FoundUnits.Free;
MisUnits.Free; MisUnits.Free;