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 Dialog to search a missing unit.
25
26 ToDo:
27 - search in packages on disk
28
29 }
30 unit FindUnitDlg;
31
32 {$mode objfpc}{$H+}
33
34 interface
35
36 uses
37 Classes, SysUtils, LCLProc, Forms, Controls, ExtCtrls,
38 StdCtrls, ComCtrls, LazFileUtils, Laz2_XMLCfg, LazFileCache,
39 // codetools
40 CodeToolsStrConsts, CodeCache, CodeToolManager,
41 // IDEIntf
42 LazIDEIntf, IDEMsgIntf, PackageLinkIntf, PackageIntf, IDEExternToolIntf,
43 // IDE
44 DialogProcs, PackageDefs, Project, IDEProcs, LazarusIDEStrConsts,
45 etFPCMsgParser, PackageLinks, PackageSystem, BasePkgManager;
46
47 type
48 TFindUnitDialog = class;
49
50 { TMissingUnit_QuickFix }
51
52 TMissingUnit_QuickFix = class
53 public
54 Dlg: TFindUnitDialog;
55 Caption: string;
56 constructor Create(aDlg: TFindUnitDialog; aCaption: string);
57 end;
58
59 { TMissingUnit_QuickFix_RemoveFromUses }
60
61 TMissingUnit_QuickFix_RemoveFromUses = class(TMissingUnit_QuickFix)
62 public
63 constructor Create(aDlg: TFindUnitDialog);
64 end;
65
66 { TMissingUnit_QuickFix_AddRequirement }
67
68 TMissingUnit_QuickFix_AddRequirement = class(TMissingUnit_QuickFix)
69 public
70 PackageName: string;
71 constructor Create(aDlg: TFindUnitDialog; aPackageName: string);
72 end;
73
74 { TFindUnitDialog }
75
76 TFindUnitDialog = class(TForm)
77 OkButton: TButton;
78 CancelButton: TButton;
79 BtnPanel: TPanel;
80 InfoGroupBox: TGroupBox;
81 ProgressBar1: TProgressBar;
82 QuickFixRadioGroup: TRadioGroup;
83 Splitter1: TSplitter;
84 InfoTreeView: TTreeView;
85 procedure FormCreate(Sender: TObject);
86 procedure FormDestroy(Sender: TObject);
87 procedure OkButtonClick(Sender: TObject);
88 procedure OnIdle(Sender: TObject; var Done: Boolean);
89 private
90 FCode: TCodeBuffer;
91 FMainOwner: TObject;
92 FMainOwnerName: string;
93 FMissingUnitName: string;
94 FSearchPackages: TStrings;
95 FSearchPackagesIndex: integer;
96 fQuickFixes: TFPList;// list of TMissingUnit_QuickFix
97 fLastUpdateProgressBar: TDateTime;
98 procedure InitSearchPackages;
99 procedure OnIteratePkgLinks(APackage: TLazPackageID);
100 procedure AddQuickFix(Item: TMissingUnit_QuickFix);
101 procedure AddRequirement(Item: TMissingUnit_QuickFix_AddRequirement);
102 procedure RemoveFromUsesSection(Item: TMissingUnit_QuickFix_RemoveFromUses);
MainOwnerHasRequirementnull103 function MainOwnerHasRequirement(PackageName: string): boolean;
104 procedure UpdateProgressBar;
CheckPackageOnDisknull105 function CheckPackageOnDisk(PkgFilename: string): boolean;
FindQuickFixAddRequirementnull106 function FindQuickFixAddRequirement(PkgName: string): TMissingUnit_QuickFix_AddRequirement;
107 public
108 procedure InitWithMsg(Line: string; aCode: TCodeBuffer;
109 aMissingUnitName: string);
110 property Code: TCodeBuffer read FCode;
111 property MissingUnitName: string read FMissingUnitName;
112 property MainOwner: TObject read FMainOwner;
113 property MainOwnerName: string read FMainOwnerName;
114 end;
115
116 type
117 { TQuickFixUnitNotFound_Search - add menu item to open this search dialog }
118
119 TQuickFixUnitNotFound_Search = class(TMsgQuickFix)
120 public
IsApplicablenull121 function IsApplicable(Msg: TMessageLine; out MissingUnit, UsedByUnit: string): boolean;
122 procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
123 procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
124 end;
125
126 { TQuickFixIncludeNotFound_Search - add menu item to open this search dialog }
127
128 TQuickFixIncludeNotFound_Search = class(TMsgQuickFix)
129 public
IsApplicablenull130 function IsApplicable(Msg: TMessageLine; out IncludeFile: string): boolean;
131 procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
132 procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
IsCodetoolsErrorIncludeFileNotFoundnull133 function IsCodetoolsErrorIncludeFileNotFound(Msg: string;
134 out IncludeFile: string): boolean;
135 end;
136
137 procedure InitFindUnitQuickFixItems;
138
139 implementation
140
141 {$R *.lfm}
142
143 procedure InitFindUnitQuickFixItems;
144 begin
145 RegisterIDEMsgQuickFix(TQuickFixUnitNotFound_Search.Create);
146 // ToDo: implement RegisterIDEMsgQuickFix(TQuickFixIncludeNotFound_Search.Create);
147 end;
148
149 { TQuickFixUnitNotFound_Search }
150
IsApplicablenull151 function TQuickFixUnitNotFound_Search.IsApplicable(Msg: TMessageLine; out
152 MissingUnit, UsedByUnit: string): boolean;
153 begin
154 Result:=false;
155 if Msg=nil then exit;
156 if Msg.MsgID<>FPCMsgIDCantFindUnitUsedBy then exit;
157 MissingUnit:=Msg.Attribute[FPCMsgAttrMissingUnit];
158 UsedByUnit:=Msg.Attribute[FPCMsgAttrUsedByUnit];
159 if (MissingUnit='')
160 and not IDEFPCParser.GetFPCMsgValues(Msg,MissingUnit,UsedByUnit) then begin
161 debugln(['TQuickFixUnitNotFound_Search.IsApplicable failed to extract unit names: ',Msg.Msg]);
162 exit;
163 end;
164 Result:=true;
165 end;
166
167 procedure TQuickFixUnitNotFound_Search.CreateMenuItems(Fixes: TMsgQuickFixes);
168 var
169 Msg: TMessageLine;
170 MissingUnit: string;
171 UsedByUnit: string;
172 i: Integer;
173 begin
174 for i:=0 to Fixes.LineCount-1 do begin
175 Msg:=Fixes.Lines[i];
176 if not IsApplicable(Msg,MissingUnit,UsedByUnit) then continue;
177 Fixes.AddMenuItem(Self, Msg, Format(lisSearchUnit, [MissingUnit]));
178 exit;
179 end;
180 end;
181
182 procedure TQuickFixUnitNotFound_Search.QuickFix(Fixes: TMsgQuickFixes;
183 Msg: TMessageLine);
184 var
185 MissingUnit: String;
186 UsedByUnit: string;
187 CodeBuf: TCodeBuffer;
188 Dlg: TFindUnitDialog;
189 StartFilename: String;
190 begin
191 // get unitname
192 if not IsApplicable(Msg,MissingUnit,UsedByUnit) then exit;
193 DebugLn(['TQuickFixUnitNotFound_Search.Execute Unit=',MissingUnit]);
194
195 if not IsValidIdent(MissingUnit) then begin
196 DebugLn(['TQuickFixUnitNotFound_Search.Execute not an identifier "',dbgstr(MissingUnit),'"']);
197 exit;
198 end;
199
200 if not LazarusIDE.BeginCodeTools then begin
201 DebugLn(['TQuickFixUnitNotFound_Search.Execute failed because IDE busy']);
202 exit;
203 end;
204
205 StartFilename:=Msg.GetFullFilename;
206 CodeBuf:=CodeToolBoss.LoadFile(StartFilename,true,false);
207 if CodeBuf=nil then begin
208 debugln(['TQuickFixUnitNotFound_Search.QuickFix cannot open file "',StartFilename,'", Msg="',Msg.Line,'"']);
209 exit;
210 end;
211
212 // show dialog
213 Dlg:=TFindUnitDialog.Create(nil);
214 try
215 Dlg.InitWithMsg(Msg.Msg,CodeBuf,MissingUnit);
216 Dlg.ShowModal;
217 finally
218 Dlg.Free;
219 end;
220 end;
221
222 { TFindUnitDialog }
223
224 procedure TFindUnitDialog.FormCreate(Sender: TObject);
225 begin
226 fQuickFixes:=TFPList.Create;
227
228 Caption:=lisFindMissingUnit;
229 CancelButton.Caption:=lisCancel;
230 OkButton.Caption:=lisMenuOk;
231 OkButton.Enabled:=false;
232 InfoGroupBox.Caption:=lisInformation;
233 QuickFixRadioGroup.Caption:=lisQuickFixes;
234
235 Application.AddOnIdleHandler(@OnIdle);
236 end;
237
238 procedure TFindUnitDialog.FormDestroy(Sender: TObject);
239 var
240 i: Integer;
241 begin
242 Application.RemoveOnIdleHandler(@OnIdle);
243 for i:=0 to fQuickFixes.Count-1 do TObject(fQuickFixes[i]).Free;
244 FreeAndNil(fQuickFixes);
245 FreeAndNil(FSearchPackages);
246 end;
247
248 procedure TFindUnitDialog.OkButtonClick(Sender: TObject);
249 var
250 i: LongInt;
251 Item: TMissingUnit_QuickFix;
252 begin
253 i:=QuickFixRadioGroup.ItemIndex;
254 if i<0 then begin
255 OkButton.Enabled:=false;
256 exit;
257 end;
258 Item:=TMissingUnit_QuickFix(fQuickFixes[i]);
259 if Item is TMissingUnit_QuickFix_RemoveFromUses then
260 RemoveFromUsesSection(TMissingUnit_QuickFix_RemoveFromUses(Item))
261 else if Item is TMissingUnit_QuickFix_AddRequirement then
262 AddRequirement(TMissingUnit_QuickFix_AddRequirement(Item));
263 end;
264
265 procedure TFindUnitDialog.OnIdle(Sender: TObject; var Done: Boolean);
266 var
267 Filename: string;
268 i: Integer;
269 APackage: TLazPackage;
270 Found: Boolean;
271 t: TDateTime;
272 begin
273 t:=Now;
274 while (FSearchPackages<>nil) and (FSearchPackagesIndex<FSearchPackages.Count)
275 do begin
276 Filename:=FSearchPackages[FSearchPackagesIndex];
277 Found:=false;
278
279 // search in open packages
280 for i:=0 to PackageGraph.Count-1 do begin
281 APackage:=PackageGraph.Packages[i];
282 if APackage.Filename=Filename then begin
283 Found:=true;
284 if APackage.FindUnit(MissingUnitName)<>nil then begin
285 APackage:=TLazPackage(
286 PackageEditingInterface.RedirectPackageDependency(APackage));
287 if MainOwnerHasRequirement(APackage.Name) then begin
288 // already in requirements
289 end else if FindQuickFixAddRequirement(APackage.Name)=nil then begin
290 // not yet in requirements -> add a quick fix
291 AddQuickFix(TMissingUnit_QuickFix_AddRequirement.Create(Self,APackage.Name));
292 end;
293 end;
294 break;
295 end;
296 end;
297
298 // search in package on disk
299 if not Found then begin
300 if CheckPackageOnDisk(Filename) then Found:=true;
301 end;
302
303 inc(FSearchPackagesIndex);
304 if FSearchPackagesIndex>=FSearchPackages.Count then begin
305 AddQuickFix(TMissingUnit_QuickFix_RemoveFromUses.Create(Self));
306 end;
307
308 UpdateProgressBar;
309 Done:=false;
310 if Now-t>0.5/86400 then
311 exit;
312 // process another package
313 end;
314 Done:=true;
315 end;
316
317 procedure TFindUnitDialog.InitSearchPackages;
318 var
319 i: Integer;
320 APackage: TLazPackage;
321 Filename: String;
322 begin
323 if FSearchPackages=nil then
324 FSearchPackages:=TStringList.Create;
325 FSearchPackages.Clear;
326 FSearchPackagesIndex:=0;
327 if MainOwner=nil then exit;
328
329 // add open packages
330 for i:=0 to PackageGraph.Count-1 do begin
331 APackage:=PackageGraph.Packages[i];
332 Filename:=APackage.GetResolvedFilename(true);
333 //DebugLn(['TFindUnitDialog.InitSearchPackages ',APackage.Name,' ',Filename]);
334 if (Filename='') or (not FileExistsCached(Filename)) then continue;
335 FSearchPackages.Add(APackage.Filename);
336 end;
337 //DebugLn(['TFindUnitDialog.InitSearchPackages ',FSearchPackages.Text]);
338
339 // add user package links
340 LazPackageLinks.IteratePackages(false,@OnIteratePkgLinks,[ploUser,ploGlobal]);
341
342 if FSearchPackages.Count>0 then begin
343 ProgressBar1.Max:=FSearchPackages.Count;
344 fLastUpdateProgressBar:=Now;
345 ProgressBar1.Visible:=true;
346 end;
347 end;
348
349 procedure TFindUnitDialog.OnIteratePkgLinks(APackage: TLazPackageID);
350 var
351 Link: TLazPackageLink;
352 begin
353 if APackage is TLazPackageLink then begin
354 Link:=TLazPackageLink(APackage);
355 FSearchPackages.Add(TrimFilename(Link.GetEffectiveFilename));
356 end;
357 end;
358
359 procedure TFindUnitDialog.AddQuickFix(Item: TMissingUnit_QuickFix);
360 begin
361 fQuickFixes.Add(Item);
362 QuickFixRadioGroup.Items.Add(Item.Caption);
363 if QuickFixRadioGroup.ItemIndex<0 then
364 QuickFixRadioGroup.ItemIndex:=0;
365 OkButton.Enabled:=true;
366 end;
367
368 procedure TFindUnitDialog.AddRequirement(Item: TMissingUnit_QuickFix_AddRequirement);
369 var
370 AProject: TProject;
371 APackage: TLazPackage;
372 NewDependency: TPkgDependency;
373 begin
374 if MainOwner is TProject then begin
375 AProject:=TProject(MainOwner);
376 //debugln(['TFindUnitDialog.AddRequirement project: ',Item.PackageName]);
377 NewDependency:=TPkgDependency.Create;
378 NewDependency.PackageName:=Item.PackageName;
379 if PkgBoss.AddProjectDependency(AProject,NewDependency)=mrOk then
380 ModalResult:=mrOK;
381 end else if MainOwner is TLazPackage then begin
382 APackage:=TLazPackage(MainOwner);
383 if PkgBoss.AddPackageDependency(APackage,Item.PackageName)=mrOk then
384 ModalResult:=mrOK;
385 end;
386 end;
387
388 procedure TFindUnitDialog.RemoveFromUsesSection(
389 Item: TMissingUnit_QuickFix_RemoveFromUses);
390 begin
391 if Item=nil then ;
392 if not CodeToolBoss.RemoveUnitFromAllUsesSections(Code,MissingUnitName) then
393 begin
394
395 end else
396 ModalResult:=mrOk;
397 end;
398
MainOwnerHasRequirementnull399 function TFindUnitDialog.MainOwnerHasRequirement(PackageName: string): boolean;
400 var
401 AProject: TProject;
402 APackage: TLazPackage;
403 begin
404 Result:=false;
405 if MainOwner=nil then exit;
406 if MainOwner is TProject then begin
407 AProject:=TProject(MainOwner);
408 Result:=PackageGraph.FindDependencyRecursively(
409 AProject.FirstRequiredDependency,PackageName)<>nil;
410 end else if MainOwner is TLazPackage then begin
411 APackage:=TLazPackage(MainOwner);
412 if CompareText(APackage.Name,PackageName)=0 then
413 Result:=true
414 else
415 Result:=PackageGraph.FindDependencyRecursively(
416 APackage.FirstRequiredDependency,PackageName)<>nil;
417 end;
418 end;
419
420 procedure TFindUnitDialog.UpdateProgressBar;
421 begin
422 if (FSearchPackages=nil) or (FSearchPackagesIndex>=FSearchPackages.Count) then
423 begin
424 ProgressBar1.Visible:=false;
425 end;
426 if Now-fLastUpdateProgressBar>1/86400 then begin
427 ProgressBar1.Position:=FSearchPackagesIndex;
428 fLastUpdateProgressBar:=Now;
429 end;
430 end;
431
CheckPackageOnDisknull432 function TFindUnitDialog.CheckPackageOnDisk(PkgFilename: string): boolean;
433 var
434 r: TModalResult;
435 XMLConfig: TXMLConfig;
436 XMLCode: TCodeBuffer;
437 Path: String;
438 FileCount: LongInt;
439 i: Integer;
440 SubPath: String;
441 FileType: TPkgFileType;
442 AUnitName: String;
443 Filename: String;
444 PkgName: String;
445 begin
446 Result:=false;
447 PkgName:=ExtractFileNameOnly(PkgFilename);
448 if FindQuickFixAddRequirement(PkgName)<>nil then exit;
449 if not FileExistsCached(PkgFilename) then exit;
450 //DebugLn(['TFindUnitDialog.CheckPackageOnDisk ',PkgFilename]);
451
452 XMLConfig:=nil;
453 XMLCode:=nil;
454 try
455 //DebugLn(['TFindUnitDialog.CheckPackageOnDisk loading: ',PkgFilename]);
456 XMLConfig:=TXMLConfig.Create(nil);
457 r:=LoadXMLConfigFromCodeBuffer(PkgFilename,XMLConfig,
458 XMLCode,[lbfUpdateFromDisk,lbfRevert,lbfQuiet],false);
459 if r<>mrOk then begin
460 //DebugLn(['TFindUnitDialog.CheckPackageOnDisk failed loading: ',PkgFilename]);
461 exit;
462 end;
463 Path:='Package/Files/';
464 FileCount:=XMLConfig.GetValue(Path+'Count',0);
465 //DebugLn(['TFindUnitDialog.CheckPackageOnDisk FileCount=',FileCount,' ',PkgName]);
466 for i:=1 to FileCount do begin
467 SubPath:=Path+'Item'+IntToStr(i)+'/';
468 FileType:=PkgFileTypeIdentToType(XMLConfig.GetValue(SubPath+'Type/Value',''));
469 if not (FileType in PkgFileRealUnitTypes) then continue;
470 Filename:=XMLConfig.GetValue(SubPath+'Filename/Value','');
471 AUnitName:=ExtractFileNameOnly(Filename);
472 //DebugLn(['TFindUnitDialog.CheckPackageOnDisk ',UnitName]);
473 if SysUtils.CompareText(AUnitName,MissingUnitName)=0 then begin
474 Result:=true;
475 AddQuickFix(TMissingUnit_QuickFix_AddRequirement.Create(Self,PkgName));
476 exit;
477 end;
478 end;
479 finally
480 XMLConfig.Free;
481 end;
482 end;
483
FindQuickFixAddRequirementnull484 function TFindUnitDialog.FindQuickFixAddRequirement(PkgName: string
485 ): TMissingUnit_QuickFix_AddRequirement;
486 var
487 i: Integer;
488 begin
489 Result:=nil;
490 if fQuickFixes=nil then exit;
491 for i:=0 to fQuickFixes.Count-1 do begin
492 if TObject(fQuickFixes[i]) is TMissingUnit_QuickFix_AddRequirement then begin
493 Result:=TMissingUnit_QuickFix_AddRequirement(fQuickFixes[i]);
494 if SysUtils.CompareText(Result.PackageName,PkgName)=0 then exit;
495 end;
496 end;
497 Result:=nil;
498 end;
499
500 procedure TFindUnitDialog.InitWithMsg(Line: string;
501 aCode: TCodeBuffer; aMissingUnitName: string);
502
503 procedure AddPaths(ParentTVNode: TTreeNode; PathTitle, BaseDir, Paths: string;
504 Expanded: boolean);
505 var
506 p: Integer;
507 s: String;
508 PathsNode: TTreeNode;
509 begin
510 PathsNode:=InfoTreeView.Items.AddChild(ParentTVNode,PathTitle);
511 Paths:=CreateAbsoluteSearchPath(Paths,BaseDir);
512 p:=1;
513 repeat
514 s:=GetNextDirectoryInSearchPath(Paths,p);
515 if s<>'' then
516 InfoTreeView.Items.AddChild(PathsNode,dbgstr(s));
517 until p>length(Paths);
518 PathsNode.Expanded:=Expanded;
519 if (ParentTVNode<>nil) and Expanded then
520 ParentTVNode.Expanded:=true;
521 end;
522
523 var
524 UnitPath: String;
525 Directory: String;
526 DirNode: TTreeNode;
527 Owners: TFPList;
528 i: Integer;
529 OwnerNode: TTreeNode;
530 AProject: TProject;
531 APackage: TLazPackage;
532 begin
533 FCode:=aCode;
534 FMissingUnitName:=aMissingUnitName;
535 FMainOwner:=nil;
536 FMainOwnerName:='';
537
538 InfoTreeView.BeginUpdate;
539 InfoTreeView.Items.Clear;
540
541 Owners:=nil;
542 try
543 InfoTreeView.Items.Add(nil,'Message: '+dbgstr(Line));
544 InfoTreeView.Items.Add(nil,'File: '+dbgstr(aCode.Filename));
545 InfoTreeView.Items.Add(nil,'Missing unit: '+dbgstr(aMissingUnitName));
546 Directory:=ExtractFilePath(aCode.Filename);
547 DirNode:=InfoTreeView.Items.Add(nil,'Directory: '+dbgstr(Directory));
548
549 // unit path of directory
550 UnitPath:=CodeToolBoss.GetUnitPathForDirectory(Directory);
551 AddPaths(DirNode,'IDE unit search path:',Directory,UnitPath,false);
552
553 //
554 Owners:=PackageEditingInterface.GetOwnersOfUnit(aCode.Filename);
555 if Owners<>nil then begin
556 for i:=0 to Owners.Count-1 do begin
557 if TObject(Owners[i]) is TProject then begin
558 AProject:=TProject(Owners[i]);
559 if FMainOwner=nil then begin
560 FMainOwner:=AProject;
561 FMainOwnerName:='project';
562 end;
563 OwnerNode:=InfoTreeView.Items.Add(nil,'Owner: Project');
564 AddPaths(OwnerNode,'Unit search paths',AProject.Directory,
565 AProject.CompilerOptions.GetUnitPath(true),true);
566
567 end
568 else if TObject(Owners[i]) is TLazPackage then begin
569 APackage:=TLazPackage(Owners[i]);
570 if FMainOwner=nil then begin
571 FMainOwner:=APackage;
572 FMainOwnerName:=APackage.Name;
573 end;
574 OwnerNode:=InfoTreeView.Items.Add(nil,'Owner: Package '+APackage.IDAsString);
575 AddPaths(OwnerNode,'Unit search paths',APackage.Directory,
576 APackage.CompilerOptions.GetUnitPath(true),true);
577 end;
578 end;
579 end;
580 finally
581 Owners.Free;
582 end;
583
584 InfoTreeView.EndUpdate;
585
586 InitSearchPackages;
587 end;
588
589 { TMissingUnit_QuickFix }
590
591 constructor TMissingUnit_QuickFix.Create(aDlg: TFindUnitDialog; aCaption: string);
592 begin
593 Dlg:=aDlg;;
594 Caption:=aCaption;
595 end;
596
597 { TMissingUnit_QuickFix_AddRequirement }
598
599 constructor TMissingUnit_QuickFix_AddRequirement.Create(aDlg: TFindUnitDialog;
600 aPackageName: string);
601 begin
602 PackageName:=aPackageName;
603 Caption:='Add package '+PackageName+' as requirement to '+aDlg.MainOwnerName;
604 end;
605
606 { TMissingUnit_QuickFix_RemoveFromUses }
607
608 constructor TMissingUnit_QuickFix_RemoveFromUses.Create(aDlg: TFindUnitDialog);
609 begin
610 Dlg:=aDlg;
611 Caption:='Remove unit from uses clause';
612 end;
613
614 { TQuickFixIncludeNotFound_Search }
615
TQuickFixIncludeNotFound_Search.IsApplicablenull616 function TQuickFixIncludeNotFound_Search.IsApplicable(Msg: TMessageLine; out
617 IncludeFile: string): boolean;
618 var
619 Dummy: string;
620 begin
621 debugln(['TQuickFixIncludeNotFound_Search.IsApplicable ',Msg.Msg,' ',TIDEFPCParser.MsgLineIsId(Msg,2013,IncludeFile,Dummy),' ',IsCodetoolsErrorIncludeFileNotFound(Msg.Msg,IncludeFile)]);
622 if TIDEFPCParser.MsgLineIsId(Msg,2013,IncludeFile,Dummy) then
623 Result:=true // Can't open include file "$1"
624 else
625 Result:=IsCodetoolsErrorIncludeFileNotFound(Msg.Msg,IncludeFile);
626 if IncludeFile='' then
627 Result:=false;
628 end;
629
630 procedure TQuickFixIncludeNotFound_Search.CreateMenuItems(Fixes: TMsgQuickFixes
631 );
632 var
633 IncludeFile: string;
634 Msg: TMessageLine;
635 i: Integer;
636 begin
637 for i:=0 to Fixes.LineCount-1 do begin
638 Msg:=Fixes.Lines[i];
639 if not IsApplicable(Msg,IncludeFile) then continue;
640 Fixes.AddMenuItem(Self,Msg,'Search Include File "'+ExtractFilename(IncludeFile)+'"');
641 exit;
642 end;
643 end;
644
645 procedure TQuickFixIncludeNotFound_Search.QuickFix(Fixes: TMsgQuickFixes;
646 Msg: TMessageLine);
647 var
648 IncludeFilename: string;
649 CodeBuf: TCodeBuffer;
650 Dlg: TFindUnitDialog;
651 begin
652 DebugLn(['TQuickFixIncludeNotFound_Search.Execute ']);
653 if not IsApplicable(Msg,IncludeFilename) then exit;
654 DebugLn(['TQuickFixIncludeNotFound_Search.Execute include file=',IncludeFilename]);
655
656 if not LazarusIDE.BeginCodeTools then begin
657 DebugLn(['TQuickFixIncludeNotFound_Search.Execute failed because IDE busy']);
658 exit;
659 end;
660
661 CodeBuf:=CodeToolBoss.LoadFile(Msg.GetFullFilename,true,false);
662 if CodeBuf=nil then begin
663 debugln(['TQuickFixIncludeNotFound_Search.QuickFix can not load file "',Msg.GetFullFilename,'"']);
664 exit;
665 end;
666
667 // show dialog
668 Dlg:=TFindUnitDialog.Create(nil);
669 try
670 Dlg.InitWithMsg(Msg.Msg,CodeBuf,IncludeFilename);
671 Dlg.ShowModal;
672 finally
673 Dlg.Free;
674 end;
675 end;
676
IsCodetoolsErrorIncludeFileNotFoundnull677 function TQuickFixIncludeNotFound_Search.IsCodetoolsErrorIncludeFileNotFound(
678 Msg: string; out IncludeFile: string): boolean;
679 var
680 SearchStr: String;
681 p: integer;
682 StartPos: LongInt;
683 begin
684 IncludeFile:='';
685 // check for codetools 'include file not found'
686 SearchStr:=ctsIncludeFileNotFound;
687 p:=System.Pos('%',SearchStr);
688 if p>0 then SearchStr:=copy(SearchStr,1,p-1);
689 SearchStr:=SearchStr+': '+SearchStr; // e.g.: ': include file not found "'
690 p:=System.Pos(SearchStr,Msg);
691 if p<1 then exit(false);
692 Result:=true;
693 inc(p,length(SearchStr));
694 StartPos:=p;
695 while (p<=length(Msg)) and (Msg[p]<>'"') do inc(p);
696 IncludeFile:=copy(Msg,StartPos,p-StartPos);
697 end;
698
699 end.
700
701