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