1 { Dialog to write fppkg-configuration files (fppkg.cfg and default) using the
2 fpcmkcfg tool that comes with fpc.
3
4 Copyright (C) 2019 Joost van der Sluis/CNOC joost@cnoc.nl
5
6 This source is free software; you can redistribute it and/or modify it under
7 the terms of the GNU General Public License as published by the Free
8 Software Foundation; either version 2 of the License, or (at your option)
9 any later version.
10
11 This code is distributed in the hope that it will be useful, but WITHOUT ANY
12 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
13 FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
14 details.
15
16 A copy of the GNU General Public License is available on the World Wide Web
17 at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
18 to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
19 Boston, MA 02110-1335, USA.
20 }
21 unit GenerateFppkgConfigurationDlg;
22
23 {$mode objfpc}{$H+}
24
25 interface
26
27 uses
28 // Rtl
29 Classes,
30 SysUtils,
31 // Fcl
32 fpmkunit,
33 process,
34 // Fppkg
35 pkgglobals,
36 // LazUtils
37 LazFileUtils,
38 LazFileCache,
39 UTF8Process,
40 // Lcl
41 Forms,
42 Controls,
43 Graphics,
44 Dialogs,
45 StdCtrls,
46 ExtCtrls,
47 // Codetools
48 CodeToolManager,
49 // IDE
50 IDEProcs,
51 LazConf,
52 LazarusIDEStrConsts,
53 InitialSetupProc,
54 EnvironmentOpts,
55 // Packager
56 FppkgHelper,
57 // Ideintf
58 IDEDialogs;
59
60 type
61
62 { TGenerateFppkgConfigurationDialog }
63
64 TGenerateFppkgConfigurationDialog = class(TForm)
65 FppkgLabel: TLabel;
66 FpcPrefixCombobox: TComboBox;
67 FppkgPrefixLabel: TLabel;
68 InfoMemo: TMemo;
69 BtnPanel: TPanel;
70 FppkgWriteConfigButton: TButton;
71 WarningsLabel: TLabel;
72 BrowsePanel: TPanel;
73 BrowseButton: TButton;
74
75 procedure FormCreate(Sender: TObject);
76 procedure FpcPrefixComboboxChange(Sender: TObject);
77 procedure BrowseButtonClick(Sender: TObject);
78 procedure FppkgWriteConfigButtonClick(Sender: TObject);
79 private
80 FCompiler: string;
81 FFppkgCfgFilename: string;
82 fLastParsedFpcPrefix: string;
83 fLastParsedFpcLibPath: string;
84 procedure SetCompiler(AValue: string);
85 procedure SetFppkgCfgFilename(AValue: string);
CheckIfWritablenull86 function CheckIfWritable(Filename: string): Boolean;
CheckFppkgQualitynull87 function CheckFppkgQuality(APrefix: string; out LibPath, Note: string): TSDFilenameQuality;
88 procedure UpdateFppkgNote;
89 procedure SearchFppkgFpcPrefixCandidates;
CheckFpcmkcfgQualitynull90 function CheckFpcmkcfgQuality(out Note: string): TSDFilenameQuality;
91 public
92 // Filename of the Free Pascal compiler that has to be written to the
93 // configuration-files.
94 property Compiler: string read FCompiler write SetCompiler;
95 // Filename of the configuration file that has to be written.
96 property FppkgCfgFilename: string read FFppkgCfgFilename write SetFppkgCfgFilename;
97 end;
98
99 var
100 GenerateFppkgConfigurationDialog: TGenerateFppkgConfigurationDialog;
101
102 implementation
103
104 {$R *.lfm}
105
106 { TGenerateFppkgConfigurationDialog }
107
108 procedure TGenerateFppkgConfigurationDialog.FormCreate(Sender: TObject);
109 begin
110 Caption := lisGenerateFppkgConfigurationCaption;
111 FppkgLabel.Caption := lisGenerateFppkgConfiguration;
112 {$IFDEF WINDOWS}
113 FppkgPrefixLabel.Caption:=Format(lisFppkgInstallationPath, [GetFPCVer+PathDelim+'units', GetFPCVer+PathDelim+'fpmkinst']);
114 {$ELSE}
115 FppkgPrefixLabel.Caption:=Format(lisFppkgInstallationPath, ['lib/fpc', 'lib64/fpc']);
116 {$ENDIF WINDOWS}
117 SearchFppkgFpcPrefixCandidates;
118 FpcPrefixCombobox.Text := '';
119 if FpcPrefixCombobox.Items.Count > 0 then
120 FpcPrefixCombobox.ItemIndex := 0;
121 WarningsLabel.Caption := lisFppkgConfGenProblems;
122 FppkgWriteConfigButton.Caption := lisFppkgWriteConfigFile;
123 BrowseButton.Caption:=lisPathEditBrowse;
124 UpdateFppkgNote;
125 end;
126
127 procedure TGenerateFppkgConfigurationDialog.SearchFppkgFpcPrefixCandidates;
128
CheckPathnull129 function CheckPath(APath: string; List: TStrings): boolean;
130 var
131 LibPath, Note: String;
132 begin
133 Result:=false;
134 if APath='' then exit;
135 ForcePathDelims(APath);
136 // check if already checked
137 if Assigned(List) and (List.IndexOf(APath)>-1) then exit;
138
139 if CheckFppkgQuality(APath, LibPath, Note) = sddqCompatible then
140 begin
141 List.Add(APath);
142 Result := True;
143 end;
144 end;
145
146 var
147 ChkPath: string;
148 begin
149 FpcPrefixCombobox.Clear;
150
151 ChkPath := ExtractFileDir(ExtractFileDir(EnvironmentOptions.GetParsedCompilerFilename));
152 {$IFDEF WINDOWS}
153 ChkPath := ExtractFileDir(ChkPath);
154 {$ENDIF WINDOWS}
155 CheckPath(ChkPath, FpcPrefixCombobox.Items);
156
157 {$IFNDEF WINDOWS}
158 // Check if the user provided the compiler-executable inside the lib-directory
159 // itself. (prefix/lib/3.3.1/ppcarm or something)
160 ChkPath := ExtractFileDir(ExtractFileDir(ChkPath));
161 CheckPath(ChkPath, FpcPrefixCombobox.Items);
162 {$ENDIF}
163
164 {$IFDEF WINDOWS}
165 CheckPath('C:\PP', FpcPrefixCombobox.Items);
166 CheckPath('D:\PP', FpcPrefixCombobox.Items);
167 CheckPath('C:\FPC', FpcPrefixCombobox.Items);
168 CheckPath('D:\FPC', FpcPrefixCombobox.Items);
169 {$ELSE}
170 CheckPath('/usr', FpcPrefixCombobox.Items);
171 CheckPath('/usr/local', FpcPrefixCombobox.Items);
172 {$ENDIF WINDOWS}
173 end;
174
CheckFppkgQualitynull175 function TGenerateFppkgConfigurationDialog.CheckFppkgQuality(APrefix: string; out LibPath,
176 Note: string): TSDFilenameQuality;
177 var
178 SR: TRawByteSearchRec;
179 LibPathValid: Boolean;
180 Ver: TFPVersion;
181 begin
182 Result := sddqInvalid;
183 LibPath := '';
184
185 if APrefix='' then
186 begin
187 Note := lisWarning + lisNoFppkgPrefix + LineEnding;
188 Exit;
189 end;
190
191 APrefix:=TrimFilename(APrefix);
192 if not FileExistsCached(APrefix) then
193 begin
194 Note:= lisWarning + lisFreePascalPrefix + ' ' + lisISDDirectoryNotFound + '.' + LineEnding;
195 end
196 else if not DirPathExistsCached(APrefix) then
197 begin
198 Note:= lisWarning + lisFreePascalPrefix + ' ' + lisPathIsNoDirectory + LineEnding;
199 end
200 else
201 begin
202 LibPathValid := True;
203
204 {$IFNDEF WINDOWS}
205 LibPath := ConcatPaths([APrefix, 'lib', 'fpc']);
206 if not DirPathExistsCached(LibPath) then
207 begin
208 LibPath := ConcatPaths([APrefix, 'lib64', 'fpc']);
209 if not DirPathExistsCached(LibPath) then
210 begin
211 LibPathValid := False;
212 end;
213 end;
214 {$ELSE}
215 LibPath := APrefix;
216 {$ENDIF}
217 LibPath := IncludeTrailingPathDelimiter(LibPath);
218
219 if DirPathExistsCached(LibPath+PathDelim+'fpmkinst') and
220 DirPathExistsCached(LibPath+PathDelim+'units') then
221 begin
222 LibPathValid := True;
223 Result := sddqCompatible;
224 end
225 else if LibPathValid and (FindFirstUTF8(LibPath+AllFilesMask, faDirectory, SR) = 0) then
226 begin
227 LibPathValid := False;
228 repeat
229 if (SR.Name<>'.') and (SR.Name<>'..') then
230 begin
231 if DirPathExistsCached(LibPath+SR.Name+PathDelim+'fpmkinst') and
232 DirPathExistsCached(LibPath+SR.Name+PathDelim+'units') then
233 begin
234 Ver := TFPVersion.Create;
235 try
236 Ver.AsString:=SR.Name;
237 if (Ver.Major > -1) and (Ver.Minor > -1) and (Ver.Micro > -1) then
238 LibPath:=LibPath + '{CompilerVersion}' + PathDelim
239 else
240 LibPath:=LibPath + SR.Name + PathDelim
241 finally
242 Ver.Free;
243 end;
244 LibPathValid := True;
245 Result := sddqCompatible;
246 Break;
247 end;
248 end;
249 until FindNext(SR) <> 0;
250 FindCloseUTF8(SR);
251 end;
252
253 if not LibPathValid then
254 Note:= Note + lisWarning + lisNotAValidFppkgPrefix + LineEnding
255 else
256 Note:='';
257 end;
258
259 end;
260
261 procedure TGenerateFppkgConfigurationDialog.UpdateFppkgNote;
262 var
263 CurCaption: String;
264 Msg, Note: string;
265 FileName: string;
266 begin
267 if csDestroying in ComponentState then exit;
268 CurCaption:=FpcPrefixCombobox.Text;
269 if (fLastParsedFpcPrefix=CurCaption) and (CurCaption<>'') then exit;
270 fLastParsedFpcPrefix:=CurCaption;
271
272 Msg := '';
273 if CheckFppkgQuality(CurCaption,fLastParsedFpcLibPath,Note)<>sddqCompatible then
274 Msg := Note;
275 if (CheckFPCExeQuality(FCompiler, Note, CodeToolBoss.CompilerDefinesCache.TestFilename)<>sddqCompatible) then
276 Msg := Msg + lisWarning + lisFppkgCompilerProblem +Note + LineEnding;
277 if CheckFpcmkcfgQuality(Note) <> sddqCompatible then
278 Msg := Msg + lisWarning + Note + LineEnding;
279
280 Note := lisFppkgFilesToBeWritten + LineEnding;
281 Note := Note + Format(lisGenerateFppkgCfg, [FppkgCfgFilename]) + LineEnding;
282 // These are the default config-locations used by fpcmkcfg
283 {$IFDEF WINDOWS}
284 FileName := '%LocalAppData%\FreePascal\Fppkg\config\default';
285 {$ELSE}
286 FileName := '~/.fppkg/config/default';
287 {$ENDIF}
288 Note := Note + Format(lisGenerateFppkgCompCfg, [FileName]) + LineEnding;
289
290 if not CheckIfWritable(FppkgCfgFilename) then
291 Msg := Msg + lisWarning + ueFileROText1 + FppkgCfgFilename + ueFileROText2 + LineEnding;
292 if not CheckIfWritable(FileName) then
293 Msg := Msg + lisWarning + ueFileROText1 + FileName + ueFileROText2 + LineEnding;
294
295 if Msg<>'' then
296 begin
297 WarningsLabel.Visible := True;
298 Note := Msg + LineEnding + Note;
299 FppkgWriteConfigButton.Enabled := False;
300 end
301 else
302 begin
303 WarningsLabel.Visible := False;
304 FppkgWriteConfigButton.Enabled := True;
305 end;
306
307 if fLastParsedFpcLibPath<>'' then
308 begin
309 // If the fLastParsedFpcLibPath is empty, these two lines contain garbage
310 Note := Note + LineEnding + Format(lisFppkgPrefix, [fLastParsedFpcPrefix]) + LineEnding;
311 Note := Note + Format(lisFppkgLibPrefix, [fLastParsedFpcLibPath]) + LineEnding;
312 end;
313
314 InfoMemo.Text := Note;
315 end;
316
317 procedure TGenerateFppkgConfigurationDialog.SetCompiler(AValue: string);
318 begin
319 if FCompiler = AValue then Exit;
320 FCompiler := AValue;
321 fLastParsedFpcPrefix := ' ';
322 UpdateFppkgNote;
323 end;
324
CheckFpcmkcfgQualitynull325 function TGenerateFppkgConfigurationDialog.CheckFpcmkcfgQuality(out Note: string): TSDFilenameQuality;
326 {$IF FPC_FULLVERSION>30100}
327 var
328 FpcmkcfgExecutable: string;
329 Proc: TProcessUTF8;
330 S: string;
331 Ver: TFPVersion;
332 {$ENDIF}
333 begin
334 Result := sddqCompatible;
335 Note:='';
336 {$IF FPC_FULLVERSION>30100}
337 FpcmkcfgExecutable := FindFPCTool('fpcmkcfg'+GetExecutableExt, EnvironmentOptions.GetParsedCompilerFilename);
338 if FpcmkcfgExecutable = '' then
339 begin
340 Note := lisFppkgFpcmkcfgMissing + ' ' + lisFppkgRecentFpcmkcfgNeeded;
341 Result := sddqInvalid;
342 end
343 else
344 begin
345 Proc := TProcessUTF8.Create(nil);
346 try
347
348 Proc.Options := proc.Options + [poNoConsole, poWaitOnExit,poUsePipes];
349 // Write fppkg.cfg
350 Proc.Executable := FpcmkcfgExecutable;
351 proc.Parameters.Add('-V');
352 proc.Execute;
353
354 if proc.ExitStatus <> 0 then
355 begin
356 Note := lisFppkgFpcmkcfgCheckFailed + ' ' + lisFppkgFpcmkcfgProbTooOld + ' ' + lisFppkgRecentFpcmkcfgNeeded;
357 Result := sddqInvalid;
358 end
359 else
360 begin
361 S := '';
362 SetLength(S, Proc.Output.NumBytesAvailable);
363 Proc.Output.Read(S[1], Proc.Output.NumBytesAvailable);
364 Ver := TFPVersion.Create;
365 try
366 S := Copy(S, pos(':', S)+2);
367 Ver.AsString := Trim(S);
368 if Ver.Major = -1 then
369 begin
370 Note := lisFppkgFpcmkcfgCheckFailed + ' ' + lisFppkgFpcmkcfgNeeded + lisFppkgRecentFpcmkcfgNeeded;
371 Result := sddqInvalid;
372 end
373 else if not ((Ver.Major = 0) or (Ver.Major > 3) or (((Ver.Major = 3)) and (Ver.Minor>1))) then
374 begin
375 // fpcmkcfg's version must be > 3.1. Older versions need other
376 // parameters. Version 0 is also allowed, because it is probably
377 // self-built.
378 Note := Format( lisFppkgFpcmkcfgTooOld, [Ver.AsString]) + ' ' + lisFppkgFpcmkcfgNeeded + ' ' + lisFppkgRecentFpcmkcfgNeeded;
379 Result := sddqInvalid;
380 end;
381 finally
382 Ver.Free;
383 end;
384 end;
385 finally
386 Proc.Free;
387 end;
388 end;
389 {$ENDIF}
390 end;
391
392 procedure TGenerateFppkgConfigurationDialog.FpcPrefixComboboxChange(Sender: TObject);
393 begin
394 UpdateFppkgNote;
395 end;
396
397 procedure TGenerateFppkgConfigurationDialog.SetFppkgCfgFilename(AValue: string);
398 begin
399 if FFppkgCfgFilename = AValue then Exit;
400 FFppkgCfgFilename := AValue;
401 fLastParsedFpcPrefix := ' ';
402 UpdateFppkgNote;
403 end;
404
405 procedure TGenerateFppkgConfigurationDialog.BrowseButtonClick(Sender: TObject);
406 var
407 Dlg: TSelectDirectoryDialog;
408 begin
409 Dlg:=TSelectDirectoryDialog.Create(nil);
410 try
411 Dlg.Title:=lisSelectFPCPath;
412 Dlg.Options:=Dlg.Options+[ofPathMustExist];
413 if not Dlg.Execute then exit;
414 FpcPrefixCombobox.Text:=Dlg.FileName;
415 finally
416 Dlg.Free;
417 end;
418 UpdateFppkgNote;
419 end;
420
421 procedure TGenerateFppkgConfigurationDialog.FppkgWriteConfigButtonClick(Sender: TObject);
422 var
423 Msg: string;
424 {$IF FPC_FULLVERSION>30100}
425 FpcmkcfgExecutable, CompConfigFilename: string;
426 Proc: TProcessUTF8;
427 Fppkg: TFppkgHelper;
428 {$ENDIF}
429
430 procedure ShowFpcmkcfgError;
431 begin
432 SetLength(Msg, Proc.Output.NumBytesAvailable);
433 if Msg <> '' then
434 begin
435 Proc.Output.Read(Msg[1], Proc.Output.NumBytesAvailable);
436 IDEMessageDialog(lisFppkgProblem, Format(lisFppkgCreateFileFailed, [GetFppkgConfigFile(False, False), Msg]), mtWarning, [mbOK])
437 end;
438 end;
439
440 begin
441 {$IF FPC_FULLVERSION>30100}
442 try
443 FpcmkcfgExecutable := FindFPCTool('fpcmkcfg'+GetExecutableExt, EnvironmentOptions.GetParsedCompilerFilename);
444 if FpcmkcfgExecutable<>'' then
445 begin
446 Proc := TProcessUTF8.Create(nil);
447 try
448 Proc.Options := proc.Options + [poWaitOnExit, poNoConsole, poUsePipes, poStderrToOutPut];
449 // Write fppkg.cfg
450 Proc.Executable := FpcmkcfgExecutable;
451 proc.Parameters.Add('-p');
452 proc.Parameters.Add('-3');
453 proc.Parameters.Add('-o');
454 proc.Parameters.Add(FppkgCfgFilename);
455 proc.Parameters.Add('-d');
456 proc.Parameters.Add('globalpath='+fLastParsedFpcLibPath);
457 proc.Parameters.Add('-d');
458 {$IFDEF WINDOWS}
459 proc.Parameters.Add('globalprefix='+fLastParsedFpcLibPath);
460 {$ELSE}
461 proc.Parameters.Add('globalprefix='+fLastParsedFpcPrefix);
462 {$ENDIF}
463 proc.Execute;
464
465 Fppkg:=TFppkgHelper.Instance;
466
467 if proc.ExitStatus <> 0 then
468 ShowFpcmkcfgError
469 else
470 begin
471 Fppkg:=TFppkgHelper.Instance;
472 Fppkg.ReInitialize;
473
474 // Write default compiler configuration file
475 CompConfigFilename := Fppkg.GetCompilerConfigurationFileName;
476 if CompConfigFilename <> '' then
477 begin
478 proc.Parameters.Clear;
479 proc.Parameters.Add('-p');
480 proc.Parameters.Add('-4');
481 proc.Parameters.Add('-o');
482 proc.Parameters.Add(CompConfigFilename);
483 proc.Parameters.Add('-d');
484 proc.Parameters.Add('fpcbin='+EnvironmentOptions.GetParsedCompilerFilename);
485 proc.Execute;
486
487 if proc.ExitStatus <> 0 then
488 ShowFpcmkcfgError
489 end;
490 end;
491
492 Fppkg.ReInitialize;
493 finally
494 Proc.Free;
495 end;
496 end;
497 except
498 on E: Exception do
499 IDEMessageDialog(lisFppkgProblem, Format(lisFppkgWriteConfException, [E.Message]), mtWarning, [mbOK]);
500 end;
501
502 fLastParsedFpcPrefix := '';
503 UpdateFppkgNote;
504 {$ENDIF}
505 if CheckFppkgConfiguration(FFppkgCfgFilename, Msg)<>sddqCompatible then
506 begin
507 IDEMessageDialog(lisFppkgProblem, Format(lisFppkgWriteConfFailed, [Msg]),
508 mtWarning, [mbOK]);
509 ModalResult := mrCancel;
510 end
511 else
512 ModalResult := mrOK;
513 end;
514
CheckIfWritablenull515 function TGenerateFppkgConfigurationDialog.CheckIfWritable(Filename: string): Boolean;
516 begin
517 Result := True;
518 if (FileName<>'') then
519 begin
520 Filename := ExpandFileNameUTF8(Filename);
521 if FileExistsUTF8(Filename) then
522 Result := FileIsWritable(FileName)
523 end;
524 end;
525
526
527 end.
528
529