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 stats about the used FPC.
25 }
26 unit IDEFPCInfo;
27 
28 {$mode objfpc}{$H+}
29 
30 interface
31 
32 uses
33   // RTL + LCL
34   Classes, SysUtils,
35   Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, ButtonPanel,
36   // CodeTools
37   DefineTemplates, CodeToolManager, FileProcs,
38   // LazUtils
39   LazFileUtils, LazUTF8,
40   // Other
41   IDEWindowIntf, LazIDEIntf, BaseBuildManager,
42   Project, EnvironmentOpts, LazarusIDEStrConsts, AboutFrm, TransferMacros;
43 
44 type
45 
46   { TIDEFPCInfoDialog }
47 
48   TIDEFPCInfoDialog = class(TForm)
49     ButtonPanel1: TButtonPanel;
50     CmdLineOutputMemo: TMemo;
51     ValuesMemo: TMemo;
52     PageControl1: TPageControl;
53     ValuesTabSheet: TTabSheet;
54     OutputTabSheet: TTabSheet;
55     procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
56     procedure FormCreate(Sender: TObject);
57   private
58     procedure UpdateValuesMemo;
59     procedure UpdateCmdLinePage;
60     procedure GatherIDEVersion(sl: TStrings);
61     procedure GatherEnvironmentVars(sl: TStrings);
62     procedure GatherGlobalOptions(sl: TStrings);
63     procedure GatherProjectOptions(sl: TStrings);
64     procedure GatherActiveOptions(sl: TStrings);
65     procedure GatherFPCExecutable(UnitSetCache: TFPCUnitSetCache; sl: TStrings);
66   public
67   end;
68 
ShowFPCInfonull69 function ShowFPCInfo: TModalResult;
70 
71 implementation
72 
ShowFPCInfonull73 function ShowFPCInfo: TModalResult;
74 var
75   Dlg: TIDEFPCInfoDialog;
76 begin
77   Dlg:=TIDEFPCInfoDialog.Create(nil);
78   try
79     Result:=Dlg.ShowModal;
80   finally
81     Dlg.Free;
82   end;
83 end;
84 
85 {$R *.lfm}
86 
87 { TIDEFPCInfoDialog }
88 
89 procedure TIDEFPCInfoDialog.FormCreate(Sender: TObject);
90 begin
91   Caption:=lisInformationAboutUsedFPC;
92 
93   UpdateValuesMemo;
94   UpdateCmdLinePage;
95   PageControl1.PageIndex:=0;
96   IDEDialogLayoutList.ApplyLayout(Self);
97 end;
98 
99 procedure TIDEFPCInfoDialog.FormClose(Sender: TObject;
100   var CloseAction: TCloseAction);
101 begin
102   IDEDialogLayoutList.SaveLayout(Self);
103 end;
104 
105 procedure TIDEFPCInfoDialog.UpdateValuesMemo;
106 var
107   sl: TStringList;
108   TargetOS: String;
109   TargetCPU: String;
110   CompilerFilename: String;
111   FPCSrcDir: String;
112   UnitSetCache: TFPCUnitSetCache;
113 begin
114   sl:=TStringList.Create;
115   try
116     GatherIDEVersion(sl);
117     GatherEnvironmentVars(sl);
118     GatherGlobalOptions(sl);
119     GatherProjectOptions(sl);
120     GatherActiveOptions(sl);
121 
122     TargetOS:=BuildBoss.GetTargetOS;
123     TargetCPU:=BuildBoss.GetTargetCPU;
124     CompilerFilename:=LazarusIDE.GetCompilerFilename;
125     FPCSrcDir:=EnvironmentOptions.GetParsedFPCSourceDirectory; // needs FPCVer macro
126     UnitSetCache:=CodeToolBoss.CompilerDefinesCache.FindUnitSet(
127       CompilerFilename,TargetOS,TargetCPU,'',FPCSrcDir,true);
128     GatherFPCExecutable(UnitSetCache,sl);
129 
130     ValuesMemo.Lines.Assign(sl);
131   finally
132     sl.Free;
133   end;
134 end;
135 
136 procedure TIDEFPCInfoDialog.UpdateCmdLinePage;
137 var
138   TargetOS: String;
139   TargetCPU: String;
140   CompilerFilename: String;
141   CompilerOptions: String;
142   Cfg: TPCTargetConfigCache;
143   Params: String;
144   ExtraOptions: String;
145   sl, List: TStringList;
146   TestFilename: String;
147   Filename: String;
148   WorkDir: String;
149   fs: TFileStream;
150 begin
151   sl:=TStringList.Create;
152   List:=nil;
153   try
154     sl.Add('The IDE asks the compiler with the following command for the real OS/CPU:');
155     CompilerFilename:=LazarusIDE.GetCompilerFilename;
156     CompilerOptions:='';
157     if Project1<>nil then
158     begin
159       CompilerOptions:=ExtractFPCFrontEndParameters(Project1.CompilerOptions.CustomOptions);
160       if not GlobalMacroList.SubstituteStr(CompilerOptions) then
161       begin
162         sl.Add('invalid macros in project''s compiler options: '+Project1.CompilerOptions.CustomOptions);
163         CompilerOptions:='';
164       end;
165     end;
166     if not LazarusIDE.CallHandlerGetFPCFrontEndParams(Self,CompilerOptions) then
167     begin
168       sl.Add('ERROR: design time event (lihtGetFPCFrontEndParams) failed to extend fpc front end parameters: "'+CompilerOptions+'"');
169     end;
170     Cfg:=CodeToolBoss.CompilerDefinesCache.ConfigCaches.Find(
171                         CompilerFilename,CompilerOptions,'','',true);
172     // fpc -i
173     ExtraOptions:=Cfg.GetFPCInfoCmdLineOptions(CodeToolBoss.CompilerDefinesCache.ExtraOptions);
174     Params:=Trim('-iTOTP '+ExtraOptions);
175     WorkDir:=GetCurrentDirUTF8;
176     sl.Add(CompilerFilename+' '+Params);
177     sl.Add('Working directory: '+WorkDir);
178     List:=RunTool(CompilerFilename,Params);
179     if (List=nil) or (List.Count<1) then begin
180       sl.Add('ERROR: unable to run compiler.');
181     end else begin
182       sl.Add('Output:');
183       sl.AddStrings(List);
184     end;
185     List.Free;
186     sl.Add('');
187 
188     // fpc -va
189     TargetOS:=BuildBoss.GetTargetOS;
190     TargetCPU:=BuildBoss.GetTargetCPU;
191     Cfg:=CodeToolBoss.CompilerDefinesCache.ConfigCaches.Find(
192                         CompilerFilename,CompilerOptions,TargetOS,TargetCPU,true);
193     TestFilename:=CodeToolBoss.CompilerDefinesCache.TestFilename;
194     Filename:=ExtractFileName(TestFilename);
195     WorkDir:=ExtractFilePath(TestFilename);
196     sl.Add('The IDE asks the compiler with the following command for paths and macros:');
197     ExtraOptions:=Cfg.GetFPCInfoCmdLineOptions(CodeToolBoss.CompilerDefinesCache.ExtraOptions);
198     Params:=Trim('-va '+ExtraOptions)+' '+Filename;
199     sl.Add(CompilerFilename+' '+Params);
200     sl.Add('Working directory: '+WorkDir);
201     // create empty file
202     try
203       fs:=TFileStream.Create(TestFilename,fmCreate);
204       fs.Free;
205     except
206       sl.Add('ERROR: unable to create test file '+TestFilename);
207       exit;
208     end;
209     List:=RunTool(CompilerFilename,Params,WorkDir);
210     if (List=nil) or (List.Count<1) then begin
211       sl.Add('ERROR: unable to run compiler.');
212     end else begin
213       sl.Add('Output:');
214       sl.AddStrings(List);
215       sl.Add('');
216       sl.Add('NOTE: The '+Filename+' is empty, so compilation fails. This is what we want.');
217     end;
218 
219   finally
220     CmdLineOutputMemo.Lines.Assign(sl);
221     List.free;
222     sl.Free;
223   end;
224 end;
225 
226 procedure TIDEFPCInfoDialog.GatherIDEVersion(sl: TStrings);
227 begin
228   sl.Add('Lazarus version: '+GetLazarusVersionString);
229   sl.Add('Lazarus revision: '+LazarusRevisionStr);
230   sl.Add('Lazarus build date: '+{$I %date%});
231   sl.Add('Lazarus was compiled for '+GetCompiledTargetCPU+'-'+GetCompiledTargetOS);
232   sl.Add('Lazarus was compiled with FPC '+{$I %FPCVERSION%});
233   sl.Add('');
234 end;
235 
236 procedure TIDEFPCInfoDialog.GatherEnvironmentVars(sl: TStrings);
237 
238   procedure Add(EnvName: string);
239   begin
240     sl.Add(EnvName+'='+GetEnvironmentVariableUTF8(EnvName));
241   end;
242 
243 begin
244   sl.Add('Environment variables:');
245   Add('PATH');
246   Add('PP');
247   Add('FPCDIR');
248   Add('USESVN2REVISIONINC');
249   Add('USER');
250   Add('HOME');
251   Add('PWD');
252   Add('LANG');
253   Add('LANGUAGE');
254   sl.Add('');
255 end;
256 
257 procedure TIDEFPCInfoDialog.GatherGlobalOptions(sl: TStrings);
258 begin
259   sl.add('Global IDE options:');
260   sl.Add('LazarusDirectory='+EnvironmentOptions.LazarusDirectory);
261   sl.Add('Resolved LazarusDirectory='+EnvironmentOptions.GetParsedLazarusDirectory);
262   if Project1<>nil then
263     sl.Add('Project''s CompilerFilename='+Project1.CompilerOptions.CompilerPath);
264   sl.Add('Resolved Project''s CompilerFilename='+Project1.GetCompilerFilename);
265   sl.Add('Default CompilerFilename='+EnvironmentOptions.CompilerFilename);
266   sl.Add('Resolved default compilerFilename='+EnvironmentOptions.GetParsedCompilerFilename);
267   sl.Add('CompilerMessagesFilename='+EnvironmentOptions.CompilerMessagesFilename);
268   sl.Add('Resolved CompilerMessagesFilename='+EnvironmentOptions.GetParsedCompilerMessagesFilename);
269   sl.Add('');
270 end;
271 
272 procedure TIDEFPCInfoDialog.GatherProjectOptions(sl: TStrings);
273 begin
274   sl.Add('Project:');
275   if Project1<>nil then begin
276     sl.Add('lpi='+Project1.ProjectInfoFile);
277     sl.Add('Directory='+Project1.Directory);
278     sl.Add('TargetOS='+Project1.CompilerOptions.TargetOS);
279     sl.Add('TargetCPU='+Project1.CompilerOptions.TargetCPU);
280     sl.Add('CompilerFilename='+Project1.CompilerOptions.CompilerPath);
281     sl.Add('CompilerOptions='+ExtractFPCFrontEndParameters(Project1.CompilerOptions.CompilerPath));
282   end else begin
283     sl.Add('no project');
284   end;
285   sl.Add('');
286 end;
287 
288 procedure TIDEFPCInfoDialog.GatherActiveOptions(sl: TStrings);
289 begin
290   sl.Add('Active target:');
291   sl.Add('TargetOS='+BuildBoss.GetTargetOS);
292   sl.Add('TargetCPU='+BuildBoss.GetTargetCPU);
293   sl.Add('');
294 end;
295 
296 procedure TIDEFPCInfoDialog.GatherFPCExecutable(UnitSetCache: TFPCUnitSetCache;
297   sl: TStrings);
298 var
299   CfgCache: TPCTargetConfigCache;
300   i: Integer;
301   CfgFileItem: TPCConfigFileState;
302   HasCfgs: Boolean;
303   SrcCache: TFPCSourceCache;
304   AFilename: string;
305   AnUnitName: string;
306 begin
307   sl.Add('FPC executable:');
308   if UnitSetCache<>nil then begin
309     CfgCache:=UnitSetCache.GetConfigCache(false);
310     if CfgCache<>nil then begin
311       sl.Add('Compiler='+CfgCache.Compiler);
312       sl.Add('Options='+CfgCache.CompilerOptions);
313       sl.Add('CompilerDate='+DateTimeToStr(FileDateToDateTimeDef(CfgCache.CompilerDate)));
314       sl.Add('RealCompiler='+CfgCache.RealCompiler);
315       sl.Add('RealCompilerDate='+DateTimeToStr(FileDateToDateTimeDef(CfgCache.RealCompilerDate)));
316       sl.Add('RealTargetOS='+CfgCache.RealTargetOS);
317       sl.Add('RealTargetCPU='+CfgCache.RealTargetCPU);
318       sl.Add('RealCompilerInPath='+CfgCache.RealTargetCPUCompiler);
319       sl.Add('Version='+CfgCache.FullVersion);
320       HasCfgs:=false;
321       if CfgCache.ConfigFiles<>nil then begin
322         for i:=0 to CfgCache.ConfigFiles.Count-1 do begin
323           CfgFileItem:=CfgCache.ConfigFiles[i];
324           if CfgFileItem.FileExists then begin
325             sl.Add('CfgFilename='+CfgFileItem.Filename);
326             HasCfgs:=true;
327           end;
328         end;
329       end;
330       if not HasCfgs then
331         sl.Add('WARNING: fpc has no config file');
332       sl.Add('');
333       sl.Add('Defines:');
334       if CfgCache.Defines<>nil then begin
335         sl.Add(CfgCache.Defines.AsText);
336       end;
337       sl.Add('Undefines:');
338       if CfgCache.Undefines<>nil then begin
339         sl.Add(CfgCache.Undefines.AsText);
340       end;
341       sl.Add('Include Paths:');
342       if CfgCache.IncludePaths<>nil then begin
343         sl.AddStrings(CfgCache.IncludePaths);
344       end;
345       sl.Add('Unit Scopes:');
346       if CfgCache.UnitScopes<>nil then begin
347         sl.AddStrings(CfgCache.UnitScopes);
348       end;
349       sl.Add('Unit Paths:');
350       if CfgCache.UnitPaths<>nil then begin
351         sl.AddStrings(CfgCache.UnitPaths);
352       end;
353       sl.add('Units:');
354       if CfgCache.Units<>nil then begin
355         sl.Add(CfgCache.Units.AsText);
356       end;
357     end;
358     SrcCache:=UnitSetCache.GetSourceCache(false);
359     if SrcCache<>nil then begin
360       sl.Add('Sources:');
361       sl.Add('Directory='+SrcCache.Directory);
362       if SrcCache.Files<>nil then begin
363         sl.Add('Files.Count='+dbgs(SrcCache.Files.Count));
364         for i:=0 to SrcCache.Files.Count-1 do begin
365           AFilename:=SrcCache.Files[i];
366           AnUnitName:=ExtractFilenameOnly(AFilename);
367           if (AnUnitName='classes')
368           or (AnUnitName='sysutils')
369           or (AnUnitName='system')
370           then
371             sl.Add(AFilename);
372         end;
373       end else
374         sl.Add('Files.Count=0');
375     end;
376   end;
377   sl.Add('');
378 end;
379 
380 end.
381 
382