mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-02 19:23:40 +02:00
463 lines
16 KiB
ObjectPascal
463 lines
16 KiB
ObjectPascal
{
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
|
* *
|
|
***************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
Defines the standard message Quick Fix menu items.
|
|
}
|
|
unit MsgQuickFixes;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, LCLProc, Controls, Dialogs, FileUtil,
|
|
CodeAtom, CodeCache, CodeToolManager,
|
|
IDEMsgIntf, TextTools, ProjectIntf, LazIDEIntf,
|
|
AbstractsMethodsDlg, LazarusIDEStrConsts;
|
|
|
|
type
|
|
|
|
{ TQuickFixUnitNotFoundPosition }
|
|
|
|
TQuickFixUnitNotFoundPosition = class(TIDEMsgQuickFixItem)
|
|
public
|
|
constructor Create;
|
|
function IsApplicable(Line: TIDEMessageLine): boolean; override;
|
|
procedure Execute(const Msg: TIDEMessageLine; Step: TIMQuickFixStep); override;
|
|
end;
|
|
|
|
{ TQuickFixLinkerUndefinedReference }
|
|
|
|
TQuickFixLinkerUndefinedReference = class(TIDEMsgQuickFixItem)
|
|
public
|
|
constructor Create;
|
|
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;
|
|
Msg: TIDEMessageLine);
|
|
|
|
function GetMsgLineFilename(Msg: TIDEMessageLine;
|
|
out CodeBuf: TCodeBuffer): boolean;
|
|
|
|
procedure InitStandardIDEQuickFixItems;
|
|
procedure FreeStandardIDEQuickFixItems;
|
|
|
|
implementation
|
|
|
|
procedure QuickFixParameterNotUsed(Sender: TObject; Step: TIMQuickFixStep;
|
|
Msg: TIDEMessageLine);
|
|
begin
|
|
DebugLn('QuickFixParameterNotUsed ');
|
|
end;
|
|
|
|
procedure QuickFixUnitNotUsed(Sender: TObject; Step: TIMQuickFixStep;
|
|
Msg: TIDEMessageLine);
|
|
var
|
|
CodeBuf: TCodeBuffer;
|
|
UnneededUnitname: String;
|
|
OldChange: Boolean;
|
|
begin
|
|
if Step<>imqfoMenuItem then exit;
|
|
if not GetMsgLineFilename(Msg,CodeBuf) then exit;
|
|
|
|
if not REMatches(Msg.Msg,'Unit "([a-z_0-9]+)" not used','I') then begin
|
|
DebugLn('QuickFixUnitNotUsed invalid message ',Msg.Msg);
|
|
exit;
|
|
end;
|
|
UnneededUnitname:=REVar(1);
|
|
|
|
// remove unit
|
|
if not LazarusIDE.BeginCodeTools then exit;
|
|
OldChange:=LazarusIDE.OpenEditorsOnCodeToolChange;
|
|
LazarusIDE.OpenEditorsOnCodeToolChange:=true;
|
|
try
|
|
LazarusIDE.SaveSourceEditorChangesToCodeCache(-1);
|
|
if not CodeToolBoss.RemoveUnitFromAllUsesSections(CodeBuf,UnneededUnitname)
|
|
then begin
|
|
LazarusIDE.DoJumpToCodeToolBossError;
|
|
exit;
|
|
end;
|
|
finally
|
|
LazarusIDE.OpenEditorsOnCodeToolChange:=OldChange;
|
|
end;
|
|
|
|
// message fixed
|
|
Msg.Msg:='';
|
|
end;
|
|
|
|
function GetMsgLineFilename(Msg: TIDEMessageLine; out CodeBuf: TCodeBuffer
|
|
): boolean;
|
|
var
|
|
Filename: String;
|
|
TestDir: String;
|
|
begin
|
|
Result:=false;
|
|
CodeBuf:=nil;
|
|
if Msg.Parts=nil then begin
|
|
DebugLn('GetMsgLineFilename Msg.Parts=nil');
|
|
exit;
|
|
end;
|
|
|
|
Filename:=Msg.Parts.Values['Filename'];
|
|
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.');
|
|
exit;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
procedure InitStandardIDEQuickFixItems;
|
|
begin
|
|
IDEMsgQuickFixes:=TIDEMsgQuickFixItems.Create;
|
|
|
|
//RegisterIDEMsgQuickFix('Parameter xxx not used','Quick fix: Add dummy line',
|
|
// 'Parameter "[a-z_0-9]+" not used',nil,@QuickFixParameterNotUsed);
|
|
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;
|
|
begin
|
|
FreeThenNil(IDEMsgQuickFixes);
|
|
end;
|
|
|
|
{ TQuickFixUnitNotFoundPosition }
|
|
|
|
constructor TQuickFixUnitNotFoundPosition.Create;
|
|
begin
|
|
Name:='Improve error position of: Fatal: Can''t find unit xxx';
|
|
Steps:=[imqfoImproveMessage];
|
|
end;
|
|
|
|
function TQuickFixUnitNotFoundPosition.IsApplicable(Line: TIDEMessageLine
|
|
): boolean;
|
|
begin
|
|
Result:=(Line.Parts<>nil)
|
|
and (System.Pos(') Fatal: Can''t find unit ',Line.Msg)>0);
|
|
end;
|
|
|
|
procedure TQuickFixUnitNotFoundPosition.Execute(const Msg: TIDEMessageLine;
|
|
Step: TIMQuickFixStep);
|
|
var
|
|
CodeBuf: TCodeBuffer;
|
|
MissingUnitname: String;
|
|
NamePos, InPos: Integer;
|
|
Line, Col: Integer;
|
|
UsedByUnit: String;
|
|
NewFilename: String;
|
|
begin
|
|
if Step<>imqfoImproveMessage then exit;
|
|
//DebugLn('QuickFixUnitNotFoundPosition ');
|
|
if not GetMsgLineFilename(Msg,CodeBuf) then exit;
|
|
|
|
if not REMatches(Msg.Msg,'Can''t find unit ([a-z_0-9]+)','I') then begin
|
|
DebugLn('QuickFixUnitNotFoundPosition invalid message ',Msg.Msg);
|
|
exit;
|
|
end;
|
|
MissingUnitname:=REVar(1);
|
|
if REMatches(Msg.Msg,'Can''t find unit ([a-z_0-9]+) used by ([a-z_0-9]+)','I') then begin
|
|
UsedByUnit:=REVar(2);
|
|
if SysUtils.CompareText(UsedByUnit,ExtractFileNameOnly(CodeBuf.Filename))<>0 then
|
|
begin
|
|
// the message belongs to another unit
|
|
NewFilename:=LazarusIDE.FindUnitFile(UsedByUnit);
|
|
if NewFilename='' then begin
|
|
DebugLn('QuickFixUnitNotFoundPosition unit not found: ',UsedByUnit);
|
|
exit;
|
|
end;
|
|
CodeBuf:=CodeToolBoss.LoadFile(NewFilename,false,false);
|
|
if CodeBuf=nil then begin
|
|
DebugLn('QuickFixUnitNotFoundPosition unable to load unit: ',NewFilename);
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
LazarusIDE.SaveSourceEditorChangesToCodeCache(-1);
|
|
if not CodeToolBoss.FindUnitInAllUsesSections(CodeBuf,MissingUnitname,
|
|
NamePos,InPos)
|
|
then begin
|
|
DebugLn('QuickFixUnitNotFoundPosition failed due to syntax errors or '+MissingUnitname+' is not used in '+CodeBuf.Filename);
|
|
exit;
|
|
end;
|
|
if InPos=0 then ;
|
|
CodeBuf.AbsoluteToLineCol(NamePos,Line,Col);
|
|
if (Line>0) and (Col>0) then begin
|
|
//DebugLn('QuickFixUnitNotFoundPosition Line=',dbgs(Line),' Col=',dbgs(Col));
|
|
NewFilename:=CodeBuf.Filename;
|
|
if (Msg.Directory<>'') and (FilenameIsAbsolute(Msg.Directory)) then
|
|
NewFilename:=CreateRelativePath(NewFilename,Msg.Directory);
|
|
Msg.SetSourcePosition(NewFilename,Line,Col);
|
|
end;
|
|
end;
|
|
|
|
{ TQuickFixLinkerUndefinedReference }
|
|
|
|
constructor TQuickFixLinkerUndefinedReference.Create;
|
|
begin
|
|
Name:='Linker: undefined reference to';
|
|
Steps:=[imqfoJump];
|
|
RegExpression:='^((.*:[0-9]+)?: .* `(.*)'')|((.*)\(\.text.*?\): .* `([A-Z0-9_$]+)'':)$';
|
|
end;
|
|
|
|
procedure TQuickFixLinkerUndefinedReference.Execute(const Msg: TIDEMessageLine;
|
|
Step: TIMQuickFixStep);
|
|
{ Examples:
|
|
/usr/lib/fpc/2.1.1/units/i386-linux/gtk2/gtk2.o(.text+0xbba1): In function `GTK2_GTK_TYPE_CELL_RENDERER_COMBO$$LONGWORD':
|
|
: undefined reference to `gtk_cell_renderer_combo_get_type'
|
|
|
|
unit1.o(.text+0x1a): In function `SubProc':
|
|
unit1.pas:37: undefined reference to `DoesNotExist'
|
|
unit1.o(.text+0x3a):unit1.pas:48: undefined reference to `DoesNotExist'
|
|
}
|
|
|
|
procedure Error(const Msg: string);
|
|
begin
|
|
DebugLn('TQuickFixLinkerUndefinedReference.Execute ',Msg);
|
|
MessageDlg('TQuickFixLinkerUndefinedReference.Execute',
|
|
Msg,mtError,[mbCancel],0);
|
|
end;
|
|
|
|
procedure JumpTo(Line1, Line2: TIDEMessageLine);
|
|
var
|
|
Identifier: String;
|
|
Filename: String;
|
|
MangledFunction: String;
|
|
CurProject: TLazProject;
|
|
CodeBuf: TCodeBuffer;
|
|
NewCode: TCodeBuffer;
|
|
NewX, NewY, NewTopLine: integer;
|
|
AnUnitName: String;
|
|
SourceFilename: String;
|
|
SourceLine: Integer;
|
|
begin
|
|
DebugLn(['TQuickFixLinkerUndefinedReference.JumpTo START ',Line1.Msg]);
|
|
Filename:='';
|
|
MangledFunction:='';
|
|
Identifier:='';
|
|
SourceFilename:='';
|
|
SourceLine:=0;
|
|
if REMatches(Line1.Msg,'^(.*)\(\.text.*?\): .* `([a-zA-Z0-9_$]+)'':$') then
|
|
begin
|
|
// example: unit1.o(.text+0x1a): In function `SubProc':
|
|
Filename:=REVar(1);
|
|
MangledFunction:=REVar(2);
|
|
if (Line2<>nil) and REMatches(Line2.Msg,'^: .* `(.*)''$') then begin
|
|
// example: ": undefined reference to `gtk_cell_renderer_combo_get_type'"
|
|
Identifier:=REVar(1);
|
|
end else if (Line2<>nil)
|
|
and REMatches(Line2.Msg,'^(.*):([0-9]+): .* `(.*)''$') then begin
|
|
// example: unit1.pas:37: undefined reference to `DoesNotExist'
|
|
SourceFilename:=REVar(1);
|
|
SourceLine:=StrToIntDef(REVar(2),0);
|
|
Identifier:=REVar(3);
|
|
end else begin
|
|
DebugLn('TQuickFixLinkerUndefinedReference.JumpTo Line2 does not match: "',Line2.Msg,'"');
|
|
exit;
|
|
end;
|
|
end
|
|
else if REMatches(Line1.Msg,'^(.*)\(\.text.*?\):(.*):([0-9]*): .* `([a-zA-Z0-9_$]+)'':$')
|
|
then begin
|
|
// example: unit1.o(.text+0x3a):unit1.pas:48: undefined reference to `DoesNotExist'
|
|
Filename:=REVar(1);
|
|
SourceFilename:=REVar(2);
|
|
SourceLine:=StrToIntDef(REVar(3),0);
|
|
Identifier:=REVar(4);
|
|
end
|
|
else if REMatches(Line1.Msg,'^(.*):([0-9]+): .* `([a-zA-Z0-9_$]+)''$') then begin
|
|
// example: unit1.pas:48: undefined reference to `DoesNotExist'
|
|
Filename:=REVar(1);
|
|
SourceFilename:=Filename;
|
|
SourceLine:=StrToIntDef(REVar(2),0);
|
|
Identifier:=REVar(3);
|
|
end else begin
|
|
DebugLn('JumpTo Line1 does not match: "',Line1.Msg,'"');
|
|
exit;
|
|
end;
|
|
DebugLn(['TQuickFixLinkerUndefinedReference.JumpTo Filename="',Filename,'" MangledFunction="',MangledFunction,'" Identifier="',Identifier,'" SourceFilename="',SourceFilename,'" SourceLine=',SourceLine]);
|
|
CurProject:=LazarusIDE.ActiveProject;
|
|
if CurProject=nil then begin
|
|
Error('no project');
|
|
exit;
|
|
end;
|
|
if (CurProject.MainFile=nil) then begin
|
|
Error('no main file in project');
|
|
exit;
|
|
end;
|
|
if (CurProject.MainFile=nil) then begin
|
|
Error('no main file in project');
|
|
exit;
|
|
end;
|
|
CodeBuf:=CodeToolBoss.LoadFile(CurProject.MainFile.Filename,true,false);
|
|
if (CodeBuf=nil) then begin
|
|
Error('project main file has no source');
|
|
exit;
|
|
end;
|
|
AnUnitName:=ExtractFilenameOnly(Filename);
|
|
CodeBuf:=CodeToolBoss.FindUnitSource(CodeBuf,AnUnitName,'');
|
|
if (CodeBuf=nil) then begin
|
|
Error('unit not found: '+AnUnitName);
|
|
exit;
|
|
end;
|
|
if not CodeToolBoss.JumpToLinkerIdentifier(CodeBuf,
|
|
SourceFilename,SourceLine,MangledFunction,Identifier,
|
|
NewCode,NewX,NewY,NewTopLine)
|
|
then begin
|
|
if CodeToolBoss.ErrorCode<>nil then
|
|
LazarusIDE.DoJumpToCodeToolBossError
|
|
else
|
|
Error('function not found: '+MangledFunction+' Identifier='+Identifier);
|
|
exit;
|
|
end;
|
|
LazarusIDE.DoOpenFileAndJumpToPos(NewCode.Filename,Point(NewX,NewY),
|
|
NewTopLine,-1,[]);
|
|
end;
|
|
|
|
begin
|
|
inherited Execute(Msg, Step);
|
|
if Step=imqfoJump then begin
|
|
//DebugLn(['TQuickFixLinkerUndefinedReference.Execute ',Msg.Msg]);
|
|
if REMatches(Msg.Msg,'^(.*)\(\.text.*?\):.*:([0-9]+): .* `([a-zA-Z0-9_$]+)''$') then
|
|
// example: unit1.o(.text+0x3a):unit1.pas:48: undefined reference to `DoesNotExist'
|
|
JumpTo(Msg,nil)
|
|
else if (Msg.Position>0) and REMatches(Msg.Msg,'^(.*:[0-9]+)?: .* `(.*)''$') then
|
|
// example: unit1.pas:37: undefined reference to `DoesNotExist'
|
|
JumpTo(IDEMessagesWindow[Msg.Position-1],Msg)
|
|
else if (Msg.Position<IDEMessagesWindow.LinesCount-1)
|
|
and REMatches(Msg.Msg,'^(.*)\(\.text.*?\): .* `([a-zA-Z0-9_$]+)'':$') then
|
|
// example: unit1.o(.text+0x1a): In function `SubProc':
|
|
JumpTo(Msg,IDEMessagesWindow[Msg.Position+1]);
|
|
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.
|
|
|