IDE: further migration external tools

git-svn-id: trunk@42423 -

components/ideintf/ideexterntoolintf.pas

@@ -253,6 +253,7 @@ type
     class function IsSubTool(const SubTool: string): boolean; virtual;
     class function GetMsgExample({%H-}SubTool: string; {%H-}MsgID: integer): string; virtual;
     class function GetMsgHint({%H-}SubTool: string; {%H-}MsgID: integer): string; virtual;
+    class function GetMsgParser(Msg: TMessageLine; ParserClass: TClass): TExtToolParser;
     class function DefaultSubTool: string; virtual; abstract;
     class function Priority: integer; virtual; // higher comes first
   end;
@@ -261,6 +262,11 @@ type
   { TFPCParser - standard parser for Free Pascal messages, implemented by IDE }
 
   TFPCParser = class(TExtToolParser)
+  public
+    class function GetFPCParser(Msg: TMessageLine): TFPCParser;
+    function GetFPCMsgIDPattern(MsgID: integer): string; virtual; abstract;
+    class function GetFPCMsgPattern(Msg: TMessageLine): string; virtual; abstract;
+    class function GetFPCMsgValue1(Msg: TMessageLine): string; virtual; abstract;
   end;
 
   { TMakeParser - standard parser for 'make' messages, implemented by IDE }
@@ -463,6 +469,7 @@ type
     procedure RemoveParser(Parser: TExtToolParser); // disconnect without free
     function IndexOfParser(Parser: TExtToolParser): integer;
     procedure ClearParsers(Delete: boolean = true);
+    function FindParser(aParserClass: TExtToolParserClass): TExtToolParser;
 
     // viewers
     function ViewCount: integer;
@@ -530,6 +537,7 @@ type
     property Parsers[Index: integer]: TExtToolParserClass read GetParsers; // (main thread)
     function GetMsgExample(SubTool: string; MsgID: integer): string; virtual; // (main thread)
     function GetMsgHint(SubTool: string; MsgID: integer): string; virtual; // (main thread)
+    function GetMsgTool(Msg: TMessageLine): TAbstractExternalTool; virtual; abstract;
   end;
 
 var
@@ -640,6 +648,13 @@ begin
   WriteStr(Result,s);
 end;
 
+{ TFPCParser }
+
+class function TFPCParser.GetFPCParser(Msg: TMessageLine): TFPCParser;
+begin
+  Result:=TFPCParser(GetMsgParser(Msg,TFPCParser));
+end;
+
 { TIDEExternalToolOptions }
 
 procedure TIDEExternalToolOptions.SetEnvironmentOverrides(AValue: TStringList);
@@ -1109,6 +1124,18 @@ begin
       RemoveParser(Parsers[ParserCount-1]);
 end;
 
+function TAbstractExternalTool.FindParser(aParserClass: TExtToolParserClass
+  ): TExtToolParser;
+var
+  i: Integer;
+begin
+  for i:=0 to ParserCount-1 do begin
+    Result:=Parsers[i];
+    if Result.InheritsFrom(aParserClass) then exit;
+  end;
+  Result:=nil;
+end;
+
 function TAbstractExternalTool.ViewCount: integer;
 begin
   Result:=FViews.Count;
@@ -1239,6 +1266,18 @@ begin
   Result:='';
 end;
 
+class function TExtToolParser.GetMsgParser(Msg: TMessageLine;
+  ParserClass: TClass): TExtToolParser;
+var
+  aTool: TAbstractExternalTool;
+begin
+  Result:=nil;
+  if ExternalToolList=nil then exit;
+  aTool:=ExternalToolList.GetMsgTool(Msg);
+  if aTool=nil then exit;
+  Result:=aTool.FindParser(TExtToolParserClass(ParserClass));
+end;
+
 class function TExtToolParser.Priority: integer;
 begin
   Result:=0;

components/ideintf/idemsgintf.pas

@@ -30,7 +30,7 @@ type
   public
     procedure CreateMenuItems(Fixes: TMsgQuickFixes); virtual;
     procedure JumpTo({%H-}Msg: TMessageLine; var {%H-}Handled: boolean); virtual; // called when user (double) clicks on message
-    procedure QuickFix(Fixes: TMsgQuickFixes; Msg: TMessageLine); virtual;
+    procedure QuickFix(Fixes: TMsgQuickFixes; Msg: TMessageLine); virtual; // Msg=nil means fix all Fixes.Lines
   end;
   TMsgQuickFixClass = class of TMsgQuickFix;
 

ide/etfpcmsgparser.pas

@@ -143,6 +143,7 @@ type
     procedure ReadLine(Line: string; OutputIndex: integer; var Handled: boolean); override;
     function LongenFilename(aFilename: string): string;
     procedure ImproveMessages(aSynchronized: boolean); override;
+    function GetFPCMsgIDPattern(MsgID: integer): string; override;
     class function IsSubTool(const SubTool: string): boolean; override;
     class function DefaultSubTool: string; override;
     class function GetMsgExample(SubTool: string; MsgID: integer): string;
@@ -150,6 +151,8 @@ type
     class function GetMsgHint(SubTool: string; MsgID: integer): string;
       override;
     class function Priority: integer; override;
+    class function GetFPCMsgPattern(Msg: TMessageLine): string; override;
+    class function GetFPCMsgValue1(Msg: TMessageLine): string; override;
   end;
 
 var
@@ -1699,6 +1702,38 @@ begin
   Result:=SubToolFPCPriority;
 end;
 
+function TIDEFPCParser.GetFPCMsgIDPattern(MsgID: integer): string;
+var
+  MsgItem: TFPCMsgItem;
+begin
+  Result:='';
+  if MsgID<=0 then exit;
+  if MsgFile=nil then exit;
+  MsgItem:=MsgFile.GetMsg(MsgID);
+  if MsgItem=nil then exit;
+  Result:=MsgItem.Pattern;
+end;
+
+class function TIDEFPCParser.GetFPCMsgPattern(Msg: TMessageLine): string;
+var
+  aFPCParser: TFPCParser;
+begin
+  Result:='';
+  if Msg.MsgID<=0 then exit;
+  aFPCParser:=GetFPCParser(Msg);
+  if aFPCParser=nil then exit;
+  Result:=aFPCParser.GetFPCMsgIDPattern(Msg.MsgID);
+end;
+
+class function TIDEFPCParser.GetFPCMsgValue1(Msg: TMessageLine): string;
+begin
+  Result:='';
+  if Msg.MsgID<=0 then exit;
+  if Msg.SubTool<>SubToolFPC then exit;
+  if not etFPCMsgParser.GetFPCMsgValue1(Msg.Msg,GetFPCMsgPattern(Msg),Result) then
+    Result:='';
+end;
+
 finalization
   FreeAndNil(FPCMsgFilePool)
 

ide/etquickfixes.pas

@@ -30,12 +30,13 @@ unit etQuickFixes;
 interface
 
 uses
-  Classes, SysUtils, IDEExternToolIntf, IDEMsgIntf, Menus, CodeToolManager,
+  Classes, SysUtils, IDEExternToolIntf, IDEMsgIntf, LazIDEIntf, IDEDialogs,
-  CodeCache, LazLogger, AvgLvlTree, LazFileUtils;
+  Menus, Dialogs, etFPCMsgParser, CodeToolManager, CodeCache, CodeTree,
+  CodeAtom, BasicCodeTools, LazLogger, AvgLvlTree, LazFileUtils;
 
 type
 
-  { TQuickFix_Hide }
+  { TQuickFix_Hide - hide via IDE directive %H- }
 
   TQuickFix_Hide = class(TMsgQuickFix)
   public
@@ -44,6 +45,15 @@ type
     procedure QuickFix(Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
   end;
 
+  { TQuickFixIdentifierNotFoundAddLocal }
+
+  TQuickFixIdentifierNotFoundAddLocal = class(TMsgQuickFix)
+  public
+    function IsApplicable(Msg: TMessageLine): boolean;
+    procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
+    procedure QuickFix(Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
+  end;
+
   { TIDEQuickFixes }
 
   TIDEQuickFixes = class(TMsgQuickFixes)
@@ -77,6 +87,129 @@ type
     Msg: TMessageLine;
   end;
 
+procedure ShowError(Msg: string);
+begin
+  IDEMessageDialog('QuickFix error',Msg,mtError,[mbCancel]);
+end;
+
+function IsIdentifierInCode(Code: TCodeBuffer; X,Y: integer;
+  Identifier, ErrorMsg: string): boolean;
+var
+  p: integer;
+  IdentStart: integer;
+  IdentEnd: integer;
+begin
+  Result:=false;
+  if Code=nil then begin
+    ShowError(ErrorMsg+' (Code=nil)');
+    exit;
+  end;
+  Code.LineColToPosition(Y,X,p);
+  if p<1 then begin
+    ShowError(ErrorMsg+' (position outside of source');
+    exit;
+  end;
+  GetIdentStartEndAtPosition(Code.Source,p,IdentStart,IdentEnd);
+  if SysUtils.CompareText(Identifier,copy(Code.Source,IdentStart,IdentEnd-IdentStart))<>0
+  then begin
+    ShowError(ErrorMsg);
+    exit;
+  end;
+  Result:=true;
+end;
+
+{ TQuickFixIdentifierNotFoundAddLocal }
+
+function TQuickFixIdentifierNotFoundAddLocal.IsApplicable(Msg: TMessageLine
+  ): boolean;
+var
+  Code: TCodeBuffer;
+  Tool: TCodeTool;
+  CleanPos: integer;
+  Node: TCodeTreeNode;
+  Identifier: String;
+begin
+  Result:=false;
+  if (Msg.SubTool<>SubToolFPC)
+  or (Msg.MsgID<>5000) // identifier not found "$1"
+  or (not Msg.HasSourcePosition)
+  then exit;
+  Identifier:=TFPCParser.GetFPCMsgValue1(Msg);
+  if not IsValidIdent(Identifier) then exit;
+
+  // check if message position is at end of identifier
+  // (FPC gives position of end of identifier)
+  Code:=CodeToolBoss.LoadFile(Msg.GetFullFilename,true,false);
+  if Code=nil then exit;
+  if not CodeToolBoss.Explore(Code,Tool,false) then exit;
+  if Tool.CaretToCleanPos(CodeXYPosition(Msg.Column,Msg.Line,Code),CleanPos)<>0 then exit;
+  Node:=Tool.FindDeepestNodeAtPos(CleanPos,false);
+  if Node=nil then exit;
+  if not (Node.Desc in AllPascalStatements) then exit;
+  Tool.MoveCursorToCleanPos(CleanPos);
+  Tool.ReadPriorAtom;
+  if not Tool.AtomIs(Identifier) then exit;
+  Tool.ReadPriorAtom;
+  if (Tool.CurPos.Flag in [cafPoint,cafRoundBracketClose,cafEdgedBracketClose,
+                           cafEnd])
+  then exit;
+  Result:=true;
+end;
+
+procedure TQuickFixIdentifierNotFoundAddLocal.CreateMenuItems(
+  Fixes: TMsgQuickFixes);
+var
+  Msg: TMessageLine;
+  Identifier: String;
+begin
+  if Fixes.LineCount<>1 then exit;
+  Msg:=Fixes.Lines[0];
+  if not IsApplicable(Msg) then exit;
+  Identifier:=TFPCParser.GetFPCMsgValue1(Msg);
+  if Identifier='' then exit;
+  Fixes.AddMenuItem(Self,Msg,'Create local variable "'+Identifier+'"');
+  // ToDo: add private/public variable
+end;
+
+procedure TQuickFixIdentifierNotFoundAddLocal.QuickFix(Fixes: TMsgQuickFixes;
+  Msg: TMessageLine);
+var
+  Identifier: String;
+  Code: TCodeBuffer;
+  NewCode: TCodeBuffer;
+  NewX: integer;
+  NewY: integer;
+  NewTopLine: integer;
+begin
+  if Msg=nil then exit;
+  Identifier:=TFPCParser.GetFPCMsgValue1(Msg);
+  if Identifier='' then exit;
+
+  if not LazarusIDE.BeginCodeTools then begin
+    DebugLn(['TQuickFixIdentifierNotFoundAddLocal.Execute failed because IDE busy']);
+    exit;
+  end;
+
+  Code:=CodeToolBoss.LoadFile(Msg.GetFullFilename,true,false);
+  if Code=nil then exit;
+
+  if not IsIdentifierInCode(Code,Msg.Column,Msg.Line,Identifier,
+    Identifier+' not found in '+Code.Filename
+       +' at line '+IntToStr(Msg.Line)+', column '+IntToStr(Msg.Column)+'.'
+       +LineEnding+'Maybe the message is outdated.')
+  then exit;
+
+  if not CodeToolBoss.CreateVariableForIdentifier(Code,Msg.Column,Msg.Line,-1,
+             NewCode,NewX,NewY,NewTopLine)
+  then begin
+    LazarusIDE.DoJumpToCodeToolBossError;
+    exit;
+  end;
+
+  // success
+  Msg.MarkFixed;
+end;
+
 { TQuickFix_Hide }
 
 procedure TQuickFix_Hide.QuickFix(Fixes: TMsgQuickFixes; Msg: TMessageLine);
@@ -152,9 +285,10 @@ function TQuickFix_Hide.IsApplicable(Msg: TMessageLine): boolean;
 begin
   Result:=false;
   if (Msg.Urgency>=mluError)
-  or (Msg.Line<1) or (Msg.Column<1)
+  or (Msg.SubTool<>SubToolFPC)
+  or (not Msg.HasSourcePosition)
   or (mlfHiddenByIDEDirective in Msg.Flags)
-  or (Msg.GetFullFilename='') then exit;
+  then exit;
   Result:=true;
 end;
 

ide/findunitdlg.pas

@@ -725,7 +725,7 @@ begin
   // get include file name
   if not IsCodetoolsErrorIncludeFileNotFound(Msg.Msg,IncludeFilename) then
   begin
-    GetFPCMsgValue1(Msg.Msg,'Can''t open include file "$1"',IncludeFilename);
+    IncludeFilename:=TFPCParser.GetFPCMsgValue1(Msg);
   end;
   DebugLn(['TQuickFixIncludeNotFound_Search.Execute include file=',IncludeFilename]);
   if IncludeFilename='' then