IDE: added quick fix for fpc warning constructing a class with abstract methods

git-svn-id: trunk@13218 -

components/codetools/codetoolmanager.pas

@@ -360,6 +360,10 @@ type
     function FindDeclaration(Code: TCodeBuffer; X,Y: integer;
           out NewCode: TCodeBuffer;
           out NewX, NewY, NewTopLine: integer): boolean;
+    function FindDeclarationOfIdentifier(Code: TCodeBuffer; X,Y: integer;
+          Identifier: PChar;
+          out NewCode: TCodeBuffer;
+          out NewX, NewY, NewTopLine: integer): boolean;
     function FindSmartHint(Code: TCodeBuffer; X,Y: integer): string;
     function FindDeclarationInInterface(Code: TCodeBuffer;
           const Identifier: string; out NewCode: TCodeBuffer;
@@ -1682,7 +1686,7 @@ var
 begin
   Result:=false;
   {$IFDEF CTDEBUG}
-  DebugLn('TCodeToolManager.FindDeclaration A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
+  DebugLn(['TCodeToolManager.FindDeclaration A ',Code.Filename,' x=',x,' y=',y]);
   {$ENDIF}
   if not InitCurCodeTool(Code) then exit;
   CursorPos.X:=X;
@@ -1716,6 +1720,49 @@ begin
   {$ENDIF}
 end;
 
+function TCodeToolManager.FindDeclarationOfIdentifier(Code: TCodeBuffer;
+  X,Y: integer; Identifier: PChar; out NewCode: TCodeBuffer; out NewX, NewY,
+  NewTopLine: integer): boolean;
+var
+  CursorPos: TCodeXYPosition;
+  NewPos: TCodeXYPosition;
+begin
+  Result:=false;
+  {$IFDEF CTDEBUG}
+  DebugLn('TCodeToolManager.FindDeclarationOfIdentifier A ',Code.Filename,' x=',x,' y=',y,' Identifier=',GetIdentifier(Identifier));
+  {$ENDIF}
+  if not InitCurCodeTool(Code) then exit;
+  CursorPos.X:=X;
+  CursorPos.Y:=Y;
+  CursorPos.Code:=Code;
+  {$IFDEF CTDEBUG}
+  DebugLn('TCodeToolManager.FindDeclarationOfIdentifier B ',dbgs(FCurCodeTool.Scanner<>nil));
+  {$ENDIF}
+  try
+    {$IFDEF DoNotHandleFindDeclException}
+    DebugLn('TCodeToolManager.FindDeclarationOfIdentifier NOT HANDLING EXCEPTIONS');
+    RaiseUnhandableExceptions:=true;
+    {$ENDIF}
+    Result:=FCurCodeTool.FindDeclarationOfIdentifier(CursorPos,Identifier,NewPos,NewTopLine);
+    if Result then begin
+      NewX:=NewPos.X;
+      NewY:=NewPos.Y;
+      NewCode:=NewPos.Code;
+    end;
+  {$IFDEF DoNotHandleFindDeclException}
+  finally
+    RaiseUnhandableExceptions:=false;
+  end;
+  {$ELSE}
+  except
+    on e: Exception do Result:=HandleException(e);
+  end;
+  {$ENDIF}
+  {$IFDEF CTDEBUG}
+  DebugLn('TCodeToolManager.FindDeclarationOfIdentifier END ');
+  {$ENDIF}
+end;
+
 function TCodeToolManager.FindSmartHint(Code: TCodeBuffer; X, Y: integer
   ): string;
 var

components/codetools/finddeclarationtool.pas

@@ -497,6 +497,7 @@ type
     procedure ChangeFoundProc(const ProcContext: TFindContext;
                               ProcCompatibility: TTypeCompatibility;
                               ParamCompatibilityList: TTypeCompatibilityList);
+    procedure PrettifyResult;
     procedure ConvertResultCleanPosToCaretPos;
     procedure ClearResult(CopyCacheFlags: boolean);
     procedure ClearInput;
@@ -696,6 +697,9 @@ type
       var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
     function FindMainDeclaration(const CursorPos: TCodeXYPosition;
       var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
+    function FindDeclarationOfIdentifier(const CursorPos: TCodeXYPosition;
+      Identifier: PChar;
+      var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
     function FindDeclaration(const CursorPos: TCodeXYPosition;
       SearchSmartFlags: TFindSmartFlags;
       var NewTool: TFindDeclarationTool; var NewNode: TCodeTreeNode;
@@ -1111,6 +1115,51 @@ begin
                           NewPos,NewTopLine);
 end;
 
+function TFindDeclarationTool.FindDeclarationOfIdentifier(
+  const CursorPos: TCodeXYPosition; Identifier: PChar;
+  var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
+var
+  CleanCursorPos: integer;
+  CursorNode: TCodeTreeNode;
+  Params: TFindDeclarationParams;
+begin
+  Result:=false;
+  ActivateGlobalWriteLock;
+  Params:=nil;
+  try
+    // build code tree
+    {$IFDEF CTDEBUG}
+    DebugLn('TFindDeclarationTool.FindDeclarationOfIdentifier A CursorPos=X',dbgs(CursorPos.X),',Y',dbgs(CursorPos.Y));
+    {$ENDIF}
+    if DirtySrc<>nil then DirtySrc.Clear;
+    BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
+                  [{$IFNDEF DisableIgnoreErrorAfter}btSetIgnoreErrorPos{$ENDIF}]);
+    {$IFDEF CTDEBUG}
+    DebugLn('TFindDeclarationTool.FindDeclarationOfIdentifier B CleanCursorPos=',dbgs(CleanCursorPos));
+    {$ENDIF}
+    // find CodeTreeNode at cursor
+    CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(Tree.Root,CleanCursorPos,true);
+    // search
+    Params:=TFindDeclarationParams.Create;
+    Params.ContextNode:=CursorNode;
+    Params.SetIdentifier(Self,Identifier,nil);
+    Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound,
+                   fdfExceptionOnPredefinedIdent,
+                   fdfTopLvlResolving,fdfSearchInAncestors,
+                   fdfIgnoreCurContextNode];
+    FindIdentifierInContext(Params);
+    // convert result to nice source position
+    Params.PrettifyResult;
+    Params.ConvertResultCleanPosToCaretPos;
+    NewPos:=Params.NewPos;
+    NewTopLine:=Params.NewTopLine;
+    Result:=true;
+  finally
+    Params.Free;
+    DeactivateGlobalWriteLock;
+  end;
+end;
+
 function TFindDeclarationTool.FindDeclaration(const CursorPos: TCodeXYPosition;
   SearchSmartFlags: TFindSmartFlags;
   var NewTool: TFindDeclarationTool; var NewNode: TCodeTreeNode;
@@ -1350,27 +1399,7 @@ begin
           Result:=FindIdentifierInContext(Params);
         end;
         if Result then begin
-        
-          // adjust result for nicer position
-          NewNode:=Params.NewNode;
-          if (NewNode<>nil) then begin
-            if (NewNode.Desc=ctnProcedure)
-            and (NewNode.FirstChild<>nil)
-            and (NewNode.FirstChild.Desc=ctnProcedureHead) then begin
-              // Instead of jumping to the procedure keyword,
-              // jump to the procedure name
-              Params.NewNode:=NewNode.FirstChild;
-              Params.NewCleanPos:=Params.NewNode.StartPos;
-            end;
-            if (NewNode.Desc=ctnGenericType)
-            and (NewNode.FirstChild<>nil) then begin
-              // Instead of jumping to the generic keyword,
-              // jump to the name
-              Params.NewNode:=NewNode.FirstChild;
-              Params.NewCleanPos:=Params.NewNode.StartPos;
-            end;
-          end;
-            
+          Params.PrettifyResult;
           Params.ConvertResultCleanPosToCaretPos;
           NewNode:=Params.NewNode;
           NewTool:=Params.NewCodeTool;
@@ -8240,6 +8269,28 @@ begin
   end;
 end;
 
+procedure TFindDeclarationParams.PrettifyResult;
+begin
+  // adjust result for nicer position
+  if (NewNode<>nil) then begin
+    if (NewNode.Desc=ctnProcedure)
+    and (NewNode.FirstChild<>nil)
+    and (NewNode.FirstChild.Desc=ctnProcedureHead) then begin
+      // Instead of jumping to the procedure keyword,
+      // jump to the procedure name
+      NewNode:=NewNode.FirstChild;
+      NewCleanPos:=NewNode.StartPos;
+    end;
+    if (NewNode.Desc=ctnGenericType)
+    and (NewNode.FirstChild<>nil) then begin
+      // Instead of jumping to the generic keyword,
+      // jump to the name
+      NewNode:=NewNode.FirstChild;
+      NewCleanPos:=NewNode.StartPos;
+    end;
+  end;
+end;
+
 procedure TFindDeclarationParams.SetResult(
   NodeCacheEntry: PCodeTreeNodeCacheEntry);
 begin

ide/abstractsmethodsdlg.pas

@@ -265,7 +265,7 @@ begin
       DebugLn(['TAbstractMethodsDialog.AddOverrides ',Item.CodeXYPos.Code.Filename,' ',Item.CodeXYPos.X,',',Item.CodeXYPos.Y]);
       if OnlyFirst then break;
     end;
-
+    
     //DebugLn(['TAbstractMethodsDialog.AddOverrides ',CodePos.Code.Filename,' ',CodePos.X,',',CodePos.Y]);
     if not CodeToolBoss.AddMethods(CodePos.Code,CodePos.X,CodePos.Y,TopLine,
       NewList,true,NewCode,NewX,NewY,NewTopLine)
@@ -361,7 +361,8 @@ begin
       phpWithDefaultValues,phpWithResultType,
       phpWithOfObject,phpWithCallingSpecs]);
     NewItem.BelongsToStartClass:=ProcNode.HasAsParent(ClassNode);
-    inc(BelongsToStartClassCnt);
+    if NewItem.BelongsToStartClass then
+      inc(BelongsToStartClassCnt);
     FItems.Add(NewItem);
   end;
   

ide/msgquickfixes.pas

@@ -30,8 +30,10 @@ unit MsgQuickFixes;
 interface
 
 uses
-  Classes, SysUtils, Dialogs, FileUtil, LCLProc, IDEMsgIntf, TextTools,
-  LazarusIDEStrConsts, ProjectIntf, LazIDEIntf, CodeCache, CodeToolManager;
+  Classes, SysUtils, LCLProc, Controls, Dialogs, FileUtil,
+  CodeAtom, CodeCache, CodeToolManager,
+  IDEMsgIntf, TextTools, ProjectIntf, LazIDEIntf,
+  AbstractsMethodsDlg, LazarusIDEStrConsts;
   
 type
 
@@ -52,6 +54,17 @@ type
     procedure Execute(const Msg: TIDEMessageLine; Step: TIMQuickFixStep); override;
   end;
 
+  { TQuickFixClassWithAbstractMethods
+    Quick fix for example:
+    Warning: Constructing a class "TClassA" with abstract methods }
+
+  TQuickFixClassWithAbstractMethods = class(TIDEMsgQuickFixItem)
+  public
+    constructor Create;
+    function IsApplicable(Line: TIDEMessageLine): boolean; override;
+    procedure Execute(const Msg: TIDEMessageLine; Step: TIMQuickFixStep); override;
+  end;
+
 procedure QuickFixParameterNotUsed(Sender: TObject; Step: TIMQuickFixStep;
                                    Msg: TIDEMessageLine);
 procedure QuickFixUnitNotUsed(Sender: TObject; Step: TIMQuickFixStep;
@@ -123,7 +136,10 @@ begin
   TestDir:=LazarusIDE.GetTestBuildDirectory;
   if (TestDir<>'') or (FileIsInDirectory(Filename,TestDir)) then
     Filename:=ExtractFileName(Filename);
+  if not FilenameIsAbsolute(Filename) then
+    Filename:=AppendPathDelim(Msg.Directory)+Filename;
   //DebugLn('GetMsgLineFilename Filename=',Filename,' ',Msg.Parts.Text);
+
   CodeBuf:=CodeToolBoss.LoadFile(Filename,false,false);
   if CodeBuf=nil then begin
     DebugLn('GetMsgLineFilename Filename "',Filename,'" not found.');
@@ -141,8 +157,10 @@ begin
   RegisterIDEMsgQuickFix('Unit xxx not used in yyy','Quick fix: Remove unit',
     'Unit "[a-z_0-9]+" not used in [a-z_0-9]+',[imqfoMenuItem],
     nil,@QuickFixUnitNotUsed);
+    
   RegisterIDEMsgQuickFix(TQuickFixUnitNotFoundPosition.Create);
   RegisterIDEMsgQuickFix(TQuickFixLinkerUndefinedReference.Create);
+  RegisterIDEMsgQuickFix(TQuickFixClassWithAbstractMethods.Create);
 end;
 
 procedure FreeStandardIDEQuickFixItems;
@@ -154,7 +172,7 @@ end;
 
 constructor TQuickFixUnitNotFoundPosition.Create;
 begin
-  Name:='Fatal: Can''t find unit xxx';
+  Name:='Improve error position of: Fatal: Can''t find unit xxx';
   Steps:=[imqfoImproveMessage];
 end;
 
@@ -336,5 +354,87 @@ begin
   end;
 end;
 
+{ TQuickFixClassWithAbstractMethods }
+
+constructor TQuickFixClassWithAbstractMethods.Create;
+begin
+  Name:='Show abstract methods';
+  Steps:=[imqfoMenuItem];
+end;
+
+function TQuickFixClassWithAbstractMethods.IsApplicable(Line: TIDEMessageLine
+  ): boolean;
+begin
+  Result:=(Line.Parts<>nil)
+          and (System.Pos(') Warning: Constructing a class "',Line.Msg)>0)
+          and (System.Pos('" with abstract methods',Line.Msg)>0);
+end;
+
+procedure TQuickFixClassWithAbstractMethods.Execute(const Msg: TIDEMessageLine;
+  Step: TIMQuickFixStep);
+var
+  CodeBuf: TCodeBuffer;
+  Caret: TPoint;
+  Filename: string;
+  NewCode: TCodeBuffer;
+  NewX,NewY,NewTopLine: Integer;
+  Tool: TCodeTool;
+  CurClassName: String;
+begin
+  if Step=imqfoMenuItem then begin
+    DebugLn(['TQuickFixClassWithAbstractMethods.Execute ']);
+    // get source position
+    // (FPC reports position right after the constructor call
+    //  for example right after TStrings.Create)
+    if not GetMsgLineFilename(Msg,CodeBuf) then exit;
+    Msg.GetSourcePosition(Filename,Caret.Y,Caret.X);
+    if not LazarusIDE.BeginCodeTools then begin
+      DebugLn(['TQuickFixClassWithAbstractMethods.Execute failed because IDE busy']);
+      exit;
+    end;
+
+    // get class name
+    if not REMatches(Msg.Msg,'Warning: Constructing a class "([a-z_0-9]+)"','I') then begin
+      DebugLn('QuickFixClassWithAbstractMethods invalid message ',Msg.Msg);
+      exit;
+    end;
+    CurClassName:=REVar(1);
+    DebugLn(['TQuickFixClassWithAbstractMethods.Execute Class=',CurClassName]);
+
+    // find the class
+
+    // build the tree
+    CodeToolBoss.Explore(CodeBuf,Tool,false,true);
+    if Tool=nil then begin
+      DebugLn(['TQuickFixClassWithAbstractMethods.Execute no tool for ',CodeBuf.Filename]);
+      exit;
+    end;
+
+    if not CodeToolBoss.FindDeclarationOfIdentifier(CodeBuf,Caret.X,Caret.Y,
+      @CurClassName[1],NewCode,NewX,NewY,NewTopLine)
+    then begin
+      if CodeToolBoss.ErrorMessage<>'' then begin
+        LazarusIDE.DoJumpToCodeToolBossError
+      end else begin
+        MessageDlg('Class not found',
+          'Class '+CurClassName+' not found at '
+          +CodeBuf.Filename+'('+IntToStr(Caret.Y)+','+IntToStr(Caret.X)+')',
+          mtError,[mbCancel],0);
+      end;
+      exit;
+    end;
+    DebugLn(['TQuickFixClassWithAbstractMethods.Execute Declaration at ',NewCode.Filename,' ',NewX,',',NewY]);
+
+    if LazarusIDE.DoOpenFileAndJumpToPos(NewCode.Filename,
+      Point(NewX,NewY),NewTopLine,-1,[])<>mrOk
+    then begin
+      DebugLn(['TQuickFixClassWithAbstractMethods.Execute failed opening ',NewCode.Filename]);
+      exit;
+    end;
+
+    ShowAbstractMethodsDialog;
+  end;
+end;
+
 end.