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