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

fixed commenting multiple units, implemented Delphi project conversion: cleaning up units and non existing search paths

Browse Source 
git-svn-id: trunk@8901 -
This commit is contained in:
mattias 2006-03-09 23:29:20 +00:00
parent 1f6f6b3a7e
commit 4cc456c4b3
5 changed files with 88 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/codetools/examples/scanexamples/brokenfilenames.pas
View File

@ -10,7 +10,7 @@ uses
biglettersunit, // must be fixed to BigLettersUnit
biglettersunit in 'biglettersunit.pas',// -> BigLettersUnit.pas
biglettersunit in '..\ScanExamples\biglettersunit.pas',// -> ../scanexamples/BigLettersUnit
NonExistingUnit1, SysUtils, NonExistingUnit2;
NonExistingUnit1, NonExistingUnit2, SysUtils, NonExistingUnit3;
{$I BROKENincfiles.inc}// must be fixed to brokenincfiles.inc
{$I ../ScanExamples/BROKENincfiles.inc}// must be fixed to ../scanexamples/brokenincfiles.inc

25
components/codetools/stdcodetools.pas
View File

@ -99,9 +99,8 @@ type
SourceChangeCache: TSourceChangeCache): boolean;
function RemoveUnitFromAllUsesSections(const UpperUnitName: string;
SourceChangeCache: TSourceChangeCache): boolean;
function FixUnitInFilenameCase(
SourceChangeCache: TSourceChangeCache): boolean;
function FixUnitInFilenameCaseInUsesSection(UsesNode: TCodeTreeNode;
function FixUsedUnitCase(SourceChangeCache: TSourceChangeCache): boolean;
function FixUsedUnitCaseInUsesSection(UsesNode: TCodeTreeNode;
SourceChangeCache: TSourceChangeCache): boolean;
function FindUsedUnitNames(var MainUsesSection,
ImplementationUsesSection: TStrings): boolean;
@ -634,19 +633,19 @@ begin
Result:=true;
end;
function TStandardCodeTool.FixUnitInFilenameCase(
function TStandardCodeTool.FixUsedUnitCase(
SourceChangeCache: TSourceChangeCache): boolean;
var
SectionNode: TCodeTreeNode;
begin
debugln('TStandardCodeTool.FixUnitInFilenameCase ',MainFilename);
debugln('TStandardCodeTool.FixUsedUnitCase ',MainFilename);
Result:=false;
BuildTree(false);
SectionNode:=Tree.Root;
while (SectionNode<>nil) do begin
if (SectionNode.FirstChild<>nil)
and (SectionNode.FirstChild.Desc=ctnUsesSection) then begin
if not FixUnitInFilenameCaseInUsesSection(
if not FixUsedUnitCaseInUsesSection(
SectionNode.FirstChild,SourceChangeCache)
then begin
exit;
@ -657,7 +656,7 @@ begin
Result:=true;
end;
function TStandardCodeTool.FixUnitInFilenameCaseInUsesSection(
function TStandardCodeTool.FixUsedUnitCaseInUsesSection(
UsesNode: TCodeTreeNode; SourceChangeCache: TSourceChangeCache): boolean;
function FindUnit(const AFilename: string): string;
@ -714,18 +713,18 @@ begin
if UpAtomIs('IN') then begin
ReadNextAtom;
UnitInFilename:=GetAtom;
debugln('TStandardCodeTool.FixUnitInFilenameCaseInUsesSection A UnitInFilename="',UnitInFilename,'"');
//debugln('TStandardCodeTool.FixUsedUnitCaseInUsesSection A UnitInFilename="',UnitInFilename,'"');
if (UnitInFilename<>'') and (UnitInFilename[1]='''') then begin
UnitInFilename:=copy(UnitInFilename,2,length(UnitInFilename)-2);
RealUnitInFilename:=FindUnit(UnitInFilename);
debugln('TStandardCodeTool.FixUnitInFilenameCaseInUsesSection B RealUnitInFilename="',RealUnitInFilename,'"');
//debugln('TStandardCodeTool.FixUsedUnitCaseInUsesSection B RealUnitInFilename="',RealUnitInFilename,'"');
if (RealUnitInFilename<>'')
and (RealUnitInFilename<>UnitInFilename) then begin
if not Changed then begin
SourceChangeCache.MainScanner:=Scanner;
Changed:=true;
end;
debugln('TStandardCodeTool.FixUnitInFilenameCaseInUsesSection C Replacing ...');
debugln('TStandardCodeTool.FixUsedUnitCaseInUsesSection Replacing UnitInFilename="',UnitInFilename,'" with "',RealUnitInFilename,'"');
if not SourceChangeCache.Replace(gtNone,gtNone,
CurPos.StartPos,CurPos.EndPos,''''+RealUnitInFilename+'''') then exit;
end;
@ -1108,14 +1107,14 @@ function TStandardCodeTool.CommentUnitsInUsesSections(MissingUnits: TStrings;
ReadNextAtom; // read comma or semicolon
end;
if CommentCurUnit and (LastCommaAfterCommentUnitsStart<1) then
if CommentCurUnit then
LastCommaAfterCommentUnitsStart:=CurPos.EndPos;
if CurPos.Flag<>cafComma then begin
if CommentCurUnit then begin
// last unit must be commented
if LastNormalUnitEnd>=1 then begin
// there are some units to be kept
// comment last unit and keep some units in front
// See example: 4.
Comment(LastNormalUnitEnd,LastCommentUnitEnd);
end else begin
@ -3039,7 +3038,7 @@ function TStandardCodeTool.ConvertDelphiToLazarusSource(AddLRSCode: boolean;
debugln('ConvertUsedUnits Unable to remove Variants from all uses sections');
exit;
end;
if not FixUnitInFilenameCase(SourceChangeCache) then
if not FixUsedUnitCase(SourceChangeCache) then
begin
debugln('ConvertUsedUnits Unable to fix unit filename case sensitivity in all uses sections');
exit;

36
converter/delphiproject2laz.pas
View File

@ -114,6 +114,24 @@ begin
exit;
end;
// clean up project
Project1.RemoveNonExistingFiles(false);
Project1.CompilerOptions.OtherUnitFiles:=
RemoveNonExistingPaths(Project1.CompilerOptions.OtherUnitFiles,
Project1.ProjectDirectory);
Project1.CompilerOptions.IncludeFiles:=
RemoveNonExistingPaths(Project1.CompilerOptions.IncludeFiles,
Project1.ProjectDirectory);
Project1.CompilerOptions.Libraries:=
RemoveNonExistingPaths(Project1.CompilerOptions.Libraries,
Project1.ProjectDirectory);
Project1.CompilerOptions.ObjectPath:=
RemoveNonExistingPaths(Project1.CompilerOptions.ObjectPath,
Project1.ProjectDirectory);
Project1.CompilerOptions.SrcPath:=
RemoveNonExistingPaths(Project1.CompilerOptions.SrcPath,
Project1.ProjectDirectory);
// load required packages
Project1.AddPackageDependency('LCL');// Nearly all Delphi projects require it
PkgBoss.AddDefaultDependencies(Project1);
@ -165,13 +183,9 @@ begin
if Result<>mrIgnore then exit;
end;
// clean up project
Project1.RemoveNonExistingFiles(false);
// 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);
CurFilename:=FoundInUnits[i];
p:=System.Pos(' in ',CurFilename);
if p>0 then
@ -183,9 +197,15 @@ begin
DebugLn('ConvertDelphiToLazarusProject file not found: "',CurFilename,'"');
continue;
end;
TUnitInfo(CurUnitInfo).Filename:=CurFilename;
CurUnitInfo.IsPartOfProject:=true;
Project1.AddFile(CurUnitInfo,false);
CurUnitInfo:=Project1.UnitInfoWithFilename(CurFilename);
if CurUnitInfo<>nil then begin
CurUnitInfo.IsPartOfProject:=true;
end else begin
CurUnitInfo:=TUnitInfo.Create(nil);
CurUnitInfo.Filename:=CurFilename;
CurUnitInfo.IsPartOfProject:=true;
Project1.AddFile(CurUnitInfo,false);
end;
end;
// set search paths to find all project units
NewUnitPath:=MergeSearchPaths(Project1.CompilerOptions.OtherUnitFiles,
@ -318,7 +338,7 @@ begin
// TODO: fix delphi ambiguousities like incomplete proc implementation headers
Result:=ConvertDelphiSourceToLazarusSource(LazarusUnitFilename,
LRSFilename<>'');
if not IfNotOkJumpToCodetoolErrorAndAskToAbort(Result<>mrOk,IsSubProc,Result)
if not IfNotOkJumpToCodetoolErrorAndAskToAbort(Result=mrOk,IsSubProc,Result)
then exit;
// check the LFM file and the pascal unit

1
converter/delphiunit2laz.pas
View File

@ -273,6 +273,7 @@ begin
if Result<>mrOk then exit;
CTResult:=CodeToolBoss.ConvertDelphiToLazarusSource(LazUnitCode,AddLRSCode);
if not CTResult then begin
DebugLn('ConvertDelphiSourceToLazarusSource Failed');
Result:=mrCancel;
exit;
end;

46
ide/ideprocs.pp
View File

@ -119,6 +119,7 @@ function FindFPCTool(const Executable, CompilerFilename: string): string;
function TrimSearchPath(const SearchPath, BaseDirectory: string): string;
function MergeSearchPaths(const OldSearchPath, AddSearchPath: string): string;
function RemoveSearchPaths(const SearchPath, RemoveSearchPath: string): string;
function RemoveNonExistingPaths(const SearchPath, BaseDirectory: string): string;
function CreateAbsoluteSearchPath(const SearchPath, BaseDirectory: string): string;
function CreateRelativeSearchPath(const SearchPath, BaseDirectory: string): string;
function RebaseSearchPath(const SearchPath,
@ -640,6 +641,51 @@ begin
Result:=FileProcs.CreateRelativeSearchPath(SearchPath,BaseDirectory);
end;
function RemoveNonExistingPaths(const SearchPath, BaseDirectory: string
): string;
var
StartPos: Integer;
EndPos: LongInt;
CurPath: String;
MacroStartPos: LongInt;
begin
Result:=SearchPath;
StartPos:=1;
while StartPos<=length(Result) do begin
EndPos:=StartPos;
while (EndPos<=length(Result)) and (Result[EndPos]=';') do inc(EndPos);
if EndPos>StartPos then begin
// empty paths, e.g. ;;;;
// remove
Result:=copy(Result,1,StartPos-1)+copy(Result,EndPos,length(Result));
EndPos:=StartPos;
end;
while (EndPos<=length(Result)) and (Result[EndPos]<>';') do inc(EndPos);
CurPath:=copy(Result,StartPos,EndPos-StartPos);
// cut macros
MacroStartPos:=System.Pos('$(',CurPath);
if MacroStartPos>0 then begin
CurPath:=copy(CurPath,1,MacroStartPos-1);
if (CurPath<>'') and (CurPath[length(CurPath)]<>PathDelim) then
CurPath:=ExtractFilePath(CurPath);
end;
// make path absolute
if (CurPath<>'') and (not FilenameIsAbsolute(CurPath)) then
CurPath:=AppendPathDelim(BaseDirectory)+CurPath;
if (CurPath='') or (not DirectoryExists(CurPath)) then begin
// path does not exist -> remove
Result:=copy(Result,1,StartPos-1)+copy(Result,EndPos+1,length(Result));
EndPos:=StartPos;
end else begin
StartPos:=EndPos+1;
end;
end;
end;
function CreateAbsoluteSearchPath(const SearchPath, BaseDirectory: string
): string;
begin