IDE: checking lfm files now check used units first

git-svn-id: trunk@10450 -

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;

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;

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;
 

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"');

ide/main.pp

@@ -8792,6 +8792,7 @@ begin
   end;
 
   if ToolStatus<>itNone then begin
+    DebugLn(['TMainIDE.DoCheckLFMInEditor ToolStatus<>itNone']);
     Result:=mrCancel;
     exit;
   end;

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;

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;