paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-07 11:17:21 +01:00
Code Issues Packages Projects Releases Wiki Activity

fixed double clicking on treeview without node

Browse Source 
git-svn-id: trunk@8876 -
This commit is contained in:
mattias 2006-03-07 11:01:48 +00:00
parent 3db66482b8
commit 3c7832808c
16 changed files with 483 additions and 234 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -65,7 +65,7 @@ components/codetools/examples/fixfilenames.lpi svneol=native#text/plain
components/codetools/examples/fixfilenames.pas svneol=native#text/plain
components/codetools/examples/methodjumping.lpi svneol=native#text/plain
components/codetools/examples/methodjumping.pas svneol=native#text/plain
components/codetools/examples/scanexamples/biglettersunit.pas svneol=native#text/plain
components/codetools/examples/scanexamples/BigLettersUnit.pas svneol=native#text/plain
components/codetools/examples/scanexamples/brokenfilenames.pas svneol=native#text/plain
components/codetools/examples/scanexamples/brokenincfiles.inc svneol=native#text/plain
components/codetools/examples/scanexamples/empty.inc svneol=native#text/plain

9
components/codetools/codetoolmanager.pas
View File

@ -413,8 +413,8 @@ type
ImplementationUsesSection: TStrings): boolean;
function FindUsedUnitNames(Code: TCodeBuffer; var MainUsesSection,
ImplementationUsesSection: TStrings): boolean;
function FindMissingUnits(Code: TCodeBuffer;
var MissingUnits: TStrings): boolean;
function FindMissingUnits(Code: TCodeBuffer; var MissingUnits: TStrings;
FixCase: boolean = false): boolean;
function FindDelphiProjectUnits(Code: TCodeBuffer;
var FoundInUnits, MissingInUnits, NormalUnits: TStrings): boolean;
function CommentUnitsInUsesSections(Code: TCodeBuffer;
@ -2697,7 +2697,7 @@ begin
end;
function TCodeToolManager.FindMissingUnits(Code: TCodeBuffer;
var MissingUnits: TStrings): boolean;
var MissingUnits: TStrings; FixCase: boolean): boolean;
begin
Result:=false;
{$IFDEF CTDEBUG}
@ -2705,7 +2705,8 @@ begin
{$ENDIF}
if not InitCurCodeTool(Code) then exit;
try
Result:=FCurCodeTool.FindMissingUnits(MissingUnits);
Result:=FCurCodeTool.FindMissingUnits(MissingUnits,FixCase,
SourceChangeCache);
except
on e: Exception do Result:=HandleException(e);
end;

21
components/codetools/customcodetool.pas
View File

@ -1592,12 +1592,18 @@ end;
procedure TCustomCodeTool.BeginParsing(DeleteNodes,
OnlyInterfaceNeeded: boolean);
var
LinkScanRange: TLinkScannerRange;
begin
// scan
FLastProgressPos:=0;
CurrentPhase:=CodeToolPhaseScan;
try
Scanner.Scan(OnlyInterfaceNeeded,CheckFilesOnDisk);
if OnlyInterfaceNeeded then
LinkScanRange:=lsrInterface
else
LinkScanRange:=lsrEnd;
Scanner.Scan(LinkScanRange,CheckFilesOnDisk);
// update scanned code
if FLastScannerChangeStep<>Scanner.ChangeStep then begin
// code has changed
@ -2246,6 +2252,8 @@ begin
end;
function TCustomCodeTool.UpdateNeeded(OnlyInterfaceNeeded: boolean): boolean;
var
LinkScanRange: TLinkScannerRange;
begin
{$IFDEF CTDEBUG}
DebugLn('TCustomCodeTool.UpdateNeeded A ',dbgs(Scanner<>nil),' FForceUpdateNeeded=',dbgs(FForceUpdateNeeded));
@ -2254,8 +2262,15 @@ begin
Result:=true;
exit;
end;
Result:=(FLastScannerChangeStep<>Scanner.ChangeStep)
or (Scanner.UpdateNeeded(OnlyInterfaceNeeded, CheckFilesOnDisk));
if (FLastScannerChangeStep<>Scanner.ChangeStep) then begin
Result:=true;
end else begin
if OnlyInterfaceNeeded then
LinkScanRange:=lsrInterface
else
LinkScanRange:=lsrEnd;
Result:=Scanner.UpdateNeeded(LinkScanRange, CheckFilesOnDisk);
end;
FForceUpdateNeeded:=Result;
{$IFDEF CTDEBUG}
DebugLn('TCustomCodeTool.UpdateNeeded END Result=',dbgs(Result));

9
components/codetools/examples/fixfilenames.pas
View File

@ -38,6 +38,7 @@ var
Options: TCodeToolsOptions;
Code: TCodeBuffer;
Filename: String;
MissingUnits: TStrings;
begin
// setup the Options
Options:=TCodeToolsOptions.Create;
@ -75,8 +76,12 @@ begin
raise Exception.Create('unable to fix include filesnames in '+Filename+' '+CodeToolBoss.ErrorMessage);
// fix the unitnames in the uses section
//if not CodeToolBoss.FixUsesSectionsCase(Code) then
// raise Exception.Create('unable to fix unit names in '+Filename+' '+CodeToolBoss.ErrorMessage);
MissingUnits:=nil;
if not CodeToolBoss.FindMissingUnits(Code,MissingUnits,true) then
raise Exception.Create('unable to fix unit names in '+Filename+' '+CodeToolBoss.ErrorMessage);
if MissingUnits<>nil then
writeln('MissingUnits=',MissingUnits.Text);
writeln('==================================================================');
writeln(Code.Source);
end.

0
components/codetools/examples/scanexamples/biglettersunit.pas → components/codetools/examples/scanexamples/BigLettersUnit.pas
View File

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

@ -6,9 +6,11 @@ interface
uses
Classes, SysUtils,
biglettersunit // must be fixed to BigLettersUnit
;
Classes,
biglettersunit, // must be fixed to BigLettersUnit
biglettersunit in 'biglettersunit.pas',// -> BigLettersUnit.pas
biglettersunit in '..\ScanExamples\biglettersunit.pas',// -> ../scanexamples/BigLettersUnit
SysUtils;
{$I BROKENincfiles.inc}// must be fixed to brokenincfiles.inc
{$I ../ScanExamples/BROKENincfiles.inc}// must be fixed to ../scanexamples/brokenincfiles.inc

105
components/codetools/fileprocs.pas
View File

@ -96,6 +96,13 @@ function FindDiskFilename(const Filename: string): string;
function CompareAnsiStringFilenames(Data1, data2: Pointer): integer;
function FilenameIsPascalUnit(const Filename: string;
CaseSensitive: boolean = false): boolean;
function SearchPascalUnitInDir(const AnUnitName, BaseDirectory: string;
SearchCase: TCTSearchFileCase): string;
function SearchPascalUnitInPath(const AnUnitName, BasePath, SearchPath,
Delimiter: string; SearchCase: TCTSearchFileCase): string;
type
TCTPascalExtType = (petNone, petPAS, petPP, petP);
@ -853,6 +860,103 @@ begin
Result:=Path;
end;
function FilenameIsPascalUnit(const Filename: string;
CaseSensitive: boolean): boolean;
var
i: TCTPascalExtType;
begin
for i:=Low(CTPascalExtension) to High(CTPascalExtension) do begin
if CTPascalExtension[i]='' then continue;
if CompareFileExt(Filename,CTPascalExtension[i],CaseSensitive)=0 then
exit(true);
end;
Result:=false;
end;
function SearchPascalUnitInDir(const AnUnitName, BaseDirectory: string;
SearchCase: TCTSearchFileCase): string;
procedure RaiseNotImplemented;
begin
raise Exception.Create('not implemented');
end;
var
Base: String;
FileInfo: TSearchRec;
CurExt: String;
begin
Base:=AppendPathDelim(BaseDirectory);
Base:=TrimFilename(Base);
// search file
Result:='';
if SearchCase=ctsfcAllCase then
Base:=FindDiskFilename(Base);
if SysUtils.FindFirst(Base+FileMask,faAnyFile,FileInfo)=0 then
begin
repeat
// check if special file
if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='')
then
continue;
if not FilenameIsPascalUnit(FileInfo.Name,false) then continue;
CurExt:=ExtractFileExt(FileInfo.Name);
case SearchCase of
ctsfcDefault,ctsfcLoUpCase:
begin
if (AnUnitName+lowercase(CurExt)=FileInfo.Name)
or (lowercase(AnUnitName+CurExt)=FileInfo.Name)
or (uppercase(AnUnitName+CurExt)=FileInfo.Name)
then begin
Result:=FileInfo.Name;
if AnUnitName+CurExt=FileInfo.Name then break;
end;
end;
ctsfcAllCase:
begin
if CompareText(AnUnitName+CurExt,FileInfo.Name)=0 then begin
Result:=FileInfo.Name;
if AnUnitName+CurExt=FileInfo.Name then break;
end;
end;
else
RaiseNotImplemented;
end;
until SysUtils.FindNext(FileInfo)<>0;
end;
SysUtils.FindClose(FileInfo);
if Result<>'' then Result:=Base+Result;
end;
function SearchPascalUnitInPath(const AnUnitName, BasePath, SearchPath,
Delimiter: string; SearchCase: TCTSearchFileCase): string;
var
p, StartPos, l: integer;
CurPath, Base: string;
begin
Base:=ExpandFilename(AppendPathDelim(BasePath));
// search in current directory
Result:=SearchPascalUnitInDir(AnUnitName,Base,SearchCase);
if Result<>'' then exit;
// search in search path
StartPos:=1;
l:=length(SearchPath);
while StartPos<=l do begin
p:=StartPos;
while (p<=l) and (pos(SearchPath[p],Delimiter)<1) do inc(p);
CurPath:=Trim(copy(SearchPath,StartPos,p-StartPos));
if CurPath<>'' then begin
if not FilenameIsAbsolute(CurPath) then
CurPath:=Base+CurPath;
CurPath:=ExpandFilename(AppendPathDelim(CurPath));
Result:=SearchPascalUnitInDir(AnUnitName,CurPath,SearchCase);
if Result<>'' then exit;
end;
StartPos:=p+1;
end;
Result:='';
end;
function SearchFileInDir(const Filename, BaseDirectory: string;
SearchCase: TCTSearchFileCase): string;
@ -894,6 +998,7 @@ begin
begin
// search file
Result:='';
Base:=FindDiskFilename(Base);
if SysUtils.FindFirst(Base+FileMask,faAnyFile,FileInfo)=0 then
begin
repeat

202
components/codetools/finddeclarationtool.pas
View File

@ -684,7 +684,10 @@ type
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
function FindUnitSource(const AnUnitName,
AnUnitInFilename: string; ExceptionOnNotFound: boolean): TCodeBuffer;
function FindUnitCaseInsensitive(var AnUnitName,
AnUnitInFilename: string): string;
procedure GatherUnitAndSrcPath(var UnitPath, SrcPath: string);
function SearchUnitInUnitLinks(const TheUnitName: string): string;
function FindSmartHint(const CursorPos: TCodeXYPosition): string;
function BaseTypeOfNodeHasSubIdents(ANode: TCodeTreeNode): boolean;
function FindBaseTypeOfNode(Params: TFindDeclarationParams;
@ -1541,75 +1544,14 @@ var
Result:=nil;
end;
function SearchUnitInUnitLinks(const TheUnitName: string): TCodeBuffer;
var
UnitLinks, CurFilename: string;
UnitLinkStart, UnitLinkEnd, UnitLinkLen: integer;
pe: TCTPascalExtType;
begin
Result:=nil;
UnitLinks:=Scanner.Values[ExternalMacroStart+'UnitLinks'];
{$IFDEF ShowTriedFiles}
DebugLn('TFindDeclarationTool.FindUnitSource.SearchUnitInUnitLinks length(UnitLinks)=',dbgs(length(UnitLinks)));
{$ENDIF}
UnitLinkStart:=1;
while UnitLinkStart<=length(UnitLinks) do begin
while (UnitLinkStart<=length(UnitLinks))
and (UnitLinks[UnitLinkStart] in [#10,#13]) do
inc(UnitLinkStart);
UnitLinkEnd:=UnitLinkStart;
while (UnitLinkEnd<=length(UnitLinks)) and (UnitLinks[UnitLinkEnd]<>' ')
do
inc(UnitLinkEnd);
UnitLinkLen:=UnitLinkEnd-UnitLinkStart;
if UnitLinkLen>0 then begin
{$IFDEF ShowTriedFiles}
DebugLn(' unit "',copy(UnitLinks,UnitLinkStart,UnitLinkEnd-UnitLinkStart),'" ',
dbgs(CompareSubStrings(TheUnitName,UnitLinks,1,UnitLinkStart,UnitLinkLen,false)));
{$ENDIF}
if (UnitLinkLen=length(TheUnitName))
and (CompareText(PChar(TheUnitName),length(TheUnitName),
@UnitLinks[UnitLinkStart],UnitLinkLen,false)=0)
then begin
// unit found -> parse filename
UnitLinkStart:=UnitLinkEnd+1;
UnitLinkEnd:=UnitLinkStart;
while (UnitLinkEnd<=length(UnitLinks))
and (not (UnitLinks[UnitLinkEnd] in [#10,#13])) do
inc(UnitLinkEnd);
if UnitLinkEnd>UnitLinkStart then begin
CurFilename:=copy(UnitLinks,UnitLinkStart,UnitLinkEnd-UnitLinkStart);
LoadFile(CurFilename,Result);
if Result=nil then begin
// try also different extensions
for pe:=Low(TCTPascalExtType) to High(TCTPascalExtType) do begin
if CompareFileExt(CurFilename,CTPascalExtension[pe],false)<>0
then
LoadFile(ChangeFileExt(CurFilename,CTPascalExtension[pe]),
Result);
if Result<>nil then break;
end;
end;
exit;
end;
end else begin
UnitLinkStart:=UnitLinkEnd+1;
while (UnitLinkStart<=length(UnitLinks))
and (not (UnitLinks[UnitLinkStart] in [#10,#13])) do
inc(UnitLinkStart);
end;
end else
break;
end;
end;
var UnitSrcSearchPath: string;
var
UnitSrcSearchPath: string;
MainCodeIsVirtual: boolean;
CompiledResult: TCodeBuffer;
UnitSearchPath: string;
SrcPathInitialized: boolean;
WorkingUnitInFilename: String;
CurFilename: String;
procedure InitSrcPath;
begin
@ -1656,8 +1598,8 @@ begin
// search as the compiler would search
if AnUnitInFilename<>'' then begin
WorkingUnitInFilename:=SetDirSeparators(AnUnitInFilename);
// uses IN parameter
WorkingUnitInFilename:=SetDirSeparators(AnUnitInFilename);
if FilenameIsAbsolute(WorkingUnitInFilename) then begin
Result:=TCodeBuffer(Scanner.OnLoadSource(Self,WorkingUnitInFilename,true));
end else begin
@ -1665,9 +1607,7 @@ begin
// -> search file in current directory
CurDir:=AppendPathDelim(CurDir);
if not LoadFile(CurDir+WorkingUnitInFilename,Result) then begin
// search AnUnitInFilename in searchpath
InitSrcPath;
Result:=SearchFileInPath(UnitSrcSearchPath,WorkingUnitInFilename);
Result:=nil;
end;
end;
end else begin
@ -1733,7 +1673,9 @@ begin
if Result=nil then begin
// search in FPC source directory
Result:=SearchUnitInUnitLinks(AnUnitName);
CurFilename:=SearchUnitInUnitLinks(AnUnitName);
if CurFilename<>'' then
LoadFile(CurFilename,Result);
end;
end;
if (Result=nil) and Assigned(OnFindUsedUnit) then begin
@ -1756,6 +1698,60 @@ begin
end;
end;
function TFindDeclarationTool.FindUnitCaseInsensitive(var AnUnitName,
AnUnitInFilename: string): string;
var
CurDir: String;
UnitPath, SrcPath: string;
NewUnitName: String;
begin
//DebugLn('TFindDeclarationTool.FindUnitCaseInsensitive AnUnitName=',AnUnitName,' AnUnitInFilename=',AnUnitInFilename);
if AnUnitInFilename<>'' then begin
// uses IN parameter
AnUnitInFilename:=TrimFilename(SetDirSeparators(AnUnitInFilename));
if FilenameIsAbsolute(AnUnitInFilename) then begin
Result:=FindDiskFilename(AnUnitInFilename);
if FileExists(Result) then
AnUnitInFilename:=Result
else
Result:='';
end else begin
// file is relative to current unit directory
// -> search file in current directory
CurDir:=ExtractFilePath(MainFilename);
if CurDir<>'' then begin
Result:=SearchFileInDir(AnUnitInFilename,CurDir,ctsfcAllCase);
if FileExists(Result) then begin
AnUnitInFilename:=CreateRelativePath(Result,CurDir);
end else begin
Result:='';
end;
end else begin
// virtual unit -> TODO
Result:='';
end;
end;
end else begin
// normal unit name
// search in unit, src and compiled src path
GatherUnitAndSrcPath(UnitPath,SrcPath);
Result:=SearchPascalUnitInPath(AnUnitName,CurDir,UnitPath+';'+SrcPath,';',
ctsfcAllCase);
if Result='' then begin
// search in unit links
Result:=SearchUnitInUnitLinks(AnUnitName);
end;
if Result<>'' then begin
NewUnitName:=ExtractFileNameOnly(Result);
if (NewUnitName<>lowercase(NewUnitName))
and (AnUnitName<>NewUnitName) then
AnUnitName:=NewUnitName;
end;
//DebugLn('TFindDeclarationTool.FindUnitCaseInsensitive TODO search unit');
end;
//DebugLn('TFindDeclarationTool.FindUnitCaseInsensitive RESULT AnUnitName=',AnUnitName,' AnUnitInFilename=',AnUnitInFilename,' Result=',Result);
end;
procedure TFindDeclarationTool.GatherUnitAndSrcPath(var UnitPath,
SrcPath: string);
var
@ -1821,6 +1817,72 @@ begin
SearchCompiledSrcPaths(UnitPath);
end;
function TFindDeclarationTool.SearchUnitInUnitLinks(const TheUnitName: string
): string;
var
UnitLinks: string;
UnitLinkStart, UnitLinkEnd, UnitLinkLen: integer;
pe: TCTPascalExtType;
begin
Result:='';
UnitLinks:=Scanner.Values[ExternalMacroStart+'UnitLinks'];
{$IFDEF ShowTriedFiles}
DebugLn('TFindDeclarationTool.SearchUnitInUnitLinks length(UnitLinks)=',dbgs(length(UnitLinks)));
{$ENDIF}
UnitLinkStart:=1;
while UnitLinkStart<=length(UnitLinks) do begin
while (UnitLinkStart<=length(UnitLinks))
and (UnitLinks[UnitLinkStart] in [#10,#13]) do
inc(UnitLinkStart);
UnitLinkEnd:=UnitLinkStart;
while (UnitLinkEnd<=length(UnitLinks)) and (UnitLinks[UnitLinkEnd]<>' ')
do
inc(UnitLinkEnd);
UnitLinkLen:=UnitLinkEnd-UnitLinkStart;
if UnitLinkLen>0 then begin
{$IFDEF ShowTriedFiles}
DebugLn(' unit "',copy(UnitLinks,UnitLinkStart,UnitLinkEnd-UnitLinkStart),'" ',
dbgs(CompareSubStrings(TheUnitName,UnitLinks,1,UnitLinkStart,UnitLinkLen,false)));
{$ENDIF}
if (UnitLinkLen=length(TheUnitName))
and (CompareText(PChar(TheUnitName),length(TheUnitName),
@UnitLinks[UnitLinkStart],UnitLinkLen,false)=0)
then begin
// unit found -> parse filename
UnitLinkStart:=UnitLinkEnd+1;
UnitLinkEnd:=UnitLinkStart;
while (UnitLinkEnd<=length(UnitLinks))
and (not (UnitLinks[UnitLinkEnd] in [#10,#13])) do
inc(UnitLinkEnd);
if UnitLinkEnd>UnitLinkStart then begin
Result:=copy(UnitLinks,UnitLinkStart,UnitLinkEnd-UnitLinkStart);
if FileExistsCached(Result) then exit;
// try also different extensions
for pe:=Low(TCTPascalExtType) to High(TCTPascalExtType) do begin
if (CTPascalExtension[pe]<>'')
and (CompareFileExt(Result,CTPascalExtension[pe],false)<>0)
then begin
Result:=ChangeFileExt(Result,CTPascalExtension[pe]);
if FileExistsCached(Result) then begin
Result:=Result;
exit;
end;
end;
end;
Result:='';
exit;
end;
end else begin
UnitLinkStart:=UnitLinkEnd+1;
while (UnitLinkStart<=length(UnitLinks))
and (not (UnitLinks[UnitLinkStart] in [#10,#13])) do
inc(UnitLinkStart);
end;
end else
break;
end;
end;
function TFindDeclarationTool.FindSmartHint(const CursorPos: TCodeXYPosition
): string;
var
@ -7164,7 +7226,7 @@ begin
if Result then exit;
ANode:=FDependsOnCodeTools.FindSuccessor(ANode);
end;
Result:=UpdateNeeded(Scanner.ScanTillInterfaceEnd);
Result:=UpdateNeeded(Scanner.ScanTill=lsrInterface);
finally
{$IFDEF ShowCacheDependencies}
DebugLn('[TFindDeclarationTool.CheckDependsOnNodeCaches] Result=',

69
components/codetools/linkscanner.pas
View File

@ -94,6 +94,13 @@ type
ChangeStep: integer;
Next: PSourceChangeStep;
end;
TLinkScannerRange = (
lsrNone, // undefined
lsrInit, // init, but do not scan any code
lsrInterface, // scan only interface
lsrEnd // scan till 'end.'
);
TCommentStyle = (CommentNone, CommentTP, CommentOldTP, CommentDelphi);
@ -146,7 +153,6 @@ type
ABuffer: Pointer; ABufferPos: integer);
end;
{ TLinkScanner }
TLinkScanner = class(TObject)
@ -173,7 +179,7 @@ type
FChangeStep: integer;
FMainSourceFilename: string;
FMainCode: pointer;
FScanTillInterfaceEnd: boolean;
FScanTill: TLinkScannerRange;
FIgnoreMissingIncludeFiles: boolean;
FNestedComments: boolean;
FForceUpdateNeeded: boolean;
@ -188,7 +194,7 @@ type
procedure AddLink(ACleanedPos, ASrcPos: integer; ACode: Pointer);
procedure IncreaseChangeStep;
procedure SetMainCode(const Value: pointer);
procedure SetScanTillInterfaceEnd(const Value: boolean);
procedure SetScanTill(const Value: TLinkScannerRange);
procedure SetIgnoreMissingIncludeFiles(const Value: boolean);
function TokenIs(const AToken: shortstring): boolean;
function UpTokenIs(const AToken: shortstring): boolean;
@ -292,9 +298,8 @@ type
Code: pointer; // current code object
Values: TExpressionEvaluator;
EndOfInterfaceFound: boolean;
EndOfSourceFound: boolean;
ScannedRange: TLinkScannerRange;
function MainFilename: string;
// links
@ -328,9 +333,8 @@ type
procedure DeleteRange(CleanStartPos,CleanEndPos: integer);
// scanning
procedure Scan(TillInterfaceEnd, CheckFilesOnDisk: boolean;
CheckUpdate: boolean = true; DoScan: boolean = true);
function UpdateNeeded(OnlyInterfaceNeeded,
procedure Scan(Range: TLinkScannerRange; CheckFilesOnDisk: boolean);
function UpdateNeeded(Range: TLinkScannerRange;
CheckFilesOnDisk: boolean): boolean;
procedure SetIgnoreErrorAfter(ACursorPos: integer; ACode: Pointer);
procedure ClearIgnoreErrorAfter;
@ -382,8 +386,7 @@ type
read FCompilerMode write SetCompilerMode;
property PascalCompiler: TPascalCompiler
read FPascalCompiler write FPascalCompiler;
property ScanTillInterfaceEnd: boolean read FScanTillInterfaceEnd
write SetScanTillInterfaceEnd;
property ScanTill: TLinkScannerRange read FScanTill write SetScanTill;
procedure Clear;
function ConsistencyCheck: integer;
@ -1026,8 +1029,7 @@ begin
end;
end;
procedure TLinkScanner.Scan(TillInterfaceEnd, CheckFilesOnDisk: boolean;
CheckUpdate: boolean; DoScan: boolean);
procedure TLinkScanner.Scan(Range: TLinkScannerRange; CheckFilesOnDisk: boolean);
var
LastTokenType: TLSTokenType;
cm: TCompilerMode;
@ -1037,8 +1039,7 @@ var
CheckForAbort: boolean;
NewSrcLen: Integer;
begin
if CheckUpdate and (not UpdateNeeded(TillInterfaceEnd,CheckFilesOnDisk)) then
begin
if (not UpdateNeeded(Range,CheckFilesOnDisk)) then begin
// input is the same as last time -> output is the same
// -> if there was an error, raise it again
if LastErrorIsValid
@ -1051,7 +1052,7 @@ begin
{$IFDEF CTDEBUG}
DebugLn('TLinkScanner.Scan A -------- TillInterfaceEnd=',dbgs(TillInterfaceEnd));
{$ENDIF}
ScanTillInterfaceEnd:=TillInterfaceEnd;
ScanTill:=Range;
Clear;
IncreaseChangeStep;
{$IFDEF CTDEBUG}
@ -1066,8 +1067,7 @@ begin
{$IFDEF CTDEBUG}
DebugLn('TLinkScanner.Scan C ',dbgs(SrcLen));
{$ENDIF}
EndOfInterfaceFound:=false;
EndOfSourceFound:=false;
ScannedRange:=lsrNone;
CommentStyle:=CommentNone;
CommentLevel:=0;
CompilerMode:=cmFPC;
@ -1113,7 +1113,7 @@ begin
{$IFDEF CTDEBUG}
DebugLn('TLinkScanner.Scan F ',dbgs(SrcLen));
{$ENDIF}
if not DoScan then exit;
if ScanTill=lsrInit then exit;
try
try
repeat
@ -1126,11 +1126,10 @@ begin
//DebugLn('TLinkScanner.Scan G "',copy(Src,TokenStart,SrcPos-TokenStart),'"');
if (TokenType=lsttEndOfInterface) and (LastTokenType<>lsttEqual) then
begin
EndOfInterfaceFound:=true;
if ScanTillInterfaceEnd then break;
ScannedRange:=lsrInterface;
if ScanTill=lsrInterface then break;
end else if (LastTokenType=lsttEnd) and (TokenType=lsttPoint) then begin
EndOfInterfaceFound:=true;
EndOfSourceFound:=true;
ScannedRange:=lsrEnd;
break;
end else if (SrcPos>SrcLen) and ReturnFromIncludeFileAndIsEnd then
break;
@ -1383,7 +1382,7 @@ begin
end;
function TLinkScanner.UpdateNeeded(
OnlyInterfaceNeeded, CheckFilesOnDisk: boolean): boolean;
Range: TLinkScannerRange; CheckFilesOnDisk: boolean): boolean;
{ the clean source must be rebuild if
1. scanrange changed from only interface to whole source
2. unit source changed
@ -1408,8 +1407,8 @@ begin
// frozen
if (FLastGlobalWriteLockStep=GlobalWriteLockStep) then begin
// source and values did not change since last UpdateNeeded check
// -> check only if ScanRange has increased
if (OnlyInterfaceNeeded=false) and (not EndOfSourceFound) then exit;
// -> check only if ScanTill has increased
if ord(Range)>ord(ScannedRange) then exit;
Result:=false;
exit;
end else begin
@ -1423,12 +1422,9 @@ begin
// check if any input has changed ...
FForceUpdateNeeded:=true;
// check if code was ever scanned
if LinkCount=0 then exit;
// check if ScanRange has increased
if (OnlyInterfaceNeeded=false) and (ScanTillInterfaceEnd) then exit;
if ord(Range)>ord(ScannedRange) then exit;
// check all used files
if Assigned(FOnGetSource) then begin
if CheckFilesOnDisk and Assigned(FOnCheckFileOnDisk) then begin
@ -1959,11 +1955,14 @@ begin
Clear;
end;
procedure TLinkScanner.SetScanTillInterfaceEnd(const Value: boolean);
procedure TLinkScanner.SetScanTill(const Value: TLinkScannerRange);
var
OldScanRange: TLinkScannerRange;
begin
if FScanTillInterfaceEnd=Value then exit;
FScanTillInterfaceEnd := Value;
if not Value then Clear;
if FScanTill=Value then exit;
OldScanRange:=FScanTill;
FScanTill := Value;
if ord(OldScanRange)<ord(FScanTill) then Clear;
end;
function TLinkScanner.ShortSwitchDirective: boolean;

96
components/codetools/stdcodetools.pas
View File

@ -95,26 +95,27 @@ type
function AddUnitToMainUsesSection(const NewUnitName, NewUnitInFile: string;
SourceChangeCache: TSourceChangeCache): boolean;
function RemoveUnitFromUsesSection(UsesNode: TCodeTreeNode;
const UpperUnitName: string;
SourceChangeCache: TSourceChangeCache): boolean;
const UpperUnitName: string;
SourceChangeCache: TSourceChangeCache): boolean;
function RemoveUnitFromAllUsesSections(const UpperUnitName: string;
SourceChangeCache: TSourceChangeCache): boolean;
SourceChangeCache: TSourceChangeCache): boolean;
function FixUnitInFilenameCase(
SourceChangeCache: TSourceChangeCache): boolean;
SourceChangeCache: TSourceChangeCache): boolean;
function FixUnitInFilenameCaseInUsesSection(UsesNode: TCodeTreeNode;
SourceChangeCache: TSourceChangeCache): boolean;
SourceChangeCache: TSourceChangeCache): boolean;
function FindUsedUnitNames(var MainUsesSection,
ImplementationUsesSection: TStrings): boolean;
ImplementationUsesSection: TStrings): boolean;
function FindUsedUnitFiles(var MainUsesSection: TStrings): boolean;
function FindUsedUnitFiles(var MainUsesSection,
ImplementationUsesSection: TStrings): boolean;
ImplementationUsesSection: TStrings): boolean;
function FindDelphiProjectUnits(var FoundInUnits, MissingInUnits,
NormalUnits: TStrings): boolean;
function UsesSectionToFilenames(UsesNode: TCodeTreeNode): TStrings;
function UsesSectionToUnitnames(UsesNode: TCodeTreeNode): TStrings;
function FindMissingUnits(var MissingUnits: TStrings): boolean;
function FindMissingUnits(var MissingUnits: TStrings; FixCase: boolean;
SourceChangeCache: TSourceChangeCache): boolean;
function CommentUnitsInUsesSections(MissingUnits: TStrings;
SourceChangeCache: TSourceChangeCache): boolean;
SourceChangeCache: TSourceChangeCache): boolean;
// lazarus resources
function FindNextIncludeInInitialization(
@ -872,7 +873,7 @@ end;
function TStandardCodeTool.UsesSectionToFilenames(UsesNode: TCodeTreeNode
): TStrings;
Reads the uses section backwards and tries to find each unit file
Reads the uses section backwards and tries to find each unit file.
The associated objects in the list will be the found codebuffers.
If no codebuffer was found/created then the filename will be the unit name
plus the 'in' extension.
@ -934,36 +935,67 @@ begin
until not AtomIsChar(',');
end;
function TStandardCodeTool.FindMissingUnits(var MissingUnits: TStrings
): boolean;
function TStandardCodeTool.FindMissingUnits(var MissingUnits: TStrings;
FixCase: boolean; SourceChangeCache: TSourceChangeCache): boolean;
function CheckUsesSection(UsesNode: TCodeTreeNode): boolean;
var
UsesSection: TStrings;
i: Integer;
InAtom, UnitNameAtom: TAtomPosition;
OldUnitName: String;
OldInFilename: String;
AFilename: String;
s: String;
NewUnitName: String;
NewInFilename: String;
FromPos: LongInt;
ToPos: LongInt;
begin
Result:=true;
if UsesNode=nil then exit;
UsesSection:=nil;
try
UsesSection:=UsesSectionToFilenames(UsesNode);
if UsesSection=nil then exit;
// gather all missing units
for i:=0 to UsesSection.Count-1 do begin
//debugln('TStandardCodeTool.FindMissingUnits A ',UsesSection[i],' ',dbgs(UsesSection.Objects[i]=nil));
if UsesSection.Objects[i]=nil then begin
if MissingUnits=nil then MissingUnits:=TStringList.Create;
MissingUnits.Add(UsesSection[i]);
if UsesNode=nil then exit(true);
MoveCursorToUsesEnd(UsesNode);
repeat
// read prior unit name
ReadPriorUsedUnit(UnitNameAtom, InAtom);
OldUnitName:=GetAtom(UnitNameAtom);
if InAtom.StartPos>0 then
OldInFilename:=copy(Src,InAtom.StartPos+1,
InAtom.EndPos-InAtom.StartPos-2)
else
OldInFilename:='';
// find unit file
NewUnitName:=OldUnitName;
NewInFilename:=OldInFilename;
AFilename:=FindUnitCaseInsensitive(NewUnitName,NewInFilename);
s:=NewUnitName;
if NewInFilename<>'' then
s:=s+' in '''+NewInFilename+'''';
if AFilename<>'' then begin
// unit found
if (NewUnitName<>OldUnitName) or (NewInFilename<>OldInFilename) then
begin
// fix case
FromPos:=UnitNameAtom.StartPos;
if InAtom.StartPos>0 then
ToPos:=InAtom.EndPos
else
ToPos:=UnitNameAtom.EndPos;
SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,s);
DebugLn('CheckUsesSection fix case UnitName(',OldUnitName,'->',NewUnitName,') InFile(',OldInFilename,'->',NewInFilename,')');
end;
end else begin
// unit not found
if MissingUnits=nil then MissingUnits:=TStringList.Create;
MissingUnits.Add(s);
end;
finally
UsesSection.Free;
end;
// read keyword 'uses' or comma
ReadPriorAtom;
until not AtomIsChar(',');
Result:=true;
end;
begin
Result:=false;
BuildTree(false);
SourceChangeCache.MainScanner:=Scanner;
try
if not CheckUsesSection(FindMainUsesSection) then exit;
if not CheckUsesSection(FindImplementationUsesSection) then exit;
@ -971,7 +1003,7 @@ begin
FreeAndNil(MissingUnits);
raise;
end;
Result:=true;
Result:=SourceChangeCache.Apply;
end;
function TStandardCodeTool.CommentUnitsInUsesSections(MissingUnits: TStrings;
@ -4394,7 +4426,7 @@ var
OldFilename: String;
AFilename: String;
begin
OldFilename:=copy(ASource,StartPos,EndPos-StartPos);
OldFilename:=SetDirSeparators(copy(ASource,StartPos,EndPos-StartPos));
//DebugLn('FixFilename ',dbgs(StartPos),' ',dbgs(EndPos),' ',OldFilename);
AFilename:=OldFilename;
if ExtractFileExt(AFilename)='' then begin
@ -4421,7 +4453,7 @@ begin
MissingIncludeFiles:=nil;
if (Scanner=nil) or (Scanner.MainCode=nil) then exit;
ASource:=Code.Source;
Scanner.Scan(false,false,false,false);// init scanner, but do not scan
Scanner.Scan(lsrInit,false);
SourceChangeCache.MainScanner:=Scanner;
Result:=true;

88
converter/delphiproject2laz.pas
View File

@ -54,8 +54,8 @@ uses
function ConvertDelphiToLazarusProject(const ProjectFilename: string
): TModalResult;
function ConvertDelphiToLazarusUnit(const DelphiFilename: string
): TModalResult;
function ConvertDelphiToLazarusUnit(const DelphiFilename: string;
RenameLowercase: boolean): TModalResult;
function CreateDelphiToLazarusProject(const LPIFilename: string): TModalResult;
function CreateDelphiToLazarusMainSourceFile(AProject: TProject;
@ -79,13 +79,12 @@ var
FoundInUnits, MissingInUnits, NormalUnits: TStrings;
NotFoundUnits: String;
LPRCode: TCodeBuffer;
NewProjectDesc: TProjectEmptyProgramDescriptor;
i: Integer;
CurUnitInfo: TUnitInfo;
MainUnitInfo: TUnitInfo;
LPIFilename: String;
DPRFilename: String;
MainSourceFilename: String;
RenameLowercase: Boolean;
begin
debugln('ConvertDelphiToLazarusProject ProjectFilename="',ProjectFilename,'"');
IDEMessagesWindow.Clear;
@ -108,7 +107,10 @@ begin
// read config files (they often contain clues about paths, switches and defines)
Result:=ReadDelphiProjectConfigFiles(Project1);
if Result<>mrOk then exit;
if Result<>mrOk then begin
DebugLn('ConvertDelphiToLazarusProject failed reading Delphi configs');
exit;
end;
// load required packages
Project1.AddPackageDependency('LCL');// Nearly all Delphi projects require it
@ -119,35 +121,27 @@ begin
// init codetools
if not LazarusIDE.BeginCodeTools then begin
DebugLn('ConvertDelphiToLazarusProject failed BeginCodeTools');
Result:=mrCancel;
exit;
end;
// fix include filenames
if not CodeToolBoss.FixIncludeFilenames(Project1.MainUnitInfo.Source,true)
then begin
LazarusIDE.DoJumpToCodeToolBossError;
exit(mrCancel);
// fix .lpr
RenameLowercase:=false;
Result:=ConvertDelphiToLazarusUnit(LPRCode.Filename,RenameLowercase);
if Result=mrAbort then begin
DebugLn('ConvertDelphiToLazarusProject failed converting unit ',LPRCode.Filename);
exit;
end;
// try to find out as much about search paths as possible before parsing code
// TODO: open lpr
// TODO: fix include paths
// TODO: get all compiler options from .dpr
// TODO: find all project files in .dpr
// TODO: fix all include filenames
{$IFDEF NewDelphiProjConverter}
exit(mrOk);
{$ENDIF}
// TODO: get all compiler options from .dpr
// TODO: get all compiler options from .lpr
Result:=ExtractOptionsFromDPR(LPRCode,Project1);
if Result<>mrOk then exit;
// fix
Result:=ConvertDelphiToLazarusUnit(LPRCode.Filename);
if Result=mrAbort then exit;
{$IFDEF NewDelphiProjConverter}
DebugLn('ConvertDelphiToLazarusProject DEBUG STOP');
exit(mrOk);
{$ENDIF}
// find all project files
FoundInUnits:=nil;
@ -168,9 +162,9 @@ begin
// warn about missing units
if (MissingInUnits<>nil) and (MissingInUnits.Count>0) then begin
NotFoundUnits:=MissingInUnits.Text;
Result:=MessageDlg('Units not found',
Result:=QuestionDlg('Units not found',
'Some units of the delphi project are missing:'#13
+NotFoundUnits,mtWarning,[mbIgnore,mbAbort],0);
+NotFoundUnits,mtWarning,[mrIgnore,mrAbort],0);
if Result<>mrIgnore then exit;
end;
@ -196,7 +190,7 @@ begin
while i<Project1.UnitCount do begin
CurUnitInfo:=Project1.Units[i];
if CurUnitInfo.IsPartOfProject and not (CurUnitInfo.IsMainUnit) then begin
Result:=ConvertDelphiToLazarusUnit(CurUnitInfo.Filename);
Result:=ConvertDelphiToLazarusUnit(CurUnitInfo.Filename,RenameLowercase);
if Result=mrAbort then exit;
end;
inc(i);
@ -212,7 +206,8 @@ begin
Result:=mrOk;
end;
function ConvertDelphiToLazarusUnit(const DelphiFilename: string): TModalResult;
function ConvertDelphiToLazarusUnit(const DelphiFilename: string;
RenameLowercase: boolean): TModalResult;
var
DFMFilename: String;
LazarusUnitFilename: String;
@ -223,12 +218,9 @@ var
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]);
@ -240,17 +232,19 @@ 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);
Result:=RenameDelphiUnitToLazarusUnit(DelphiFilename,true,RenameLowercase,
LazarusUnitFilename,LFMFilename);
if Result<>mrOk then exit;
if LFMFilename='' then LFMFilename:=ChangeFIleExt(LazarusUnitFilename,'.lfm');
if LFMFilename='' then LFMFilename:=ChangeFileExt(LazarusUnitFilename,'.lfm');
HasDFMFile:=FileExists(LFMFilename);
// convert .dfm file to .lfm file
// convert .dfm file to .lfm file (without context type checking)
if HasDFMFile then begin
DebugLn('ConvertDelphiToLazarusUnit Convert dfm format to lfm "',LFMFilename,'"');
Result:=ConvertDFMFileToLFMFile(LFMFilename);
@ -272,6 +266,18 @@ begin
exit;
end;
// check LCL path
Result:=CheckFilenameForLCLPaths(LazarusUnitFilename);
if Result<>mrOk then exit;
// fix or comment missing units
DebugLn('ConvertDelphiToLazarusUnit FixMissingUnits');
Result:=FixMissingUnits(LazarusUnitFilename);
if Result<>mrOk then begin
LazarusIDE.DoJumpToCodeToolBossError;
exit;
end;
// add {$mode delphi} directive
// remove windows unit and add LResources, LCLIntf
// remove {$R *.dfm} or {$R *.xfm} directive
@ -285,14 +291,6 @@ begin
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);

87
converter/delphiunit2laz.pas
View File

@ -43,6 +43,8 @@ uses
Dialogs, Buttons, StdCtrls, FileUtil, IniFiles,
// Components
SynEdit, CodeCache, CodeToolManager, DefineTemplates,
// IDEIntf
LazIDEIntf, MsgIntf,
// IDE
Project, DialogProcs, IDEProcs, LazarusIDEStrConsts;
@ -57,12 +59,13 @@ var
function CheckDelphiFileExt(const Filename: string): TModalResult;
function CheckFilenameForLCLPaths(const Filename: string): TModalResult;
function ConvertDelphiToLazarusFilename(const DelphiFilename: string): string;
function ConvertDelphiToLazarusFilename(const DelphiFilename: string;
RenameLowercase: boolean): string;
function ConvertDFMToLFMFilename(const DFMFilename: string;
KeepCase: boolean): string;
function FindDFMFileForDelphiUnit(const DelphiFilename: string): string;
function RenameDelphiUnitToLazarusUnit(const DelphiFilename: string;
RenameDFMFile: boolean;
RenameDFMFile, RenameLowercase: boolean;
var LazarusFilename, LFMFilename: string): TModalResult;
function ConvertDFMFileToLFMFile(const DFMFilename: string): TModalResult;
function ConvertDelphiSourceToLazarusSource(const LazarusUnitFilename: string;
@ -98,9 +101,9 @@ implementation
function CheckDelphiFileExt(const Filename: string): TModalResult;
begin
if CompareFileExt(Filename,'.pas',false)<>0 then begin
Result:=MessageDlg(lisNotADelphiUnit,
Result:=QuestionDlg(lisNotADelphiUnit,
Format(lisTheFileIsNotADelphiUnit, ['"', Filename, '"']),
mtError,[mbCancel,mbAbort],0);
mtError,[mrCancel,'Skip this file',mbAbort,'Abort'],0);
exit;
end;
Result:=mrOk;
@ -130,20 +133,24 @@ begin
if GetNextUsedDirectoryInSearchPath(UnitPath,LCLPath,NextStartPos)='' then
begin
LCLPath:=LCLPath+'$(TargetCPU)-$(TargetOS)';
Result:=MessageDlg(lisLCLUnitPathMissing,
Result:=QuestionDlg(lisLCLUnitPathMissing,
Format(lisTheCurrentUnitPathForTheFileIsThePathToTheLCLUnits, [#13, '"',
Filename, '"', #13, '"', UnitPath, '"', #13, #13, '"', LCLPath, '"',
#13, #13, #13]),
mtError,[mbCancel,mbAbort],0);
mtError,[mrCancel,'Skip this step',mrAbort,'Abort'],0);
exit;
end;
Result:=mrOk;
end;
function ConvertDelphiToLazarusFilename(const DelphiFilename: string): string;
function ConvertDelphiToLazarusFilename(const DelphiFilename: string;
RenameLowercase: boolean): string;
begin
Result:=ExtractFilePath(DelphiFilename)
+lowercase(ExtractFileName(DelphiFilename));
if RenameLowercase then
Result:=ExtractFilePath(DelphiFilename)
+lowercase(ExtractFileName(DelphiFilename))
else
Result:=DelphiFilename;
end;
function ConvertDFMToLFMFilename(const DFMFilename: string;
@ -173,21 +180,19 @@ begin
end;
function RenameDelphiUnitToLazarusUnit(const DelphiFilename: string;
RenameDFMFile: boolean;
RenameDFMFile, RenameLowercase: boolean;
var LazarusFilename, LFMFilename: string): TModalResult;
var
DFMFilename: String;
begin
LazarusFilename:=ConvertDelphiToLazarusFilename(DelphiFilename);
LazarusFilename:=ConvertDelphiToLazarusFilename(DelphiFilename,RenameLowercase);
LFMFilename:='';
//writeln('RenameDelphiUnitToLazarusUnit Unit "',DelphiFilename,'" -> "',LazarusFilename,'"');
Result:=RenameFileWithErrorDialogs(DelphiFilename,LazarusFilename,[mbAbort]);
if Result<>mrOK then exit;
if RenameDFMFile then begin
DFMFilename:=FindDFMFileForDelphiUnit(DelphiFilename);
if DFMFilename<>'' then begin
LFMFilename:=ConvertDFMToLFMFilename(DFMFilename,false);
//writeln('RenameDelphiUnitToLazarusUnit Unit "',DFMFilename,'" -> "',LFMFilename,'"');
LFMFilename:=ConvertDFMToLFMFilename(DFMFilename,not RenameLowercase);
Result:=RenameFileWithErrorDialogs(DFMFilename,LFMFilename,[mbAbort]);
if Result<>mrOK then exit;
end;
@ -208,9 +213,9 @@ begin
DFMStream.LoadFromFile(DFMFilename);
except
on E: Exception do begin
Result:=MessageDlg(lisCodeToolsDefsReadError, Format(
Result:=QuestionDlg(lisCodeToolsDefsReadError, Format(
lisUnableToReadFileError, ['"', DFMFilename, '"', #13, E.Message]),
mtError,[mbIgnore,mbAbort],0);
mtError,[mrIgnore,mrAbort],0);
exit;
end;
end;
@ -218,16 +223,15 @@ begin
FormDataToText(DFMStream,LFMStream);
except
on E: Exception do begin
Result:=MessageDlg(lisFormatError,
Result:=QuestionDlg(lisFormatError,
Format(lisUnableToConvertFileError, ['"', DFMFilename, '"', #13,
E.Message]),
mtError,[mbIgnore,mbAbort],0);
mtError,[mrIgnore,mrAbort],0);
exit;
end;
end;
// converting dfm file, without renaming unit -> keep case
LFMFilename:=ConvertDFMToLFMFilename(DFMFilename,true);
//writeln('ConvertDFMFileToLFMFile LFMFilename="',LFMFilename,'"');
try
LFMStream.SaveToFile(LFMFilename);
except
@ -270,20 +274,33 @@ var
MissingUnitsText: String;
i: Integer;
Msg: String;
CurDir: String;
ShortFilename: String;
s: string;
begin
Result:=LoadCodeBuffer(LazUnitCode,LazarusUnitFilename,
[lbfCheckIfText,lbfUpdateFromDisk]);
if Result<>mrOk then exit;
// fix include filenames
DebugLn('FixMissingUnits fixing include directives ...');
if not CodeToolBoss.FixIncludeFilenames(LazUnitCode,true)
then begin
LazarusIDE.DoJumpToCodeToolBossError;
exit(mrCancel);
end;
MissingUnits:=nil;
try
// find missing units
DebugLn('FixMissingUnits FindMissingUnits');
CTResult:=CodeToolBoss.FindMissingUnits(LazUnitCode,MissingUnits);
CTResult:=CodeToolBoss.FindMissingUnits(LazUnitCode,MissingUnits,true);
if not CTResult then begin
Result:=mrCancel;
exit;
end;
if (MissingUnits=nil) or (MissingUnits.Count=0) then begin
// no missing units -> good
Result:=mrOk;
exit;
end;
@ -295,15 +312,29 @@ begin
MissingUnitsText:=MissingUnitsText+MissingUnits[i];
end;
DebugLn('FixMissingUnits FindMissingUnits="',MissingUnitsText,'"');
// ask user if missing units should be commented
if MissingUnits.Count=1 then
Msg:=lisUnitNotFound
else
Msg:=lisUnitsNotFound2;
Result:=MessageDlg(Msg,
Msg:=Msg+' '+ExtractFileName(LazUnitCode.Filename);
// add error messages, so the user can click on them
ShortFilename:=ExtractFileName(LazUnitCode.Filename);
CurDir:=ExtractFilePath(LazUnitCode.Filename);
for i:=0 to MissingUnits.Count-1 do begin
s:=MissingUnits[i];
// TODO: add code position
IDEMessagesWindow.AddMsg(ShortFilename+'(1,1) Error: unit not found '+s,
CurDir,-1);
end;
// ask user, what to do
Result:=QuestionDlg(Msg,
Format(lisTheFollowingUnitsWereNotFound1EitherTheseUnitsAreN, [#13,
MissingUnitsText, #13, #13, #13, #13, #13, #13]),
mtConfirmation,[mbYes,mbAbort],0);
MissingUnitsText, #13, #13, #13]),
mtConfirmation,[mrYes,'Comment missing units',mrAbort],0);
if Result<>mrYes then exit;
// comment missing units
@ -336,9 +367,9 @@ begin
[lbfCheckIfText,lbfUpdateFromDisk]);
if Result<>mrOk then exit;
end else if LFMMustExist then begin
Result:=MessageDlg(lisLFMFileNotFound,
Result:=QuestionDlg(lisLFMFileNotFound,
Format(lisUnitLFMFile, [UnitFileName, #13, LFMFilename]),
mtError,[mbCancel,mbAbort],0);
mtError,[mrCancel,'Skip this step',mrAbort],0);
end;
end;
@ -356,9 +387,9 @@ end;
function CheckDelphiProjectExt(const Filename: string): TModalResult;
begin
if CompareFileExt(Filename,'.dpr',false)<>0 then begin
Result:=MessageDlg(lisNotADelphiProject,
Result:=QuestionDlg(lisNotADelphiProject,
Format(lisTheFileIsNotADelphiProjectDpr, ['"', Filename, '"']),
mtError,[mbCancel,mbAbort],0);
mtError,[mrCancel,'Skipt this step',mbAbort],0);
exit;
end;
Result:=mrOk;
@ -440,7 +471,7 @@ var
Pkg:=Pkgs[i];
DebugLn('ReadDelphiPackages Pkg=',Pkg);
AddPackageDependency(Pkg,'rtl,dbrtl','FCL');
AddPackageDependency(Pkg,'vcl;vcldb;vcldbx','LCL');
AProject.AddPackageDependency('LCL');
end;
end;

2
ide/dialogprocs.pas
View File

@ -81,7 +81,7 @@ function RenameFileWithErrorDialogs(const SrcFilename, DestFilename: string;
var
DlgButtons: TMsgDlgButtons;
begin
if CompareFilenames(SrcFilename,DestFilename)=0 then begin
if SrcFilename=DestFilename then begin
Result:=mrOk;
exit;
end;

8
ide/lazarusidestrconsts.pas
View File

@ -324,12 +324,8 @@ resourcestring
lisLFMFileNotFound = 'LFM file not found';
lisTheFollowingUnitsWereNotFound1EitherTheseUnitsAreN = 'The following '
+'units were not found:%s%s%s%s1) Either these units are not in the unit '
+'path, then you can abort now, fix the unit path and try again.%s2) Or '
+'the units came from a case insensitive file system (windows/Delphi) and '
+'are now on a case sensitive filesystem (linux, bsd, macosx). In this '
+'case you should abort now, rename the units all lowercase and try '
+'again.%s3) Or you can ignore the missing units and continue.%s%sShould '
+'the missing units be commented out?';
+'path, then you can abort now, fix the unit path and try again.%s'
+'2) Or you can ignore the missing units and comment them out.';
lisUnitNotFound = 'Unit not found';
lisUnitsNotFound2 = 'Units not found';
lisUnitLFMFile = 'Unit: %s%sLFM file: %s';

9
ide/main.pp
View File

@ -8109,7 +8109,7 @@ function TMainIDE.DoConvertDelphiUnit(const DelphiFilename: string
): TModalResult;
begin
InputHistories.LastConvertDelphiUnit:=DelphiFilename;
Result:=DelphiProject2Laz.ConvertDelphiToLazarusUnit(DelphiFilename);
Result:=DelphiProject2Laz.ConvertDelphiToLazarusUnit(DelphiFilename,false);
end;
function TMainIDE.DoConvertDelphiProject(const DelphiFilename: string
@ -10481,8 +10481,11 @@ begin
debugln('TMainIDE.BeginCodeTool impossible ',dbgs(ord(ToolStatus)));
exit;
end;
if (SourceNoteBook.NoteBook=nil) and (ctfSourceEditorNotNeeded in Flags) then
if (not (ctfSourceEditorNotNeeded in Flags)) and (SourceNoteBook.NoteBook=nil)
then begin
DebugLn('TMainIDE.BeginCodeTool no editor');
exit;
end;
// check source editor
if ctfSwitchToFormSource in Flags then
@ -10491,7 +10494,7 @@ begin
GetDesignerUnit(ADesigner,ActiveSrcEdit,ActiveUnitInfo)
else
GetCurrentUnit(ActiveSrcEdit,ActiveUnitInfo);
if (ctfSourceEditorNotNeeded in Flags)
if (not (ctfSourceEditorNotNeeded in Flags))
and ((ActiveSrcEdit=nil) or (ActiveUnitInfo=nil)) then exit;
// init codetools

2
lcl/include/treeview.inc
View File

@ -4266,7 +4266,7 @@ begin
Include(fStates,tvsWaitForDragging);
end;
end else
if (ssDouble in Shift) and (Button = mbLeft) then
if (ssDouble in Shift) and (Button = mbLeft) and (CursorNode<>nil) then
CursorNode.Expanded := not CursorNode.Expanded;
end;