1 { /***************************************************************************
2                     showcompileropts.pas  -  Lazarus IDE unit
3                     -----------------------------------------
4 
5  ***************************************************************************/
6 
7  ***************************************************************************
8  *                                                                         *
9  *   This source is free software; you can redistribute it and/or modify   *
10  *   it under the terms of the GNU General Public License as published by  *
11  *   the Free Software Foundation; either version 2 of the License, or     *
12  *   (at your option) any later version.                                   *
13  *                                                                         *
14  *   This code is distributed in the hope that it will be useful, but      *
15  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
16  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
17  *   General Public License for more details.                              *
18  *                                                                         *
19  *   A copy of the GNU General Public License is available on the World    *
20  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
21  *   obtain it by writing to the Free Software Foundation,                 *
22  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
23  *                                                                         *
24  ***************************************************************************
25 
26   Author: Mattias Gaertner
27 
28   Abstract:
29     Dialog for showing the compiler options as command line parameters.
30 }
31 unit ShowCompilerOpts;
32 
33 {$mode objfpc}{$H+}
34 
35 interface
36 
37 uses
38   Classes, SysUtils, contnrs,
39   // LCL
40   Forms, Controls, Buttons, StdCtrls, ComCtrls, ExtCtrls,
41   // LazUtils
42   LazFileUtils, LazUTF8, LazStringUtils,
43   // CodeTools
44   CodeToolsCfgScript,
45   // IdeIntf
46   BaseIDEIntf, LazIDEIntf, IDEImagesIntf, CompOptsIntf, ProjectIntf,
47   PackageIntf, MacroIntf,
48   // IDE
49   LazarusIDEStrConsts, Project, PackageDefs,
50   CompilerOptions, ModeMatrixOpts, MiscOptions;
51 
52 type
53   TShowCompToolOpts = class
54     CompOpts: TCompilationToolOptions;
55     Sheet: TTabSheet;
56     Memo: TMemo;
57     MultiLineCheckBox: TCheckBox;
58   end;
59 
60   { TShowCompilerOptionsDlg }
61 
62   TShowCompilerOptionsDlg = class(TForm)
63     CloseButton: TBitBtn;
64     CmdLineMemo: TMemo;
65     CmdLineParamsTabSheet: TTabSheet;
66     InheritedParamsTabSheet: TTabSheet;
67     InhItemMemo: TMemo;
68     InhSplitter: TSplitter;
69     InhTreeView: TTreeView;
70     MultilineCheckBox: TCheckBox;
71     PageControl1: TPageControl;
72     RelativePathsCheckBox: TCheckBox;
73     procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
74     procedure FormCreate(Sender: TObject);
75     procedure FormDestroy(Sender: TObject);
76     procedure InhTreeViewSelectionChanged(Sender: TObject);
77     procedure MultilineCheckBoxChange(Sender: TObject);
78     procedure RelativePathsCheckBoxChange(Sender: TObject);
79   private
80     FCompilerOpts: TBaseCompilerOptions;
81     ImageIndexInherited: Integer;
82     ImageIndexRequired: Integer;
83     ImageIndexPackage: Integer;
84     InheritedChildDatas: TFPList; // list of PInheritedNodeData
85     FToolOptions: TObjectList; // list of TShowCompToolOpts
86     FUpdatingMultiline: boolean;
87     procedure ClearInheritedTree;
88     procedure SetCompilerOpts(const AValue: TBaseCompilerOptions);
89     procedure FillMemo(Memo: TMemo; Params: string);
90     procedure UpdateMemo;
91     procedure UpdateInheritedTree;
92     procedure UpdateExecuteBeforeAfter;
93     procedure UpdateToolMemo(Opts: TShowCompToolOpts);
94   public
95     property CompilerOpts: TBaseCompilerOptions read FCompilerOpts write SetCompilerOpts;
96   end;
97 
ShowCompilerOptionsDialognull98 function ShowCompilerOptionsDialog(OwnerForm: TCustomForm;
99   CompilerOpts: TBaseCompilerOptions): TModalResult;
100 
101 implementation
102 
103 {$R *.lfm}
104 
105 type
106   TInheritedNodeData = record
107     FullText: string;
108     Option: TInheritedCompilerOption;
109   end;
110   PInheritedNodeData = ^TInheritedNodeData;
111 
ShowCompilerOptionsDialognull112 function ShowCompilerOptionsDialog(OwnerForm: TCustomForm;
113   CompilerOpts: TBaseCompilerOptions): TModalResult;
114 var
115   ShowCompilerOptionsDlg: TShowCompilerOptionsDlg;
116 begin
117   Result:=mrOk;
118   LazarusIDE.PrepareBuildTarget(false,smsfsBackground);
119   ShowCompilerOptionsDlg:=TShowCompilerOptionsDlg.Create(OwnerForm);
120   try
121     ShowCompilerOptionsDlg.CompilerOpts:=CompilerOpts;
122     Result:=ShowCompilerOptionsDlg.ShowModal;
123   finally
124     ShowCompilerOptionsDlg.Free;
125   end;
126 end;
127 
128 { TShowCompilerOptionsDlg }
129 
130 procedure TShowCompilerOptionsDlg.RelativePathsCheckBoxChange(Sender: TObject);
131 begin
132   UpdateMemo;
133 end;
134 
135 procedure TShowCompilerOptionsDlg.ClearInheritedTree;
136 var
137   i: integer;
138   ChildData: PInheritedNodeData;
139 begin
140   if InhTreeView = nil then
141     exit;
142   InhTreeView.BeginUpdate;
143   // dispose all child data
144   if InheritedChildDatas <> nil then
145   begin
146     for i := 0 to InheritedChildDatas.Count - 1 do
147     begin
148       ChildData := PInheritedNodeData(InheritedChildDatas[i]);
149       Dispose(ChildData);
150     end;
151     InheritedChildDatas.Free;
152     InheritedChildDatas := nil;
153   end;
154   InhTreeView.Items.Clear;
155   InhTreeView.EndUpdate;
156 end;
157 
158 procedure TShowCompilerOptionsDlg.InhTreeViewSelectionChanged(Sender: TObject);
159 var
160   ANode: TTreeNode;
161   ChildData: PInheritedNodeData;
162   sl: TStrings;
163 begin
164   ANode := InhTreeView.Selected;
165   if (ANode = nil) or (ANode.Data = nil) then
166   begin
167     InhItemMemo.Lines.Text := lisSelectANode;
168   end
169   else
170   begin
171     ChildData := PInheritedNodeData(ANode.Data);
172     if ChildData^.Option in icoAllSearchPaths then
173     begin
174       sl := SplitString(ChildData^.FullText, ';');
175       InhItemMemo.Lines.Assign(sl);
176       sl.Free;
177     end
178     else
179       InhItemMemo.Lines.Text := ChildData^.FullText;
180   end;
181 end;
182 
183 procedure TShowCompilerOptionsDlg.MultilineCheckBoxChange(Sender: TObject);
184 var
185   CheckBox: TCheckBox;
186   Checked: Boolean;
187   i: Integer;
188   Opts: TShowCompToolOpts;
189 begin
190   if FUpdatingMultiline then exit;
191   CheckBox:=Sender as TCheckBox;
192   Checked:=CheckBox.Checked;
193 
194   FUpdatingMultiline:=true;
195   try
196     MultilineCheckBox.Checked:=Checked;
197     UpdateMemo;
198 
199     for i:=0 to FToolOptions.Count-1 do
200     begin
201       Opts:=TShowCompToolOpts(FToolOptions[i]);
202       if Opts.MultiLineCheckBox<>nil then begin
203         Opts.MultiLineCheckBox.Checked:=Checked;
204         UpdateToolMemo(Opts);
205       end;
206     end;
207   finally
208     FUpdatingMultiline:=false;
209   end;
210 end;
211 
212 procedure TShowCompilerOptionsDlg.FormCreate(Sender: TObject);
213 begin
214   FToolOptions:=TObjectList.Create(true);
215 
216   ImageIndexPackage := IDEImages.LoadImage('item_package');
217   ImageIndexRequired := IDEImages.LoadImage('pkg_required');
218   ImageIndexInherited := IDEImages.LoadImage('pkg_inherited');
219 
220   Caption:=dlgCompilerOptions;
221 
222   PageControl1.ActivePage:=CmdLineParamsTabSheet;
223   CmdLineParamsTabSheet.Caption:=lisCommandLineParameters;
224   RelativePathsCheckBox.Caption:=lisShowRelativePaths;
225   RelativePathsCheckBox.Checked:=not MiscellaneousOptions.ShowCompOptFullFilenames;
226   MultilineCheckBox.Caption:=lisShowMultipleLines;
227   MultilineCheckBox.Checked:=MiscellaneousOptions.ShowCompOptMultiLine;
228 
229   InheritedParamsTabSheet.Caption:=lisInheritedParameters;
230   InhTreeView.Images := IDEImages.Images_16;
231   InhItemMemo.Text := lisSelectANode;
232 
233   CloseButton.Caption:=lisBtnClose;
234 end;
235 
236 procedure TShowCompilerOptionsDlg.FormClose(Sender: TObject;
237   var CloseAction: TCloseAction);
238 begin
239   MiscellaneousOptions.ShowCompOptFullFilenames:=not RelativePathsCheckBox.Checked;
240   MiscellaneousOptions.ShowCompOptMultiLine:=MultilineCheckBox.Checked;
241   MiscellaneousOptions.Save;
242 
243   FreeAndNil(FToolOptions);
244 end;
245 
246 procedure TShowCompilerOptionsDlg.FormDestroy(Sender: TObject);
247 begin
248   ClearInheritedTree;
249 end;
250 
251 procedure TShowCompilerOptionsDlg.SetCompilerOpts(
252   const AValue: TBaseCompilerOptions);
253 begin
254   if FCompilerOpts=AValue then exit;
255   FCompilerOpts:=AValue;
256   UpdateMemo;
257   UpdateInheritedTree;
258   UpdateExecuteBeforeAfter;
259 end;
260 
261 procedure TShowCompilerOptionsDlg.FillMemo(Memo: TMemo; Params: string);
262 var
263   ParamList: TStringList;
264 begin
265   if Memo=nil then exit;
266   if MultilineCheckBox.Checked then begin
267     ParamList:=TStringList.Create;
268     try
269       SplitCmdLineParams(Params,ParamList);
270       Memo.Lines.Assign(ParamList);
271     finally
272       ParamList.Free;
273     end;
274     Memo.ScrollBars:=ssAutoBoth;
275   end else begin
276     Memo.ScrollBars:=ssAutoVertical;
277     Memo.Lines.Text:=Params;
278   end;
279 end;
280 
281 procedure TShowCompilerOptionsDlg.UpdateMemo;
282 var
283   Flags: TCompilerCmdLineOptions;
284   CurOptions, CompPath: String;
285 begin
286   if CompilerOpts=nil then exit;
287 
288   Flags:=CompilerOpts.DefaultMakeOptionsFlags;
289   if not RelativePathsCheckBox.Checked then
290     Include(Flags,ccloAbsolutePaths);
291   CurOptions := CompilerOpts.MakeOptionsString(Flags);
292   CompPath:=CompilerOpts.ParsedOpts.GetParsedValue(pcosCompilerPath);
293   if Pos(' ',CompPath)>0 then
294     CompPath:=QuotedStr(CompPath);
295   FillMemo(CmdLineMemo,CompPath+' '+CurOptions);
296 end;
297 
298 procedure TShowCompilerOptionsDlg.UpdateInheritedTree;
299 var
300   OptionsList: TFPList;
301   i: integer;
302   AncestorOptions: TAdditionalCompilerOptions;
303   AncestorNode: TTreeNode;
304   AncestorBaseOpts: TBaseCompilerOptions;
305   Vars: TCTCfgScriptVariables;
306   Macro: TLazBuildMacro;
307   j: Integer;
308 
309   procedure AddChildNode(const NewNodeName, Value: string;
310     Option: TInheritedCompilerOption);
311   var
312     VisibleValue: string;
313     ChildNode: TTreeNode;
314     ChildData: PInheritedNodeData;
315   begin
316     if Value = '' then
317       exit;
318     New(ChildData);
319     ChildData^.FullText := Value;
320     ChildData^.Option := Option;
321     if InheritedChildDatas = nil then
322       InheritedChildDatas := TFPList.Create;
323     InheritedChildDatas.Add(ChildData);
324 
325     if UTF8Length(Value) > 100 then
326       VisibleValue := UTF8Copy(Value, 1, 100) + '[...]'
327     else
328       VisibleValue := Value;
329     ChildNode := InhTreeView.Items.AddChildObject(AncestorNode,
330       NewNodeName + ' = "' + VisibleValue + '"', ChildData);
331     ChildNode.ImageIndex := ImageIndexRequired;
332     ChildNode.SelectedIndex := ChildNode.ImageIndex;
333   end;
334 
335 var
336   SkippedPkgList: TFPList;
337   AProject: TProject;
338   Pkg: TLazPackage;
339   t: TBuildMatrixGroupType;
340 
341   procedure AddMatrixGroupNode(Grp: TBuildMatrixGroupType);
342   begin
343     if AncestorNode<>nil then exit;
344     AncestorNode := InhTreeView.Items.Add(nil, '');
345     case Grp of
346     bmgtEnvironment: AncestorNode.Text:=dlgGroupEnvironment;
347     bmgtProject: AncestorNode.Text:=dlgProject;
348     bmgtSession: AncestorNode.Text:=lisProjectSession;
349     end;
350     AncestorNode.ImageIndex := ImageIndexPackage;
351     AncestorNode.SelectedIndex := AncestorNode.ImageIndex;
352   end;
353 
354   procedure AddMatrixGroup(Grp: TBuildMatrixGroupType);
355   var
356     CustomOptions: String;
357     OutDir: String;
358   begin
359     AncestorNode := nil;
360     CustomOptions:='';
361     OnAppendCustomOption(CompilerOpts,CustomOptions,[Grp]);
362     if CustomOptions<>'' then begin
363       AddMatrixGroupNode(Grp);
364       AddChildNode(liscustomOptions, CustomOptions, icoCustomOptions);
365     end;
366     OutDir:='.*';
367     OnGetOutputDirectoryOverride(CompilerOpts,OutDir,[Grp]);
368     if OutDir<>'.*' then begin
369       AddMatrixGroupNode(Grp);
370       AddChildNode('Output directory', OutDir, icoNone);
371     end;
372     if AncestorNode<>nil then
373       AncestorNode.Expand(true);
374   end;
375 
376 begin
377   if CompilerOpts=nil then exit;
378   OptionsList := nil;
379   //debugln(['TCompilerInheritedOptionsFrame.UpdateInheritedTree START CompilerOpts=',DbgSName(CompilerOpts)]);
380   CompilerOpts.GetInheritedCompilerOptions(OptionsList);
381   SkippedPkgList:=nil;
382   try
383     if CompilerOpts is TProjectCompilerOptions then begin
384       AProject:=TProjectCompilerOptions(CompilerOpts).LazProject;
385       AProject.GetAllRequiredPackages(SkippedPkgList);
386       if (SkippedPkgList<>nil)
387       and (not (pfUseDesignTimePackages in AProject.Flags)) then begin
388         // keep design time only packages
389         for i:=SkippedPkgList.Count-1 downto 0 do
390           if TLazPackage(SkippedPkgList[i]).PackageType<>lptDesignTime then
391             SkippedPkgList.Delete(i);
392       end;
393     end;
394     //debugln(['TCompilerInheritedOptionsFrame.UpdateInheritedTree END']);
395     InhTreeView.BeginUpdate;
396     ClearInheritedTree;
397     if OptionsList <> nil then
398     begin
399       Vars:=GetBuildMacroValues(CompilerOpts,false);
400       // add All node
401       AncestorNode := InhTreeView.Items.Add(nil, lisAllInheritedOptions);
402       AncestorNode.ImageIndex := ImageIndexInherited;
403       AncestorNode.SelectedIndex := AncestorNode.ImageIndex;
404       with CompilerOpts do
405       begin
406         AddChildNode(lisunitPath,
407           GetInheritedOption(icoUnitPath, True), icoUnitPath);
408         AddChildNode(lisincludePath,
409           GetInheritedOption(icoIncludePath, True), icoIncludePath);
410         AddChildNode(lisobjectPath,
411           GetInheritedOption(icoObjectPath, True), icoObjectPath);
412         AddChildNode(lislibraryPath,
413           GetInheritedOption(icoLibraryPath, True), icoLibraryPath);
414         AddChildNode(lislinkerOptions, GetInheritedOption(icoLinkerOptions, True),
415           icoLinkerOptions);
416         AddChildNode(liscustomOptions, GetInheritedOption(icoCustomOptions, True),
417           icoCustomOptions);
418       end;
419       AncestorNode.Expanded := True;
420       // add detail nodes
421       for i := 0 to OptionsList.Count - 1 do
422       begin
423         AncestorOptions := TAdditionalCompilerOptions(OptionsList[i]);
424         AncestorNode := InhTreeView.Items.Add(nil, '');
425         AncestorNode.Text := AncestorOptions.GetOwnerName;
426         AncestorNode.ImageIndex := ImageIndexPackage;
427         AncestorNode.SelectedIndex := AncestorNode.ImageIndex;
428         AncestorBaseOpts:=AncestorOptions.GetBaseCompilerOptions;
429         with AncestorOptions.ParsedOpts do
430         begin
431           AddChildNode(lisunitPath,
432             CreateRelativeSearchPath(GetParsedValue(pcosUnitPath),CompilerOpts.BaseDirectory),
433             icoUnitPath);
434           AddChildNode(lisincludePath,
435             CreateRelativeSearchPath(GetParsedValue(pcosIncludePath),CompilerOpts.BaseDirectory),
436             icoIncludePath);
437           AddChildNode(lisobjectPath,
438             CreateRelativeSearchPath(GetParsedValue(pcosObjectPath),CompilerOpts.BaseDirectory),
439             icoObjectPath);
440           AddChildNode(lislibraryPath,
441             CreateRelativeSearchPath(GetParsedValue(pcosLibraryPath),CompilerOpts.BaseDirectory),
442             icoLibraryPath);
443           AddChildNode(lislinkerOptions, GetParsedValue(pcosLinkerOptions),
444             icoLinkerOptions);
445           AddChildNode(liscustomOptions, GetParsedValue(pcosCustomOptions),
446             icoCustomOptions);
447         end;
448         if (AncestorBaseOpts<>nil) and (Vars<>nil) then begin
449           for j:=0 to AncestorBaseOpts.BuildMacros.Count-1 do
450           begin
451             Macro:=AncestorBaseOpts.BuildMacros[j];
452             AddChildNode(Macro.Identifier,Vars.Values[Macro.Identifier],icoNone);
453           end;
454         end;
455         AncestorNode.Expanded := True;
456       end;
457       OptionsList.Free;
458     end else
459     begin
460       InhTreeView.Items.Add(nil, lisNoCompilerOptionsInherited);
461     end;
462     if SkippedPkgList<>nil then begin
463       for i:=0 to SkippedPkgList.Count-1 do begin
464         Pkg:=TLazPackage(SkippedPkgList[i]);
465         AncestorNode := InhTreeView.Items.Add(nil, '');
466         AncestorNode.Text := Format(lisExcludedAtRunTime, [Pkg.Name]);
467         AncestorNode.ImageIndex := ImageIndexPackage;
468         AncestorNode.SelectedIndex := AncestorNode.ImageIndex;
469       end;
470     end;
471 
472     // add matrix options
473     for t:=low(TBuildMatrixGroupType) to high(TBuildMatrixGroupType) do
474       AddMatrixGroup(t);
475 
476     InhTreeView.EndUpdate;
477   finally
478     SkippedPkgList.Free;
479   end;
480 end;
481 
482 procedure TShowCompilerOptionsDlg.UpdateExecuteBeforeAfter;
483 var
484   PgIndex, ToolIndex: integer;
485 
486   procedure AddTool(CompOpts: TCompilationToolOptions; aCaption: string);
487   const
488     Space = 6;
489   var
490     ShowOpts: TShowCompToolOpts;
491     Sheet: TTabSheet;
492     Memo: TMemo;
493     CheckBox: TCheckBox;
494   begin
495     if ToolIndex>=FToolOptions.Count then begin
496       ShowOpts:=TShowCompToolOpts.Create;
497       ShowOpts.CompOpts:=CompOpts;
498       FToolOptions.Add(ShowOpts);
499     end else
500       ShowOpts:=TShowCompToolOpts(FToolOptions[ToolIndex]);
501     inc(ToolIndex);
502 
503     if CompOpts.CompileReasons=[] then begin
504       // this tool is never called -> skip
505       if ShowOpts.Sheet<>nil then begin
506         ShowOpts.Sheet.Free;
507         ShowOpts.Sheet:=nil;
508       end;
509       exit;
510     end;
511 
512     if ShowOpts.Sheet=nil then
513     begin
514       Sheet:=PageControl1.AddTabSheet;
515       ShowOpts.Sheet:=Sheet;
516       Sheet.Name:='TabSheet_Tool'+IntToStr(ToolIndex);
517     end else
518       Sheet:=ShowOpts.Sheet;
519     inc(PgIndex);
520     Sheet.Caption:=aCaption;
521 
522     if ShowOpts.Memo=nil then begin
523       Memo:=TMemo.Create(Sheet);
524       ShowOpts.Memo:=Memo;
525       Memo.Name:='Memo_Tool'+IntToStr(ToolIndex);
526       Memo.Parent:=Sheet;
527     end else
528       Memo:=ShowOpts.Memo;
529 
530     if ShowOpts.MultiLineCheckBox=nil then begin
531       CheckBox:=TCheckBox.Create(Sheet);
532       ShowOpts.MultiLineCheckBox:=CheckBox;
533       CheckBox.Name:='MulitlineCheckBox_Tool'+IntToStr(ToolIndex);
534       CheckBox.Parent:=Sheet;
535       CheckBox.Checked:=MultilineCheckBox.Checked;
536     end else
537       CheckBox:=ShowOpts.MultiLineCheckBox;
538 
539     CheckBox.Left:=Space;
540     CheckBox.AnchorParallel(akBottom,Space,Sheet);
541     CheckBox.Anchors:=[akLeft,akBottom];
542     CheckBox.Caption:=MultilineCheckBox.Caption;
543     CheckBox.Checked:=MultilineCheckBox.Checked;
544     CheckBox.OnChange:=@MultilineCheckBoxChange;
545 
546     Memo.WordWrap:=true;
547     Memo.Align:=alTop;
548     Memo.AnchorToNeighbour(akBottom,Space,CheckBox);
549 
550     UpdateToolMemo(ShowOpts);
551   end;
552 
553 var
554   OldPageIndex: integer;
555 begin
556   OldPageIndex:=PageControl1.PageIndex;
557   PgIndex:=2;
558   ToolIndex:=0;
559   DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TShowCompilerOptionsDlg.UpdateExecuteBeforeAfter'){$ENDIF};
560   try
561     AddTool(CompilerOpts.ExecuteBefore,'Execute Before');
562     AddTool(CompilerOpts.ExecuteAfter,'Execute After');
563     PageControl1.PageIndex:=OldPageIndex;
564   finally
565     EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TShowCompilerOptionsDlg.UpdateExecuteBeforeAfter'){$ENDIF};
566   end;
567 end;
568 
569 procedure TShowCompilerOptionsDlg.UpdateToolMemo(Opts: TShowCompToolOpts);
570 var
571   Params: String;
572 begin
573   Params:=Opts.CompOpts.Command;
574   IDEMacros.SubstituteMacros(Params);
575   FillMemo(Opts.Memo,Params);
576 end;
577 
578 end.
579 
580