1 {
2  ***************************************************************************
3  *                                                                         *
4  *   This source is free software; you can redistribute it and/or modify   *
5  *   it under the terms of the GNU General Public License as published by  *
6  *   the Free Software Foundation; either version 2 of the License, or     *
7  *   (at your option) any later version.                                   *
8  *                                                                         *
9  *   This code is distributed in the hope that it will be useful, but      *
10  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
11  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
12  *   General Public License for more details.                              *
13  *                                                                         *
14  *   A copy of the GNU General Public License is available on the World    *
15  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
16  *   obtain it by writing to the Free Software Foundation,                 *
17  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
18  *                                                                         *
19  ***************************************************************************
20 
21   Author: Mattias Gaertner
22 
23   Abstract:
24     Standard Quick Fixes - tools to help fixing (compiler) messages.
25 
26   ToDo:
27     - cant find unit: duplicate include file, e.g. control.inc
28     - TQuickFixIdentifierNotFoundAddLocal: extend with add private/public
29     - local var not used: remove declaration and all assignments
30     - There is no method in an ancestor class to be overriden:
31       1. option: if the ancestor has a function with the same name: update the parameter list
32       2. option: remove the method
33       3. option: add a virtual method to the ancestor
34     - function header doesn't match any method: update from interface/class
35     - function header doesn't match any method: update interface/class
36     - complete function implementation with missing parameters
37     - private variable not used => remove
38     - Hint/Warning: (5036) Local variable "Path" does not seem to be initialized
39          auto add begin+end
40          Pointer:=nil
41          integer:=0
42          string:=''
43          record: FillByte(p %H-,SizeOf(p),0)
44          set:=[]
45          enum:=low(enum);
46          default()
47     - Hint: function result does not seem to be initialized, see above for local var
48 }
49 unit etQuickFixes;
50 
51 {$mode objfpc}{$H+}
52 
53 interface
54 
55 uses
56   Classes, SysUtils, Laz_AVL_Tree,
57   // LCL
58   Menus, Dialogs, Controls,
59   // LazUtils
60   LazLoggerBase, AvgLvlTree, LazFileUtils, LazStringUtils,
61   // Codetools
62   CodeToolManager, CodeCache, CodeTree, CodeAtom, BasicCodeTools, KeywordFuncLists,
63   // IdeIntf
64   IDEExternToolIntf, IDEMsgIntf, LazIDEIntf, IDEDialogs, MenuIntf,
65   ProjectIntf, PackageIntf, CompOptsIntf,
66   // IDE
67   LazarusIDEStrConsts, etFPCMsgParser, AbstractsMethodsDlg, QFInitLocalVarDlg;
68 
69 type
70 
71   { TQuickFixIdentifierNotFoundAddLocal }
72 
73   TQuickFixIdentifierNotFoundAddLocal = class(TMsgQuickFix)
74   public
IsApplicablenull75     function IsApplicable(Msg: TMessageLine; out Identifier: string): boolean;
76     procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
77     procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
78   end;
79 
80   { TQuickFixLocalVariableNotUsed_Remove }
81 
82   TQuickFixLocalVariableNotUsed_Remove = class(TMsgQuickFix)
83   public
IsApplicablenull84     function IsApplicable(Msg: TMessageLine; out Identifier: string): boolean;
85     procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
86     procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
87   end;
88 
89   { TQuickFixLocalVarNotInitialized_AddAssignment }
90 
91   TQuickFixLocalVarNotInitialized_AddAssignment = class(TMsgQuickFix)
92   public
IsApplicablenull93     function IsApplicable(Msg: TMessageLine; out Identifier: string): boolean;
94     procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
95     procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
96   end;
97 
98   { TQuickFixUnitNotFound_Remove, also "unit not used" }
99 
100   TQuickFixUnitNotFound_Remove = class(TMsgQuickFix)
101   public
IsApplicablenull102     function IsApplicable(Msg: TMessageLine;
103       out MissingUnitName, UsedByUnit: string): boolean;
104     procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
105     procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
106   end;
107 
108   { TQuickFixClassWithAbstractMethods
109     Quick fix for example:
110     Warning: Constructing a class "TClassA" with abstract methods }
111 
112   TQuickFixClassWithAbstractMethods = class(TMsgQuickFix)
113   public
IsApplicablenull114     function IsApplicable(Msg: TMessageLine; out aClassName: string): boolean;
115     procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
116     procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
117   end;
118 
119   { TQuickFixSrcPathOfPkgContains_OpenPkg
120     QuickFix for IDE warning "other sources path of package %s contains directory "%s", ..."
121     Open Package
122     }
123 
124   TQuickFixSrcPathOfPkgContains_OpenPkg = class(TMsgQuickFix)
125   public
IsApplicablenull126     function IsApplicable(Msg: TMessageLine; out PkgName: string): boolean;
127     procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
128     procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
129   end;
130 
131   { TQuickFix_HideWithIDEDirective - hide with IDE directive %H- }
132 
133   TQuickFix_HideWithIDEDirective = class(TMsgQuickFix)
134   public
IsApplicablenull135     function IsApplicable(Msg: TMessageLine): boolean;
136     procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
137     procedure QuickFix(Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
138   end;
139 
140   { TQuickFix_HideWithCompilerOption - hide with compiler option -vm<id> }
141 
142   TQuickFix_HideWithCompilerOption = class(TMsgQuickFix)
143   public
IsApplicablenull144     function IsApplicable(Msg: TMessageLine; out ToolData: TIDEExternalToolData;
145       out IDETool: TObject): boolean;
146     procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
147     procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
148   end;
149 
150   { TQuickFix_HideWithCompilerDirective - hide with compiler directive $warn <id> off }
151 
152   TQuickFix_HideWithCompilerDirective = class(TMsgQuickFix)
153   public
IsApplicablenull154     function IsApplicable(Msg: TMessageLine; out MsgID: integer;
155       out Tool: TCodeTool): boolean;
156     procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
157     procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
158   end;
159 
160   { TQuickFixInheritedMethodIsHidden_AddModifier - add proc modifier 'overload' or 'reintroduce' }
161 
162   TQuickFixInheritedMethodIsHidden_AddModifier = class(TMsgQuickFix)
IsApplicablenull163     function IsApplicable(Msg: TMessageLine; out MsgID: integer): boolean;
164     procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
165     procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
166   end;
167 
168   { TIDEQuickFixes }
169 
170   TIDEQuickFixes = class(TMsgQuickFixes)
171   private
172     FParentMenuItem: TIDEMenuSection;
173     fMenuItemToInfo: TPointerToPointerTree; // TIDEMenuCommand to TMenuItemInfo
174     procedure MenuItemClick(Sender: TObject);
175   public
176     constructor Create(aOwner: TComponent); override;
177     destructor Destroy; override;
178     procedure ClearLines;
179     procedure SetMsgLines(aMsg: TMessageLine);
180     procedure AddMsgLine(aMsg: TMessageLine);
181     procedure OnPopupMenu(aParentMenuItem: TIDEMenuSection);
AddMenuItemnull182     function AddMenuItem(Fix: TMsgQuickFix; Msg: TMessageLine; aCaption: string;
183       aTag: PtrInt=0): TIDEMenuCommand; override;
OpenMsgnull184     function OpenMsg(Msg: TMessageLine): boolean;
185     property ParentMenuItem: TIDEMenuSection read FParentMenuItem write FParentMenuItem;
186   end;
187 
188 var
189   IDEQuickFixes: TIDEQuickFixes = nil;
190 
GetMsgCodetoolPosnull191 function GetMsgCodetoolPos(Msg: TMessageLine; out Code: TCodeBuffer;
192   out Tool: TCodeTool; out CleanPos: integer; out Node: TCodeTreeNode): boolean;
GetMsgSrcPosOfIdentifiernull193 function GetMsgSrcPosOfIdentifier(Msg: TMessageLine; out Identifier: string;
194   out Code: TCodeBuffer; out Tool: TCodeTool; out CleanPos: integer;
195   out Node: TCodeTreeNode): boolean;
GetMsgSrcPosOfThisIdentifiernull196 function GetMsgSrcPosOfThisIdentifier(Msg: TMessageLine; const Identifier: string;
197   out Code: TCodeBuffer; out Tool: TCodeTool; out CleanPos: integer;
198   out Node: TCodeTreeNode): boolean;
199 
200 implementation
201 
202 type
203   TMenuItemInfo = class
204   public
205     MenuItem: TIDEMenuCommand;
206     Fix: TMsgQuickFix;
207     Msg: TMessageLine;
208   end;
209 
210 procedure ShowError(Msg: string);
211 begin
212   IDEMessageDialog(lisQuickFixError, Msg, mtError, [mbCancel]);
213 end;
214 
IsIdentifierInCodenull215 function IsIdentifierInCode(Code: TCodeBuffer; X,Y: integer;
216   Identifier, ErrorMsg: string): boolean;
217 var
218   p: integer;
219   IdentStart: integer;
220   IdentEnd: integer;
221 begin
222   Result:=false;
223   if Code=nil then begin
224     ShowError(ErrorMsg+' (Code=nil)');
225     exit;
226   end;
227   Code.LineColToPosition(Y,X,p);
228   if p<1 then begin
229     ShowError(Format(lisPositionOutsideOfSource, [ErrorMsg]));
230     exit;
231   end;
232   GetIdentStartEndAtPosition(Code.Source,p,IdentStart,IdentEnd);
233   if SysUtils.CompareText(Identifier,copy(Code.Source,IdentStart,IdentEnd-IdentStart))<>0
234   then begin
235     ShowError(ErrorMsg);
236     exit;
237   end;
238   Result:=true;
239 end;
240 
GetMsgCodetoolPosnull241 function GetMsgCodetoolPos(Msg: TMessageLine; out Code: TCodeBuffer;
242   out Tool: TCodeTool; out CleanPos: integer; out Node: TCodeTreeNode): boolean;
243 var
244   Filename: String;
245 begin
246   Result:=false;
247   Tool:=nil;
248   CleanPos:=0;
249   Node:=nil;
250   Filename:=TrimFilename(Msg.GetFullFilename);
251   if (not FilenameIsAbsolute(Filename)) and (not (mlfTestBuildFile in Msg.Flags)) then exit;
252   Code:=CodeToolBoss.LoadFile(Filename,true,false);
253   if Code=nil then exit;
254   CodeToolBoss.Explore(Code,Tool,false);
255   if Tool=nil then exit;
256   if Tool.CaretToCleanPos(CodeXYPosition(Msg.Column,Msg.Line,Code),CleanPos)<>0 then exit;
257   Node:=Tool.FindDeepestNodeAtPos(CleanPos,false);
258   Result:=Node<>nil;
259 end;
260 
GetMsgSrcPosOfIdentifiernull261 function GetMsgSrcPosOfIdentifier(Msg: TMessageLine; out Identifier: string;
262   out Code: TCodeBuffer; out Tool: TCodeTool; out CleanPos: integer; out
263   Node: TCodeTreeNode): boolean;
264 begin
265   Result:=false;
266   Code:=nil;
267   Tool:=nil;
268   CleanPos:=0;
269   Node:=nil;
270   // check if message position is at end of identifier
271   // (FPC gives position of start or end of identifier)
272   if not GetMsgCodetoolPos(Msg,Code,Tool,CleanPos,Node) then exit;
273   Tool.MoveCursorToCleanPos(CleanPos);
274   if (CleanPos>Tool.SrcLen) or (not IsIdentChar[Tool.Src[CleanPos]]) then
275     Tool.ReadPriorAtom
276   else
277     Tool.ReadNextAtom;
278   Identifier:=Tool.GetAtom;
279   CleanPos:=Tool.CurPos.StartPos;
280   Result:=IsValidIdent(Identifier);
281 end;
282 
GetMsgSrcPosOfThisIdentifiernull283 function GetMsgSrcPosOfThisIdentifier(Msg: TMessageLine; const Identifier: string;
284   out Code: TCodeBuffer; out Tool: TCodeTool; out CleanPos: integer;
285   out Node: TCodeTreeNode): boolean;
286 var
287   CurIdentifier: string;
288 begin
289   Result:=GetMsgSrcPosOfIdentifier(Msg,CurIdentifier,Code,Tool,CleanPos,Node)
290      and (CompareIdentifiers(PChar(CurIdentifier),PChar(Identifier))=0);
291 end;
292 
293 { TQuickFixInheritedMethodIsHidden_AddModifier }
294 
IsApplicablenull295 function TQuickFixInheritedMethodIsHidden_AddModifier.IsApplicable(
296   Msg: TMessageLine; out MsgID: integer): boolean;
297 var
298   Value1, Value2: string;
299 begin
300   Result:=false;
301   MsgID:=0;
302   if (not Msg.HasSourcePosition) then exit;
303   if IDEFPCParser.MsgLineIsId(Msg,3057,Value1,Value2) then begin
304     // An inherited method is hidden by "$1;"
305     MsgID:=3057;
306     Result:=true
307   end
308   else if (Msg.SubTool=SubToolPas2js) and (Msg.MsgID=3021) then begin
hidesnull309     // function hides identifier at "$1". Use overload or reintroduce
310     MsgID:=3021;
311     Result:=true;
312   end
313   else if (Msg.SubTool=SubToolPas2js) and (Msg.MsgID=3077) then begin
314     // Method "$1" hides method of base type "$2" at $3
315     MsgID:=3077;
316     Result:=true;
317   end;
318 end;
319 
320 procedure TQuickFixInheritedMethodIsHidden_AddModifier.CreateMenuItems(
321   Fixes: TMsgQuickFixes);
322 var
323   i, MsgID: Integer;
324   Msg: TMessageLine;
325 begin
326   for i:=0 to Fixes.LineCount-1 do begin
327     Msg:=Fixes.Lines[i];
328     if not IsApplicable(Msg,MsgID) then continue;
329     if ((Msg.SubTool=SubToolFPC) and (MsgID=3057))
330     or ((Msg.SubTool=SubToolPas2js) and (MsgID=3077)) then
331       Fixes.AddMenuItem(Self, Msg, lisAddModifierOverride, 3);
332     Fixes.AddMenuItem(Self,Msg,lisAddModifierOverload,1);
333     Fixes.AddMenuItem(Self,Msg,lisAddModifierReintroduce,2);
334   end;
335 end;
336 
337 procedure TQuickFixInheritedMethodIsHidden_AddModifier.QuickFix(
338   Fixes: TMsgQuickFixes; Msg: TMessageLine);
339 var
340   MsgID: integer;
341   Code: TCodeBuffer;
342   OldChange: Boolean;
343   aModifier: String;
344 begin
345   if not IsApplicable(Msg,MsgID) then begin
346     debugln(['TQuickFixInheritedMethodIsHidden_AddOverload.QuickFix invalid message ',Msg.Msg]);
347     exit;
348   end;
349 
350   if not LazarusIDE.BeginCodeTools then begin
351     DebugLn(['TQuickFixInheritedMethodIsHidden_AddOverload failed because IDE busy']);
352     exit;
353   end;
354 
355   Code:=CodeToolBoss.LoadFile(Msg.GetFullFilename,true,false);
356   if Code=nil then exit;
357 
358   OldChange:=LazarusIDE.OpenEditorsOnCodeToolChange;
359   LazarusIDE.OpenEditorsOnCodeToolChange:=true;
360   try
361     case Fixes.CurrentCommand.Tag of
362     2: aModifier:='reintroduce';
363     3: aModifier:='override';
364     else aModifier:='overload';
365     end;
366 
367     if not CodeToolBoss.AddProcModifier(Code,Msg.Column,Msg.Line,aModifier) then
368     begin
369       DebugLn(['TQuickFixInheritedMethodIsHidden_AddOverload AddProcModifier failed']);
370       LazarusIDE.DoJumpToCodeToolBossError;
371       exit;
372     end;
373 
374     // success
375     Msg.MarkFixed;
376   finally
377     LazarusIDE.OpenEditorsOnCodeToolChange:=OldChange;
378   end;
379 end;
380 
381 { TQuickFix_HideWithCompilerDirective }
382 
IsApplicablenull383 function TQuickFix_HideWithCompilerDirective.IsApplicable(Msg: TMessageLine;
384   out MsgID: integer; out Tool: TCodeTool): boolean;
385 var
386   CleanPos: integer;
387   Node: TCodeTreeNode;
388   Code: TCodeBuffer;
389 begin
390   Result:=false;
391   MsgID:=0;
392   Tool:=nil;
393   if (Msg.Urgency>=mluError)
394   or ((Msg.SubTool<>SubToolFPC) and (Msg.SubTool<>SubToolPas2js))
395   or (Msg.MsgID=0)
396   then exit;
397   MsgID:=Msg.MsgID;
398   GetMsgCodetoolPos(Msg,Code,Tool,CleanPos,Node);
399   Result:=(Tool<>nil);
400 end;
401 
402 procedure TQuickFix_HideWithCompilerDirective.CreateMenuItems(
403   Fixes: TMsgQuickFixes);
404 var
405   i, MsgID: Integer;
406   Msg: TMessageLine;
407   Tool: TCodeTool;
408   aCaption: String;
409 begin
410   for i:=0 to Fixes.LineCount-1 do begin
411     Msg:=Fixes.Lines[i];
412     if not IsApplicable(Msg,MsgID,Tool) then continue;
413     aCaption:=Format(lisHideMessageByInsertingWarnOffToUnit, [IntToStr(MsgID),
414       ExtractFilename(Tool.MainFilename)]);
415     Fixes.AddMenuItem(Self,Msg,aCaption);
416   end;
417 end;
418 
419 procedure TQuickFix_HideWithCompilerDirective.QuickFix(Fixes: TMsgQuickFixes;
420   Msg: TMessageLine);
421 var
422   MsgID: integer;
423   Tool: TCodeTool;
424   Code: TCodeBuffer;
425   Comment: String;
426   OldChange: Boolean;
427 begin
428   if not IsApplicable(Msg,MsgID,Tool) then exit;
429 
430   if not LazarusIDE.BeginCodeTools then begin
431     DebugLn(['TQuickFix_HideWithCompilerDirective failed because IDE busy']);
432     exit;
433   end;
434 
435   Code:=CodeToolBoss.LoadFile(Tool.MainFilename,true,false);
436   if Code=nil then begin
437     debugln(['TQuickFix_HideWithCompilerDirective.QuickFix LoadFile failed: ',Tool.MainFilename]);
438     exit;
439   end;
440 
441   OldChange:=LazarusIDE.OpenEditorsOnCodeToolChange;
442   LazarusIDE.OpenEditorsOnCodeToolChange:=true;
443   try
444     Comment:=' : '+TIDEFPCParser.GetFPCMsgPattern(Msg);
445     if not CodeToolBoss.AddUnitWarnDirective(Code,IntToStr(MsgID),Comment,false) then
446     begin
447       DebugLn(['TQuickFix_HideWithCompilerDirective CodeToolBoss.AddUnitWarnDirective failed']);
448       LazarusIDE.DoJumpToCodeToolBossError;
449       exit;
450     end;
451   finally
452     LazarusIDE.OpenEditorsOnCodeToolChange:=OldChange;
453   end;
454 
455   // success
456   Msg.MarkFixed;
457 end;
458 
459 { TQuickFixLocalVarNotInitialized_AddAssignment }
460 
IsApplicablenull461 function TQuickFixLocalVarNotInitialized_AddAssignment.IsApplicable(
462   Msg: TMessageLine; out Identifier: string): boolean;
463 var
464   Tool: TCodeTool;
465   CleanPos: integer;
466   Node: TCodeTreeNode;
467   Code: TCodeBuffer;
468 begin
469   Result:=false;
470   if (Msg=nil) or (Msg.MsgID<1)
471   or ((Msg.SubTool<>SubToolFPC) and (Msg.SubTool<>SubToolPas2js))
472   or (not Msg.HasSourcePosition) then exit;
473 
474   // Check: Local variable "$1" does not seem to be initialized
475   case Msg.MsgID of
476   5036, // W_Local variable "$1" does not seem to be initialized
477   5037, // W_Variable "$1" does not seem to be initialized
478   5057, // H_Local variable "$1" does not seem to be initialized
479   5058, // H_Variable "$1" does not seem to be initialized
480   5089, // W_Local variable "$1" of a managed type does not seem to be initialized
481   5090, // W_Variable "$1" of a managed type does not seem to be initialized
482   5091, // H_Local variable "$1" of a managed type does not seem to be initialized
483   5092: // H_Variable "$1" of a managed type does not seem to be initialized
484     begin
485       Identifier:=TIDEFPCParser.GetFPCMsgValue1(Msg);
486       // check if message position is at end of identifier
487       if not GetMsgSrcPosOfThisIdentifier(Msg,Identifier,Code,Tool,CleanPos,Node)
488       then exit;
489     end;
resultnull490   5059, // W_Function result variable does not seem to initialized
491   5060, // H_Function result variable does not seem to be initialized
492   5093, // W_function result variable of a managed type does not seem to initialized
493   5094: // H_Function result variable of a managed type does not seem to be initialized
494     begin
495       if not GetMsgSrcPosOfIdentifier(Msg,Identifier,Code,Tool,CleanPos,Node)
496       then exit;
497     end;
498   else
499     exit;
500   end;
501   if not IsValidIdent(Identifier) then exit;
502 
503   // check if identifier is in statement and start of expression
504   if not (Node.Desc in AllPascalStatements) then exit;
505   if (Tool.CurPos.Flag in [cafPoint,cafRoundBracketClose,cafEdgedBracketClose,
506                            cafEnd])
507   then exit;
508   Result:=true;
509 end;
510 
511 procedure TQuickFixLocalVarNotInitialized_AddAssignment.CreateMenuItems(
512   Fixes: TMsgQuickFixes);
513 var
514   Msg: TMessageLine;
515   Identifier: String;
516   i: Integer;
517 begin
518   for i:=0 to Fixes.LineCount-1 do begin
519     Msg:=Fixes.Lines[i];
520     if not IsApplicable(Msg,Identifier) then continue;
521     Fixes.AddMenuItem(Self, Msg, Format(lisInsertAssignment, [Identifier]));
522     exit;
523   end;
524 end;
525 
526 procedure TQuickFixLocalVarNotInitialized_AddAssignment.QuickFix(
527   Fixes: TMsgQuickFixes; Msg: TMessageLine);
528 var
529   Identifier: String;
530   Code: TCodeBuffer;
531 begin
532   if not IsApplicable(Msg,Identifier) then exit;
533 
534   if not LazarusIDE.BeginCodeTools then begin
535     DebugLn(['TQuickFixLocalVarNotInitialized_AddAssignment failed because IDE busy']);
536     exit;
537   end;
538 
539   Code:=CodeToolBoss.LoadFile(Msg.GetFullFilename,true,false);
540   if Code=nil then exit;
541 
542   if QuickFixLocalVarNotInitialized(Code, Msg.Column, Msg.Line) then
543     Msg.MarkFixed;
544 end;
545 
546 { TQuickFixSrcPathOfPkgContains_OpenPkg }
547 
IsApplicablenull548 function TQuickFixSrcPathOfPkgContains_OpenPkg.IsApplicable(Msg: TMessageLine;
549   out PkgName: string): boolean;
550 var
551   Dir: string;
552   Pattern: String;
553   p: SizeInt;
554 begin
555   Result:=false;
556   if Msg=nil then exit;
557   if Msg.MsgID<>0 then exit;
558 
559   Pattern:=lisOtherSourcesPathOfPackageContainsDirectoryWhichIsA;
560   p:=Pos('%s',Pattern);
561   if p<1 then begin
562     debugln(['TQuickFixSrcPathOfPkgContains_OpenPkg.IsApplicable resourcestring misses %s: lisOtherSourcesPathOfPackageContainsDirectoryWhichIsA=',lisOtherSourcesPathOfPackageContainsDirectoryWhichIsA]);
563     exit;
564   end;
565   ReplaceSubstring(Pattern,p,2,'$1');
566   p:=Pos('%s',Pattern);
567   if p<1 then begin
568     debugln(['TQuickFixSrcPathOfPkgContains_OpenPkg.IsApplicable resourcestring misses %s: lisOtherSourcesPathOfPackageContainsDirectoryWhichIsA=',lisOtherSourcesPathOfPackageContainsDirectoryWhichIsA]);
569     exit;
570   end;
571   ReplaceSubstring(Pattern,p,2,'$2');
572 
573   if not GetFPCMsgValues2(Msg.Msg,Pattern,PkgName,Dir) then exit;
574   if PkgName='' then exit;
575   PkgName:=GetIdentifier(PChar(PkgName));
576   Result:=IsValidIdent(PkgName);
577 end;
578 
579 procedure TQuickFixSrcPathOfPkgContains_OpenPkg.CreateMenuItems(
580   Fixes: TMsgQuickFixes);
581 var
582   i: Integer;
583   Msg: TMessageLine;
584   PkgName: string;
585 begin
586   for i:=0 to Fixes.LineCount-1 do begin
587     Msg:=Fixes.Lines[i];
588     if not IsApplicable(Msg,PkgName) then continue;
589     Fixes.AddMenuItem(Self, Msg, 'Open package "'+PkgName+'"');
590     exit;
591   end;
592 end;
593 
594 procedure TQuickFixSrcPathOfPkgContains_OpenPkg.QuickFix(Fixes: TMsgQuickFixes;
595   Msg: TMessageLine);
596 var
597   PkgName: string;
598 begin
599   if not IsApplicable(Msg,PkgName) then exit;
600   PackageEditingInterface.DoOpenPackageWithName(PkgName,[pofAddToRecent],false);
601 end;
602 
603 { TQuickFix_HideWithCompilerOption }
604 
IsApplicablenull605 function TQuickFix_HideWithCompilerOption.IsApplicable(Msg: TMessageLine; out
606   ToolData: TIDEExternalToolData; out IDETool: TObject): boolean;
607 begin
608   Result:=false;
609   ToolData:=nil;
610   IDETool:=nil;
611   if (Msg.Urgency>=mluError)
612   or ((Msg.SubTool<>SubToolFPC) and (Msg.SubTool<>SubToolPas2js))
613   or (Msg.MsgID=0)
614   then exit;
615   ToolData:=Msg.GetToolData;
616   if ToolData=nil then exit;
617   IDETool:=ExternalToolList.GetIDEObject(ToolData);
618   Result:=IDETool<>nil;
619 end;
620 
621 procedure TQuickFix_HideWithCompilerOption.CreateMenuItems(Fixes: TMsgQuickFixes
622   );
623 var
624   i: Integer;
625   Msg: TMessageLine;
626   IDETool: TObject;
627   s: String;
628   ToolData: TIDEExternalToolData;
629   CompOpts: TLazCompilerOptions;
630 begin
631   for i:=0 to Fixes.LineCount-1 do begin
632     Msg:=Fixes.Lines[i];
633     if not IsApplicable(Msg,ToolData,IDETool) then continue;
634     if IDETool is TLazProject then begin
635       CompOpts:=TLazProject(IDETool).LazCompilerOptions;
636       if CompOpts.MessageFlags[Msg.MsgID]=cfvHide then exit;
637       s:=Format(lisHideWithProjectOptionVm, [IntToStr(Msg.MsgID)])
638     end else if IDETool is TIDEPackage then begin
639       CompOpts:=TIDEPackage(IDETool).LazCompilerOptions;
640       if CompOpts.MessageFlags[Msg.MsgID]=cfvHide then exit;
641       s:=Format(lisHideWithPackageOptionVm, [IntToStr(Msg.MsgID)]);
642     end else
643       continue;
644     Fixes.AddMenuItem(Self,Msg,s);
645   end;
646   inherited CreateMenuItems(Fixes);
647 end;
648 
649 procedure TQuickFix_HideWithCompilerOption.QuickFix(Fixes: TMsgQuickFixes;
650   Msg: TMessageLine);
651 var
652   IDETool: TObject;
653   CompOpts: TLazCompilerOptions;
654   Pkg: TIDEPackage;
655   ToolData: TIDEExternalToolData;
656   i: Integer;
657   CurMsg: TMessageLine;
658 begin
659   if not IsApplicable(Msg,ToolData,IDETool) then exit;
660   if IDETool is TLazProject then begin
661     CompOpts:=TLazProject(IDETool).LazCompilerOptions;
662     CompOpts.MessageFlags[Msg.MsgID]:=cfvHide;
663   end else if IDETool is TIDEPackage then begin
664     if PackageEditingInterface.DoOpenPackageFile(ToolData.Filename,
665                                         [pofAddToRecent],false)<>mrOk then exit;
666     Pkg:=PackageEditingInterface.FindPackageWithName(ToolData.ModuleName);
667     if Pkg=nil then exit;
668     CompOpts:=Pkg.LazCompilerOptions;
669     CompOpts.MessageFlags[Msg.MsgID]:=cfvHide;
670   end else
671     exit;
672   Msg.MarkFixed;
673   // mark all lines of the View with the same message type
674   for i:=0 to Msg.Lines.Count-1 do begin
675     CurMsg:=Msg.Lines[i];
676     if (CurMsg.MsgID<>Msg.MsgID)
677     or (CurMsg.Urgency>=mluError)
678     or ((CurMsg.SubTool<>SubToolFPC) and (CurMsg.SubTool<>SubToolPas2js))
679     then continue;
680     CurMsg.MarkFixed;
681   end;
682 end;
683 
684 { TQuickFixLocalVariableNotUsed_Remove }
685 
TQuickFixLocalVariableNotUsed_Remove.IsApplicablenull686 function TQuickFixLocalVariableNotUsed_Remove.IsApplicable(Msg: TMessageLine;
687   out Identifier: string): boolean;
688 var
689   Tool: TCodeTool;
690   CleanPos: integer;
691   Node: TCodeTreeNode;
692   Dummy: string;
693   Code: TCodeBuffer;
694 begin
695   Result:=false;
696   // Check: Local variable "$1" not used
697   if IDEFPCParser.MsgLineIsId(Msg,5025,Identifier,Dummy)
698   or IDEPas2jsParser.MsgLineIsId(Msg,5025,Identifier,Dummy) then
699     // ok
700   else
701     exit;
702   if not Msg.HasSourcePosition or not IsValidIdent(Identifier) then exit;
703 
704   // check if message position is at end of identifier
705   if not GetMsgSrcPosOfThisIdentifier(Msg,Identifier,Code,Tool,CleanPos,Node) then exit;
706 
707   // check if identifier is a var definition
708   if not (Node.Desc in [ctnVarDefinition]) then exit;
709   Tool.ReadPriorAtom;
710   if (Tool.CurPos.Flag in [cafPoint,cafRoundBracketClose,cafEdgedBracketClose,
711                            cafEnd])
712   then exit;
713   Result:=true;
714 end;
715 
716 procedure TQuickFixLocalVariableNotUsed_Remove.CreateMenuItems(
717   Fixes: TMsgQuickFixes);
718 var
719   Msg: TMessageLine;
720   Identifier: String;
721   i: Integer;
722 begin
723   for i:=0 to Fixes.LineCount-1 do begin
724     Msg:=Fixes.Lines[i];
725     if not IsApplicable(Msg,Identifier) then continue;
726     Fixes.AddMenuItem(Self, Msg, Format(lisRemoveLocalVariable3, [Identifier]));
727     exit;
728   end;
729 end;
730 
731 procedure TQuickFixLocalVariableNotUsed_Remove.QuickFix(Fixes: TMsgQuickFixes;
732   Msg: TMessageLine);
733 var
734   Identifier: String;
735   Code: TCodeBuffer;
736   OldChange: Boolean;
737 begin
738   if not IsApplicable(Msg,Identifier) then exit;
739 
740   if not LazarusIDE.BeginCodeTools then begin
741     DebugLn(['TQuickFixLocalVariableNotUsed_Remove failed because IDE busy']);
742     exit;
743   end;
744 
745   Code:=CodeToolBoss.LoadFile(Msg.GetFullFilename,true,false);
746   if Code=nil then exit;
747 
748   OldChange:=LazarusIDE.OpenEditorsOnCodeToolChange;
749   LazarusIDE.OpenEditorsOnCodeToolChange:=true;
750   try
751     if not CodeToolBoss.RemoveIdentifierDefinition(Code,Msg.Column,Msg.Line) then
752     begin
753       DebugLn(['TQuickFixLocalVariableNotUsed_Remove remove failed']);
754       LazarusIDE.DoJumpToCodeToolBossError;
755       exit;
756     end;
757   finally
758     LazarusIDE.OpenEditorsOnCodeToolChange:=OldChange;
759   end;
760 
761   // message fixed
762   Msg.MarkFixed;
763 end;
764 
765 { TQuickFixClassWithAbstractMethods }
766 
TQuickFixClassWithAbstractMethods.IsApplicablenull767 function TQuickFixClassWithAbstractMethods.IsApplicable(Msg: TMessageLine; out
768   aClassName: string): boolean;
769 var
770   Dummy: string;
771   Tool: TCodeTool;
772   CleanPos: integer;
773   Node: TCodeTreeNode;
774   MissingMethod: string;
775   Code: TCodeBuffer;
776 begin
777   Result:=false;
778   if (not Msg.HasSourcePosition) then exit;
779   if IDEFPCParser.MsgLineIsId(Msg,4046,aClassname,Dummy)
780   or IDEPas2jsParser.MsgLineIsId(Msg,4046,aClassname,Dummy) then begin
781     // Constructing a class "$1" with abstract method "$2"
782     Result:=true;
783   end else if IDEFPCParser.MsgLineIsId(Msg,5042,MissingMethod,Dummy)
784   or IDEFPCParser.MsgLineIsId(Msg,5042,MissingMethod,Dummy) then begin
785     // No matching implementation for interface method "$1" found
786     // The position is on the 'class' keyword
787     // The MissingMethod is 'interfacename.procname'
788     if not GetMsgCodetoolPos(Msg,Code,Tool,CleanPos,Node) then exit;
789     if not (Node.Desc in AllClassObjects) then exit;
790     aClassName:=Tool.ExtractClassName(Node,false);
791     Result:=aClassName<>'';
792   end;
793 end;
794 
795 procedure TQuickFixClassWithAbstractMethods.CreateMenuItems(
796   Fixes: TMsgQuickFixes);
797 var
798   Msg: TMessageLine;
799   aClassName: string;
800   i: Integer;
801 begin
802   for i:=0 to Fixes.LineCount-1 do begin
803     Msg:=Fixes.Lines[i];
804     if not IsApplicable(Msg,aClassName) then continue;
805     Fixes.AddMenuItem(Self, Msg, Format(lisShowAbstractMethodsOf, [aClassName])
806       );
807     exit;
808   end;
809 end;
810 
811 procedure TQuickFixClassWithAbstractMethods.QuickFix(Fixes: TMsgQuickFixes;
812   Msg: TMessageLine);
813 var
814   Code: TCodeBuffer;
815   aClassName: string;
816   Tool: TCodeTool;
817   NewCode: TCodeBuffer;
818   NewX: integer;
819   NewY: integer;
820   NewTopLine: integer;
821   CleanPos: integer;
822   Node: TCodeTreeNode;
823 begin
824   if not IsApplicable(Msg,aClassName) then exit;
825 
826   if not LazarusIDE.BeginCodeTools then begin
827     DebugLn(['TQuickFixClassWithAbstractMethods failed because IDE busy']);
828     exit;
829   end;
830 
831   if not GetMsgCodetoolPos(Msg,Code,Tool,CleanPos,Node) then begin
832     DebugLn(['TQuickFixClassWithAbstractMethods no tool for ',Msg.GetFullFilename]);
833     ShowError('QuickFix: ClassWithAbstractMethods no tool for '+Msg.GetFullFilename);
834     exit;
835   end;
836 
837   if not CodeToolBoss.FindDeclarationOfIdentifier(Code,Msg.Column,Msg.Line,
838     @aClassName[1],NewCode,NewX,NewY,NewTopLine)
839   then begin
840     if CodeToolBoss.ErrorMessage<>'' then begin
841       LazarusIDE.DoJumpToCodeToolBossError
842     end else begin
843       IDEMessageDialog(lisClassNotFound,
844         Format(lisClassNotFoundAt, [aClassName, Code.Filename, IntToStr(Msg.Line
845           ), IntToStr(Msg.Column)]),
846         mtError,[mbCancel]);
847     end;
848     exit;
849   end;
850   //DebugLn(['TQuickFixClassWithAbstractMethods Declaration at ',NewCode.Filename,' ',NewX,',',NewY]);
851 
852   if LazarusIDE.DoOpenFileAndJumpToPos(NewCode.Filename,
853     Point(NewX,NewY),NewTopLine,-1,-1,[])<>mrOK
854   then begin
855     DebugLn(['TQuickFixClassWithAbstractMethods failed opening ',NewCode.Filename]);
856     ShowError('QuickFix: ClassWithAbstractMethods failed opening '+NewCode.Filename);
857     exit;
858   end;
859 
860   ShowAbstractMethodsDialog;
861 end;
862 
863 { TQuickFixUnitNotFound_Remove }
864 
IsApplicablenull865 function TQuickFixUnitNotFound_Remove.IsApplicable(Msg: TMessageLine; out
866   MissingUnitName, UsedByUnit: string): boolean;
867 begin
868   Result:=false;
869   if Msg=nil then exit;
870   if (Msg.SubTool=SubToolFPC) then begin
871     if Msg.HasSourcePosition
872     and ((Msg.MsgID=5023) // Unit "$1" not used in $2
873       or (Msg.MsgID=FPCMsgIDCantFindUnitUsedBy) // Can't find unit $1 used by $2
874       or (Msg.MsgID=10023)) // Unit $1 was not found but $2 exists
875     then
876       // ok
877     else exit;
878   end else if (Msg.SubTool=SubToolPas2js) then begin
879     if Msg.HasSourcePosition
880     and ((Msg.MsgID=5023) // Unit "$1" not used in $2
881       or (Msg.MsgID=3073)) // Can't find unit $1
882     then
883       // ok
884     else exit;
885   end else
886     exit;
887 
888   MissingUnitName:=Msg.Attribute[FPCMsgAttrMissingUnit];
889   UsedByUnit:=Msg.Attribute[FPCMsgAttrUsedByUnit];
890   if (MissingUnitName='')
891   and not IDEFPCParser.GetFPCMsgValues(Msg,MissingUnitName,UsedByUnit) then begin
892     debugln(['TQuickFixUnitNotFound_Remove.IsApplicable failed to extract unit names: ',Msg.Msg]);
893     exit;
894   end;
895   Result:=true;
896 end;
897 
898 procedure TQuickFixUnitNotFound_Remove.CreateMenuItems(Fixes: TMsgQuickFixes);
899 var
900   Msg: TMessageLine;
901   MissingUnitName: string;
902   UsedByUnit: string;
903   i: Integer;
904 begin
905   for i:=0 to Fixes.LineCount-1 do begin
906     Msg:=Fixes.Lines[i];
907     if not IsApplicable(Msg,MissingUnitName,UsedByUnit) then continue;
908     Fixes.AddMenuItem(Self, Msg, Format(lisRemoveUses, [MissingUnitName]));
909     exit;
910   end;
911 end;
912 
913 procedure TQuickFixUnitNotFound_Remove.QuickFix(Fixes: TMsgQuickFixes;
914   Msg: TMessageLine);
915 var
916   MissingUnitName: string;
917   SrcUnitName: string;
918   Code: TCodeBuffer;
919   OldChange: Boolean;
920 begin
921   if not IsApplicable(Msg,MissingUnitName,SrcUnitName) then begin
922     debugln(['TQuickFixUnitNotFound_Remove.QuickFix invalid message ',Msg.Msg]);
923     exit;
924   end;
925 
926   if not LazarusIDE.BeginCodeTools then begin
927     DebugLn(['TQuickFixUnitNotFound_Remove failed because IDE busy']);
928     exit;
929   end;
930 
931   Code:=CodeToolBoss.LoadFile(Msg.GetFullFilename,true,false);
932   if Code=nil then exit;
933 
934   OldChange:=LazarusIDE.OpenEditorsOnCodeToolChange;
935   LazarusIDE.OpenEditorsOnCodeToolChange:=true;
936   try
937     if not CodeToolBoss.RemoveUnitFromAllUsesSections(Code,MissingUnitName) then
938     begin
939       DebugLn(['TQuickFixUnitNotFound_Remove RemoveUnitFromAllUsesSections failed']);
940       LazarusIDE.DoJumpToCodeToolBossError;
941       exit;
942     end;
943 
944     // success
945     Msg.MarkFixed;
946   finally
947     LazarusIDE.OpenEditorsOnCodeToolChange:=OldChange;
948   end;
949 end;
950 
951 { TQuickFixIdentifierNotFoundAddLocal }
952 
IsApplicablenull953 function TQuickFixIdentifierNotFoundAddLocal.IsApplicable(Msg: TMessageLine;
954   out Identifier: string): boolean;
955 var
956   Code: TCodeBuffer;
957   Tool: TCodeTool;
958   CleanPos: integer;
959   Node: TCodeTreeNode;
960   Dummy: string;
961 begin
962   Result:=false;
963   Identifier:='';
964   // check: identifier not found "$1"
965   if IDEFPCParser.MsgLineIsId(Msg,5000,Identifier,Dummy)
966   or IDEPas2jsParser.MsgLineIsId(Msg,3001,Identifier,Dummy) then
967     // ok
968   else
969     exit;
970   if not Msg.HasSourcePosition or not IsValidIdent(Identifier) then exit;
971 
972   // check if message position is at identifier
973   if not GetMsgSrcPosOfThisIdentifier(Msg,Identifier,Code,Tool,CleanPos,Node) then exit;
974 
975   // check if identifier is expression start in statement
976   if not (Node.Desc in AllPascalStatements) then exit;
977   if (Tool.CurPos.Flag in [cafPoint,cafRoundBracketClose,cafEdgedBracketClose,
978                            cafEnd])
979   then exit;
980   Result:=true;
981 end;
982 
983 procedure TQuickFixIdentifierNotFoundAddLocal.CreateMenuItems(
984   Fixes: TMsgQuickFixes);
985 var
986   Msg: TMessageLine;
987   Identifier: String;
988   i: Integer;
989 begin
990   for i:=0 to Fixes.LineCount-1 do begin
991     Msg:=Fixes.Lines[i];
992     if not IsApplicable(Msg,Identifier) then continue;
993     Fixes.AddMenuItem(Self, Msg, Format(lisCreateLocalVariable, [Identifier]));
994     // ToDo: add private/public variable
995     exit;
996   end;
997 end;
998 
999 procedure TQuickFixIdentifierNotFoundAddLocal.QuickFix(Fixes: TMsgQuickFixes;
1000   Msg: TMessageLine);
1001 var
1002   Identifier: String;
1003   Code: TCodeBuffer;
1004   NewCode: TCodeBuffer;
1005   NewX: integer;
1006   NewY: integer;
1007   NewTopLine: integer;
1008   OldChange: Boolean;
1009 begin
1010   if not IsApplicable(Msg,Identifier) then exit;
1011 
1012   if not LazarusIDE.BeginCodeTools then begin
1013     DebugLn(['TQuickFixIdentifierNotFoundAddLocal.Execute failed because IDE busy']);
1014     exit;
1015   end;
1016 
1017   Code:=CodeToolBoss.LoadFile(Msg.GetFullFilename,true,false);
1018   if Code=nil then exit;
1019 
1020   OldChange:=LazarusIDE.OpenEditorsOnCodeToolChange;
1021   LazarusIDE.OpenEditorsOnCodeToolChange:=true;
1022   try
1023     if not CodeToolBoss.CreateVariableForIdentifier(Code,Msg.Column,Msg.Line,-1,
1024                NewCode,NewX,NewY,NewTopLine,False)
1025     then begin
1026       LazarusIDE.DoJumpToCodeToolBossError;
1027       exit;
1028     end;
1029   finally
1030     LazarusIDE.OpenEditorsOnCodeToolChange:=OldChange;
1031   end;
1032 
1033   // success
1034   Msg.MarkFixed;
1035 end;
1036 
1037 { TQuickFix_HideWithIDEDirective }
1038 
1039 procedure TQuickFix_HideWithIDEDirective.QuickFix(Fixes: TMsgQuickFixes; Msg: TMessageLine);
1040 var
1041   Code: TCodeBuffer;
1042 
1043   procedure Fix(CurMsg: TMessageLine);
1044   var
1045     p: integer;
1046     aFilename: String;
1047   begin
1048     aFilename:=CurMsg.GetFullFilename;
1049     if (Code=nil) or (CompareFilenames(aFilename,Code.Filename)<>0) then begin
1050       Code:=CodeToolBoss.LoadFile(aFilename,true,false);
1051       if Code=nil then begin
1052         DebugLn(['TQuickFix_Hide.MenuItemClick ']);
1053         // ToDo: IDEMessageDialog
1054         exit;
1055       end;
1056     end;
1057     Code.LineColToPosition(CurMsg.Line,CurMsg.Column,p);
1058     if p<1 then begin
1059       DebugLn(['TQuickFix_Hide failed because invalid line, column']);
1060       {IDEMessageDialog(lisCCOErrorCaption,
1061         Format(lisInvalidLineColumnInMessage, [LineEnding, Msg.Msg]),
1062         mtError, [mbCancel]);}
1063       exit;
1064     end;
1065 
1066     debugln(['TQuickFix_Hide.MenuItemClick ',Code.Filename,' ',CurMsg.Line,',',CurMsg.Column]);
1067     Code.Insert(p,'{%H-}');
1068     CurMsg.Flags:=CurMsg.Flags+[mlfHiddenByIDEDirectiveValid,mlfHiddenByIDEDirective];
1069     CurMsg.MarkFixed;
1070   end;
1071 
1072 var
1073   Tree: TAvlTree;
1074   Node: TAvlTreeNode;
1075   i: Integer;
1076   OldChange: Boolean;
1077 begin
1078   OldChange:=LazarusIDE.OpenEditorsOnCodeToolChange;
1079   LazarusIDE.OpenEditorsOnCodeToolChange:=true;
1080   Tree:=TAvlTree.Create(@CompareMsgLinesSrcPos);
1081   try
1082     // get all messages to hide and sort them for position
1083     if Msg=nil then begin
1084       for i:=0 to Fixes.LineCount-1 do begin
1085         Msg:=Fixes.Lines[i];
1086         if not IsApplicable(Msg) then continue;
1087         Tree.Add(Msg);
1088       end;
1089     end else if IsApplicable(Msg) then
1090       Tree.Add(Msg);
1091     if Tree.Count=0 then exit;
1092 
1093     {if not LazarusIDE.BeginCodeTools then begin
1094       DebugLn(['TQuickFix_Hide failed because IDE busy']);
1095       exit;
1096     end;}
1097 
1098     // insert marks beginning with the highest line,column
1099     Code:=nil;
1100     Node:=Tree.FindHighest;
1101     while Node<>nil do begin
1102       Msg:=TMessageLine(Node.Data);
1103       Fix(Msg);
1104       Node:=Node.Precessor;
1105     end;
1106   finally
1107     LazarusIDE.OpenEditorsOnCodeToolChange:=OldChange;
1108     Tree.Free;
1109   end;
1110 end;
1111 
IsApplicablenull1112 function TQuickFix_HideWithIDEDirective.IsApplicable(Msg: TMessageLine): boolean;
1113 begin
1114   Result:=false;
1115   if (Msg.Urgency>=mluError)
1116   or ((Msg.SubTool<>SubToolFPC) and (Msg.SubTool<>SubToolPas2js))
1117   or (not Msg.HasSourcePosition)
1118   or (mlfHiddenByIDEDirective in Msg.Flags)
1119   then exit;
1120   Result:=true;
1121 end;
1122 
1123 procedure TQuickFix_HideWithIDEDirective.CreateMenuItems(Fixes: TMsgQuickFixes);
1124 var
1125   Msg: TMessageLine;
1126   i: Integer;
1127   List: TFPList;
1128   aCaption: String;
1129   aFilename: String;
1130   MultiFile: Boolean;
1131 begin
1132   List:=TFPList.Create;
1133   try
1134     MultiFile:=false;
1135     aFilename:='';
1136     for i:=0 to Fixes.LineCount-1 do begin
1137       Msg:=Fixes.Lines[i];
1138       if not IsApplicable(Msg) then continue;
1139       if aFilename='' then
1140         aFilename:=Msg.GetFullFilename
1141       else if CompareFilenames(aFilename,Msg.GetFullFilename)<>0 then
1142         MultiFile:=true;
1143       List.Add(Msg);
1144     end;
1145     if List.Count=0 then exit;
1146     if List.Count>1 then
1147       Fixes.AddMenuItem(Self, nil,
1148         lisHideAllHintsAndWarningsByInsertingIDEDirectivesH);
1149 
1150     for i:=0 to List.Count-1 do begin
1151       Msg:=TMessageLine(List[i]);
1152       if MultiFile then
1153         aCaption:=Msg.GetShortFilename
1154       else
1155         aCaption:='';
1156       if List.Count>1 then
1157         aCaption+='('+IntToStr(Msg.Line)+','+IntToStr(Msg.Column)+')';
1158       if aCaption<>'' then
1159         aCaption:=Format(lisHideMessageAtByInsertingIDEDirectiveH, [aCaption])
1160       else
1161         aCaption:=lisHideMessageByInsertingIDEDirectiveH;
1162       Fixes.AddMenuItem(Self,Msg,aCaption);
1163     end;
1164   finally
1165     List.Free;
1166   end;
1167 end;
1168 
1169 { TIDEQuickFixes }
1170 
1171 procedure TIDEQuickFixes.MenuItemClick(Sender: TObject);
1172 var
1173   i: Integer;
1174   Info: TMenuItemInfo;
1175   ListsMsgLines: TFPList;
1176   MsgLines: TMessageLines;
1177   Cmd: TIDEMenuCommand;
1178 begin
1179   Cmd:=Sender as TIDEMenuCommand;
1180   Info:=TMenuItemInfo(fMenuItemToInfo[Cmd]);
1181   if Info=nil then exit;
1182   FCurrentSender:=Sender;
1183   FCurrentCommand:=Cmd;
1184   try
1185     Info.Fix.QuickFix(Self,Info.Msg);
1186   finally
1187     ListsMsgLines:=TFPList.Create;
1188     try
1189       for i:=0 to LineCount-1 do begin
1190         MsgLines:=Lines[i].Lines;
1191         if ListsMsgLines.IndexOf(MsgLines)>=0 then continue;
1192         ListsMsgLines.Add(MsgLines);
1193       end;
1194       for i:=0 to ListsMsgLines.Count-1 do
1195         TMessageLines(ListsMsgLines[i]).ApplyFixedMarks;
1196     finally
1197       FCurrentSender:=nil;
1198       FCurrentCommand:=nil;
1199       ListsMsgLines.Free;
1200     end;
1201   end;
1202 end;
1203 
1204 constructor TIDEQuickFixes.Create(aOwner: TComponent);
1205 begin
1206   inherited Create(aOwner);
1207   IDEQuickFixes:=Self;
1208   MsgQuickFixes:=Self;
1209   fMenuItemToInfo:=TPointerToPointerTree.Create;
1210 
1211   // init standard quickfixes
1212   // add them in the order of usefulness
1213   IDEQuickFixes.RegisterQuickFix(TQuickFixIdentifierNotFoundAddLocal.Create);
1214   IDEQuickFixes.RegisterQuickFix(TQuickFixLocalVariableNotUsed_Remove.Create);
1215   IDEQuickFixes.RegisterQuickFix(TQuickFixLocalVarNotInitialized_AddAssignment.Create);
1216   IDEQuickFixes.RegisterQuickFix(TQuickFixUnitNotFound_Remove.Create);
1217   IDEQuickFixes.RegisterQuickFix(TQuickFixClassWithAbstractMethods.Create);
1218   IDEQuickFixes.RegisterQuickFix(TQuickFixSrcPathOfPkgContains_OpenPkg.Create);
1219   IDEQuickFixes.RegisterQuickFix(TQuickFixInheritedMethodIsHidden_AddModifier.Create);
1220 
1221   // add as last (no fix, just hide message)
1222   IDEQuickFixes.RegisterQuickFix(TQuickFix_HideWithIDEDirective.Create);
1223   IDEQuickFixes.RegisterQuickFix(TQuickFix_HideWithCompilerDirective.Create);
1224   IDEQuickFixes.RegisterQuickFix(TQuickFix_HideWithCompilerOption.Create);
1225 end;
1226 
1227 destructor TIDEQuickFixes.Destroy;
1228 begin
1229   fMenuItemToInfo.ClearWithFree;
1230   FreeAndNil(fMenuItemToInfo);
1231   MsgQuickFixes:=nil;
1232   IDEQuickFixes:=nil;
1233   inherited Destroy;
1234 end;
1235 
1236 procedure TIDEQuickFixes.OnPopupMenu(aParentMenuItem: TIDEMenuSection);
1237 var
1238   i: Integer;
1239 begin
1240   ParentMenuItem:=aParentMenuItem;
1241   try
1242     if LineCount=0 then exit;
1243     for i:=0 to Count-1 do
1244       Items[i].CreateMenuItems(Self);
1245   finally
1246     ParentMenuItem:=nil;
1247   end;
1248 end;
1249 
1250 procedure TIDEQuickFixes.SetMsgLines(aMsg: TMessageLine);
1251 begin
1252   ClearLines;
1253   if aMsg<>nil then
1254     fMsg.Add(aMsg);
1255 end;
1256 
1257 procedure TIDEQuickFixes.AddMsgLine(aMsg: TMessageLine);
1258 begin
1259   if (aMsg<>nil) and (fMsg.IndexOf(aMsg)<0) then
1260     fMsg.Add(aMsg);
1261 end;
1262 
1263 procedure TIDEQuickFixes.ClearLines;
1264 var
1265   i: Integer;
1266 begin
1267   fMenuItemToInfo.ClearWithFree;
1268   for i:=ComponentCount-1 downto 0 do
1269     if Components[i] is TMenuItem then
1270       Components[i].Free;
1271   fMsg.Clear;
1272 end;
1273 
TIDEQuickFixes.AddMenuItemnull1274 function TIDEQuickFixes.AddMenuItem(Fix: TMsgQuickFix; Msg: TMessageLine;
1275   aCaption: string; aTag: PtrInt): TIDEMenuCommand;
1276 var
1277   Info: TMenuItemInfo;
1278 begin
1279   if (Fix=nil) then
1280     raise Exception.Create('missing Fix');
1281   if (aCaption='') then
1282     raise Exception.Create('missing Caption');
1283   if (ParentMenuItem.Count>50) then exit(nil);
1284   Result:=RegisterIDEMenuCommand(ParentMenuItem,
1285     'MsgQuickFix'+IntToStr(ParentMenuItem.Count),aCaption,@MenuItemClick);
1286   Result.Tag:=aTag;
1287   Info:=TMenuItemInfo.Create;
1288   Info.Fix:=Fix;
1289   Info.Msg:=Msg;
1290   Info.MenuItem:=Result;
1291   fMenuItemToInfo[Result]:=Info;
1292 end;
1293 
TIDEQuickFixes.OpenMsgnull1294 function TIDEQuickFixes.OpenMsg(Msg: TMessageLine): boolean;
1295 var
1296   i: Integer;
1297 begin
1298   Result:=false;
1299   if Msg=nil then exit;
1300   for i:=0 to Count-1 do begin
1301     Items[i].JumpTo(Msg,Result);
1302     if Result then exit;
1303   end;
1304 end;
1305 
1306 end.
1307 
1308