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, LazUTF8,
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 TargetComboBox.DropDownCount:=EnvironmentOptions.DropDownCount;
154 end;
155
156 procedure TIDEInfoNeedBuildDlg.FormDestroy(Sender: TObject);
157 begin
158 IdleConnected:=false;
159 ClearTargets;
160 FreeAndNil(FTargetToItem);
161 FreeAndNil(FTargets);
162 MainTarget:=nil;
163 end;
164
165 procedure TIDEInfoNeedBuildDlg.FormKeyDown(Sender: TObject; var Key: Word;
166 Shift: TShiftState);
167 begin
168 if Key=VK_ESCAPE then
169 ModalResult:=mrCancel;
170 end;
171
172 procedure TIDEInfoNeedBuildDlg.OnIdle(Sender: TObject; var Done: Boolean);
173 begin
174 if CheckNeedBuild(false) then
175 IdleConnected:=false;
176 end;
177
178 procedure TIDEInfoNeedBuildDlg.TargetComboBoxChange(Sender: TObject);
179 begin
180 IdleConnected:=true;
181 end;
182
183 procedure TIDEInfoNeedBuildDlg.FormClose(Sender: TObject;
184 var CloseAction: TCloseAction);
185 var
186 Target: TCaption;
187 begin
188 IdleConnected:=false;
189 IDEDialogLayoutList.SaveLayout(Self);
190 Target:=TargetComboBox.Text;
191 if Target=ProjectAsTarget(Project1) then
192 Target:='';
193 InputHistories.ViewNeedBuildTarget:=Target;
194 end;
195
196 procedure TIDEInfoNeedBuildDlg.FillTargets;
197 var
198 sl: TStringListUTF8Fast;
199 i: Integer;
200 begin
201 sl:=TStringListUTF8Fast.Create;
202 try
203 for i:=0 to PackageGraph.Count-1 do
204 sl.Add(PackageGraph[i].Name);
205 sl.Sort;
206 sl.Insert(0,IDEAsTarget);
207 if Project1<>nil then
208 sl.Insert(0,ProjectAsTarget(Project1));
209 TargetComboBox.Items.Assign(sl);
210 finally
211 sl.Free;
212 end;
213 end;
214
TIDEInfoNeedBuildDlg.ProjectAsTargetnull215 function TIDEInfoNeedBuildDlg.ProjectAsTarget(AProject: TProject): string;
216 begin
217 if AProject=nil then
218 Result:=''
219 else
220 Result:=Format(lisProject, [AProject.Title]);
221 end;
222
TIDEInfoNeedBuildDlg.IDEAsTargetnull223 function TIDEInfoNeedBuildDlg.IDEAsTarget: string;
224 begin
225 Result:=lisLazarusIDE;
226 end;
227
228 procedure TIDEInfoNeedBuildDlg.SetIdleConnected(AValue: boolean);
229 begin
230 if FIdleConnected=AValue then Exit;
231 if AValue and (ComponentState*[csDestroying,csLoading]<>[]) then exit;
232 FIdleConnected:=AValue;
233 if IdleConnected then
234 Application.AddOnIdleHandler(@OnIdle)
235 else
236 Application.RemoveOnIdleHandler(@OnIdle);
237 end;
238
CheckNeedBuildnull239 function TIDEInfoNeedBuildDlg.CheckNeedBuild(All: boolean): boolean;
240 var
241 NewTargets: TFPList;
242 i: Integer;
243 Item: TInfoNeedBuildItem;
244 s: String;
245 Pkg: TLazPackage;
246 AProject: TProject;
247 NeedBuildAll: boolean;
248 NeedBuild: TModalResult;
249 begin
250 SkipDesignTimePackages:=false;
251 NewTargets:=GetTargets(TargetComboBox.Text);
252 try
253 if not HaveSameTargets(FTargets,NewTargets) then begin
254 // targets have changed
255 ClearTargets;
256 if NewTargets=nil then exit(true);
257 for i:=0 to NewTargets.Count-1 do begin
258 Item:=TInfoNeedBuildItem.Create;
259 Item.Target:=TObject(NewTargets[i]);
260 if Item.Target=LazarusIDE then begin
261 Item.Caption:=IDEAsTarget;
262 Item.Filename:=EnvironmentOptions.LazarusDirectory;
263 end
264 else if Item.Target is TProject then begin
265 AProject:=TProject(Item.Target);
266 Item.Caption:=ProjectAsTarget(AProject);
267 Item.Filename:=AProject.ProjectInfoFile;
268 SkipDesignTimePackages:=not (pfUseDesignTimePackages in AProject.Flags);
269 end
270 else if Item.Target is TLazPackage then begin
271 Pkg:=TLazPackage(Item.Target);
272 Pkg.Flags:=Pkg.Flags-[lpfNeedGroupCompile];
273 Item.Caption:=Pkg.IDAsString;
274 Item.Filename:=Pkg.Filename;
275 end;
276 FTargetToItem.Add(Item);
277 FTargets.Add(Item);
278 end;
279 end;
280 finally
281 NewTargets.Free;
282 end;
283 Result:=true;
284
285 // check
286 if (FTargets.Count>0) then
287 MainTarget:=TInfoNeedBuildItem(FTargets.Last).Target
288 else
289 MainTarget:=nil;
290
291 i:=0;
292 while i<FTargets.Count do begin
293 Item:=TInfoNeedBuildItem(FTargets[i]);
294 if Item.NeedBuild=inbNone then begin
295 Item.NeedBuild:=inbNo;
296 if Item.Target=LazarusIDE then begin
297 // no check available
298 end
299 else if Item.Target is TProject then begin
300 AProject:=TProject(Item.Target);
301 Item.Note:='';
302 NeedBuild:=MainBuildBoss.DoCheckIfProjectNeedsCompilation(AProject,
303 NeedBuildAll,Item.Note);
304 if NeedBuild=mrYes then begin
305 if NeedBuildAll then
306 Item.NeedBuild:=inbClean
307 else
308 Item.NeedBuild:=inbNormal;
309 end;
310 end
311 else if Item.Target is TLazPackage then begin
312 Pkg:=TLazPackage(Item.Target);
313 Item.Note:='';
314 NeedBuild:=PackageGraph.CheckIfPackageNeedsCompilation(
315 Pkg,SkipDesignTimePackages,true,NeedBuildAll,Item.Note);
316 if NeedBuild=mrYes then begin
317 PackageGraph.SetFlagDependenciesNeedBuild(Pkg);
318 if NeedBuildAll then
319 Item.NeedBuild:=inbClean
320 else
321 Item.NeedBuild:=inbNormal;
322 end;
323 end;
324 if not All then break;
325 end;
326 inc(i);
327 end;
328 Result:=i=FTargets.Count; // true = all checked
329
330 // update memo
331 s:='';
332 for i:=0 to FTargets.Count-1 do begin
333 Item:=TInfoNeedBuildItem(FTargets[i]);
334 s+='Target: '+Item.Caption+LineEnding;
335 case Item.NeedBuild of
336 inbNone: s+='checking ...';
337 inbNo: s+='No build needed.';
338 inbNormal: s+='Build needed.';
339 inbClean: s+='Clean build needed.';
340 end;
341 s+=LineEnding;
342 if Item.Filename<>'' then
343 s+='File: '+Item.Filename+LineEnding;
344 if Item.Note<>'' then
345 s+='Note: '+Item.Note+LineEnding;
346 s+=LineEnding;
347 end;
348 MainMemo.Lines.Text:=s;
349 end;
350
TIDEInfoNeedBuildDlg.GetTargetsnull351 function TIDEInfoNeedBuildDlg.GetTargets(Target: string): TFPList;
352
GetListnull353 function GetList(Main: TObject; FirstDependency: TPkgDependency;
354 ReqFlags: TPkgIntfRequiredFlags): TFPList;
355 begin
356 Result:=nil;
357 if Main=nil then exit;
358 PackageGraph.GetAllRequiredPackages(nil,FirstDependency,Result,ReqFlags);
359 if Result<>nil then begin
360 // PackageGraph.GetAllRequiredPackages starts with the inner nodes
361 // => reverse order
362 ReverseList(Result);
363 end
364 else
365 Result:=TFPList.Create;
366 Result.Add(Main);
367 end;
368
369 var
370 Pkg: TLazPackage;
371 ReqFlags: TPkgIntfRequiredFlags;
372 begin
373 ReqFlags:=[];
374 if Target=IDEAsTarget then begin
375 Result:=GetList(LazarusIDE,PackageGraph.FirstAutoInstallDependency,ReqFlags);
376 end else if Target=ProjectAsTarget(Project1) then begin
377 if not (pfUseDesignTimePackages in Project1.Flags) then
378 Include(ReqFlags,pirSkipDesignTimeOnly);
379 Result:=GetList(Project1,Project1.FirstRequiredDependency,ReqFlags);
380 end else begin
381 Pkg:=PackageGraph.FindPackageWithName(Target,nil);
382 Result:=GetList(Pkg,Pkg.FirstRequiredDependency,ReqFlags);
383 end;
384 end;
385
TIDEInfoNeedBuildDlg.HaveSameTargetsnull386 function TIDEInfoNeedBuildDlg.HaveSameTargets(BuildItems, Targets: TFPList
387 ): boolean;
388 // check if BuildItems and Targets have the same targets
389 var
390 Targets1: TFPList;
391 Targets2: TFPList;
392 i: Integer;
393 Target: TObject;
394 begin
395 Result:=false;
396 if (BuildItems=nil)<>(Targets=nil) then exit;
397 Targets1:=TFPList.Create;
398 Targets2:=TFPList.Create;
399 try
400 // create a list of targets from BuildItems and a second list from Targets
401 for i:=0 to BuildItems.Count-1 do
402 Targets1.Add(TInfoNeedBuildItem(BuildItems[i]).Target);
403 for i:=0 to Targets.Count-1 do begin
404 Target:=TObject(Targets[i]);
405 if (Target=LazarusIDE) or (Target is TProject) or (Target is TLazPackage) then
406 Targets2.Add(Target);
407 end;
408 if Targets1.Count<>Targets2.Count then exit;
409 // sort both lists
410 Targets1.Sort(@ComparePointers);
411 Targets2.Sort(@ComparePointers);
412 // compare each item
413 for i:=0 to Targets1.Count-1 do
414 if Targets1[i]<>Targets2[i] then exit;
415 finally
416 Targets1.Free;
417 Targets2.Free;
418 end;
419 Result:=true;
420 end;
421
422 procedure TIDEInfoNeedBuildDlg.ClearTargets;
423 begin
424 FTargetToItem.FreeAndClear;
425 FTargets.Clear;
426 end;
427
428 procedure TIDEInfoNeedBuildDlg.SetMainTarget(AValue: TObject);
429 begin
430 if FMainTarget=AValue then Exit;
431 FMainTarget:=AValue;
432 //debugln(['TIDEInfoNeedBuildDlg.SetMainTarget ',DbgSName(MainTarget)]);
433 if (MainTarget=LazarusIDE) then
434 MainBuildBoss.SetBuildTargetIDE
435 else
436 MainBuildBoss.SetBuildTargetProject1(true);
437 end;
438
439 end.
440
441