IDE: quick fix: add -vm option

git-svn-id: trunk@45342 -

components/ideintf/compoptsintf.pas

@@ -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;

components/ideintf/ideexterntoolintf.pas

@@ -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;

ide/compiler.pp

@@ -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;

ide/compileroptions.pp

@@ -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;
+  protected
-    function GetModified: boolean;
+    function GetValues(MsgId: integer): TCompilerFlagValue; override;
-    procedure SetModified(AValue: boolean);
+    function GetModified: boolean; override;
-    procedure SetValues(MsgId: integer; AValue: TCompilerFlagValue);
+    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;

ide/etmessageframe.pas

@@ -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);

ide/etquickfixes.pas

@@ -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;

ide/exttools.pas

@@ -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;

ide/frames/compiler_messages_options.pas

@@ -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}