← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to ide/initialsetupdlgs.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
ide/initialsetupdlgs.pas
2
2
 /***************************************************************************
3
3
                            initialsetupdlgs.pas
4
4
                            --------------------
5
 
       Contains the dialogs to help users to setup basic settings.
 
5
       Contains the dialogs to help users setup basic settings.
6
6
 
7
7
 
8
8
 ***************************************************************************/
30
30
  
31
31
  Abstract:
32
32
    Procedures and dialogs to check environment. The IDE uses these procedures
33
 
    at startup to check for example the lazarus directory and warns if, there
34
 
    it looks suspicious.
 
33
    at startup to check for example the lazarus directory and warns if it looks
 
34
    suspicious and choose another.
35
35
}
36
36
unit InitialSetupDlgs;
37
37
 
40
40
interface
41
41
 
42
42
uses
43
 
  Classes, SysUtils, LCLProc, Forms, Controls, Buttons, Dialogs, FileUtil,
44
 
  ComCtrls, Laz_XMLCfg,
45
 
  LazarusIDEStrConsts, LazConf, EnvironmentOpts, IDEProcs;
 
43
  Classes, SysUtils, contnrs, LCLProc, Forms, Controls, Buttons, Dialogs,
 
44
  FileUtil, Laz2_XMLCfg, lazutf8classes, Graphics, ComCtrls, ExtCtrls, StdCtrls,
 
45
  DefineTemplates, CodeToolManager,
 
46
  TextTools,
 
47
  TransferMacros, LazarusIDEStrConsts, LazConf, EnvironmentOpts, IDEProcs,
 
48
  AboutFrm;
46
49
  
47
 
procedure SetupCompilerFilename(var InteractiveSetup: boolean);
48
 
procedure SetupFPCSourceDirectory(var InteractiveSetup: boolean);
49
 
procedure SetupLazarusDirectory(var InteractiveSetup: boolean);
50
 
 
 
50
type
 
51
  TSDFilenameQuality = (
 
52
    sddqInvalid,
 
53
    sddqWrongMinorVersion,
 
54
    sddqWrongVersion,
 
55
    sddqIncomplete,
 
56
    sddqCompatible
 
57
    );
 
58
 
 
59
  TSDFileInfo = class
 
60
  public
 
61
    Filename: string; // macros resolved, trimmed, expanded
 
62
    Caption: string; // filename with macros
 
63
    Note: string;
 
64
    Quality: TSDFilenameQuality;
 
65
  end;
 
66
 
 
67
  TSDFilenameType = (
 
68
    sddtLazarusSrcDir,
 
69
    sddtCompilerFilename,
 
70
    sddtFPCSrcDir
 
71
    );
 
72
 
 
73
  { TInitialSetupDialog }
 
74
 
 
75
  TInitialSetupDialog = class(TForm)
 
76
    BtnPanel: TPanel;
 
77
    CompilerBrowseButton: TButton;
 
78
    CompilerComboBox: TComboBox;
 
79
    CompilerLabel: TLabel;
 
80
    CompilerMemo: TMemo;
 
81
    FPCSrcDirBrowseButton: TButton;
 
82
    FPCSrcDirComboBox: TComboBox;
 
83
    FPCSrcDirLabel: TLabel;
 
84
    FPCSrcDirMemo: TMemo;
 
85
    ImageList1: TImageList;
 
86
    LazDirBrowseButton: TButton;
 
87
    LazDirLabel: TLabel;
 
88
    LazDirComboBox: TComboBox;
 
89
    LazDirMemo: TMemo;
 
90
    PropertiesPageControl: TPageControl;
 
91
    PropertiesTreeView: TTreeView;
 
92
    Splitter1: TSplitter;
 
93
    StartIDEBitBtn: TBitBtn;
 
94
    LazarusTabSheet: TTabSheet;
 
95
    CompilerTabSheet: TTabSheet;
 
96
    FPCSourcesTabSheet: TTabSheet;
 
97
    WelcomePaintBox: TPaintBox;
 
98
    procedure CompilerBrowseButtonClick(Sender: TObject);
 
99
    procedure CompilerComboBoxChange(Sender: TObject);
 
100
    procedure FormCreate(Sender: TObject);
 
101
    procedure FormDestroy(Sender: TObject);
 
102
    procedure FPCSrcDirBrowseButtonClick(Sender: TObject);
 
103
    procedure FPCSrcDirComboBoxChange(Sender: TObject);
 
104
    procedure LazDirBrowseButtonClick(Sender: TObject);
 
105
    procedure LazDirComboBoxChange(Sender: TObject);
 
106
    procedure OnAppActivate(Sender: TObject);
 
107
    procedure PropertiesPageControlChange(Sender: TObject);
 
108
    procedure PropertiesTreeViewSelectionChanged(Sender: TObject);
 
109
    procedure StartIDEBitBtnClick(Sender: TObject);
 
110
    procedure WelcomePaintBoxPaint(Sender: TObject);
 
111
    procedure OnIdle(Sender: TObject; var {%H-}Done: Boolean);
 
112
  private
 
113
    FLazarusDirChanged: boolean;
 
114
    fCompilerFilenameChanged: boolean;
 
115
    FLastParsedLazDir: string;
 
116
    fLastParsedCompiler: string;
 
117
    fLastParsedFPCSrcDir: string;
 
118
    FIdleConnected: boolean;
 
119
    ImgIDError: LongInt;
 
120
    ImgIDWarning: LongInt;
 
121
    FHeadGraphic: TPortableNetworkGraphic;
 
122
    FSelectingPage: boolean;
 
123
    FCandidates: array[TSDFilenameType] of TObjectList; // list of TSDFileInfo
 
124
    procedure SelectPage(const NodeText: string);
 
125
    function SelectDirectory(aTitle: string): string;
 
126
    procedure UpdateLazarusDirCandidates;
 
127
    procedure UpdateCompilerFilenameCandidates;
 
128
    procedure UpdateFPCSrcDirCandidates;
 
129
    procedure FillComboboxWithFileInfoList(ABox: TComboBox; List: TObjectList;
 
130
       ItemIndex: integer = 0);
 
131
    procedure SetIdleConnected(const AValue: boolean);
 
132
    procedure UpdateLazDirNote;
 
133
    procedure UpdateCompilerNote;
 
134
    procedure UpdateFPCSrcDirNote;
 
135
    function FirstErrorNode: TTreeNode;
 
136
    function GetFPCVer: string;
 
137
    function GetFirstCandidate(Candidates: TObjectList;
 
138
      MinQuality: TSDFilenameQuality = sddqCompatible): TSDFileInfo;
 
139
    function QualityToImgIndex(Quality: TSDFilenameQuality): integer;
 
140
  public
 
141
    TVNodeLazarus: TTreeNode;
 
142
    TVNodeCompiler: TTreeNode;
 
143
    TVNodeFPCSources: TTreeNode;
 
144
    procedure Init;
 
145
    property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
 
146
  end;
 
147
 
 
148
function ShowInitialSetupDialog: TModalResult;
 
149
 
 
150
function CheckLazarusDirectoryQuality(ADirectory: string;
 
151
  out Note: string): TSDFilenameQuality;
 
152
function SearchLazarusDirectoryCandidates(StopIfFits: boolean): TObjectList;
 
153
procedure SetupLazarusDirectory;
 
154
 
 
155
function CheckCompilerQuality(AFilename: string;
 
156
  out Note: string; TestSrcFilename: string): TSDFilenameQuality;
 
157
function SearchCompilerCandidates(StopIfFits: boolean;
 
158
  const TestSrcFilename: string): TObjectList;
 
159
procedure SetupCompilerFilename;
 
160
 
 
161
function CheckFPCSrcDirQuality(ADirectory: string;
 
162
  out Note: string; FPCVer: string): TSDFilenameQuality;
 
163
function SearchFPCSrcDirCandidates(StopIfFits: boolean;
 
164
  const FPCVer: string): TObjectList;
 
165
procedure SetupFPCSrcDir(FPCVer: string);
 
166
 
 
167
function CheckMakeExeQuality(AFilename: string;
 
168
  out Note: string): TSDFilenameQuality;
 
169
function SearchMakeExeCandidates(StopIfFits: boolean): TObjectList;
 
170
procedure SetupMakeExe;
 
171
 
 
172
function GetValueFromPrimaryConfig(OptionFilename, Path: string): string;
51
173
function GetValueFromSecondaryConfig(OptionFilename, Path: string): string;
 
174
function GetValueFromIDEConfig(OptionFilename, Path: string): string;
52
175
 
53
176
implementation
54
177
 
55
 
procedure SetupCompilerFilename(var InteractiveSetup: boolean);
56
 
var
57
 
  DefaultCompPath: String;
58
 
  CurCompilerFilename: String;
59
 
  r: integer;
60
 
begin
61
 
  CurCompilerFilename:=EnvironmentOptions.GetCompilerFilename;
62
 
  if CurCompilerFilename='' then
63
 
    CurCompilerFilename:=FindDefaultCompilerPath;
64
 
  if not FileIsExecutable(CurCompilerFilename) then
65
 
    CurCompilerFilename:=GetValueFromSecondaryConfig(EnvOptsConfFileName,
66
 
      'EnvironmentOptions/CompilerFilename/Value');
67
 
  if not FileIsExecutable(CurCompilerFilename) then begin
68
 
    if not InteractiveSetup then exit;
69
 
    if CurCompilerFilename='' then begin
70
 
      MessageDlg(lisFreePascalCompilerNotFound,
71
 
        Format(lisTheFreePascalCompilerFilenameWasNotFoundItIsRecomm, [
72
 
          GetDefaultCompilerFilename, #13]),
73
 
        mtWarning,[mbIgnore],0);
74
 
    end else begin
75
 
      DefaultCompPath:=FindDefaultCompilerPath;
76
 
      if CompareFilenames(DefaultCompPath,CurCompilerFilename)<>0 then begin
77
 
        r:=MessageDlg(lisInvalidCompilerFilename,
78
 
           Format(lisTheCurrentCompilerFilenameIsNotAValidExecutableCho, ['"',
79
 
             CurCompilerFilename, '"', #13, #13, '"', DefaultCompPath, '"', #13]
80
 
             ),
81
 
           mtWarning,[mbOk,mbIgnore],0);
82
 
        if r=mrOk then
83
 
          CurCompilerFilename:=DefaultCompPath;
84
 
      end else begin
85
 
        MessageDlg(lisInvalidCompilerFilename,
86
 
           Format(lisTheCurrentCompilerFilenameIsNotAValidExecutablePlease, ['"',
87
 
             CurCompilerFilename, '"', #13, #13]),
88
 
           mtWarning,[mbIgnore],0);
89
 
      end;
90
 
    end;
91
 
  end;
92
 
  EnvironmentOptions.CompilerFilename:=CurCompilerFilename;
93
 
end;
94
 
 
95
 
procedure SetupFPCSourceDirectory(var InteractiveSetup: boolean);
96
 
var
97
 
  CurFPCSrcDir: String;
98
 
  DefaultFPCSrcDir: String;
99
 
  r: integer;
100
 
  Changed: Boolean;
101
 
begin
102
 
  CurFPCSrcDir:=EnvironmentOptions.GetFPCSourceDirectory;
103
 
  Changed:=false;
104
 
  if CurFPCSrcDir='' then begin
105
 
    CurFPCSrcDir:=FindDefaultFPCSrcDirectory;
106
 
    Changed:=true;
107
 
  end;
108
 
  if not DirectoryExistsUTF8(CurFPCSrcDir) then
109
 
  begin
110
 
    CurFPCSrcDir:=GetValueFromSecondaryConfig(EnvOptsConfFileName,
111
 
      'EnvironmentOptions/FPCSourceDirectory/Value');
112
 
    Changed:=true;
113
 
  end;
114
 
  if not CheckFPCSourceDir(CurFPCSrcDir) then begin
115
 
    if (not InteractiveSetup)
116
 
    or (not FileIsExecutable(EnvironmentOptions.GetCompilerFilename)) then
117
 
      exit;
118
 
    if CurFPCSrcDir='' then begin
119
 
      MessageDlg(lisFreePascalSourcesNotFound,
120
 
        Format(lisTheFreePascalSourceDirectoryWasNotFoundSomeCodeFun, [#13,
121
 
          #13, #13]),
122
 
        mtWarning,[mbIgnore],0);
123
 
    end else begin
124
 
      DefaultFPCSrcDir:=FindDefaultFPCSrcDirectory;
125
 
      if CompareFilenames(DefaultFPCSrcDir,CurFPCSrcDir)<>0 then begin
126
 
        r:=MessageDlg(lisInvalidFreePascalSourceDirectory,
127
 
           Format(lisTheCurrentFreePascalSourceDirectoryDoesNotLookCorr, ['"',
128
 
             CurFPCSrcDir, '"', #13, #13, '"', DefaultFPCSrcDir, '"', #13]),
129
 
           mtWarning,[mbOk,mbIgnore],0);
130
 
        if r=mrOk then begin
131
 
          CurFPCSrcDir:=DefaultFPCSrcDir;
132
 
          Changed:=true;
 
178
type
 
179
 
 
180
  { TSetupMacros }
 
181
 
 
182
  TSetupMacros = class(TTransferMacroList)
 
183
  protected
 
184
    procedure DoSubstitution({%H-}TheMacro: TTransferMacro; const MacroName: string;
 
185
      var s: string; const {%H-}Data: PtrInt; var Handled, {%H-}Abort: boolean;
 
186
      {%H-}Depth: integer); override;
 
187
  public
 
188
    FPCVer: string;
 
189
    LazarusDir: string;
 
190
  end;
 
191
 
 
192
function CaptionInSDFileList(aCaption: string; SDFileList: TObjectList): boolean;
 
193
var
 
194
  i: Integer;
 
195
begin
 
196
  Result:=false;
 
197
  if SDFileList=nil then exit;
 
198
  for i:=0 to SDFileList.Count-1 do
 
199
    if CompareFilenames(aCaption,TSDFileInfo(SDFileList[i]).Caption)=0 then
 
200
      exit(true);
 
201
end;
 
202
 
 
203
function CheckLazarusDirectoryQuality(ADirectory: string;
 
204
  out Note: string): TSDFilenameQuality;
 
205
 
 
206
  function SubDirExists(SubDir: string; var q: TSDFilenameQuality): boolean;
 
207
  begin
 
208
    SubDir:=SetDirSeparators(SubDir);
 
209
    if DirPathExistsCached(ADirectory+SubDir) then exit(true);
 
210
    Result:=false;
 
211
    Note:=Format(lisDirectoryNotFound2, [SubDir]);
 
212
    q:=sddqIncomplete;
 
213
  end;
 
214
 
 
215
  function SubFileExists(SubFile: string; var q: TSDFilenameQuality): boolean;
 
216
  begin
 
217
    SubFile:=SetDirSeparators(SubFile);
 
218
    if FileExistsCached(ADirectory+SubFile) then exit(true);
 
219
    Result:=false;
 
220
    Note:=Format(lisFileNotFound3, [SubFile]);
 
221
    q:=sddqIncomplete;
 
222
  end;
 
223
 
 
224
var
 
225
  sl: TStringListUTF8;
 
226
  VersionIncFile: String;
 
227
  Version: String;
 
228
begin
 
229
  Result:=sddqInvalid;
 
230
  ADirectory:=TrimFilename(ADirectory);
 
231
  if not DirPathExistsCached(ADirectory) then
 
232
  begin
 
233
    Note:=lisISDDirectoryNotFound;
 
234
    exit;
 
235
  end;
 
236
  ADirectory:=AppendPathDelim(ADirectory);
 
237
  if not SubDirExists('lcl',Result) then exit;
 
238
  if not SubDirExists('packager/globallinks',Result) then exit;
 
239
  if not SubDirExists('ide',Result) then exit;
 
240
  if not SubDirExists('components',Result) then exit;
 
241
  if not SubDirExists('ideintf',Result) then exit;
 
242
  if not SubFileExists('ide/lazarus.lpi',Result) then exit;
 
243
  VersionIncFile:=SetDirSeparators('ide/version.inc');
 
244
  if not SubFileExists(VersionIncFile,Result) then exit;
 
245
  sl:=TStringListUTF8.Create;
 
246
  try
 
247
    try
 
248
      sl.LoadFromFile(ADirectory+VersionIncFile);
 
249
      if (sl.Count=0) or (sl[0]='') or (sl[0][1]<>'''') then
 
250
      begin
 
251
        Note:=Format(lisInvalidVersionIn, [VersionIncFile]);
 
252
        exit;
 
253
      end;
 
254
      Version:=copy(sl[0],2,length(sl[0])-2);
 
255
      if Version<>LazarusVersionStr then
 
256
      begin
 
257
        Note:=Format(lisWrongVersionIn, [VersionIncFile, Version]);
 
258
        Result:=sddqWrongVersion;
 
259
        exit;
 
260
      end;
 
261
      Note:=lisOk;
 
262
      Result:=sddqCompatible;
 
263
    except
 
264
      on E: Exception do begin
 
265
        Note:=Format(lisUnableToLoadFile2, [VersionIncFile, E.Message]);
 
266
        exit;
 
267
      end;
 
268
    end;
 
269
  finally
 
270
    sl.Free;
 
271
  end;
 
272
end;
 
273
 
 
274
function SearchLazarusDirectoryCandidates(StopIfFits: boolean): TObjectList;
 
275
 
 
276
  function CheckDir(Dir: string; var List: TObjectList): boolean;
 
277
  var
 
278
    Item: TSDFileInfo;
 
279
    RealDir: String;
 
280
  begin
 
281
    Result:=false;
 
282
    if Dir='' then Dir:='.';
 
283
    DoDirSeparators(Dir);
 
284
    Dir:=ChompPathDelim(Dir);
 
285
    // check if already checked
 
286
    if CaptionInSDFileList(Dir,List) then exit;
 
287
    EnvironmentOptions.LazarusDirectory:=Dir;
 
288
    RealDir:=ChompPathDelim(EnvironmentOptions.GetParsedLazarusDirectory);
 
289
    debugln(['SearchLazarusDirectoryCandidates Value=',Dir,' File=',RealDir]);
 
290
    // check if exists
 
291
    if not DirPathExistsCached(RealDir) then exit;
 
292
    // add to list and check quality
 
293
    Item:=TSDFileInfo.Create;
 
294
    Item.Filename:=RealDir;
 
295
    Item.Quality:=CheckLazarusDirectoryQuality(RealDir,Item.Note);
 
296
    Item.Caption:=Dir;
 
297
    if List=nil then
 
298
      List:=TObjectList.create(true);
 
299
    List.Add(Item);
 
300
    Result:=(Item.Quality=sddqCompatible) and StopIfFits;
 
301
  end;
 
302
 
 
303
  function CheckViaExe(Filename: string; var List: TObjectList): boolean;
 
304
  begin
 
305
    Result:=false;
 
306
    Filename:=FindDefaultExecutablePath(Filename);
 
307
    if Filename='' then exit;
 
308
    Filename:=ReadAllLinks(Filename,false);
 
309
    if Filename='' then exit;
 
310
    Result:=CheckDir(ExtractFilePath(ExpandFileNameUTF8(Filename)),List);
 
311
  end;
 
312
 
 
313
var
 
314
  Dir: String;
 
315
  ResolvedDir: String;
 
316
  Dirs: TStringList;
 
317
  i: Integer;
 
318
  OldLazarusDir: String;
 
319
begin
 
320
  Result:=nil;
 
321
 
 
322
  OldLazarusDir:=EnvironmentOptions.LazarusDirectory;
 
323
  try
 
324
    // first check the value in the options
 
325
    if CheckDir(EnvironmentOptions.LazarusDirectory,Result) then exit;
 
326
 
 
327
    // then check the directory of the executable
 
328
    Dir:=ProgramDirectory(true);
 
329
    if CheckDir(Dir,Result) then exit;
 
330
    ResolvedDir:=ReadAllLinks(Dir,false);
 
331
    if (ResolvedDir<>Dir) and (CheckDir(ResolvedDir,Result)) then exit;
 
332
 
 
333
    // check the primary options
 
334
    Dir:=GetValueFromPrimaryConfig(EnvOptsConfFileName,
 
335
                                     'EnvironmentOptions/LazarusDirectory/Value');
 
336
    if CheckDir(Dir,Result) then exit;
 
337
 
 
338
    // check the secondary options
 
339
    Dir:=GetValueFromSecondaryConfig(EnvOptsConfFileName,
 
340
                                     'EnvironmentOptions/LazarusDirectory/Value');
 
341
    if CheckDir(Dir,Result) then exit;
 
342
 
 
343
    // check common directories
 
344
    Dirs:=GetDefaultLazarusSrcDirectories;
 
345
    try
 
346
      for i:=0 to Dirs.Count-1 do
 
347
        if CheckDir(Dirs[i],Result) then exit;
 
348
    finally
 
349
      Dirs.Free;
 
350
    end;
 
351
 
 
352
    // check history
 
353
    Dirs:=EnvironmentOptions.LazarusDirHistory;
 
354
    if Dirs<>nil then
 
355
      for i:=0 to Dirs.Count-1 do
 
356
        if CheckDir(Dirs[i],Result) then exit;
 
357
 
 
358
    // search lazarus-ide and lazarus in PATH, then follow the links,
 
359
    // which will lead to the lazarus directory
 
360
    if CheckViaExe('lazarus-ide'+GetExecutableExt,Result) then exit;
 
361
    if CheckViaExe('lazarus'+GetExecutableExt,Result) then exit;
 
362
 
 
363
  finally
 
364
    EnvironmentOptions.LazarusDirectory:=OldLazarusDir;
 
365
  end;
 
366
end;
 
367
 
 
368
procedure SetupLazarusDirectory;
 
369
var
 
370
  Note: string;
 
371
  Dir: String;
 
372
  Quality: TSDFilenameQuality;
 
373
  BestDir: TSDFileInfo;
 
374
  List: TObjectList;
 
375
begin
 
376
  Dir:=EnvironmentOptions.GetParsedLazarusDirectory;
 
377
  Quality:=CheckLazarusDirectoryQuality(Dir,Note);
 
378
  if Quality<>sddqInvalid then exit;
 
379
  // bad lazarus directory => searching a good one
 
380
  dbgout('SetupLazarusDirectory:');
 
381
  if EnvironmentOptions.LazarusDirectory<>'' then
 
382
  begin
 
383
    dbgout(' The Lazarus directory "',EnvironmentOptions.LazarusDirectory,'"');
 
384
    if EnvironmentOptions.LazarusDirectory<>Dir then
 
385
      dbgout(' => "',Dir,'"');
 
386
    dbgout(' is invalid (Error: ',Note,')');
 
387
    debugln(' Searching a proper one ...');
 
388
  end else begin
 
389
    debugln(' Searching ...');
 
390
  end;
 
391
  List:=SearchLazarusDirectoryCandidates(true);
 
392
  try
 
393
    BestDir:=nil;
 
394
    if List<>nil then
 
395
      BestDir:=TSDFileInfo(List[List.Count-1]);
 
396
    if (BestDir=nil) or (BestDir.Quality=sddqInvalid) then begin
 
397
      debugln(['SetupLazarusDirectory: no proper Lazarus directory found.']);
 
398
      exit;
 
399
    end;
 
400
    EnvironmentOptions.LazarusDirectory:=BestDir.Filename;
 
401
    debugln(['SetupLazarusDirectory: using ',EnvironmentOptions.LazarusDirectory]);
 
402
  finally
 
403
    List.Free;
 
404
  end;
 
405
end;
 
406
 
 
407
function CheckCompilerQuality(AFilename: string; out Note: string;
 
408
  TestSrcFilename: string): TSDFilenameQuality;
 
409
var
 
410
  CfgCache: TFPCTargetConfigCache;
 
411
  i: LongInt;
 
412
  ShortFilename: String;
 
413
begin
 
414
  Result:=sddqInvalid;
 
415
  AFilename:=TrimFilename(AFilename);
 
416
  if not FileExistsCached(AFilename) then
 
417
  begin
 
418
    Note:=lisFileNotFound4;
 
419
    exit;
 
420
  end;
 
421
  if DirPathExistsCached(AFilename) then
 
422
  begin
 
423
    Note:=lisFileIsDirectory;
 
424
    exit;
 
425
  end;
 
426
  if not FileIsExecutableCached(AFilename) then
 
427
  begin
 
428
    Note:=lisFileIsNotAnExecutable;
 
429
    exit;
 
430
  end;
 
431
 
 
432
  // do not execute unusual exe files
 
433
  ShortFilename:=ExtractFileNameOnly(AFilename);
 
434
  if (CompareFilenames(ShortFilename,'fpc')<>0)
 
435
  and (CompareFilenames(copy(ShortFilename,1,3),'ppc')<>0)
 
436
  then begin
 
437
    Note:=lisUnusualCompilerFileNameUsuallyItStartsWithFpcPpcOr;
 
438
    exit(sddqIncomplete);
 
439
  end;
 
440
 
 
441
  if TestSrcFilename<>'' then
 
442
  begin
 
443
    CfgCache:=CodeToolBoss.FPCDefinesCache.ConfigCaches.Find(
 
444
                                                       AFilename,'','','',true);
 
445
    if CfgCache.NeedsUpdate then
 
446
      CfgCache.Update(TestSrcFilename);
 
447
    i:=CfgCache.IndexOfUsedCfgFile;
 
448
    if i<0 then
 
449
    begin
 
450
      Note:=lisFpcCfgIsMissing;
 
451
      exit;
 
452
    end;
 
453
    if not CfgCache.HasPPUs then
 
454
    begin
 
455
      Note:=lisSystemPpuNotFoundCheckYourFpcCfg;
 
456
      exit;
 
457
    end;
 
458
    if CompareFileExt(CfgCache.Units['classes'],'ppu',false)<>0 then
 
459
    begin
 
460
      Note:=lisClassesPpuNotFoundCheckYourFpcCfg;
 
461
      exit;
 
462
    end;
 
463
  end;
 
464
 
 
465
  Note:=lisOk;
 
466
  Result:=sddqCompatible;
 
467
end;
 
468
 
 
469
function SearchCompilerCandidates(StopIfFits: boolean;
 
470
  const TestSrcFilename: string): TObjectList;
 
471
var
 
472
  ShortCompFile: String;
 
473
 
 
474
  function CheckFile(AFilename: string; var List: TObjectList): boolean;
 
475
  var
 
476
    Item: TSDFileInfo;
 
477
    RealFilename: String;
 
478
  begin
 
479
    Result:=false;
 
480
    if AFilename='' then exit;
 
481
    DoDirSeparators(AFilename);
 
482
    // check if already checked
 
483
    if CaptionInSDFileList(AFilename,List) then exit;
 
484
    EnvironmentOptions.CompilerFilename:=AFilename;
 
485
    RealFilename:=EnvironmentOptions.GetParsedCompilerFilename;
 
486
    debugln(['SearchCompilerCandidates Value=',AFilename,' File=',RealFilename]);
 
487
    if RealFilename='' then exit;
 
488
    // check if exists
 
489
    if not FileExistsCached(RealFilename) then exit;
 
490
    // add to list and check quality
 
491
    Item:=TSDFileInfo.Create;
 
492
    Item.Filename:=RealFilename;
 
493
    Item.Quality:=CheckCompilerQuality(RealFilename,Item.Note,TestSrcFilename);
 
494
    Item.Caption:=AFilename;
 
495
    if List=nil then
 
496
      List:=TObjectList.create(true);
 
497
    List.Add(Item);
 
498
    Result:=(Item.Quality=sddqCompatible) and StopIfFits;
 
499
  end;
 
500
 
 
501
  function CheckSubDirs(ADir: string; var List: TObjectList): boolean;
 
502
  // search for ADir\bin\i386-win32\fpc.exe
 
503
  // and for ADir\*\bin\i386-win32\fpc.exe
 
504
  var
 
505
    FileInfo: TSearchRec;
 
506
    SubFile: String;
 
507
  begin
 
508
    Result:=true;
 
509
    ADir:=AppendPathDelim(TrimFilename(ExpandFileNameUTF8(TrimFilename(ADir))));
 
510
    SubFile:='bin/$(TargetCPU)-$(TargetOS)/'+ShortCompFile;
 
511
    if CheckFile(ADir+SubFile,List) then
 
512
      exit;
 
513
    try
 
514
      if FindFirstUTF8(ADir+GetAllFilesMask,faAnyFile,FileInfo)=0 then begin
 
515
        repeat
 
516
          // check if special file
 
517
          if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
 
518
            continue;
 
519
          if ((FileInfo.Attr and faDirectory)>0)
 
520
          and CheckFile(ADir+FileInfo.Name+PathDelim+SubFile,List) then
 
521
            exit;
 
522
        until FindNextUTF8(FileInfo)<>0;
 
523
      end;
 
524
    finally
 
525
      FindCloseUTF8(FileInfo);
 
526
    end;
 
527
    Result:=false;
 
528
  end;
 
529
 
 
530
var
 
531
  AFilename: String;
 
532
  Files: TStringList;
 
533
  i: Integer;
 
534
  SysDrive: String;
 
535
  ProgDir: String;
 
536
  OldCompilerFilename: String;
 
537
begin
 
538
  Result:=nil;
 
539
 
 
540
  OldCompilerFilename:=EnvironmentOptions.CompilerFilename;
 
541
  try
 
542
    // check current setting
 
543
    if CheckFile(EnvironmentOptions.CompilerFilename,Result) then exit;
 
544
 
 
545
    // check the primary options
 
546
    AFilename:=GetValueFromPrimaryConfig(EnvOptsConfFileName,
 
547
                                    'EnvironmentOptions/CompilerFilename/Value');
 
548
    if CheckFile(AFilename,Result) then exit;
 
549
 
 
550
    // check the secondary options
 
551
    AFilename:=GetValueFromSecondaryConfig(EnvOptsConfFileName,
 
552
                                    'EnvironmentOptions/CompilerFilename/Value');
 
553
    if CheckFile(AFilename,Result) then exit;
 
554
 
 
555
    // check PATH
 
556
    if CheckFile(FindDefaultCompilerPath,Result) then exit;
 
557
 
 
558
    // check history
 
559
    Files:=EnvironmentOptions.CompilerFileHistory;
 
560
    if Files<>nil then
 
561
      for i:=0 to Files.Count-1 do
 
562
        if CheckFile(Files[i],Result) then exit;
 
563
 
 
564
    // check paths with versions
 
565
    ShortCompFile:=GetDefaultCompilerFilename;
 
566
 
 
567
    // check $(LazarusDir)\fpc\bin\i386-win32\fpc.exe
 
568
    if CheckFile(SetDirSeparators('$(LazarusDir)/fpc/bin/$(TargetCPU)-$(TargetOS)/')+ShortCompFile,Result)
 
569
    then exit;
 
570
 
 
571
    // check common directories
 
572
    Files:=TStringList.Create;
 
573
    try
 
574
      GetDefaultCompilerFilenames(Files);
 
575
      for i:=0 to Files.Count-1 do
 
576
        if CheckFile(Files[i],Result) then exit;
 
577
    finally
 
578
      Files.Free;
 
579
    end;
 
580
 
 
581
    if (GetDefaultSrcOSForTargetOS(GetCompiledTargetOS)='win') then begin
 
582
      // Windows has some special places
 
583
      SysDrive:=GetEnvironmentVariableUTF8('SYSTEMDRIVE');
 
584
      if SysDrive='' then SysDrive:='C:';
 
585
      SysDrive:=AppendPathDelim(SysDrive);
 
586
      // %SYSTEMDRIVE%\fpc\
 
587
      if CheckSubDirs(SysDrive+'FPC',Result) then exit;
 
588
      // %SYSTEMDRIVE%\pp\
 
589
      if CheckSubDirs(SysDrive+'pp',Result) then exit;
 
590
      // %PROGRAMFILES%\FPC\*
 
591
      ProgDir:=AppendPathDelim(GetEnvironmentVariableUTF8('PROGRAMFILES'));
 
592
      if (ProgDir<>'')
 
593
      and CheckSubDirs(ProgDir+'FPC',Result) then exit;
 
594
    end;
 
595
 
 
596
  finally
 
597
    EnvironmentOptions.CompilerFilename:=OldCompilerFilename;
 
598
  end;
 
599
end;
 
600
 
 
601
procedure SetupCompilerFilename;
 
602
var
 
603
  Note: string;
 
604
  Filename: String;
 
605
  Quality: TSDFilenameQuality;
 
606
  BestDir: TSDFileInfo;
 
607
  List: TObjectList;
 
608
begin
 
609
  Filename:=EnvironmentOptions.GetParsedCompilerFilename;
 
610
  Quality:=CheckCompilerQuality(Filename,Note,'');
 
611
  if Quality<>sddqInvalid then exit;
 
612
  // bad compiler
 
613
  dbgout('SetupCompilerFilename:');
 
614
  if EnvironmentOptions.CompilerFilename<>'' then
 
615
  begin
 
616
    dbgout(' The compiler path "',EnvironmentOptions.CompilerFilename,'"');
 
617
    if EnvironmentOptions.CompilerFilename<>Filename then
 
618
      dbgout(' => "',Filename,'"');
 
619
    dbgout(' is invalid (Error: ',Note,')');
 
620
    debugln(' Searching a proper one ...');
 
621
  end else begin
 
622
    debugln(' Searching compiler ...');
 
623
  end;
 
624
  List:=SearchCompilerCandidates(true,CodeToolBoss.FPCDefinesCache.TestFilename);
 
625
  try
 
626
    BestDir:=nil;
 
627
    if List<>nil then
 
628
      BestDir:=TSDFileInfo(List[List.Count-1]);
 
629
    if (BestDir=nil) or (BestDir.Quality=sddqInvalid) then begin
 
630
      debugln(['SetupCompilerFilename: no proper compiler found.']);
 
631
      exit;
 
632
    end;
 
633
    EnvironmentOptions.CompilerFilename:=BestDir.Filename;
 
634
    debugln(['SetupCompilerFilename: using ',EnvironmentOptions.CompilerFilename]);
 
635
  finally
 
636
    List.Free;
 
637
  end;
 
638
end;
 
639
 
 
640
function CheckFPCSrcDirQuality(ADirectory: string; out Note: string;
 
641
  FPCVer: string): TSDFilenameQuality;
 
642
 
 
643
  function SubDirExists(SubDir: string; var q: TSDFilenameQuality): boolean;
 
644
  begin
 
645
    SubDir:=SetDirSeparators(SubDir);
 
646
    if DirPathExistsCached(ADirectory+SubDir) then exit(true);
 
647
    Result:=false;
 
648
    Note:=Format(lisDirectoryNotFound2, [SubDir]);
 
649
    q:=sddqIncomplete;
 
650
  end;
 
651
 
 
652
  function SubFileExists(SubFile: string; var q: TSDFilenameQuality): boolean;
 
653
  begin
 
654
    SubFile:=SetDirSeparators(SubFile);
 
655
    if FileExistsCached(ADirectory+SubFile) then exit(true);
 
656
    Result:=false;
 
657
    Note:=Format(lisFileNotFound3, [SubFile]);
 
658
    q:=sddqIncomplete;
 
659
  end;
 
660
 
 
661
var
 
662
  VersionFile: String;
 
663
  sl: TStringListUTF8;
 
664
  i: Integer;
 
665
  VersionNr: String;
 
666
  ReleaseNr: String;
 
667
  PatchNr: String;
 
668
  SrcVer: String;
 
669
begin
 
670
  Result:=sddqInvalid;
 
671
  Note:='';
 
672
  ADirectory:=TrimFilename(ADirectory);
 
673
  if not DirPathExistsCached(ADirectory) then
 
674
  begin
 
675
    Note:=lisISDDirectoryNotFound;
 
676
    exit;
 
677
  end;
 
678
  ADirectory:=AppendPathDelim(ADirectory);
 
679
  if not SubDirExists('rtl',Result) then exit;
 
680
  if not SubDirExists('packages',Result) then exit;
 
681
  if not SubFileExists('rtl/linux/system.pp',Result) then exit;
 
682
  // check version
 
683
  if (FPCVer<>'') then
 
684
  begin
 
685
    VersionFile:=ADirectory+'compiler'+PathDelim+'version.pas';
 
686
    if FileExistsCached(VersionFile) then
 
687
    begin
 
688
      sl:=TStringListUTF8.Create;
 
689
      try
 
690
        try
 
691
          sl.LoadFromFile(VersionFile);
 
692
          for i:=0 to sl.Count-1 do
 
693
          begin
 
694
            if REMatches(sl[i],' version_nr *= *''([0-9]+)''','I') then
 
695
              VersionNr:=REVar(1)
 
696
            else if REMatches(sl[i],' release_nr *= *''([0-9]+)''','I') then
 
697
              ReleaseNr:=REVar(1)
 
698
            else if REMatches(sl[i],' patch_nr *= *''([0-9]+)''','I') then begin
 
699
              PatchNr:=REVar(1);
 
700
              break;
 
701
            end;
 
702
          end;
 
703
          SrcVer:=VersionNr+'.'+ReleaseNr+'.'+PatchNr;
 
704
          if SrcVer<>FPCVer then
 
705
          begin
 
706
            Note:=Format(lisFoundVersionExpected, [SrcVer, FPCVer]);
 
707
            SrcVer:=VersionNr+'.'+ReleaseNr+'.';
 
708
            if LeftStr(FPCVer,length(SrcVer))=SrcVer then
 
709
              Result:=sddqWrongMinorVersion
 
710
            else
 
711
              Result:=sddqWrongVersion;
 
712
            exit;
 
713
          end;
 
714
        except
133
715
        end;
134
 
      end else begin
135
 
        MessageDlg(lisInvalidFreePascalSourceDirectory,
136
 
           Format(lisTheCurrentFreePascalSourceDirectoryDoesNotLookCorr2, ['"',
137
 
             CurFPCSrcDir, '"', #13, #13]),
138
 
           mtWarning,[mbIgnore],0);
139
 
      end;
140
 
    end;
141
 
  end;
142
 
  if Changed then
143
 
    EnvironmentOptions.FPCSourceDirectory:=CurFPCSrcDir;
144
 
end;
145
 
 
146
 
procedure SetupLazarusDirectory(var InteractiveSetup: boolean);
147
 
var
148
 
  CurLazDir: String;
149
 
  DefaultLazDir: String;
150
 
  r: integer;
151
 
begin
152
 
  CurLazDir:=EnvironmentOptions.LazarusDirectory;
153
 
  if CurLazDir='' then begin
154
 
    CurLazDir:=ProgramDirectory(true);
155
 
    if not CheckLazarusDirectory(CurLazDir) then
156
 
      CurLazDir:=FindDefaultLazarusSrcDirectory;
157
 
  end;
158
 
  if not CheckLazarusDirectory(CurLazDir) then
159
 
    CurLazDir:=GetValueFromSecondaryConfig(EnvOptsConfFileName,
160
 
      'EnvironmentOptions/LazarusDirectory/Value');
161
 
  if not CheckLazarusDirectory(CurLazDir) then begin
162
 
    if not InteractiveSetup then exit;
163
 
    if CurLazDir='' then begin
164
 
      MessageDlg(lisLazarusDirectoryNotFound,
165
 
        Format(lisTheLazarusDirectoryWasNotFoundYouWillNotBeAbleToCr, [#13, #13]
166
 
          ),
167
 
        mtWarning,[mbIgnore],0);
168
 
    end else begin
169
 
      DefaultLazDir:=ProgramDirectory(true);
170
 
      if CompareFilenames(DefaultLazDir,CurLazDir)<>0 then begin
171
 
        r:=MessageDlg(lisLazarusDirectoryNotFound,
172
 
           Format(lisTheCurrentLazarusDirectoryDoesNotLookCorrectWithou, ['"',
173
 
             CurLazDir, '"', #13, #13, #13, '"', DefaultLazDir, '"', #13]),
174
 
           mtWarning,[mbOk,mbIgnore],0);
175
 
        if r=mrOk then
176
 
          CurLazDir:=DefaultLazDir;
177
 
      end else begin
178
 
        MessageDlg(lisLazarusDirectoryNotFound,
179
 
           Format(lisTheCurrentLazarusDirectoryDoesNotLookCorrectWithou2, ['"',
180
 
             CurLazDir, '"', #13, #13, #13]),
181
 
           mtWarning,[mbIgnore],0);
182
 
      end;
183
 
    end;
184
 
  end;
185
 
  EnvironmentOptions.LazarusDirectory:=CurLazDir;
 
716
      finally
 
717
        sl.Free;
 
718
      end;
 
719
    end;
 
720
  end;
 
721
  Note:=lisOk;
 
722
  Result:=sddqCompatible;
 
723
end;
 
724
 
 
725
function SearchFPCSrcDirCandidates(StopIfFits: boolean;
 
726
  const FPCVer: string): TObjectList;
 
727
 
 
728
  function Check(Dir: string; var List: TObjectList): boolean;
 
729
  var
 
730
    Item: TSDFileInfo;
 
731
    RealDir: String;
 
732
  begin
 
733
    Result:=false;
 
734
    DoDirSeparators(Dir);
 
735
    Dir:=ChompPathDelim(Dir);
 
736
    if Dir='' then exit;
 
737
    // check if already checked
 
738
    if CaptionInSDFileList(Dir,List) then exit;
 
739
    EnvironmentOptions.FPCSourceDirectory:=Dir;
 
740
    RealDir:=EnvironmentOptions.GetParsedFPCSourceDirectory;
 
741
    debugln(['SearchFPCSrcDirCandidates Value=',Dir,' File=',RealDir]);
 
742
    if RealDir='' then exit;
 
743
    // check if exists
 
744
    if not DirPathExistsCached(RealDir) then exit;
 
745
    // add to list and check quality
 
746
    Item:=TSDFileInfo.Create;
 
747
    Item.Filename:=RealDir;
 
748
    Item.Quality:=CheckFPCSrcDirQuality(RealDir,Item.Note,FPCVer);
 
749
    Item.Caption:=Dir;
 
750
    if List=nil then
 
751
      List:=TObjectList.create(true);
 
752
    List.Add(Item);
 
753
    Result:=(Item.Quality=sddqCompatible) and StopIfFits;
 
754
  end;
 
755
 
 
756
var
 
757
  AFilename: String;
 
758
  Dirs: TStringList;
 
759
  i: Integer;
 
760
  OldFPCSrcDir: String;
 
761
begin
 
762
  Result:=nil;
 
763
 
 
764
  OldFPCSrcDir:=EnvironmentOptions.FPCSourceDirectory;
 
765
  try
 
766
    // check current setting
 
767
    if Check(EnvironmentOptions.FPCSourceDirectory,Result) then exit;
 
768
 
 
769
    // check the primary options
 
770
    AFilename:=GetValueFromPrimaryConfig(EnvOptsConfFileName,
 
771
                                 'EnvironmentOptions/FPCSourceDirectory/Value');
 
772
    if Check(AFilename,Result) then exit;
 
773
 
 
774
    // check the secondary options
 
775
    AFilename:=GetValueFromSecondaryConfig(EnvOptsConfFileName,
 
776
                                 'EnvironmentOptions/FPCSourceDirectory/Value');
 
777
    if Check(AFilename,Result) then exit;
 
778
 
 
779
    // check history
 
780
    Dirs:=EnvironmentOptions.FPCSourceDirHistory;
 
781
    if Dirs<>nil then
 
782
      for i:=0 to Dirs.Count-1 do
 
783
        if Check(Dirs[i],Result) then exit;
 
784
 
 
785
    // $(LazarusDir)/fpc/$(FPCVer)/source
 
786
    if Check(SetDirSeparators('$(LazarusDir)/fpc/$(FPCVer)/source'),Result) then
 
787
      exit;
 
788
 
 
789
    // check relative to fpc.exe
 
790
    if Check(SetDirSeparators('$Path($(CompPath))/../../source'),Result) then
 
791
      exit;
 
792
 
 
793
    // check common directories
 
794
    Dirs:=GetDefaultFPCSrcDirectories;
 
795
    try
 
796
      if Dirs<>nil then
 
797
        for i:=0 to Dirs.Count-1 do
 
798
          if Check(Dirs[i],Result) then exit;
 
799
    finally
 
800
      Dirs.Free;
 
801
    end;
 
802
  finally
 
803
    EnvironmentOptions.FPCSourceDirectory:=OldFPCSrcDir;
 
804
  end;
 
805
end;
 
806
 
 
807
procedure SetupFPCSrcDir(FPCVer: string);
 
808
var
 
809
  Note: string;
 
810
  Dir: String;
 
811
  Quality: TSDFilenameQuality;
 
812
  BestDir: TSDFileInfo;
 
813
  List: TObjectList;
 
814
begin
 
815
  Dir:=EnvironmentOptions.GetParsedFPCSourceDirectory;
 
816
  Quality:=CheckFPCSrcDirQuality(Dir,Note,FPCVer);
 
817
  if Quality<>sddqInvalid then exit;
 
818
  // bad fpc src directory => searching a good one
 
819
  dbgout('SetupFPCSourceDirectory:');
 
820
  if EnvironmentOptions.FPCSourceDirectory<>'' then
 
821
  begin
 
822
    dbgout(' The FPC source directory "',EnvironmentOptions.FPCSourceDirectory,'"');
 
823
    if EnvironmentOptions.FPCSourceDirectory<>Dir then
 
824
      dbgout(' => "',Dir,'"');
 
825
    dbgout(' is invalid (Error: ',Note,')');
 
826
    debugln(' Searching a proper one ...');
 
827
  end else begin
 
828
    debugln(' Searching ...');
 
829
  end;
 
830
  List:=SearchFPCSrcDirCandidates(true,FPCVer);
 
831
  try
 
832
    BestDir:=nil;
 
833
    if List<>nil then
 
834
      BestDir:=TSDFileInfo(List[List.Count-1]);
 
835
    if (BestDir=nil) or (BestDir.Quality=sddqInvalid) then begin
 
836
      debugln(['SetupFPCSourceDirectory: no proper FPC source directory found.']);
 
837
      exit;
 
838
    end;
 
839
    EnvironmentOptions.FPCSourceDirectory:=BestDir.Filename;
 
840
    debugln(['SetupFPCSourceDirectory: using ',EnvironmentOptions.FPCSourceDirectory]);
 
841
  finally
 
842
    List.Free;
 
843
  end;
 
844
end;
 
845
 
 
846
function CheckMakeExeQuality(AFilename: string; out Note: string
 
847
  ): TSDFilenameQuality;
 
848
begin
 
849
  Result:=sddqInvalid;
 
850
  AFilename:=TrimFilename(AFilename);
 
851
  if not FileExistsCached(AFilename) then
 
852
  begin
 
853
    Note:=lisFileNotFound4;
 
854
    exit;
 
855
  end;
 
856
  if DirPathExistsCached(AFilename) then
 
857
  begin
 
858
    Note:=lisFileIsDirectory;
 
859
    exit;
 
860
  end;
 
861
  if not FileIsExecutableCached(AFilename) then
 
862
  begin
 
863
    Note:=lisFileIsNotAnExecutable;
 
864
    exit;
 
865
  end;
 
866
 
 
867
  if (GetDefaultSrcOSForTargetOS(GetCompiledTargetOS)='win') then begin
 
868
    // under Windows the make.exe is in the same directory as fpc.exe
 
869
    if not FileExistsCached(ExtractFilePath(AFilename)+'fpc.exe') then begin
 
870
      Note:='There is no fpc.exe in the directory of the '+ExtractFilename(AFilename)+'. Usually the make executable is installed together with the fpc compiler.';
 
871
      Result:=sddqIncomplete;
 
872
    end;
 
873
  end;
 
874
 
 
875
  Result:=sddqCompatible;
 
876
end;
 
877
 
 
878
function SearchMakeExeCandidates(StopIfFits: boolean): TObjectList;
 
879
 
 
880
  function CheckFile(AFilename: string; var List: TObjectList): boolean;
 
881
  var
 
882
    Item: TSDFileInfo;
 
883
    RealFilename: String;
 
884
  begin
 
885
    Result:=false;
 
886
    if AFilename='' then exit;
 
887
    DoDirSeparators(AFilename);
 
888
    // check if already checked
 
889
    if CaptionInSDFileList(AFilename,List) then exit;
 
890
    EnvironmentOptions.MakeFilename:=AFilename;
 
891
    RealFilename:=EnvironmentOptions.GetParsedMakeFilename;
 
892
    debugln(['SearchMakeExeCandidates Value=',AFilename,' File=',RealFilename]);
 
893
    if RealFilename='' then exit;
 
894
    // check if exists
 
895
    if not FileExistsCached(RealFilename) then exit;
 
896
    // add to list and check quality
 
897
    Item:=TSDFileInfo.Create;
 
898
    Item.Filename:=RealFilename;
 
899
    Item.Quality:=CheckMakeExeQuality(RealFilename,Item.Note);
 
900
    Item.Caption:=AFilename;
 
901
    if List=nil then
 
902
      List:=TObjectList.create(true);
 
903
    List.Add(Item);
 
904
    Result:=(Item.Quality=sddqCompatible) and StopIfFits;
 
905
  end;
 
906
 
 
907
var
 
908
  OldMakeFilename: String;
 
909
  AFilename: String;
 
910
  Files: TStringList;
 
911
  i: Integer;
 
912
begin
 
913
  Result:=nil;
 
914
 
 
915
  OldMakeFilename:=EnvironmentOptions.MakeFilename;
 
916
  try
 
917
    // check current setting
 
918
    if CheckFile(EnvironmentOptions.MakeFilename,Result) then exit;
 
919
 
 
920
    // check the primary options
 
921
    AFilename:=GetValueFromPrimaryConfig(EnvOptsConfFileName,
 
922
                                    'EnvironmentOptions/MakeFilename/Value');
 
923
    if CheckFile(AFilename,Result) then exit;
 
924
 
 
925
    // check the secondary options
 
926
    AFilename:=GetValueFromSecondaryConfig(EnvOptsConfFileName,
 
927
                                    'EnvironmentOptions/MakeFilename/Value');
 
928
    if CheckFile(AFilename,Result) then exit;
 
929
 
 
930
    if (GetDefaultSrcOSForTargetOS(GetCompiledTargetOS)='win') then begin
 
931
      // check make in fpc.exe directory
 
932
      if CheckFile(SetDirSeparators('$Path($(CompPath))/make.exe'),Result)
 
933
      then exit;
 
934
    end;
 
935
 
 
936
    // check history
 
937
    Files:=EnvironmentOptions.MakeFileHistory;
 
938
    if Files<>nil then
 
939
      for i:=0 to Files.Count-1 do
 
940
        if CheckFile(Files[i],Result) then exit;
 
941
 
 
942
    // check PATH
 
943
    {$IFDEF FreeBSD}
 
944
    AFilename:='gmake';
 
945
    {$ELSE}
 
946
    AFilename:='make';
 
947
    {$ENDIF}
 
948
    AFilename+=GetExecutableExt;
 
949
    if CheckFile(FindDefaultExecutablePath(AFilename),Result) then exit;
 
950
 
 
951
    // check common directories
 
952
    Files:=TStringList.Create;
 
953
    try
 
954
      GetDefaultMakeFilenames(Files);
 
955
      for i:=0 to Files.Count-1 do
 
956
        if CheckFile(Files[i],Result) then exit;
 
957
    finally
 
958
      Files.Free;
 
959
    end;
 
960
  finally
 
961
    EnvironmentOptions.MakeFilename:=OldMakeFilename;
 
962
  end;
 
963
end;
 
964
 
 
965
procedure SetupMakeExe;
 
966
var
 
967
  Note: string;
 
968
  Filename: String;
 
969
  Quality: TSDFilenameQuality;
 
970
  BestDir: TSDFileInfo;
 
971
  List: TObjectList;
 
972
begin
 
973
  Filename:=EnvironmentOptions.GetParsedMakeFilename;
 
974
  Quality:=CheckMakeExeQuality(Filename,Note);
 
975
  if Quality<>sddqInvalid then exit;
 
976
  // bad make exe
 
977
  dbgout('SetupMakeExe:');
 
978
  if EnvironmentOptions.MakeFilename<>'' then
 
979
  begin
 
980
    dbgout(' The "make" executable "',EnvironmentOptions.MakeFilename,'"');
 
981
    if EnvironmentOptions.MakeFilename<>Filename then
 
982
      dbgout(' => "',Filename,'"');
 
983
    dbgout(' is invalid (Error: ',Note,')');
 
984
    debugln(' Searching a proper one ...');
 
985
  end else begin
 
986
    debugln(' Searching "make" ...');
 
987
  end;
 
988
  List:=SearchMakeExeCandidates(true);
 
989
  try
 
990
    BestDir:=nil;
 
991
    if List<>nil then
 
992
      BestDir:=TSDFileInfo(List[List.Count-1]);
 
993
    if (BestDir=nil) or (BestDir.Quality=sddqInvalid) then begin
 
994
      debugln(['SetupMakeExe: no proper "make" found.']);
 
995
      exit;
 
996
    end;
 
997
    EnvironmentOptions.MakeFilename:=BestDir.Filename;
 
998
    debugln(['SetupMakeExe: using ',EnvironmentOptions.MakeFilename]);
 
999
  finally
 
1000
    List.Free;
 
1001
  end;
 
1002
end;
 
1003
 
 
1004
function GetValueFromPrimaryConfig(OptionFilename, Path: string): string;
 
1005
begin
 
1006
  if not FilenameIsAbsolute(OptionFilename) then
 
1007
    OptionFilename:=AppendPathDelim(GetPrimaryConfigPath)+OptionFilename;
 
1008
  Result:=GetValueFromIDEConfig(OptionFilename,Path);
186
1009
end;
187
1010
 
188
1011
function GetValueFromSecondaryConfig(OptionFilename, Path: string): string;
 
1012
begin
 
1013
  if not FilenameIsAbsolute(OptionFilename) then
 
1014
    OptionFilename:=AppendPathDelim(GetSecondaryConfigPath)+OptionFilename;
 
1015
  Result:=GetValueFromIDEConfig(OptionFilename,Path);
 
1016
end;
 
1017
 
 
1018
function GetValueFromIDEConfig(OptionFilename, Path: string): string;
189
1019
var
190
1020
  XMLConfig: TXMLConfig;
191
1021
begin
192
 
  if not FilenameIsAbsolute(OptionFilename) then
193
 
    OptionFilename:=AppendPathDelim(GetSecondaryConfigPath)+OptionFilename;
 
1022
  Result:='';
194
1023
  if FileExistsCached(OptionFilename) then
195
1024
  begin
196
1025
    try
202
1031
      end;
203
1032
    except
204
1033
      on E: Exception do begin
205
 
        debugln(['GetValueFromSecondaryConfig File='+OptionFilename+': '+E.Message]);
206
 
      end;
207
 
    end;
208
 
  end;
 
1034
        debugln(['GetValueFromIDEConfig File='+OptionFilename+': '+E.Message]);
 
1035
      end;
 
1036
    end;
 
1037
  end;
 
1038
end;
 
1039
 
 
1040
function ShowInitialSetupDialog: TModalResult;
 
1041
var
 
1042
  InitialSetupDialog: TInitialSetupDialog;
 
1043
begin
 
1044
  InitialSetupDialog:=TInitialSetupDialog.Create(nil);
 
1045
  try
 
1046
    Application.TaskBarBehavior:=tbMultiButton;
 
1047
    InitialSetupDialog.Init;
 
1048
    Result:=InitialSetupDialog.ShowModal;
 
1049
  finally
 
1050
    InitialSetupDialog.Free;
 
1051
    Application.TaskBarBehavior:=tbDefault;
 
1052
  end;
 
1053
end;
 
1054
 
 
1055
{ TSetupMacros }
 
1056
 
 
1057
procedure TSetupMacros.DoSubstitution(TheMacro: TTransferMacro;
 
1058
  const MacroName: string; var s: string; const Data: PtrInt; var Handled,
 
1059
  Abort: boolean; Depth: integer);
 
1060
begin
 
1061
  Handled:=true;
 
1062
  if CompareText(MacroName,'ENV')=0 then
 
1063
    s:=GetEnvironmentVariableUTF8(MacroName)
 
1064
  else if CompareText(MacroName,'PrimaryConfigPath')=0 then
 
1065
    s:=GetPrimaryConfigPath
 
1066
  else if CompareText(MacroName,'SecondaryConfigPath')=0 then
 
1067
    s:=GetSecondaryConfigPath
 
1068
  else if CompareText(MacroName,'FPCVer')=0 then begin
 
1069
    if FPCVer<>'' then
 
1070
      s:=FPCVer
 
1071
    else
 
1072
      s:={$I %FPCVERSION%};
 
1073
  end else if CompareText(MacroName,'LazarusDir')=0 then begin
 
1074
    if LazarusDir<>'' then
 
1075
      s:=LazarusDir
 
1076
    else
 
1077
      s:='<LazarusDirNotSet>';
 
1078
  end else if (CompareText(MacroName,'TargetOS')=0) then
 
1079
    s:=GetCompiledTargetOS
 
1080
  else if (CompareText(MacroName,'TargetCPU')=0) then
 
1081
    s:=GetCompiledTargetCPU
 
1082
  else if (CompareText(MacroName,'SrcOS')=0) then
 
1083
    s:=GetDefaultSrcOSForTargetOS(GetCompiledTargetOS)
 
1084
  else
 
1085
    Handled:=false;
 
1086
  //debugln(['TSetupMacros.DoSubstitution MacroName=',MacroName,' Value="',s,'"']);
 
1087
end;
 
1088
 
 
1089
{$R *.lfm}
 
1090
 
 
1091
{ TInitialSetupDialog }
 
1092
 
 
1093
procedure TInitialSetupDialog.FormCreate(Sender: TObject);
 
1094
begin
 
1095
  Caption:=Format(lisWelcomeToLazarusIDE, [GetLazarusVersionString]);
 
1096
 
 
1097
  StartIDEBitBtn.Caption:=lisStartIDE;
 
1098
 
 
1099
  LazarusTabSheet.Caption:='Lazarus';
 
1100
  CompilerTabSheet.Caption:=lisCompiler;
 
1101
  FPCSourcesTabSheet.Caption:=lisFPCSources;
 
1102
 
 
1103
  FHeadGraphic:=TPortableNetworkGraphic.Create;
 
1104
  FHeadGraphic.LoadFromLazarusResource('ide_icon48x48');
 
1105
 
 
1106
  TVNodeLazarus:=PropertiesTreeView.Items.Add(nil,LazarusTabSheet.Caption);
 
1107
  TVNodeCompiler:=PropertiesTreeView.Items.Add(nil,CompilerTabSheet.Caption);
 
1108
  TVNodeFPCSources:=PropertiesTreeView.Items.Add(nil,FPCSourcesTabSheet.Caption);
 
1109
  ImgIDError := ImageList1.AddLazarusResource('state_error');
 
1110
  ImgIDWarning := ImageList1.AddLazarusResource('state_warning');
 
1111
 
 
1112
  LazDirBrowseButton.Caption:=lisPathEditBrowse;
 
1113
  LazDirLabel.Caption:=Format(
 
1114
    lisTheLazarusDirectoryContainsTheSourcesOfTheIDEAndTh, [PathDelim]);
 
1115
 
 
1116
  CompilerBrowseButton.Caption:=lisPathEditBrowse;
 
1117
  CompilerLabel.Caption:=Format(
 
1118
    lisTheFreePascalCompilerExecutableTypicallyHasTheName, [DefineTemplates.
 
1119
    GetDefaultCompilerFilename, DefineTemplates.GetDefaultCompilerFilename(
 
1120
    GetCompiledTargetCPU)]);
 
1121
 
 
1122
  FPCSrcDirBrowseButton.Caption:=lisPathEditBrowse;
 
1123
  FPCSrcDirLabel.Caption:=Format(
 
1124
    lisTheSourcesOfTheFreePascalPackagesAreRequiredForBro, [SetDirSeparators('rtl'
 
1125
    +'/linux/system.pp')]);
 
1126
 
 
1127
  Application.AddOnActivateHandler(@OnAppActivate);
 
1128
end;
 
1129
 
 
1130
procedure TInitialSetupDialog.CompilerComboBoxChange(Sender: TObject);
 
1131
begin
 
1132
  UpdateCompilerNote;
 
1133
end;
 
1134
 
 
1135
procedure TInitialSetupDialog.CompilerBrowseButtonClick(Sender: TObject);
 
1136
var
 
1137
  Filename: String;
 
1138
  Dlg: TOpenDialog;
 
1139
  Filter: String;
 
1140
begin
 
1141
  Dlg:=TOpenDialog.Create(nil);
 
1142
  try
 
1143
    Filename:='fpc'+GetExecutableExt;
 
1144
    Dlg.Title:=Format(lisSelectPathTo, [Filename]);
 
1145
    Dlg.Options:=Dlg.Options+[ofFileMustExist];
 
1146
    Filter:=dlgAllFiles+'|'+GetAllFilesMask;
 
1147
    if ExtractFileExt(Filename)<>'' then
 
1148
      Filter:=lisExecutable+'|*'+ExtractFileExt(Filename)+'|'+Filter;
 
1149
    Dlg.Filter:=Filter;
 
1150
    if not Dlg.Execute then exit;
 
1151
    Filename:=Dlg.FileName;
 
1152
  finally
 
1153
    Dlg.Free;
 
1154
  end;
 
1155
  CompilerComboBox.Text:=Filename;
 
1156
  UpdateCompilerNote;
 
1157
end;
 
1158
 
 
1159
procedure TInitialSetupDialog.FormDestroy(Sender: TObject);
 
1160
var
 
1161
  d: TSDFilenameType;
 
1162
begin
 
1163
  IdleConnected:=false;
 
1164
  for d:=low(FCandidates) to high(FCandidates) do
 
1165
    FreeAndNil(FCandidates[d]);
 
1166
  FreeAndNil(FHeadGraphic);
 
1167
end;
 
1168
 
 
1169
procedure TInitialSetupDialog.FPCSrcDirBrowseButtonClick(Sender: TObject);
 
1170
var
 
1171
  Dir: String;
 
1172
begin
 
1173
  Dir:=SelectDirectory(lisSelectFPCSourceDirectory);
 
1174
  if Dir='' then exit;
 
1175
  FPCSrcDirComboBox.Text:=Dir;
 
1176
  UpdateFPCSrcDirNote;
 
1177
end;
 
1178
 
 
1179
procedure TInitialSetupDialog.FPCSrcDirComboBoxChange(Sender: TObject);
 
1180
begin
 
1181
  UpdateFPCSrcDirNote;
 
1182
end;
 
1183
 
 
1184
procedure TInitialSetupDialog.LazDirBrowseButtonClick(Sender: TObject);
 
1185
var
 
1186
  Dir: String;
 
1187
begin
 
1188
  Dir:=SelectDirectory(lisSelectLazarusSourceDirectory);
 
1189
  if Dir='' then exit;
 
1190
  LazDirComboBox.Text:=Dir;
 
1191
  UpdateLazDirNote;
 
1192
end;
 
1193
 
 
1194
procedure TInitialSetupDialog.LazDirComboBoxChange(Sender: TObject);
 
1195
begin
 
1196
  UpdateLazDirNote;
 
1197
end;
 
1198
 
 
1199
procedure TInitialSetupDialog.OnAppActivate(Sender: TObject);
 
1200
begin
 
1201
  // switched back from another application
 
1202
  InvalidateFileStateCache;
 
1203
end;
 
1204
 
 
1205
procedure TInitialSetupDialog.PropertiesPageControlChange(Sender: TObject);
 
1206
var
 
1207
  s: String;
 
1208
  i: Integer;
 
1209
begin
 
1210
  if PropertiesPageControl.ActivePage=nil then exit;
 
1211
  s:=PropertiesPageControl.ActivePage.Caption;
 
1212
  for i:=0 to PropertiesTreeView.Items.TopLvlCount-1 do
 
1213
    if PropertiesTreeView.Items.TopLvlItems[i].Text=s then
 
1214
      PropertiesTreeView.Selected:=PropertiesTreeView.Items.TopLvlItems[i];
 
1215
end;
 
1216
 
 
1217
procedure TInitialSetupDialog.PropertiesTreeViewSelectionChanged(Sender: TObject);
 
1218
begin
 
1219
  if PropertiesTreeView.Selected=nil then
 
1220
    SelectPage(TVNodeLazarus.Text)
 
1221
  else
 
1222
    SelectPage(PropertiesTreeView.Selected.Text);
 
1223
end;
 
1224
 
 
1225
procedure TInitialSetupDialog.StartIDEBitBtnClick(Sender: TObject);
 
1226
var
 
1227
  Node: TTreeNode;
 
1228
  s: String;
 
1229
  MsgResult: TModalResult;
 
1230
begin
 
1231
  Node:=FirstErrorNode;
 
1232
  if Node=TVNodeLazarus then
 
1233
    s:=lisWithoutAProperLazarusDirectoryYouWillGetALotOfWarn
 
1234
  else if Node=TVNodeCompiler then
 
1235
    s:=lisWithoutAProperCompilerTheCodeBrowsingAndCompilingW
 
1236
  else if Node=TVNodeFPCSources then
 
1237
    s:=lisWithoutTheProperFPCSourcesCodeBrowsingAndCompletio;
 
1238
  if s<>'' then begin
 
1239
    MsgResult:=MessageDlg(lisCCOWarningCaption, s, mtWarning, [mbIgnore,
 
1240
      mbCancel], 0);
 
1241
    if MsgResult<>mrIgnore then exit;
 
1242
  end;
 
1243
 
 
1244
  s:=LazDirComboBox.Text;
 
1245
  if s<>'' then
 
1246
    EnvironmentOptions.LazarusDirectory:=s;
 
1247
  s:=CompilerComboBox.Text;
 
1248
  if s<>'' then
 
1249
    EnvironmentOptions.CompilerFilename:=s;
 
1250
  s:=FPCSrcDirComboBox.Text;
 
1251
  if s<>'' then
 
1252
    EnvironmentOptions.FPCSourceDirectory:=s;
 
1253
 
 
1254
  SetupMakeExe;
 
1255
 
 
1256
  ModalResult:=mrOk;
 
1257
end;
 
1258
 
 
1259
procedure TInitialSetupDialog.WelcomePaintBoxPaint(Sender: TObject);
 
1260
begin
 
1261
  with WelcomePaintBox.Canvas do begin
 
1262
    GradientFill(WelcomePaintBox.ClientRect,$854b32,$c88e60,gdHorizontal);
 
1263
    Draw(0,WelcomePaintBox.ClientHeight-FHeadGraphic.Height,FHeadGraphic);
 
1264
    Font.Color:=clWhite;
 
1265
    Font.Height:=30;
 
1266
    Brush.Style:=bsClear;
 
1267
    TextOut(FHeadGraphic.Width+15, 5, lisConfigureLazarusIDE);
 
1268
  end;
 
1269
end;
 
1270
 
 
1271
procedure TInitialSetupDialog.OnIdle(Sender: TObject; var Done: Boolean);
 
1272
begin
 
1273
  if FLazarusDirChanged then begin
 
1274
    UpdateCompilerFilenameCandidates;
 
1275
    UpdateCompilerNote;
 
1276
  end else if fCompilerFilenameChanged then begin
 
1277
    UpdateFPCSrcDirCandidates;
 
1278
    UpdateFPCSrcDirNote;
 
1279
  end else
 
1280
    IdleConnected:=false;
 
1281
end;
 
1282
 
 
1283
procedure TInitialSetupDialog.SelectPage(const NodeText: string);
 
1284
var
 
1285
  i: Integer;
 
1286
  Node: TTreeNode;
 
1287
begin
 
1288
  if FSelectingPage then exit;
 
1289
  FSelectingPage:=true;
 
1290
  try
 
1291
    for i:=0 to PropertiesTreeView.Items.TopLvlCount-1 do begin
 
1292
      Node:=PropertiesTreeView.Items.TopLvlItems[i];
 
1293
      if Node.Text=NodeText then begin
 
1294
        PropertiesTreeView.Selected:=Node;
 
1295
        PropertiesPageControl.ActivePageIndex:=i;
 
1296
        break;
 
1297
      end;
 
1298
    end;
 
1299
  finally
 
1300
    FSelectingPage:=false;
 
1301
  end;
 
1302
end;
 
1303
 
 
1304
function TInitialSetupDialog.SelectDirectory(aTitle: string): string;
 
1305
var
 
1306
  DirDlg: TSelectDirectoryDialog;
 
1307
begin
 
1308
  Result:='';
 
1309
  DirDlg:=TSelectDirectoryDialog.Create(nil);
 
1310
  try
 
1311
    DirDlg.Title:=aTitle;
 
1312
    DirDlg.Options:=DirDlg.Options+[ofPathMustExist,ofFileMustExist];
 
1313
    if not DirDlg.Execute then exit;
 
1314
    Result:=DirDlg.FileName;
 
1315
  finally
 
1316
    DirDlg.Free;
 
1317
  end;
 
1318
end;
 
1319
 
 
1320
procedure TInitialSetupDialog.UpdateLazarusDirCandidates;
 
1321
var
 
1322
  Dirs: TObjectList;
 
1323
begin
 
1324
  Dirs:=SearchLazarusDirectoryCandidates(false);
 
1325
  FreeAndNil(FCandidates[sddtLazarusSrcDir]);
 
1326
  FCandidates[sddtLazarusSrcDir]:=Dirs;
 
1327
  FillComboboxWithFileInfoList(LazDirComboBox,Dirs);
 
1328
end;
 
1329
 
 
1330
procedure TInitialSetupDialog.UpdateCompilerFilenameCandidates;
 
1331
var
 
1332
  Files: TObjectList;
 
1333
begin
 
1334
  FLazarusDirChanged:=false;
 
1335
  Files:=SearchCompilerCandidates(false,
 
1336
                    CodeToolBoss.FPCDefinesCache.TestFilename);
 
1337
  FreeAndNil(FCandidates[sddtCompilerFilename]);
 
1338
  FCandidates[sddtCompilerFilename]:=Files;
 
1339
  FillComboboxWithFileInfoList(CompilerComboBox,Files);
 
1340
end;
 
1341
 
 
1342
procedure TInitialSetupDialog.UpdateFPCSrcDirCandidates;
 
1343
var
 
1344
  Dirs: TObjectList;
 
1345
begin
 
1346
  fCompilerFilenameChanged:=false;
 
1347
  Dirs:=SearchFPCSrcDirCandidates(false,GetFPCVer);
 
1348
  FreeAndNil(FCandidates[sddtFPCSrcDir]);
 
1349
  FCandidates[sddtFPCSrcDir]:=Dirs;
 
1350
  FillComboboxWithFileInfoList(FPCSrcDirComboBox,Dirs);
 
1351
end;
 
1352
 
 
1353
procedure TInitialSetupDialog.FillComboboxWithFileInfoList(ABox: TComboBox;
 
1354
  List: TObjectList; ItemIndex: integer);
 
1355
var
 
1356
  sl: TStringList;
 
1357
  i: Integer;
 
1358
begin
 
1359
  sl:=TStringList.Create;
 
1360
  try
 
1361
    if List<>nil then
 
1362
      for i:=0 to List.Count-1 do
 
1363
        sl.Add(TSDFileInfo(List[i]).Caption);
 
1364
    ABox.Items.Assign(sl);
 
1365
    if (ItemIndex>=0) and (ItemIndex<sl.Count) then
 
1366
      ABox.Text:=sl[ItemIndex]
 
1367
    else if ABox.Text=ABox.Name then
 
1368
      ABox.Text:='';
 
1369
  finally
 
1370
    sl.Free;
 
1371
  end;
 
1372
end;
 
1373
 
 
1374
procedure TInitialSetupDialog.SetIdleConnected(const AValue: boolean);
 
1375
begin
 
1376
  if FIdleConnected=AValue then exit;
 
1377
  FIdleConnected:=AValue;
 
1378
  if IdleConnected then
 
1379
    Application.AddOnIdleHandler(@OnIdle)
 
1380
  else
 
1381
    Application.RemoveOnIdleHandler(@OnIdle);
 
1382
end;
 
1383
 
 
1384
procedure TInitialSetupDialog.UpdateLazDirNote;
 
1385
var
 
1386
  CurCaption: String;
 
1387
  Note: string;
 
1388
  Quality: TSDFilenameQuality;
 
1389
  s: String;
 
1390
  ImageIndex: Integer;
 
1391
begin
 
1392
  if csDestroying in ComponentState then exit;
 
1393
  CurCaption:=LazDirComboBox.Text;
 
1394
  CurCaption:=ChompPathDelim(CurCaption);
 
1395
  EnvironmentOptions.LazarusDirectory:=CurCaption;
 
1396
  if FLastParsedLazDir=EnvironmentOptions.GetParsedLazarusDirectory then exit;
 
1397
  FLastParsedLazDir:=EnvironmentOptions.GetParsedLazarusDirectory;
 
1398
  //debugln(['TInitialSetupDialog.UpdateLazDirNote ',FLastParsedLazDir]);
 
1399
  Quality:=CheckLazarusDirectoryQuality(FLastParsedLazDir,Note);
 
1400
  case Quality of
 
1401
  sddqInvalid: s:=lisError;
 
1402
  sddqCompatible: s:='';
 
1403
  else s:=lisWarning;
 
1404
  end;
 
1405
  if EnvironmentOptions.LazarusDirectory<>EnvironmentOptions.GetParsedLazarusDirectory
 
1406
  then
 
1407
    s:=lisDirectory+EnvironmentOptions.GetParsedLazarusDirectory+LineEnding+
 
1408
      LineEnding+s;
 
1409
  LazDirMemo.Text:=s+Note;
 
1410
 
 
1411
  ImageIndex:=QualityToImgIndex(Quality);
 
1412
  TVNodeLazarus.ImageIndex:=ImageIndex;
 
1413
  TVNodeLazarus.SelectedIndex:=ImageIndex;
 
1414
 
 
1415
  FLazarusDirChanged:=true;
 
1416
  IdleConnected:=true;
 
1417
end;
 
1418
 
 
1419
procedure TInitialSetupDialog.UpdateCompilerNote;
 
1420
var
 
1421
  CurCaption: String;
 
1422
  Note: string;
 
1423
  Quality: TSDFilenameQuality;
 
1424
  s: String;
 
1425
  ImageIndex: Integer;
 
1426
begin
 
1427
  if csDestroying in ComponentState then exit;
 
1428
  CurCaption:=CompilerComboBox.Text;
 
1429
  EnvironmentOptions.CompilerFilename:=CurCaption;
 
1430
  if fLastParsedCompiler=EnvironmentOptions.GetParsedCompilerFilename then exit;
 
1431
  fLastParsedCompiler:=EnvironmentOptions.GetParsedCompilerFilename;
 
1432
  //debugln(['TInitialSetupDialog.UpdateCompilerNote ',fLastParsedCompiler]);
 
1433
  Quality:=CheckCompilerQuality(fLastParsedCompiler,Note,
 
1434
                                CodeToolBoss.FPCDefinesCache.TestFilename);
 
1435
  if Quality<>sddqInvalid then begin
 
1436
    CodeToolBoss.FPCDefinesCache.ConfigCaches.Find(
 
1437
      fLastParsedCompiler,'','','',true);
 
1438
  end;
 
1439
 
 
1440
  case Quality of
 
1441
  sddqInvalid: s:=lisError;
 
1442
  sddqCompatible: s:='';
 
1443
  else s:=lisWarning;
 
1444
  end;
 
1445
  if EnvironmentOptions.CompilerFilename<>EnvironmentOptions.GetParsedCompilerFilename
 
1446
  then
 
1447
    s:=lisFile2+EnvironmentOptions.GetParsedCompilerFilename+LineEnding+
 
1448
      LineEnding+s;
 
1449
  CompilerMemo.Text:=s+Note;
 
1450
 
 
1451
  ImageIndex:=QualityToImgIndex(Quality);
 
1452
  TVNodeCompiler.ImageIndex:=ImageIndex;
 
1453
  TVNodeCompiler.SelectedIndex:=ImageIndex;
 
1454
 
 
1455
  fCompilerFilenameChanged:=true;
 
1456
  IdleConnected:=true;
 
1457
end;
 
1458
 
 
1459
procedure TInitialSetupDialog.UpdateFPCSrcDirNote;
 
1460
var
 
1461
  CurCaption: String;
 
1462
  Note: string;
 
1463
  Quality: TSDFilenameQuality;
 
1464
  s: String;
 
1465
  ImageIndex: Integer;
 
1466
begin
 
1467
  if csDestroying in ComponentState then exit;
 
1468
  CurCaption:=FPCSrcDirComboBox.Text;
 
1469
  CurCaption:=ChompPathDelim(CurCaption);
 
1470
  EnvironmentOptions.FPCSourceDirectory:=CurCaption;
 
1471
  if fLastParsedFPCSrcDir=EnvironmentOptions.GetParsedFPCSourceDirectory then exit;
 
1472
  fLastParsedFPCSrcDir:=EnvironmentOptions.GetParsedFPCSourceDirectory;
 
1473
  //debugln(['TInitialSetupDialog.UpdateFPCSrcDirNote ',fLastParsedFPCSrcDir]);
 
1474
  Quality:=CheckFPCSrcDirQuality(fLastParsedFPCSrcDir,Note,GetFPCVer);
 
1475
  case Quality of
 
1476
  sddqInvalid: s:=lisError;
 
1477
  sddqCompatible: s:='';
 
1478
  else s:=lisWarning;
 
1479
  end;
 
1480
  if EnvironmentOptions.FPCSourceDirectory<>EnvironmentOptions.GetParsedFPCSourceDirectory
 
1481
  then
 
1482
    s:=lisDirectory+EnvironmentOptions.GetParsedFPCSourceDirectory+LineEnding+
 
1483
      LineEnding+s;
 
1484
  FPCSrcDirMemo.Text:=s+Note;
 
1485
 
 
1486
  ImageIndex:=QualityToImgIndex(Quality);
 
1487
  TVNodeFPCSources.ImageIndex:=ImageIndex;
 
1488
  TVNodeFPCSources.SelectedIndex:=ImageIndex;
 
1489
end;
 
1490
 
 
1491
function TInitialSetupDialog.FirstErrorNode: TTreeNode;
 
1492
var
 
1493
  i: Integer;
 
1494
begin
 
1495
  for i:=0 to PropertiesTreeView.Items.TopLvlCount-1 do
 
1496
  begin
 
1497
    Result:=PropertiesTreeView.Items.TopLvlItems[i];
 
1498
    if Result.ImageIndex=ImgIDError then exit;
 
1499
  end;
 
1500
  Result:=nil;
 
1501
end;
 
1502
 
 
1503
function TInitialSetupDialog.GetFPCVer: string;
 
1504
begin
 
1505
  Result:='$(FPCVer)';
 
1506
  GlobalMacroList.SubstituteStr(Result);
 
1507
end;
 
1508
 
 
1509
function TInitialSetupDialog.GetFirstCandidate(Candidates: TObjectList;
 
1510
  MinQuality: TSDFilenameQuality): TSDFileInfo;
 
1511
var
 
1512
  i: Integer;
 
1513
begin
 
1514
  if Candidates<>nil then
 
1515
    for i:=0 to Candidates.Count-1 do begin
 
1516
      Result:=TSDFileInfo(Candidates[i]);
 
1517
      if Result.Quality>=MinQuality then
 
1518
        exit;
 
1519
    end;
 
1520
  Result:=nil;
 
1521
end;
 
1522
 
 
1523
function TInitialSetupDialog.QualityToImgIndex(Quality: TSDFilenameQuality
 
1524
  ): integer;
 
1525
begin
 
1526
  if Quality=sddqCompatible then
 
1527
    Result:=-1
 
1528
  else if Quality=sddqWrongMinorVersion then
 
1529
    Result:=ImgIDWarning
 
1530
  else
 
1531
    Result:=ImgIDError;
 
1532
end;
 
1533
 
 
1534
procedure TInitialSetupDialog.Init;
 
1535
var
 
1536
  Node: TTreeNode;
 
1537
  Candidate: TSDFileInfo;
 
1538
  IsFirstStart: Boolean;
 
1539
  PrimaryFilename: String;
 
1540
  SecondaryFilename: String;
 
1541
  PrimaryEnvs: TStringListUTF8;
 
1542
  SecondaryEnvs: TStringListUTF8;
 
1543
begin
 
1544
  IsFirstStart:=not FileExistsCached(EnvironmentOptions.Filename);
 
1545
  if not IsFirstStart then begin
 
1546
    PrimaryFilename:=EnvironmentOptions.Filename;
 
1547
    SecondaryFilename:=AppendPathDelim(GetSecondaryConfigPath)+ExtractFilename(PrimaryFilename);
 
1548
    if FileExistsUTF8(PrimaryFilename)
 
1549
    and FileExistsUTF8(SecondaryFilename) then begin
 
1550
      // compare content of primary and secondary config
 
1551
      PrimaryEnvs:=TStringListUTF8.Create;
 
1552
      SecondaryEnvs:=TStringListUTF8.Create;
 
1553
      try
 
1554
        PrimaryEnvs.LoadFromFile(PrimaryFilename);
 
1555
      except
 
1556
        on E: Exception do
 
1557
          debugln(['TInitialSetupDialog.Init unable to read "'+PrimaryFilename+'": '+E.Message]);
 
1558
      end;
 
1559
      try
 
1560
        SecondaryEnvs.LoadFromFile(SecondaryFilename);
 
1561
      except
 
1562
        on E: Exception do
 
1563
          debugln(['TInitialSetupDialog.Init unable to read "'+SecondaryFilename+'": '+E.Message]);
 
1564
      end;
 
1565
      IsFirstStart:=PrimaryEnvs.Text=SecondaryEnvs.Text;
 
1566
      PrimaryEnvs.Free;
 
1567
      SecondaryEnvs.Free;
 
1568
    end;
 
1569
  end;
 
1570
  //debugln(['TInitialSetupDialog.Init IsFirstStart=',IsFirstStart,' ',EnvironmentOptions.Filename]);
 
1571
 
 
1572
  // Lazarus directory
 
1573
  UpdateLazarusDirCandidates;
 
1574
  if IsFirstStart or (not FileExistsCached(EnvironmentOptions.GetParsedLazarusDirectory))
 
1575
  then begin
 
1576
    // first start => choose first best candidate
 
1577
    Candidate:=GetFirstCandidate(FCandidates[sddtLazarusSrcDir]);
 
1578
    if Candidate<>nil then
 
1579
      EnvironmentOptions.LazarusDirectory:=Candidate.Caption;
 
1580
  end;
 
1581
  LazDirComboBox.Text:=EnvironmentOptions.LazarusDirectory;
 
1582
  FLastParsedLazDir:='. .';
 
1583
  UpdateLazDirNote;
 
1584
  FLazarusDirChanged:=false;
 
1585
 
 
1586
  // compiler filename
 
1587
  UpdateCompilerFilenameCandidates;
 
1588
  if IsFirstStart or (not FileExistsCached(EnvironmentOptions.GetParsedCompilerFilename))
 
1589
  then begin
 
1590
    // first start => choose first best candidate
 
1591
    Candidate:=GetFirstCandidate(FCandidates[sddtCompilerFilename]);
 
1592
    if Candidate<>nil then
 
1593
      EnvironmentOptions.CompilerFilename:=Candidate.Caption;
 
1594
  end;
 
1595
  CompilerComboBox.Text:=EnvironmentOptions.CompilerFilename;
 
1596
  fLastParsedCompiler:='. .';
 
1597
  UpdateCompilerNote;
 
1598
  fCompilerFilenameChanged:=false;
 
1599
 
 
1600
  // FPC source directory
 
1601
  UpdateFPCSrcDirCandidates;
 
1602
  if IsFirstStart or (not FileExistsCached(EnvironmentOptions.GetParsedFPCSourceDirectory))
 
1603
  then begin
 
1604
    // first start => choose first best candidate
 
1605
    Candidate:=GetFirstCandidate(FCandidates[sddtFPCSrcDir]);
 
1606
    if Candidate<>nil then
 
1607
      EnvironmentOptions.FPCSourceDirectory:=Candidate.Caption;
 
1608
  end;
 
1609
  FPCSrcDirComboBox.Text:=EnvironmentOptions.FPCSourceDirectory;
 
1610
  fLastParsedFPCSrcDir:='. .';
 
1611
  UpdateFPCSrcDirNote;
 
1612
 
 
1613
  // select first error
 
1614
  Node:=FirstErrorNode;
 
1615
  if Node=nil then
 
1616
    Node:=TVNodeLazarus;
 
1617
  PropertiesTreeView.Selected:=Node;
209
1618
end;
210
1619
 
211
1620
end.