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 show information about the message
25 "recompiling unit1, checksum changed for unit2"
26
27 ToDo:
28 - show the location(s) of the first unit
29 - show the location(s) of the second unit
30 - actions:
31 - open a source file
32 - open a package
33 - delete a ppu+o file
34 - recompile a package clean (remove the .compiled file)
35 }
36 unit InspectChksumChangedDlg;
37
38 {$mode objfpc}{$H+}
39
40 interface
41
42 uses
43 // RTL + FCL + LCL
44 Classes, SysUtils, contnrs,
45 LCLProc, Forms, Controls, StdCtrls, ExtCtrls, ComCtrls, ButtonPanel,
46 // CodeTools
47 CodeToolManager, FileProcs, DirectoryCacher, DefineTemplates,
48 // LazUtils
49 LazFileUtils, LazFileCache,
50 // IDEIntf
51 TextTools, IDEMsgIntf, PackageIntf, ProjectIntf, IDEExternToolIntf,
52 // IDE
53 LazarusIDEStrConsts;
54
55 const
56 ICC_FPC = '#FPC unit search path';
57 ICC_Project = '#Project';
58 type
59 TInspectChksumChgDialog = class;
60
61 { TICCAction }
62
63 TICCAction = class
64 public
65 Dlg: TInspectChksumChgDialog;
66 Caption: string;
67 constructor Create(aDlg: TInspectChksumChgDialog; aCaption: string);
68 end;
69
70 { TICCFile }
71
72 TICCFile = class(TComponent)
73 public
74 Filename: string;
75 Age: integer;
76 OwnerNames: TStringList;
77 constructor Create(AOwner: TComponent); override;
78 destructor Destroy; override;
79 end;
80
81 { TICCFiles }
82
83 TICCFiles = class(TComponentList)
84 private
GetFilesnull85 function GetFiles(Index: integer): TICCFile;
86 procedure SetFiles(Index: integer; const AValue: TICCFile);
87 public
88 property Files[Index: integer]: TICCFile read GetFiles write SetFiles; default;
89 end;
90
91 { TInspectChksumChgDialog }
92
93 TInspectChksumChgDialog = class(TForm)
94 ButtonPanel1: TButtonPanel;
95 InfoGroupBox: TGroupBox;
96 ProgressBar1: TProgressBar;
97 ActionsRadioGroup: TRadioGroup;
98 Splitter1: TSplitter;
99 InfoTreeView: TTreeView;
100 procedure CancelClick(Sender: TObject);
101 procedure OkClick(Sender: TObject);
102 procedure FormCreate(Sender: TObject);
103 procedure FormDestroy(Sender: TObject);
104 private
105 FMsg: string;
106 FUnit1: string;
107 FUnit1Files: TICCFiles;
108 FUnit2: string;
109 FUnit2Files: TICCFiles;
110 procedure FindUnitOwnerNames(aFile: TICCFile);
111 procedure SearchDirectory(anUnitName: string; Dir: string;
112 IsFPCPath: boolean; Files: TICCFiles);
113 procedure SearchInFPCFiles(anUnitName: string; Files: TICCFiles);
114 procedure SearchInSearchPath(anUnitName, SearchPath: string; Files: TICCFiles);
SearchUnitnull115 function SearchUnit(anUnitName, SearchPath: string): TICCFiles;
116 procedure AddNodesForUnit(anUnitName: string; Files: TICCFiles);
117 public
118 procedure InitWithMsg(const aMsg, aUnitName1, aUnitName2: string);
119 property Msg: string read FMsg;
120 property Unit1: string read FUnit1;
121 property Unit2: string read FUnit2;
122 property Unit1Files: TICCFiles read FUnit1Files;
123 property Unit2Files: TICCFiles read FUnit2Files;
124 end;
125
126 type
127 { TQuickFixRecompilingChecksumChanged }
128
129 TQuickFixRecompilingChecksumChanged = class(TMsgQuickFix)
130 public
IsApplicablenull131 function IsApplicable(Msg: TMessageLine; out Unitname1, Unitname2: string): boolean;
132 procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
133 procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
134 end;
135
136 procedure InitInspectChecksumChangedQuickFixItems;
137
138 implementation
139
140 procedure InitInspectChecksumChangedQuickFixItems;
141 begin
142 RegisterIDEMsgQuickFix(TQuickFixRecompilingChecksumChanged.Create);
143 end;
144
145 { TICCFile }
146
147 constructor TICCFile.Create(AOwner: TComponent);
148 begin
149 inherited Create(AOwner);
150 OwnerNames:=TStringList.Create;
151 end;
152
153 destructor TICCFile.Destroy;
154 begin
155 FreeAndNil(OwnerNames);
156 inherited Destroy;
157 end;
158
159 { TICCFiles }
160
GetFilesnull161 function TICCFiles.GetFiles(Index: integer): TICCFile;
162 begin
163 Result:=TICCFile(Items[Index]);
164 end;
165
166 procedure TICCFiles.SetFiles(Index: integer; const AValue: TICCFile);
167 begin
168 Items[Index]:=AValue;
169 end;
170
171 { TICCAction }
172
173 constructor TICCAction.Create(aDlg: TInspectChksumChgDialog; aCaption: string);
174 begin
175 Dlg:=aDlg;
176 Caption:=aCaption;
177 end;
178
179 {$R *.lfm}
180
181 { TInspectChksumChgDialog }
182
183 procedure TInspectChksumChgDialog.FormCreate(Sender: TObject);
184 begin
185 Caption:='Inspect checksum changed message';
186 InfoGroupBox.Caption:='Hints:';
187 ActionsRadioGroup.Caption:='Actions';
188
189 ButtonPanel1.OKButton.OnClick:=@OkClick;
190 ButtonPanel1.CancelButton.OnClick:=@CancelClick;
191 ProgressBar1.Visible:=false;
192 end;
193
194 procedure TInspectChksumChgDialog.OkClick(Sender: TObject);
195 begin
196 ModalResult:=mrOK;
197 end;
198
199 procedure TInspectChksumChgDialog.CancelClick(Sender: TObject);
200 begin
201 ModalResult:=mrCancel;
202 end;
203
204 procedure TInspectChksumChgDialog.FormDestroy(Sender: TObject);
205 begin
206 FreeAndNil(FUnit1Files);
207 FreeAndNil(FUnit2Files);
208 end;
209
210 procedure TInspectChksumChgDialog.FindUnitOwnerNames(aFile: TICCFile);
211 var
212 Owners: TFPList;
213 i: Integer;
214 begin
215 Owners:=PackageEditingInterface.GetPossibleOwnersOfUnit(aFile.Filename,
216 [piosfIncludeSourceDirectories]);
217 //debugln(['TInspectChksumChgDialog.FindUnitOwnerNames ',aFile.Filename,' ',DbgSName(Owners)]);
218 if Owners<>nil then begin
219 for i:=0 to Owners.Count-1 do begin
220 if TObject(Owners[i]) is TIDEPackage then
221 aFile.OwnerNames.Add(TIDEPackage(Owners[i]).Name)
222 else if TObject(Owners[i]) is TLazProject then
223 aFile.OwnerNames.Add(ICC_Project);
224 end;
225 Owners.Free;
226 end;
227 end;
228
229 procedure TInspectChksumChgDialog.SearchDirectory(anUnitName: string;
230 Dir: string; IsFPCPath: boolean; Files: TICCFiles);
231 var
232 DirCache: TCTDirectoryCache;
233 i: Integer;
234 Filename: PChar;
235 aFile: TICCFile;
236 j: Integer;
237 begin
238 if (Dir='') or (not FilenameIsAbsolute(Dir)) then exit;
239 // search in directory for all files that could be sources or ppu files of this unit
240 DirCache:=CodeToolBoss.DirectoryCachePool.GetCache(Dir,true,false);
241 if (DirCache=nil) or (DirCache.Listing=nil) then exit;
242 for i:=0 to DirCache.Listing.Count-1 do begin
243 Filename:=DirCache.Listing.GetFilename(i);
244 if FilenameExtIn(Filename,['.pas','.pp','.p','.ppu'])
245 and (CompareText(anUnitName,ExtractFileNameOnly(Filename))=0)
246 then begin
247 j:=Files.Count-1;
248 while (j>=0) and (CompareFilenames(Files[j].Filename,Filename)<>0) do
249 dec(j);
250 if j<0 then begin
251 //debugln(['TInspectChksumChgDialog.SearchUnit Unit="',anUnitName,'" Filename="',Filename,'"']);
252 aFile:=TICCFile.Create(nil);
253 aFile.Filename:=AppendPathDelim(Dir)+Filename;
254 aFile.Age:=FileAgeCached(aFile.Filename);
255 FindUnitOwnerNames(aFile);
256 if IsFPCPath then
257 aFile.OwnerNames.Add(ICC_FPC);
258 Files.Add(aFile);
259 end;
260 end;
261 end;
262 end;
263
264 procedure TInspectChksumChgDialog.SearchInSearchPath(anUnitName,
265 SearchPath: string; Files: TICCFiles);
266 var
267 CurDir: String;
268 p: LongInt;
269 l: Integer;
270 StartPos: Integer;
271 begin
272 // search in search path
273 StartPos:=1;
274 l:=length(SearchPath);
275 while StartPos<=l do begin
276 p:=StartPos;
277 while (p<=l) and (SearchPath[p]<>';') do inc(p);
278 CurDir:=TrimFilename(copy(SearchPath,StartPos,p-StartPos));
279 SearchDirectory(anUnitName,CurDir,false,Files);
280 StartPos:=p+1;
281 end;
282 end;
283
284 procedure TInspectChksumChgDialog.SearchInFPCFiles(
285 anUnitName: string; Files: TICCFiles);
286 var
287 UnitSetID: String;
288 UnitSet: TFPCUnitSetCache;
289 CfgCache: TPCTargetConfigCache;
290 i: Integer;
291 HasChanged: boolean;
292 CurDir: String;
293 begin
294 // search in fpc unit paths
295 UnitSetID:=CodeToolBoss.GetUnitSetIDForDirectory('');
296 if UnitSetID='' then exit;
297 UnitSet:=CodeToolBoss.CompilerDefinesCache.FindUnitSetWithID(UnitSetID,HasChanged,false);
298 if UnitSet=nil then exit;
299 CfgCache:=UnitSet.GetConfigCache(false);
300 if CfgCache=nil then exit;
301 if CfgCache.UnitPaths=nil then exit;
302 for i:=0 to CfgCache.UnitPaths.Count-1 do begin
303 CurDir:=TrimFilename(CfgCache.UnitPaths[i]);
304 SearchDirectory(anUnitName,CurDir,false,Files);
305 end;
306 end;
307
TInspectChksumChgDialog.SearchUnitnull308 function TInspectChksumChgDialog.SearchUnit(anUnitName, SearchPath: string
309 ): TICCFiles;
310 begin
311 Result:=TICCFiles.create(true);
312 if (anUnitName='') then exit;
313
314 SearchInSearchPath(anUnitName,SearchPath,Result);
315 SearchInFPCFiles(anUnitName,Result);
316 end;
317
318 procedure TInspectChksumChgDialog.AddNodesForUnit(anUnitName: string;
319 Files: TICCFiles);
320 var
321 UnitNode: TTreeNode;
322 i: Integer;
323 aFile: TICCFile;
324 FileNode: TTreeNode;
325 OwnerName: string;
326 j: Integer;
327 s: String;
328 APackage: TIDEPackage;
329 PPUCount: Integer;
330 SrcCount: Integer;
331 begin
332 UnitNode:=InfoTreeView.Items.Add(nil,'Unit '+anUnitName);
333 if Files<>nil then begin
334 PPUCount:=0;
335 SrcCount:=0;
336 FileNode:=nil;
337 for i:=0 to Files.Count-1 do begin
338 aFile:=Files[i];
339 if FilenameExtIs(aFile.Filename,'ppu',true) then
340 inc(PPUCount)
341 else
342 inc(SrcCount);
343 FileNode:=InfoTreeView.Items.AddChildObject(UnitNode,aFile.Filename,aFile);
344 for j:=0 to aFile.OwnerNames.Count-1 do begin
345 OwnerName:=aFile.OwnerNames[j];
346 if OwnerName=ICC_FPC then begin
347 s:=lisInFPCUnitSearchPathProbablyInstalledByTheFPCPackag;
348 end else if OwnerName=ICC_Project then begin
349 s:=lisInASourceDirectoryOfTheProjectCheckForDuplicates;
350 end else begin
351 s:=Format(lisInASourceDirectoryOfThePackage, [OwnerName]);
352 APackage:=PackageEditingInterface.FindPackageWithName(OwnerName);
353 if APackage<>nil then begin
354 if APackage.IsVirtual then begin
355 s:=Format(lisCheckTheTargetOSCPULCLWidgetTypeMaybeYouHaveToReco, [s]);
356 end else begin
357 s:=Format(lisMaybeYouHaveToRecompileThePackage, [s]);
358 end;
359 end;
360 end;
361 if s<>'' then
362 InfoTreeView.Items.AddChild(FileNode,s);
363 end;
364 end;
365 if PPUCount>1 then begin
366 // ToDo: Fix uninitialized FileNode. It is initialized inside a loop, this is outside of the loop.
367 InfoTreeView.Items.AddChild(FileNode,
368 lisDuplicatePpuFilesDeleteOneOrMakeSureAllSearchPaths);
369 end;
370 if SrcCount>1 then begin
371 InfoTreeView.Items.AddChild(FileNode,
372 lisDuplicateSourcesDeleteOneOrMakeSureAllSearchPathsH);
373 end;
374 end;
375 UnitNode.Expand(true);
376 end;
377
378 procedure TInspectChksumChgDialog.InitWithMsg(const aMsg, aUnitName1,
379 aUnitName2: string);
380 var
381 SearchPath: String;
382 begin
383 FMsg:=aMsg;
384 FUnit1:=aUnitName1;
385 FUnit2:=aUnitName2;
386 FreeAndNil(FUnit1Files);
387 FreeAndNil(FUnit2Files);
388
389 SearchPath:=CodeToolBoss.GetCompleteSrcPathForDirectory('');
390 //debugln(['TInspectChksumChgDialog.InitWithMsg SearchPath=',SearchPath]);
391 FUnit1Files:=SearchUnit(Unit1,SearchPath);
392 FUnit2Files:=SearchUnit(Unit2,SearchPath);
393
394 InfoTreeView.BeginUpdate;
395 InfoTreeView.Items.Clear;
396
397 InfoTreeView.Items.Add(nil,'Message: '+dbgstr(Msg));
398
399 AddNodesForUnit(Unit1,Unit1Files);
400 AddNodesForUnit(Unit2,Unit2Files);
401
402 InfoTreeView.EndUpdate;
403 end;
404
405 { TQuickFixRecompilingChecksumChanged }
406
IsApplicablenull407 function TQuickFixRecompilingChecksumChanged.IsApplicable(Msg: TMessageLine;
408 out Unitname1, Unitname2: string): boolean;
409 begin
410 // check: Recompiling $1, checksum changed for $2
411 Result:=IDEFPCParser.MsgLineIsId(Msg,10028,Unitname1,Unitname2);
412 end;
413
414 procedure TQuickFixRecompilingChecksumChanged.CreateMenuItems(
415 Fixes: TMsgQuickFixes);
416 var
417 Msg: TMessageLine;
418 Unitname1: string;
419 Unitname2: string;
420 i: Integer;
421 begin
422 for i:=0 to Fixes.LineCount-1 do begin
423 Msg:=Fixes.Lines[i];
424 if not IsApplicable(Msg,Unitname1,Unitname2) then continue;
425 Fixes.AddMenuItem(Self,Msg,'Explore message "checksum changed"');
426 exit;
427 end;
428 end;
429
430 procedure TQuickFixRecompilingChecksumChanged.QuickFix(Fixes: TMsgQuickFixes;
431 Msg: TMessageLine);
432 var
433 Unit1: String;
434 Unit2: String;
435 Dlg: TInspectChksumChgDialog;
436 begin
437 if not IsApplicable(Msg,Unit1,Unit2) then exit;
438 debugln(['TQuickFixRecompilingChecksumChanged.Execute Unit1=',REVar(1),', checksum changed for Unit2=',REVar(2)]);
439 Dlg:=TInspectChksumChgDialog.Create(nil);
440 try
441 Dlg.InitWithMsg(Msg.Msg,Unit1,Unit2);
442 Dlg.ShowModal;
443 finally
444 Dlg.Free;
445 end;
446 end;
447
448 end.
449
450