paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-16 06:09:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: quick fix: add -vm option

Browse Source 
git-svn-id: trunk@45342 -
This commit is contained in:
mattias 2014-06-04 21:30:42 +00:00
parent ee966ac457
commit ec6d63f4a5
8 changed files with 186 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
components/ideintf/compoptsintf.pas
View File

@ -91,6 +91,26 @@ type
coptParsedPlatformIndependent // all but platform macros resolved
);
{$IFDEF EnableNewExtTools}
TCompilerFlagValue = (
cfvNone, // default, do not pass the flag
cfvHide, // pass the flag, e.g. -vm5000
cfvShow // pass the -flag, e.g. -vm-5000
);
TAbstractCompilerMsgIDFlags = class(TPersistent)
protected
function GetValues(MsgId: integer): TCompilerFlagValue; virtual; abstract;
function GetModified: boolean; virtual; abstract;
procedure SetModified(AValue: boolean); virtual; abstract;
procedure SetValues(MsgId: integer; AValue: TCompilerFlagValue); virtual; abstract;
public
procedure Clear; virtual; abstract;
property Values[MsgId: integer]: TCompilerFlagValue read GetValues write SetValues; default;
property Modified: boolean read GetModified write SetModified;
end;
{$ENDIF}
const
crAll = [crCompile, crBuild, crRun];
@ -257,6 +277,10 @@ type
fShowHintsForSenderNotUsed: Boolean;
fWriteFPCLogo: Boolean;
fStopAfterErrCount: integer;
{$IFDEF EnableNewExtTools}
// Turn specific types of compiler messages on or off
fMessageFlags: TAbstractCompilerMsgIDFlags;
{$ENDIF}
// Other:
fDontUseConfigFile: Boolean;
@ -426,6 +450,9 @@ type
read fShowHintsForSenderNotUsed write SetShowHintsForSenderNotUsed;
property WriteFPCLogo: Boolean read fWriteFPCLogo write SetWriteFPCLogo;
property StopAfterErrCount: integer read fStopAfterErrCount write SetStopAfterErrCount;
{$IFDEF EnableNewExtTools}
property MessageFlags: TAbstractCompilerMsgIDFlags read fMessageFlags;
{$ENDIF}
// other
property DontUseConfigFile: Boolean read fDontUseConfigFile write SetDontUseConfigFile;

51
components/ideintf/ideexterntoolintf.pas
View File

@ -36,6 +36,23 @@ const
AbortedExitCode = 12321;
const
IDEToolCompilePackage = 'Package';
IDEToolCompileProject = 'Project';
type
{ TIDEExternalToolData
When the IDE compiles a package or a project it creates an instance and sets
TAbstractExternalTool.Data. }
TIDEExternalToolData = class
public
Kind: string; // e.g. IDEToolCompilePackage or IDEToolCompileProject
ModuleName: string; // e.g. the package name
Filename: string; // e.g. the lpi or lpk filename
constructor Create(aKind, aModuleName, aFilename: string);
end;
type
TETShareStringEvent = procedure(var s: string) of object;
@ -139,6 +156,7 @@ type
procedure MarkFixed;
function HasSourcePosition: boolean;
procedure GetAttributes(List: TStrings);
function GetToolData: TIDEExternalToolData; virtual;
public
property Index: integer read FIndex; // index in Lines (Note: Lines can have more or less items than the raw output has text lines)
property Urgency: TMessageLineUrgency read FUrgency write SetUrgency;
@ -570,6 +588,7 @@ type
procedure ConsistencyCheck; virtual;
procedure EnterCriticalSection; virtual; abstract;
procedure LeaveCriticalSection; virtual; abstract;
function GetIDEObject(ToolData: TIDEExternalToolData): TObject; virtual; abstract;
// parsers
procedure RegisterParser(Parser: TExtToolParserClass); virtual; abstract; // (main thread)
procedure UnregisterParser(Parser: TExtToolParserClass); virtual; abstract; // (main thread)
@ -584,24 +603,6 @@ type
var
ExternalToolList: TIDEExternalTools = nil; // will be set by the IDE
const
IDEToolCompilePackage = 'Package';
IDEToolCompileProject = 'Project';
type
{ TIDEExternalToolData
When the IDE compiles a package or a project it creates an instance and sets
TAbstractExternalTool.Data. }
TIDEExternalToolData = class
public
Kind: string; // e.g. IDEToolCompilePackage or IDEToolCompileProject
ModuleName: string; // e.g. the package name
Filename: string; // e.g. the lpi or lpk filename
constructor Create(aKind, aModuleName, aFilename: string);
end;
type
{ TIDEExternalToolOptions }
@ -2117,6 +2118,20 @@ begin
List.Values['OriginalLine']:=OriginalLine;
end;
function TMessageLine.GetToolData: TIDEExternalToolData;
var
View: TExtToolView;
begin
Result:=nil;
if Lines=nil then exit;
View:=TExtToolView(Lines.Owner);
if not (View is TExtToolView) then exit;
if View.Tool=nil then exit;
Result:=TIDEExternalToolData(View.Tool.Data);
if not (Result is TIDEExternalToolData) then
Result:=nil;
end;
{ TExtToolView }
procedure TExtToolView.FetchAllPending;

2
ide/compiler.pp
View File

@ -324,6 +324,8 @@ begin
Tool:=ExternalToolList.Add('Compile Project');
Tool.Reference(Self,ClassName);
try
Tool.Data:=TIDEExternalToolData.Create(IDEToolCompileProject,'',AProject.ProjectInfoFile);
Tool.FreeData:=true;
Tool.Hint:=aCompileHint;
Tool.Process.Executable:=CompilerFilename;
Tool.CmdLineParams:=CmdLine;

39
ide/compileroptions.pp
View File

@ -368,12 +368,6 @@ type
TCompilationToolClass = class of TCompilationToolOptions;
{$IFDEF EnableNewExtTools}
TCompilerFlagValue = (
cfvNone, // default, do not pass the flag
cfvHide, // pass the flag
cfvShow // pass the -flag
);
TCompilerMsgIdFlag = record
MsgId: integer;
Flag: TCompilerFlagValue;
@ -396,25 +390,24 @@ type
{ TCompilerMsgIDFlags }
TCompilerMsgIDFlags = class(TPersistent)
TCompilerMsgIDFlags = class(TAbstractCompilerMsgIDFlags)
private
FChangeStamp: int64;
fLastSavedStamp: int64;
fTree: TAvgLvlTree; // tree of TCompilerMsgIdFlag
function FindNode(MsgId: integer): TAvgLvlTreeNode;
function GetValues(MsgId: integer): TCompilerFlagValue;
function GetModified: boolean;
procedure SetModified(AValue: boolean);
procedure SetValues(MsgId: integer; AValue: TCompilerFlagValue);
protected
function GetValues(MsgId: integer): TCompilerFlagValue; override;
function GetModified: boolean; override;
procedure SetModified(AValue: boolean); override;
procedure SetValues(MsgId: integer; AValue: TCompilerFlagValue); override;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure Clear; override;
procedure Assign(Source: TPersistent); override;
function Equals(Obj: TObject): boolean; override;
procedure IncreaseChangeStamp;
property Values[MsgId: integer]: TCompilerFlagValue read GetValues write SetValues; default;
property Modified: boolean read GetModified write SetModified;
function GetEnumerator: TCompilerMsgIDFlagsEnumerator;
function GetMsgIdList(Delim: char; aValue: TCompilerFlagValue): string;
function CreateDiff(Tool: TCompilerDiffTool; Other: TCompilerMsgIDFlags): boolean;
@ -516,8 +509,6 @@ type
FCreateMakefileOnBuild: boolean;
{$IFDEF EnableNewExtTools}
// Turn specific types of compiler messages on or off
fMessageFlags: TCompilerMsgIDFlags;
{$ELSE}
// Compiler Messags
fUseCustomMessages: Boolean; // use messages customization
@ -675,7 +666,7 @@ type
// compiler message types by id
{$IFDEF EnableNewExtTools}
property MessageFlags: TCompilerMsgIDFlags read fMessageFlags;
function IDEMessageFlags: TCompilerMsgIDFlags; inline;
{$ELSE}
property CompilerMessages: TCompilerMessagesList read fCompilerMessages;
property UseMsgFile: Boolean read fUseMsgFile write SetUseMsgFile;
@ -1214,6 +1205,12 @@ end;
{ TBaseCompilerOptions }
// inline
function TBaseCompilerOptions.IDEMessageFlags: TCompilerMsgIDFlags;
begin
Result:=TCompilerMsgIDFlags(MessageFlags);
end;
{------------------------------------------------------------------------------
TBaseCompilerOptions Constructor
------------------------------------------------------------------------------}
@ -1865,7 +1862,7 @@ var
var
Flag: PCompilerMsgIdFlag;
begin
for Flag in MessageFlags do
for Flag in IDEMessageFlags do
if Flag^.Flag=aValue then begin
//debugln(['WriteListOfMessageFlags aPath=',aPath,' Flag.MsgId=',Flag^.MsgId]);
aXMLConfig.SetValue(aPath+'/idx'+IntToStr(Flag^.MsgId), true);
@ -3254,10 +3251,10 @@ begin
if (WriteFPCLogo) then
switches := switches + ' -l';
{$IFDEF EnableNewExtTools}
t := MessageFlags.GetMsgIdList(',',cfvHide);
t := IDEMessageFlags.GetMsgIdList(',',cfvHide);
if t <> '' then
switches := switches + ' ' + PrepareCmdLineOption('-vm'+t);
t := MessageFlags.GetMsgIdList(',',cfvShow);
t := IDEMessageFlags.GetMsgIdList(',',cfvShow);
if t <> '' then
switches := switches + ' ' + PrepareCmdLineOption('-vm-'+t);
{$ELSE}
@ -3822,7 +3819,7 @@ begin
// messages
if Tool<>nil then Tool.Path:='Messages';
{$IFDEF EnableNewExtTools}
if Done(MessageFlags.CreateDiff(Tool,CompOpts.MessageFlags)) then exit;
if Done(IDEMessageFlags.CreateDiff(Tool,CompOpts.IDEMessageFlags)) then exit;
{$ELSE}
if Done(Tool.AddDiff('UseCustomMessages',fUseCustomMessages,CompOpts.fUseCustomMessages)) then exit;
if Done(Tool.AddDiff('UseMsgFile',fUseMsgFile,CompOpts.fUseMsgFile)) then exit;

3
ide/etmessageframe.pas
View File

@ -2385,6 +2385,7 @@ begin
FViews.Add(Result);
FreeNotification(Result);
Result.OnChanged:=@OnViewChanged;
fSomeViewsRunning:=true;
end;
function TMessagesCtrl.GetLineAt(Y: integer; out View: TLMsgWndView; out
@ -2706,8 +2707,8 @@ var
begin
View:=GetAboutView;
if View=nil then exit;
if not (View.Tool.Data is TIDEExternalToolData) then exit;
ToolData:=TIDEExternalToolData(View.Tool.Data);
if not (ToolData is TIDEExternalToolData) then exit;
if ToolData.Kind=IDEToolCompilePackage then begin
PackageEditingInterface.DoOpenPackageFile(ToolData.Filename,
[pofAddToRecent],false);

97
ide/etquickfixes.pas
View File

@ -53,19 +53,29 @@ uses
Classes, SysUtils, Menus, Dialogs, Controls, CodeToolManager, CodeCache,
CodeTree, CodeAtom, BasicCodeTools, KeywordFuncLists, LazLogger, AvgLvlTree,
LazFileUtils, IDEExternToolIntf, IDEMsgIntf, LazIDEIntf, IDEDialogs, MenuIntf,
etFPCMsgParser, AbstractsMethodsDlg;
ProjectIntf, PackageIntf, CompOptsIntf, etFPCMsgParser, AbstractsMethodsDlg;
type
{ TQuickFix_Hide - hide via IDE directive %H- }
{ TQuickFix_HideWithIDEDirective - hide with IDE directive %H- }
TQuickFix_Hide = class(TMsgQuickFix)
TQuickFix_HideWithIDEDirective = class(TMsgQuickFix)
public
function IsApplicable(Msg: TMessageLine): boolean;
procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
procedure QuickFix(Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
end;
{ TQuickFix_HideWithCompilerOption - hide with compiler option -vm<id> }
TQuickFix_HideWithCompilerOption = class(TMsgQuickFix)
public
function IsApplicable(Msg: TMessageLine; out ToolData: TIDEExternalToolData;
out IDETool: TObject): boolean;
procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
procedure QuickFix(Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
end;
{ TQuickFixIdentifierNotFoundAddLocal }
TQuickFixIdentifierNotFoundAddLocal = class(TMsgQuickFix)
@ -169,6 +179,75 @@ begin
Result:=true;
end;
{ TQuickFix_HideWithCompilerOption }
function TQuickFix_HideWithCompilerOption.IsApplicable(Msg: TMessageLine; out
ToolData: TIDEExternalToolData; out IDETool: TObject): boolean;
begin
Result:=false;
ToolData:=nil;
IDETool:=nil;
if (Msg.Urgency>=mluError)
or (Msg.SubTool<>SubToolFPC)
or (Msg.MsgID=0)
then exit;
ToolData:=Msg.GetToolData;
if ToolData=nil then exit;
IDETool:=ExternalToolList.GetIDEObject(ToolData);
Result:=IDETool<>nil;
end;
procedure TQuickFix_HideWithCompilerOption.CreateMenuItems(Fixes: TMsgQuickFixes
);
var
i: Integer;
Msg: TMessageLine;
IDETool: TObject;
s: String;
ToolData: TIDEExternalToolData;
CompOpts: TLazCompilerOptions;
begin
for i:=0 to Fixes.LineCount-1 do begin
Msg:=Fixes.Lines[i];
if not IsApplicable(Msg,ToolData,IDETool) then continue;
if IDETool is TLazProject then begin
CompOpts:=TLazProject(IDETool).LazCompilerOptions;
if CompOpts.MessageFlags[Msg.MsgID]=cfvHide then exit;
s:='Hide with project option (-vm'+IntToStr(Msg.MsgID)+')'
end else if IDETool is TIDEPackage then begin
CompOpts:=TIDEPackage(IDETool).LazCompilerOptions;
if CompOpts.MessageFlags[Msg.MsgID]=cfvHide then exit;
s:='Hide with package option (-vm'+IntToStr(Msg.MsgID)+')';
end;
Fixes.AddMenuItem(Self,Msg,s);
end;
inherited CreateMenuItems(Fixes);
end;
procedure TQuickFix_HideWithCompilerOption.QuickFix(Fixes: TMsgQuickFixes;
Msg: TMessageLine);
var
IDETool: TObject;
CompOpts: TLazCompilerOptions;
Pkg: TIDEPackage;
ToolData: TIDEExternalToolData;
begin
if not IsApplicable(Msg,ToolData,IDETool) then exit;
if IDETool is TLazProject then begin
CompOpts:=TLazProject(IDETool).LazCompilerOptions;
CompOpts.MessageFlags[Msg.MsgID]:=cfvHide;
Msg.MarkFixed;
end else if IDETool is TIDEPackage then begin
if PackageEditingInterface.DoOpenPackageFile(ToolData.Filename,
[pofAddToRecent],false)<>mrOk then exit;
Pkg:=PackageEditingInterface.FindPackageWithName(ToolData.ModuleName);
if Pkg=nil then exit;
CompOpts:=Pkg.LazCompilerOptions;
CompOpts.MessageFlags[Msg.MsgID]:=cfvHide;
Msg.MarkFixed;
end;
end;
{ TQuickFixLocalVariableNotUsed_Remove }
function TQuickFixLocalVariableNotUsed_Remove.IsApplicable(Msg: TMessageLine;
@ -504,9 +583,9 @@ begin
Msg.MarkFixed;
end;
{ TQuickFix_Hide }
{ TQuickFix_HideWithIDEDirective }
procedure TQuickFix_Hide.QuickFix(Fixes: TMsgQuickFixes; Msg: TMessageLine);
procedure TQuickFix_HideWithIDEDirective.QuickFix(Fixes: TMsgQuickFixes; Msg: TMessageLine);
var
Code: TCodeBuffer;
@ -575,7 +654,7 @@ begin
end;
end;
function TQuickFix_Hide.IsApplicable(Msg: TMessageLine): boolean;
function TQuickFix_HideWithIDEDirective.IsApplicable(Msg: TMessageLine): boolean;
begin
Result:=false;
if (Msg.Urgency>=mluError)
@ -586,7 +665,7 @@ begin
Result:=true;
end;
procedure TQuickFix_Hide.CreateMenuItems(Fixes: TMsgQuickFixes);
procedure TQuickFix_HideWithIDEDirective.CreateMenuItems(Fixes: TMsgQuickFixes);
var
Msg: TMessageLine;
i: Integer;
@ -670,11 +749,13 @@ begin
fMenuItemToInfo:=TPointerToPointerTree.Create;
// init standard quickfixes
IDEQuickFixes.RegisterQuickFix(TQuickFix_Hide.Create);
IDEQuickFixes.RegisterQuickFix(TQuickFix_HideWithIDEDirective.Create);
IDEQuickFixes.RegisterQuickFix(TQuickFixIdentifierNotFoundAddLocal.Create);
IDEQuickFixes.RegisterQuickFix(TQuickFixLocalVariableNotUsed_Remove.Create);
IDEQuickFixes.RegisterQuickFix(TQuickFixUnitNotFound_Remove.Create);
IDEQuickFixes.RegisterQuickFix(TQuickFixClassWithAbstractMethods.Create);
IDEQuickFixes.RegisterQuickFix(TQuickFix_HideWithCompilerOption.Create);
end;
destructor TIDEQuickFixes.Destroy;

14
ide/exttools.pas
View File

@ -44,7 +44,7 @@ uses
// IDEIntf
IDEExternToolIntf, BaseIDEIntf, MacroIntf, IDEMsgIntf,
// IDE
IDEDialogs, CompOptsIntf, TransferMacros;
IDEDialogs, CompOptsIntf, PackageIntf, LazIDEIntf, TransferMacros;
type
TLMVToolState = (
@ -189,6 +189,7 @@ type
property RunningTools[Index: integer]: TExternalTool read GetRunningTools;
procedure EnterCriticalSection; override;
procedure LeaveCriticalSection; override;
function GetIDEObject(ToolData: TIDEExternalToolData): TObject; override;
// parsers
function ParserCount: integer; override;
procedure RegisterParser(Parser: TExtToolParserClass); override;
@ -1321,6 +1322,17 @@ begin
System.LeaveCriticalsection(FCritSec);
end;
function TExternalTools.GetIDEObject(ToolData: TIDEExternalToolData): TObject;
begin
Result:=nil;
if ToolData=nil then exit;
if ToolData.Kind=IDEToolCompileProject then begin
Result:=LazarusIDE.ActiveProject;
end else if ToolData.Kind=IDEToolCompilePackage then begin
Result:=PackageEditingInterface.FindPackageWithName(ToolData.ModuleName);
end;
end;
procedure TExternalTools.RegisterParser(Parser: TExtToolParserClass);
begin
if fParsers.IndexOf(Parser)>=0 then exit;

3
ide/frames/compiler_messages_options.pas
View File

@ -7,7 +7,8 @@ interface
uses
Classes, SysUtils, FileUtil, LazFileCache, LazLoggerBase, ListFilterEdit,
StdCtrls, CheckLst, Dialogs, IDEOptionsIntf, IDEMsgIntf, IDEExternToolIntf,
MacroIntf, IDEDialogs, CodeToolsFPCMsgs, CompilerOptions, LazarusIDEStrConsts
MacroIntf, IDEDialogs, CompOptsIntf, CodeToolsFPCMsgs, CompilerOptions,
LazarusIDEStrConsts
{$IFDEF EnableNewExtTools}
,etFPCMsgParser
{$ENDIF}