From 82ebb637571b1f103d8edc94777738d52a41f36c Mon Sep 17 00:00:00 2001 From: mattias Date: Mon, 15 Jan 2007 14:54:08 +0000 Subject: [PATCH] IDE: checking lfm files now check used units first git-svn-id: trunk@10450 - --- components/codetools/codetoolmanager.pas | 7 +- components/codetools/stdcodetools.pas | 15 +++- ide/checklfmdlg.pas | 95 +++++++++++++++++++++++- ide/idetranslations.pas | 3 +- ide/main.pp | 1 + lcl/grids.pas | 2 +- lcl/lresources.pp | 5 ++ 7 files changed, 115 insertions(+), 13 deletions(-) diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 267e67b850..dd5ed49990 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -446,7 +446,7 @@ type function FindUsedUnitNames(Code: TCodeBuffer; var MainUsesSection, ImplementationUsesSection: TStrings): boolean; function FindMissingUnits(Code: TCodeBuffer; var MissingUnits: TStrings; - FixCase: boolean = false): boolean; + FixCase: boolean = false; SearchImplementation: boolean = true): boolean; function FindDelphiProjectUnits(Code: TCodeBuffer; var FoundInUnits, MissingInUnits, NormalUnits: TStrings): boolean; function FindDelphiPackageUnits(Code: TCodeBuffer; @@ -3033,7 +3033,8 @@ begin end; function TCodeToolManager.FindMissingUnits(Code: TCodeBuffer; - var MissingUnits: TStrings; FixCase: boolean): boolean; + var MissingUnits: TStrings; FixCase: boolean; + SearchImplementation: boolean): boolean; begin Result:=false; {$IFDEF CTDEBUG} @@ -3042,7 +3043,7 @@ begin if not InitCurCodeTool(Code) then exit; try Result:=FCurCodeTool.FindMissingUnits(MissingUnits,FixCase, - SourceChangeCache); + SearchImplementation,SourceChangeCache); except on e: Exception do Result:=HandleException(e); end; diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index 3cb763db31..664d4848eb 100644 --- a/components/codetools/stdcodetools.pas +++ b/components/codetools/stdcodetools.pas @@ -114,6 +114,7 @@ type function UsesSectionToFilenames(UsesNode: TCodeTreeNode): TStrings; function UsesSectionToUnitnames(UsesNode: TCodeTreeNode): TStrings; function FindMissingUnits(var MissingUnits: TStrings; FixCase: boolean; + SearchImplementation: boolean; SourceChangeCache: TSourceChangeCache): boolean; function CommentUnitsInUsesSections(MissingUnits: TStrings; SourceChangeCache: TSourceChangeCache): boolean; @@ -1120,7 +1121,8 @@ begin end; function TStandardCodeTool.FindMissingUnits(var MissingUnits: TStrings; - FixCase: boolean; SourceChangeCache: TSourceChangeCache): boolean; + FixCase: boolean; SearchImplementation: boolean; + SourceChangeCache: TSourceChangeCache): boolean; function CheckUsesSection(UsesNode: TCodeTreeNode): boolean; var @@ -1187,15 +1189,20 @@ function TStandardCodeTool.FindMissingUnits(var MissingUnits: TStrings; begin Result:=false; BuildTree(false); - SourceChangeCache.MainScanner:=Scanner; + if FixCase then + SourceChangeCache.MainScanner:=Scanner; try if not CheckUsesSection(FindMainUsesSection) then exit; - if not CheckUsesSection(FindImplementationUsesSection) then exit; + if SearchImplementation + and not CheckUsesSection(FindImplementationUsesSection) then exit; except FreeAndNil(MissingUnits); raise; end; - Result:=SourceChangeCache.Apply; + if FixCase then + Result:=SourceChangeCache.Apply + else + Result:=true; end; function TStandardCodeTool.CommentUnitsInUsesSections(MissingUnits: TStrings; diff --git a/ide/checklfmdlg.pas b/ide/checklfmdlg.pas index 224f026eef..4aaf34e194 100644 --- a/ide/checklfmdlg.pas +++ b/ide/checklfmdlg.pas @@ -107,6 +107,32 @@ function CheckLFMBuffer(PascalBuffer, LFMBuffer: TCodeBuffer; var LFMTree: TLFMTree; + procedure WriteUnitError(Code: TCodeBuffer; x, Y: integer; + const ErrorMessage: string); + var + Dir: String; + Filename: String; + Msg: String; + begin + if not Assigned(OnOutput) then exit; + if Code=nil then + Code:=PascalBuffer; + Dir:=ExtractFilePath(Code.Filename); + Filename:=ExtractFilename(Code.Filename); + Msg:=Filename + +'('+IntToStr(Y)+','+IntToStr(X)+')' + +' Error: ' + +ErrorMessage; + debugln('WriteLFMErrors ',Msg); + OnOutput(Msg,Dir,-1); + end; + + procedure WriteCodeToolsError; + begin + WriteUnitError(CodeToolBoss.ErrorCode,CodeToolBoss.ErrorColumn, + CodeToolBoss.ErrorLine,CodeToolBoss.ErrorMessage); + end; + procedure WriteLFMErrors; var CurError: TLFMError; @@ -138,6 +164,7 @@ var RegComp: TRegisteredComponent; i: Integer; begin + DebugLn(['FixMissingComponentClasses ',LFMBuffer.Filename]); Result:=mrCancel; MissingObjectTypes:=TStringList.Create; try @@ -151,6 +178,7 @@ var end; CurError:=CurError.NextError; end; + DebugLn(['FixMissingComponentClasses Missing object types in unit: ',MissingObjectTypes.Text]); // keep all object types with a registered component class for i:=MissingObjectTypes.Count-1 downto 0 do begin @@ -159,36 +187,93 @@ var MissingObjectTypes.Delete(i); end; if MissingObjectTypes.Count=0 then exit; - + DebugLn(['FixMissingComponentClasses Missing object types, but luckily found in IDE: ',MissingObjectTypes.Text]); + // there are missing object types with registered component classes Result:=PackageEditingInterface.AddUnitDependenciesForComponentClasses( PascalBuffer.Filename,MissingObjectTypes); - if Result<>mrOk then exit; + if Result<>mrOk then begin + DebugLn(['FixMissingComponentClasses Failed to add dependencies for ',MissingObjectTypes.Text]); + exit; + end; // check LFM again LFMTree.Free; LFMTree:=nil; if CodeToolBoss.CheckLFM(PascalBuffer,LFMBuffer,LFMTree, RootMustBeClassInIntf,ObjectsMustExists) - then + then begin + DebugLn(['FixMissingComponentClasses Success: All found errors fixed']); Result:=mrOk; + end else begin + Result:=mrCancel; + end; finally MissingObjectTypes.Free; end; end; + function CheckUnit: boolean; + var + NewCode: TCodeBuffer; + NewX, NewY, NewTopLine: integer; + ErrorMsg: string; + MissingUnits: TStrings; + s: String; + begin + Result:=false; + // check syntax + DebugLn(['CheckUnit Checking syntax ...']); + if not CodeToolBoss.CheckSyntax(PascalBuffer,NewCode,NewX,NewY,NewTopLine, + ErrorMsg) + then begin + WriteUnitError(NewCode,NewX,NewY,ErrorMsg); + exit; + end; + // check used units + MissingUnits:=nil; + try + DebugLn(['CheckUnit Checking used units ...']); + if not CodeToolBoss.FindMissingUnits(PascalBuffer,MissingUnits,false, + false) + then begin + WriteCodeToolsError; + exit; + end; + if (MissingUnits<>nil) and (MissingUnits.Count>0) then begin + s:=StringListToText(MissingUnits,','); + WriteUnitError(PascalBuffer,1,1,'Units not found: '+s); + exit; + end; + finally + MissingUnits.Free; + end; + if NewTopLine=0 then ; + Result:=true; + end; + begin Result:=mrCancel; + + if not CheckUnit then begin + DebugLn(['CheckLFMBuffer failed parsing unit: ',PascalBuffer.Filename]); + exit; + end; + LFMTree:=nil; try if CodeToolBoss.CheckLFM(PascalBuffer,LFMBuffer,LFMTree, RootMustBeClassInIntf,ObjectsMustExists) then begin + DebugLn(['CheckLFMBuffer no errors found']); Result:=mrOk; exit; end; Result:=FixMissingComponentClasses; - if Result in [mrAbort,mrOk] then exit; + if Result in [mrAbort,mrOk] then begin + DebugLn(['CheckLFMBuffer all errors fixed']); + exit; + end; WriteLFMErrors; Result:=ShowRepairLFMWizard(LFMBuffer,LFMTree); finally @@ -220,11 +305,13 @@ var CheckLFMDialog: TCheckLFMDialog; begin Result:=mrCancel; + DebugLn(['ShowRepairLFMWizard START']); CheckLFMDialog:=TCheckLFMDialog.Create(nil); CheckLFMDialog.LFMTree:=LFMTree; CheckLFMDialog.LFMSource:=LFMBuffer; CheckLFMDialog.LoadLFM; Result:=CheckLFMDialog.ShowModal; + DebugLn(['ShowRepairLFMWizard END']); CheckLFMDialog.Free; end; diff --git a/ide/idetranslations.pas b/ide/idetranslations.pas index 5987b9b660..0ea9b7ff3f 100644 --- a/ide/idetranslations.pas +++ b/ide/idetranslations.pas @@ -366,7 +366,8 @@ begin e:=LineEnding; NewContent:=TMemoryStream.Create; - // write header + // write header - needed by editors like poedit so they know what encoding + // to create WriteLine('msgid ""'); WriteLine('msgstr ""'); WriteLine('"MIME-Version: 1.0\n"'); diff --git a/ide/main.pp b/ide/main.pp index a6bc4d08ec..56b4dc6e52 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -8792,6 +8792,7 @@ begin end; if ToolStatus<>itNone then begin + DebugLn(['TMainIDE.DoCheckLFMInEditor ToolStatus<>itNone']); Result:=mrCancel; exit; end; diff --git a/lcl/grids.pas b/lcl/grids.pas index 692e0ecf2c..53cc84d5af 100644 --- a/lcl/grids.pas +++ b/lcl/grids.pas @@ -4489,7 +4489,7 @@ end; procedure TCustomGrid.DoEditorShow; begin - DebugLn(['TCustomGrid.DoEditorShow ']); + //DebugLn(['TCustomGrid.DoEditorShow ']); {$ifdef dbgGrid}DebugLn('grid.DoEditorShow INIT');{$endif} ScrollToCell(FCol,FRow); Editor.Parent := nil; diff --git a/lcl/lresources.pp b/lcl/lresources.pp index 125ea9bf9b..044a5578ce 100644 --- a/lcl/lresources.pp +++ b/lcl/lresources.pp @@ -2497,6 +2497,11 @@ var end; parser.NextToken; parser.CheckToken(toSymbol); + if parser.TokenSymbolIs('END') then begin + // 'object end': no name, no content + // this is normally invalid, but Delphi can create this, so ignore it + exit; + end; ObjectName := ''; ObjectType := parser.TokenString; parser.NextToken;