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 IDE dialog showing packages needing (re)build.
25 }
26 unit IDEInfoNeedBuild;
27
28 {$mode objfpc}{$H+}
29
30 interface
31
32 uses
33 Classes, SysUtils, Laz_AVL_Tree,
34 // LCL
35 Forms, Controls, StdCtrls, ButtonPanel, LCLType,
36 // LazUtils
37 LazUtilities,
38 // IdeIntf
39 IDEWindowIntf, LazIDEIntf, ProjectIntf, PackageIntf,
40 // IDE
41 LazarusIDEStrConsts, PackageDefs, PackageSystem, Project, InputHistory,
42 EnvironmentOpts, IDEProcs, BuildManager;
43
44 type
45 TINeedBuild = (
46 inbNone,
47 inbNo,
48 inbNormal,
49 inbClean
50 );
51
52 TInfoNeedBuildItem = class
53 public
54 Target: TObject; // TProject, TLazPackage, LazarusIDE
55 Caption: string;
56 Filename: string;
57 NeedBuild: TINeedBuild;
58 Note: string;
59 end;
60
61 { TIDEInfoNeedBuildDlg }
62
63 TIDEInfoNeedBuildDlg = class(TForm)
64 ButtonPanel1: TButtonPanel;
65 MainMemo: TMemo;
66 TargetComboBox: TComboBox;
67 TargetLabel: TLabel;
68 procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
69 procedure FormCreate(Sender: TObject);
70 procedure FormDestroy(Sender: TObject);
71 procedure FormKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
72 procedure OnIdle(Sender: TObject; var {%H-}Done: Boolean);
73 procedure TargetComboBoxChange(Sender: TObject);
74 private
75 FIdleConnected: boolean;
76 FMainTarget: TObject;
77 FSkipDesignTimePackages: boolean;
78 FTargetToItem: TAvlTree; // tree of TInfoNeedBuildItem sorted for Target
79 FTargets: TFPList; // topologically sorted list of TInfoNeedBuildItem, last=main
80 procedure FillTargets;
ProjectAsTargetnull81 function ProjectAsTarget(AProject: TProject): string;
IDEAsTargetnull82 function IDEAsTarget: string;
83 procedure SetIdleConnected(AValue: boolean);
CheckNeedBuildnull84 function CheckNeedBuild(All: boolean): boolean;// true = complete
GetTargetsnull85 function GetTargets(Target: string): TFPList;
HaveSameTargetsnull86 function HaveSameTargets(BuildItems, Targets: TFPList): boolean;
87 procedure ClearTargets;
88 procedure SetMainTarget(AValue: TObject);
89 public
90 property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
91 property MainTarget: TObject read FMainTarget write SetMainTarget;
92 property SkipDesignTimePackages: boolean read FSkipDesignTimePackages
93 write FSkipDesignTimePackages;
94 end;
95
96 procedure ShowNeedBuildDialog;
97
CompareInfoNeedBuildItemWithTargetsnull98 function CompareInfoNeedBuildItemWithTargets(Info1, Info2: Pointer): integer;
CompareTargetWithInfoNeedBuildItemnull99 function CompareTargetWithInfoNeedBuildItem(Target, Info: Pointer): integer;
100
101 implementation
102
103 {$R *.lfm}
104
105 procedure ShowNeedBuildDialog;
106 var
107 IDEInfoNeedBuildDlg: TIDEInfoNeedBuildDlg;
108 begin
109 IDEInfoNeedBuildDlg:=TIDEInfoNeedBuildDlg.Create(nil);
110 try
111 IDEInfoNeedBuildDlg.ShowModal;
112 finally
113 IDEInfoNeedBuildDlg.Free;
114 end;
115 end;
116
CompareInfoNeedBuildItemWithTargetsnull117 function CompareInfoNeedBuildItemWithTargets(Info1, Info2: Pointer): integer;
118 var
119 Item1: TInfoNeedBuildItem absolute Info1;
120 Item2: TInfoNeedBuildItem absolute Info2;
121 begin
122 Result:=ComparePointers(Item1.Target,Item2.Target);
123 end;
124
CompareTargetWithInfoNeedBuildItemnull125 function CompareTargetWithInfoNeedBuildItem(Target, Info: Pointer): integer;
126 var
127 Item: TInfoNeedBuildItem absolute Info;
128 begin
129 Result:=ComparePointers(Target,Item.Target);
130 end;
131
132 { TIDEInfoNeedBuildDlg }
133
134 procedure TIDEInfoNeedBuildDlg.FormCreate(Sender: TObject);
135 var
136 Target: String;
137 begin
138 FTargetToItem:=TAvlTree.Create(@CompareInfoNeedBuildItemWithTargets);
139 FTargets:=TFPList.Create;
140
141 Caption:=lisWhatNeedsBuilding;
142
143 TargetLabel.Caption:=lisTarget;
144 FillTargets;
145 Target:=InputHistories.ViewNeedBuildTarget;
146 if (Target<>'') and (TargetComboBox.Items.IndexOf(Target)>=0) then
147 TargetComboBox.Text:=Target
148 else
149 TargetComboBox.Text:=TargetComboBox.Items[0];
150
151 IDEDialogLayoutList.ApplyLayout(Self);
152 IdleConnected:=true;
153 end;
154
155 procedure TIDEInfoNeedBuildDlg.FormDestroy(Sender: TObject);
156 begin
157 IdleConnected:=false;
158 ClearTargets;
159 FreeAndNil(FTargetToItem);
160 FreeAndNil(FTargets);
161 MainTarget:=nil;
162 end;
163
164 procedure TIDEInfoNeedBuildDlg.FormKeyDown(Sender: TObject; var Key: Word;
165 Shift: TShiftState);
166 begin
167 if Key=VK_ESCAPE then
168 ModalResult:=mrCancel;
169 end;
170
171 procedure TIDEInfoNeedBuildDlg.OnIdle(Sender: TObject; var Done: Boolean);
172 begin
173 if CheckNeedBuild(false) then
174 IdleConnected:=false;
175 end;
176
177 procedure TIDEInfoNeedBuildDlg.TargetComboBoxChange(Sender: TObject);
178 begin
179 IdleConnected:=true;
180 end;
181
182 procedure TIDEInfoNeedBuildDlg.FormClose(Sender: TObject;
183 var CloseAction: TCloseAction);
184 var
185 Target: TCaption;
186 begin
187 IdleConnected:=false;
188 IDEDialogLayoutList.SaveLayout(Self);
189 Target:=TargetComboBox.Text;
190 if Target=ProjectAsTarget(Project1) then
191 Target:='';
192 InputHistories.ViewNeedBuildTarget:=Target;
193 end;
194
195 procedure TIDEInfoNeedBuildDlg.FillTargets;
196 var
197 sl: TStringList;
198 i: Integer;
199 begin
200 sl:=TStringList.Create;
201 try
202 for i:=0 to PackageGraph.Count-1 do
203 sl.Add(PackageGraph[i].Name);
204 sl.Sort;
205 sl.Insert(0,IDEAsTarget);
206 if Project1<>nil then
207 sl.Insert(0,ProjectAsTarget(Project1));
208 TargetComboBox.Items.Assign(sl);
209 finally
210 sl.Free;
211 end;
212 end;
213
TIDEInfoNeedBuildDlg.ProjectAsTargetnull214 function TIDEInfoNeedBuildDlg.ProjectAsTarget(AProject: TProject): string;
215 begin
216 if AProject=nil then
217 Result:=''
218 else
219 Result:=Format(lisProject, [AProject.Title]);
220 end;
221
TIDEInfoNeedBuildDlg.IDEAsTargetnull222 function TIDEInfoNeedBuildDlg.IDEAsTarget: string;
223 begin
224 Result:=lisLazarusIDE;
225 end;
226
227 procedure TIDEInfoNeedBuildDlg.SetIdleConnected(AValue: boolean);
228 begin
229 if FIdleConnected=AValue then Exit;
230 if AValue and (ComponentState*[csDestroying,csLoading]<>[]) then exit;
231 FIdleConnected:=AValue;
232 if IdleConnected then
233 Application.AddOnIdleHandler(@OnIdle)
234 else
235 Application.RemoveOnIdleHandler(@OnIdle);
236 end;
237
CheckNeedBuildnull238 function TIDEInfoNeedBuildDlg.CheckNeedBuild(All: boolean): boolean;
239 var
240 NewTargets: TFPList;
241 i: Integer;
242 Item: TInfoNeedBuildItem;
243 s: String;
244 Pkg: TLazPackage;
245 AProject: TProject;
246 NeedBuildAll: boolean;
247 NeedBuild: TModalResult;
248 begin
249 SkipDesignTimePackages:=false;
250 NewTargets:=GetTargets(TargetComboBox.Text);
251 try
252 if not HaveSameTargets(FTargets,NewTargets) then begin
253 // targets have changed
254 ClearTargets;
255 if NewTargets=nil then exit(true);
256 for i:=0 to NewTargets.Count-1 do begin
257 Item:=TInfoNeedBuildItem.Create;
258 Item.Target:=TObject(NewTargets[i]);
259 if Item.Target=LazarusIDE then begin
260 Item.Caption:=IDEAsTarget;
261 Item.Filename:=EnvironmentOptions.LazarusDirectory;
262 end
263 else if Item.Target is TProject then begin
264 AProject:=TProject(Item.Target);
265 Item.Caption:=ProjectAsTarget(AProject);
266 Item.Filename:=AProject.ProjectInfoFile;
267 SkipDesignTimePackages:=not (pfUseDesignTimePackages in AProject.Flags);
268 end
269 else if Item.Target is TLazPackage then begin
270 Pkg:=TLazPackage(Item.Target);
271 Pkg.Flags:=Pkg.Flags-[lpfNeedGroupCompile];
272 Item.Caption:=Pkg.IDAsString;
273 Item.Filename:=Pkg.Filename;
274 end;
275 FTargetToItem.Add(Item);
276 FTargets.Add(Item);
277 end;
278 end;
279 finally
280 NewTargets.Free;
281 end;
282 Result:=true;
283
284 // check
285 if (FTargets.Count>0) then
286 MainTarget:=TInfoNeedBuildItem(FTargets.Last).Target
287 else
288 MainTarget:=nil;
289
290 i:=0;
291 while i<FTargets.Count do begin
292 Item:=TInfoNeedBuildItem(FTargets[i]);
293 if Item.NeedBuild=inbNone then begin
294 Item.NeedBuild:=inbNo;
295 if Item.Target=LazarusIDE then begin
296 // no check available
297 end
298 else if Item.Target is TProject then begin
299 AProject:=TProject(Item.Target);
300 Item.Note:='';
301 NeedBuild:=MainBuildBoss.DoCheckIfProjectNeedsCompilation(AProject,
302 NeedBuildAll,Item.Note);
303 if NeedBuild=mrYes then begin
304 if NeedBuildAll then
305 Item.NeedBuild:=inbClean
306 else
307 Item.NeedBuild:=inbNormal;
308 end;
309 end
310 else if Item.Target is TLazPackage then begin
311 Pkg:=TLazPackage(Item.Target);
312 Item.Note:='';
313 NeedBuild:=PackageGraph.CheckIfPackageNeedsCompilation(
314 Pkg,SkipDesignTimePackages,true,NeedBuildAll,Item.Note);
315 if NeedBuild=mrYes then begin
316 PackageGraph.SetFlagDependenciesNeedBuild(Pkg);
317 if NeedBuildAll then
318 Item.NeedBuild:=inbClean
319 else
320 Item.NeedBuild:=inbNormal;
321 end;
322 end;
323 if not All then break;
324 end;
325 inc(i);
326 end;
327 Result:=i=FTargets.Count; // true = all checked
328
329 // update memo
330 s:='';
331 for i:=0 to FTargets.Count-1 do begin
332 Item:=TInfoNeedBuildItem(FTargets[i]);
333 s+='Target: '+Item.Caption+LineEnding;
334 case Item.NeedBuild of
335 inbNone: s+='checking ...';
336 inbNo: s+='No build needed.';
337 inbNormal: s+='Build needed.';
338 inbClean: s+='Clean build needed.';
339 end;
340 s+=LineEnding;
341 if Item.Filename<>'' then
342 s+='File: '+Item.Filename+LineEnding;
343 if Item.Note<>'' then
344 s+='Note: '+Item.Note+LineEnding;
345 s+=LineEnding;
346 end;
347 MainMemo.Lines.Text:=s;
348 end;
349
TIDEInfoNeedBuildDlg.GetTargetsnull350 function TIDEInfoNeedBuildDlg.GetTargets(Target: string): TFPList;
351
GetListnull352 function GetList(Main: TObject; FirstDependency: TPkgDependency;
353 ReqFlags: TPkgIntfRequiredFlags): TFPList;
354 begin
355 Result:=nil;
356 if Main=nil then exit;
357 PackageGraph.GetAllRequiredPackages(nil,FirstDependency,Result,ReqFlags);
358 if Result<>nil then begin
359 // PackageGraph.GetAllRequiredPackages starts with the inner nodes
360 // => reverse order
361 ReverseList(Result);
362 end
363 else
364 Result:=TFPList.Create;
365 Result.Add(Main);
366 end;
367
368 var
369 Pkg: TLazPackage;
370 ReqFlags: TPkgIntfRequiredFlags;
371 begin
372 ReqFlags:=[];
373 if Target=IDEAsTarget then begin
374 Result:=GetList(LazarusIDE,PackageGraph.FirstAutoInstallDependency,ReqFlags);
375 end else if Target=ProjectAsTarget(Project1) then begin
376 if not (pfUseDesignTimePackages in Project1.Flags) then
377 Include(ReqFlags,pirSkipDesignTimeOnly);
378 Result:=GetList(Project1,Project1.FirstRequiredDependency,ReqFlags);
379 end else begin
380 Pkg:=PackageGraph.FindPackageWithName(Target,nil);
381 Result:=GetList(Pkg,Pkg.FirstRequiredDependency,ReqFlags);
382 end;
383 end;
384
TIDEInfoNeedBuildDlg.HaveSameTargetsnull385 function TIDEInfoNeedBuildDlg.HaveSameTargets(BuildItems, Targets: TFPList
386 ): boolean;
387 // check if BuildItems and Targets have the same targets
388 var
389 Targets1: TFPList;
390 Targets2: TFPList;
391 i: Integer;
392 Target: TObject;
393 begin
394 Result:=false;
395 if (BuildItems=nil)<>(Targets=nil) then exit;
396 Targets1:=TFPList.Create;
397 Targets2:=TFPList.Create;
398 try
399 // create a list of targets from BuildItems and a second list from Targets
400 for i:=0 to BuildItems.Count-1 do
401 Targets1.Add(TInfoNeedBuildItem(BuildItems[i]).Target);
402 for i:=0 to Targets.Count-1 do begin
403 Target:=TObject(Targets[i]);
404 if (Target=LazarusIDE) or (Target is TProject) or (Target is TLazPackage) then
405 Targets2.Add(Target);
406 end;
407 if Targets1.Count<>Targets2.Count then exit;
408 // sort both lists
409 Targets1.Sort(@ComparePointers);
410 Targets2.Sort(@ComparePointers);
411 // compare each item
412 for i:=0 to Targets1.Count-1 do
413 if Targets1[i]<>Targets2[i] then exit;
414 finally
415 Targets1.Free;
416 Targets2.Free;
417 end;
418 Result:=true;
419 end;
420
421 procedure TIDEInfoNeedBuildDlg.ClearTargets;
422 begin
423 FTargetToItem.FreeAndClear;
424 FTargets.Clear;
425 end;
426
427 procedure TIDEInfoNeedBuildDlg.SetMainTarget(AValue: TObject);
428 begin
429 if FMainTarget=AValue then Exit;
430 FMainTarget:=AValue;
431 //debugln(['TIDEInfoNeedBuildDlg.SetMainTarget ',DbgSName(MainTarget)]);
432 if (MainTarget=LazarusIDE) then
433 MainBuildBoss.SetBuildTargetIDE
434 else
435 MainBuildBoss.SetBuildTargetProject1(true);
436 end;
437
438 end.
439
440