diff --git a/components/ideintf/ideexterntoolintf.pas b/components/ideintf/ideexterntoolintf.pas index 86f78e4aa8..749af8ae31 100644 --- a/components/ideintf/ideexterntoolintf.pas +++ b/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; diff --git a/components/ideintf/idemsgintf.pas b/components/ideintf/idemsgintf.pas index 749e67d58b..008447b2c9 100644 --- a/components/ideintf/idemsgintf.pas +++ b/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; diff --git a/ide/etfpcmsgparser.pas b/ide/etfpcmsgparser.pas index a9f3cdf72c..5e0e375790 100644 --- a/ide/etfpcmsgparser.pas +++ b/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) diff --git a/ide/etquickfixes.pas b/ide/etquickfixes.pas index 45cf769def..3112a61927 100644 --- a/ide/etquickfixes.pas +++ b/ide/etquickfixes.pas @@ -30,12 +30,13 @@ unit etQuickFixes; interface uses - Classes, SysUtils, IDEExternToolIntf, IDEMsgIntf, Menus, CodeToolManager, - CodeCache, LazLogger, AvgLvlTree, LazFileUtils; + Classes, SysUtils, IDEExternToolIntf, IDEMsgIntf, LazIDEIntf, IDEDialogs, + 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; diff --git a/ide/findunitdlg.pas b/ide/findunitdlg.pas index e18d96bb2d..0118aab421 100644 --- a/ide/findunitdlg.pas +++ b/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