IDE: Tools/Options + startup configuration. Improve "make" location, expand paths before openfile dialogs etc. Issue #37386, patch from BrunoK.

git-svn-id: trunk@63654 -
This commit is contained in:
juha 2020-07-25 22:51:59 +00:00
parent 5ce498b490
commit 7ed8696762
11 changed files with 576 additions and 319 deletions

View File

@ -34,6 +34,16 @@ function LoadProjectIconIntoImages(const ProjFile: string;
const Images: TCustomImageList; const Index: TStringList): Integer;
{ Tests aFileDirStr and try to return the longest best path match on system.
Returns longest valid path. aoFileName contains the remainder of the supplied
aFileDirStr that couldn't be included in result }
function GetValidDirectory(const aFileDirStr: string;
out aoFileName : string): string;
{ Tests aFileDirStr and try to return best path/filename on system. }
function GetValidDirectoryAndFilename(const aFileDirStr: string;
out aoFileName : string): string;
implementation
function IndexInStringList(List: TStrings; Cmp: TCmpStrType; s: string): integer;
@ -116,5 +126,47 @@ begin
Index.AddObject(ProjFile, xObj);
end;
function GetValidDirectory(const aFileDirStr: string; out aoFileName: string): string;
var
lStartDir : string;
lResLen, lResLenNew : integer;
begin
lStartDir := SwitchPathDelims(aFileDirStr, True); // normalize
Result := ExcludeTrailingBackslash(lStartDir);
repeat
lResLen := Length(Result);
if DirectoryExists(Result) then
break;
Result := ExcludeTrailingBackslash(ExtractFilePath(Result));
lResLenNew := Length(Result);
if lResLenNew<=0 then begin
lResLen := 0;
break;
end;
if lResLenNew = lResLen then // Here make sure something was extracted
SetLength(Result, lResLen-1); // otherwise infinite loop.
until lResLen<=0;
if lResLenNew>0 then
aoFileName := Copy(lStartDir, lResLen+2, High(Integer))
else
aoFileName := lStartDir;
end;
function GetValidDirectoryAndFilename(const aFileDirStr: string;
out aoFileName: string): string;
var
lSWPD,
lDir0, lDir1 : string;
begin
lSWPD := ExcludeTrailingBackSlash(SwitchPathDelims(aFileDirStr, True)); // normalize
aoFileName := ExtractFileName(lSWPD);
lDir0 := Copy(lSWPD, 1, length(lSWPD) - Length(aoFileName));
Result := GetValidDirectory(lDir0, {out} lDir1);
if Length(Result)>0 then
aoFileName := Copy(lSWPD, Length(Result)+2, High(Integer))
else
aoFileName := lSWPD;
end;
end.

View File

@ -155,6 +155,9 @@ procedure TDebuggerClassOptionsFrame.cmdOpenDebuggerPathClick(Sender: TObject);
var
OpenDialog: TOpenDialog;
AFilename, ParsedFName: string;
lDirText : string;
lExpandedName: string; // Expanded name before Dialog
lDirName, lDirNameF : string;
begin
if FSelectedDbgPropertiesConfig = nil then
exit;
@ -165,6 +168,12 @@ begin
OpenDialog.Options:=OpenDialog.Options+[ofPathMustExist];
OpenDialog.Title:=lisChooseDebuggerExecutable;
lDirName := EnvironmentOptions.GetParsedValue(eopDebuggerFilename, lDirText);
lExpandedName := CleanAndExpandFilename(lDirName);
lDirName := GetValidDirectory(lDirName, {out} lDirNameF);
OpenDialog.InitialDir := lDirName;
OpenDialog.FileName := lDirNameF;
if OpenDialog.Execute then begin
AFilename:=CleanAndExpandFilename(OpenDialog.Filename);
ParsedFName := EnvironmentOptions.GetParsedValue(eopDebuggerFilename, AFilename);
@ -173,10 +182,11 @@ begin
if CheckExecutable(FSelectedDbgPropertiesConfig.DebuggerFilename, ParsedFName,
lisEnvOptDlgInvalidDebuggerFilename,
lisEnvOptDlgInvalidDebuggerFilenameMsg)
then begin
SetComboBoxText(cmbDebuggerPath,AFilename,cstFilename);
FSelectedDbgPropertiesConfig.DebuggerFilename := AFilename;
end;
then
if UpperCase(lExpandedName)<>UpperCase(AFilename) then begin // Changed ?
SetComboBoxText(cmbDebuggerPath,AFilename,cstFilename);
FSelectedDbgPropertiesConfig.DebuggerFilename := AFilename;
end;
end;
InputHistories.StoreFileDialogSettings(OpenDialog);
finally

View File

@ -46,7 +46,7 @@ type
// methods for building IDE (will be changed when project groups are there)
procedure SetBuildTargetProject1; virtual; abstract;
procedure SetBuildTargetIDE; virtual; abstract;
procedure SetBuildTargetIDE(aQuiet: boolean = false); virtual; abstract;
function BuildTargetIDEIsDefault: boolean; virtual; abstract;
function GetBuildMacroOverride(const MacroName: string): string; virtual; abstract;

View File

@ -19,20 +19,20 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
object CBLDBtnPanel: TPanel
AnchorSideTop.Side = asrBottom
Left = 0
Height = 41
Top = 439
Height = 38
Top = 442
Width = 700
Align = alBottom
AutoSize = True
BevelOuter = bvNone
ClientHeight = 41
ClientHeight = 38
ClientWidth = 700
TabOrder = 0
object CancelButton: TBitBtn
Left = 618
Height = 29
Left = 612
Height = 26
Top = 6
Width = 76
Width = 82
Align = alRight
AutoSize = True
BorderSpacing.Around = 6
@ -44,9 +44,9 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
end
object SaveSettingsButton: TBitBtn
Left = 512
Height = 29
Height = 26
Top = 6
Width = 100
Width = 94
Align = alRight
AutoSize = True
BorderSpacing.Around = 6
@ -55,10 +55,10 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
TabOrder = 3
end
object CompileButton: TBitBtn
Left = 295
Height = 29
Left = 302
Height = 26
Top = 6
Width = 68
Width = 71
Align = alRight
AutoSize = True
BorderSpacing.Around = 6
@ -68,9 +68,9 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
end
object HelpButton: TBitBtn
Left = 6
Height = 29
Height = 26
Top = 6
Width = 63
Width = 71
Align = alLeft
AutoSize = True
BorderSpacing.Around = 6
@ -80,10 +80,10 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
TabOrder = 0
end
object CompileAdvancedButton: TBitBtn
Left = 369
Height = 29
Left = 379
Height = 26
Top = 6
Width = 137
Width = 127
Align = alRight
AutoSize = True
BorderSpacing.Around = 6
@ -94,7 +94,7 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
end
object PageControl1: TPageControl
Left = 0
Height = 439
Height = 442
Top = 0
Width = 700
ActivePage = BuildTabSheet
@ -103,27 +103,27 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
TabOrder = 1
object BuildTabSheet: TTabSheet
Caption = 'BuildTabSheet'
ClientHeight = 408
ClientWidth = 696
ClientHeight = 414
ClientWidth = 692
object DetailsPanel: TPanel
Left = 0
Height = 408
Height = 414
Top = 0
Width = 696
Width = 692
Align = alClient
AutoSize = True
BevelOuter = bvNone
ClientHeight = 408
ClientWidth = 696
ClientHeight = 414
ClientWidth = 692
TabOrder = 0
object BuildProfileLabel: TLabel
AnchorSideLeft.Control = DetailsPanel
AnchorSideTop.Control = BuildProfileComboBox
AnchorSideTop.Side = asrCenter
Left = 6
Height = 17
Height = 15
Top = 11
Width = 109
Width = 83
BorderSpacing.Top = 5
BorderSpacing.Around = 6
Caption = 'Profile to Build'
@ -136,15 +136,15 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = BuildProfileButton
Left = 121
Height = 31
Left = 95
Height = 23
Hint = 'Name of the active profile.'
Top = 4
Width = 538
Top = 7
Width = 560
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6
BorderSpacing.Right = 6
ItemHeight = 0
ItemHeight = 15
OnSelect = BuildProfileComboBoxSelect
ParentShowHint = False
ShowHint = True
@ -157,10 +157,10 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = BuildProfileComboBox
AnchorSideBottom.Side = asrBottom
Left = 665
Height = 31
Left = 661
Height = 23
Hint = 'Manage profiles'
Top = 4
Top = 7
Width = 25
Anchors = [akTop, akRight, akBottom]
BorderSpacing.Left = 6
@ -176,9 +176,9 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideTop.Control = LCLWidgetTypeComboBox
AnchorSideTop.Side = asrBottom
Left = 6
Height = 17
Top = 95
Width = 54
Height = 15
Top = 80
Width = 42
Alignment = taRightJustify
BorderSpacing.Top = 6
Caption = 'Options'
@ -194,8 +194,8 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
Left = 6
Height = 56
Hint = 'Options passed to compiler'
Top = 112
Width = 684
Top = 95
Width = 680
Anchors = [akTop, akLeft, akRight]
Lines.Strings = (
''
@ -211,9 +211,9 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideTop.Control = TargetDirectoryComboBox
AnchorSideTop.Side = asrBottom
Left = 6
Height = 17
Top = 226
Width = 50
Height = 15
Top = 201
Width = 39
BorderSpacing.Left = 6
BorderSpacing.Top = 6
Caption = 'Defines'
@ -226,26 +226,25 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideRight.Control = CleanUpGroupBox
AnchorSideBottom.Control = CommonsDividerBevel
Left = 6
Height = 98
Height = 133
Hint = 'Defines without -d'
Top = 243
Width = 453
Top = 216
Width = 491
Anchors = [akTop, akLeft, akRight, akBottom]
ItemHeight = 0
ParentShowHint = False
PopupMenu = OptionsPopupMenu
ShowHint = True
TabOrder = 2
TopIndex = -1
end
object LCLWidgetTypeLabel: TLabel
AnchorSideLeft.Control = BuildProfileLabel
AnchorSideTop.Control = BuildProfileComboBox
AnchorSideTop.Side = asrBottom
Left = 6
Height = 17
Top = 41
Width = 111
Height = 15
Top = 36
Width = 88
BorderSpacing.Top = 6
Caption = 'LCL Widget Type'
ParentColor = False
@ -256,10 +255,10 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom
Left = 6
Height = 31
Top = 58
Height = 23
Top = 51
Width = 209
ItemHeight = 0
ItemHeight = 15
Style = csDropDownList
TabOrder = 3
end
@ -268,9 +267,9 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideTop.Control = OptionsMemo
AnchorSideTop.Side = asrBottom
Left = 6
Height = 17
Top = 174
Width = 109
Height = 15
Top = 157
Width = 83
Alignment = taRightJustify
BorderSpacing.Top = 6
Caption = 'Target Directory'
@ -282,12 +281,12 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = TargetDirectoryButton
Left = 6
Height = 29
Top = 191
Width = 653
Height = 23
Top = 172
Width = 649
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 6
ItemHeight = 0
ItemHeight = 15
TabOrder = 5
end
object TargetOSLabel: TLabel
@ -296,9 +295,9 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideTop.Control = BuildProfileComboBox
AnchorSideTop.Side = asrBottom
Left = 221
Height = 17
Top = 41
Width = 65
Height = 15
Top = 36
Width = 50
Alignment = taRightJustify
BorderSpacing.Left = 6
BorderSpacing.Top = 6
@ -311,9 +310,9 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideTop.Control = BuildProfileComboBox
AnchorSideTop.Side = asrBottom
Left = 451
Height = 17
Top = 41
Width = 74
Height = 15
Top = 36
Width = 58
Alignment = taRightJustify
BorderSpacing.Left = 6
BorderSpacing.Top = 6
@ -325,11 +324,11 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = ConfirmBuildCheckBox
AnchorSideBottom.Side = asrBottom
Left = 526
Height = 24
Left = 436
Height = 19
Hint = 'Increment revision? (ToDo: get a better hint)'
Top = 366
Width = 217
Top = 373
Width = 171
BorderSpacing.Left = 12
Caption = 'UpdateRevisionIncCheckBox'
ParentShowHint = False
@ -343,11 +342,11 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideRight.Control = OptionsMemo
AnchorSideRight.Side = asrBottom
Left = 451
Height = 29
Top = 58
Width = 239
Height = 23
Top = 51
Width = 235
Anchors = [akTop, akLeft, akRight]
ItemHeight = 0
ItemHeight = 15
TabOrder = 8
end
object CommonsDividerBevel: TDividerBevel
@ -356,9 +355,9 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideRight.Control = DetailsPanel
AnchorSideRight.Side = asrBottom
Left = 6
Height = 17
Top = 341
Width = 684
Height = 15
Top = 349
Width = 680
Caption = 'CommonsDividerBevel'
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 6
@ -373,11 +372,11 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideTop.Control = DefinesButton
AnchorSideTop.Side = asrCenter
AnchorSideBottom.Side = asrBottom
Left = 110
Height = 24
Left = 106
Height = 19
Hint = 'Restart Lazarus automatically after building the IDE. Has no effect when building other parts'
Top = 366
Width = 212
Top = 373
Width = 162
BorderSpacing.Left = 12
BorderSpacing.Top = 7
Caption = 'RestartAfterBuildCheckBox'
@ -389,11 +388,11 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideLeft.Control = RestartAfterBuildCheckBox
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = RestartAfterBuildCheckBox
Left = 334
Height = 24
Left = 280
Height = 19
Hint = 'Show confirmation dialog when building directly from Tools menu'
Top = 366
Width = 180
Top = 373
Width = 144
BorderSpacing.Left = 12
Caption = 'ConfirmBuildCheckBox'
ParentShowHint = False
@ -407,10 +406,10 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Side = asrBottom
Left = 6
Height = 29
Height = 25
Hint = 'Edit list of defines which can be used by any profile'
Top = 364
Width = 92
Top = 370
Width = 88
AutoSize = True
BorderSpacing.Right = 6
Caption = 'Edit Defines'
@ -426,9 +425,9 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = TargetDirectoryComboBox
AnchorSideBottom.Side = asrBottom
Left = 665
Height = 29
Top = 191
Left = 661
Height = 23
Top = 172
Width = 25
Anchors = [akTop, akRight, akBottom]
BorderSpacing.Left = 6
@ -444,10 +443,10 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideRight.Control = LCLWidgetTypeComboBox
AnchorSideRight.Side = asrBottom
Left = 221
Height = 29
Top = 58
Height = 23
Top = 51
Width = 224
ItemHeight = 0
ItemHeight = 15
TabOrder = 7
end
object CleanUpGroupBox: TGroupBox
@ -458,10 +457,10 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideRight.Control = DetailsPanel
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CommonsDividerBevel
Left = 465
Height = 115
Top = 226
Width = 225
Left = 503
Height = 148
Top = 201
Width = 183
Anchors = [akTop, akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 6
@ -475,8 +474,8 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 96
ClientWidth = 221
ClientHeight = 128
ClientWidth = 179
ParentShowHint = False
ShowHint = True
TabOrder = 13
@ -484,9 +483,9 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideTop.Control = CleanCommonCheckBox
AnchorSideTop.Side = asrBottom
Left = 6
Height = 24
Top = 36
Width = 181
Height = 19
Top = 31
Width = 142
BorderSpacing.Top = 6
Caption = 'CleanAutoRadioButton'
Checked = True
@ -498,9 +497,9 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideTop.Control = CleanAutoRadioButton
AnchorSideTop.Side = asrBottom
Left = 6
Height = 24
Top = 66
Width = 209
Height = 19
Top = 56
Width = 167
BorderSpacing.Top = 6
Caption = 'CleanCommonRadioButton'
OnClick = CleanRadioButtonClick
@ -510,9 +509,9 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideTop.Control = CleanCommonRadioButton
AnchorSideTop.Side = asrBottom
Left = 6
Height = 24
Top = 96
Width = 166
Height = 19
Top = 81
Width = 130
BorderSpacing.Top = 6
Caption = 'CleanAllRadioButton'
OnClick = CleanRadioButtonClick
@ -522,9 +521,9 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
AnchorSideTop.Control = CleanAllRadioButton
AnchorSideTop.Side = asrBottom
Left = 6
Height = 24
Top = 126
Width = 163
Height = 19
Top = 106
Width = 131
BorderSpacing.Top = 6
Caption = 'CleanOnceCheckBox'
TabOrder = 3
@ -532,9 +531,9 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
object CleanCommonCheckBox: TCheckBox
AnchorSideTop.Control = CleanUpGroupBox
Left = 6
Height = 24
Height = 19
Top = 6
Width = 190
Width = 154
BorderSpacing.Top = 6
Caption = 'CleanCommonCheckBox'
OnClick = CleanCommonCheckBoxClick
@ -561,8 +560,8 @@ object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
end
end
object OptionsPopupMenu: TPopupMenu
Left = 320
Top = 592
left = 320
top = 592
object ShowOptsMenuItem: TMenuItem
Caption = 'Show options and defines for cmd line'
OnClick = ShowOptsMenuItemClick

View File

@ -57,8 +57,8 @@ uses
// Codetools
CodeToolManager, DefineTemplates,
// IDEIntf
LazIDEIntf, IDEMsgIntf, IDEHelpIntf, IDEImagesIntf, IDEWindowIntf, IDEDialogs,
PackageIntf, IDEExternToolIntf,
LazIDEIntf, IDEMsgIntf, IDEHelpIntf, IDEImagesIntf, IDEWindowIntf,
PackageIntf, IDEExternToolIntf, IDEDialogs, IDEUtils,
// IDE
LazarusIDEStrConsts, TransferMacros, LazConf, DialogProcs,
MainBar, EnvironmentOpts,
@ -1145,17 +1145,29 @@ end;
procedure TConfigureBuildLazarusDlg.TargetDirectoryButtonClick(Sender: TObject);
var
AFilename: String;
DirDialog: TSelectDirectoryDialog;
lExpandedName: string;
lDirName, lDirNameF: string;
begin
DirDialog:=TSelectDirectoryDialog.Create(nil);
try
DirDialog.Options:=DirDialog.Options+[ofPathMustExist];
DirDialog.Title:=lisLazBuildABOChooseOutputDir+'(lazarus'+
GetExecutableExt(fProfiles.Current.FPCTargetOS)+')';
{ Setup directory path }
lDirName:=EnvironmentOptions.GetParsedValue(eopLazarusDirectory, TargetDirectoryComboBox.Text);
lExpandedName:=CleanAndExpandDirectory(lDirName);
lDirName:=GetValidDirectoryAndFilename(lDirName, lDirNameF);
DirDialog.InitialDir:=IncludeTrailingBackslash(lDirName);
DirDialog.FileName:=lDirNameF;
if DirDialog.Execute then begin
AFilename:=CleanAndExpandDirectory(DirDialog.Filename);
TargetDirectoryComboBox.AddHistoryItem(AFilename,10,true,true);
lDirName:=CleanAndExpandDirectory(DirDialog.Filename);
{ ~bk Here I wanted to keeep Macros but it doesn't seem to work
if UpperCase(lDirName)<>UpperCase(lExpandedName) then }
TargetDirectoryComboBox.AddHistoryItem(lDirName,10,true,true);
end;
finally
DirDialog.Free;

View File

@ -245,7 +245,7 @@ type
ScanFPCSrc: TScanModeFPCSources; Quiet: boolean);
procedure SetBuildTargetProject1; override; overload;
procedure SetBuildTargetProject1(Quiet: boolean; ScanFPCSrc: TScanModeFPCSources = smsfsBackground); overload;
procedure SetBuildTargetIDE; override;
procedure SetBuildTargetIDE(aQuiet: boolean = false); override;
function BuildTargetIDEIsDefault: boolean; override;
property FPCSrcScans: TFPCSrcScans read FFPCSrcScans;
@ -2924,7 +2924,7 @@ begin
SetBuildTarget('','','',ScanFPCSrc,Quiet);
end;
procedure TBuildManager.SetBuildTargetIDE;
procedure TBuildManager.SetBuildTargetIDE(aQuiet: boolean);
var
NewTargetOS: String;
NewTargetCPU: String;
@ -2939,7 +2939,7 @@ begin
end;
if ConsoleVerbosity>=1 then
debugln(['Hint: (lazarus) [TBuildManager.SetBuildTargetIDE] OS=',NewTargetOS,' CPU=',NewTargetCPU,' WS=',NewLCLWidgetSet]);
SetBuildTarget(NewTargetOS,NewTargetCPU,NewLCLWidgetSet,smsfsBackground,false);
SetBuildTarget(NewTargetOS,NewTargetCPU,NewLCLWidgetSet,smsfsBackground,aQuiet);
end;
function TBuildManager.BuildTargetIDEIsDefault: boolean;

View File

@ -15,9 +15,9 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
Left = 2
Height = 19
Height = 15
Top = 2
Width = 176
Width = 139
Caption = 'MaxRecentOpenFilesLabel'
ParentColor = False
end
@ -25,9 +25,9 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideLeft.Control = lblCenter
AnchorSideTop.Control = Owner
Left = 314
Height = 19
Height = 15
Top = 2
Width = 188
Width = 147
BorderSpacing.Left = 3
Caption = 'MaxRecentProjectFilesLabel'
ParentColor = False
@ -38,9 +38,9 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom
Left = 2
Height = 23
Top = 65
Width = 249
Height = 19
Top = 48
Width = 196
BorderSpacing.Top = 6
Caption = 'OpenLastProjectAtStartCheckBox'
TabOrder = 2
@ -51,9 +51,9 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom
Left = 2
Height = 23
Top = 127
Width = 226
Height = 19
Top = 94
Width = 181
BorderSpacing.Top = 2
Caption = 'ShowCompileDialogCheckBox'
OnChange = ShowCompileDialogCheckBoxChange
@ -64,9 +64,9 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Control = AutoCloseCompileDialogCheckBox
AnchorSideTop.Side = asrBottom
Left = 2
Height = 19
Top = 183
Width = 109
Height = 15
Top = 142
Width = 82
BorderSpacing.Top = 10
Caption = 'LazarusDirLabel'
ParentColor = False
@ -79,8 +79,8 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideBottom.Control = LazarusDirComboBox
AnchorSideBottom.Side = asrBottom
Left = 597
Height = 36
Top = 202
Height = 23
Top = 157
Width = 23
Anchors = [akTop, akRight, akBottom]
Caption = '...'
@ -93,11 +93,11 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = LazarusDirButton
Left = 2
Height = 36
Top = 202
Height = 23
Top = 157
Width = 595
Anchors = [akTop, akLeft, akRight]
ItemHeight = 0
ItemHeight = 15
TabOrder = 6
Text = 'LazarusDirComboBox'
end
@ -107,11 +107,11 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = CompilerPathButton
Left = 2
Height = 36
Top = 263
Height = 23
Top = 201
Width = 595
Anchors = [akTop, akLeft, akRight]
ItemHeight = 0
ItemHeight = 15
TabOrder = 8
Text = 'CompilerPathComboBox'
end
@ -122,8 +122,8 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideBottom.Control = CompilerPathComboBox
AnchorSideBottom.Side = asrBottom
Left = 597
Height = 36
Top = 263
Height = 23
Top = 201
Width = 23
Anchors = [akTop, akRight, akBottom]
Caption = '...'
@ -135,9 +135,9 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Control = LazarusDirComboBox
AnchorSideTop.Side = asrBottom
Left = 2
Height = 19
Top = 244
Width = 127
Height = 15
Top = 186
Width = 101
BorderSpacing.Top = 6
Caption = 'CompilerPathLabel'
ParentColor = False
@ -148,11 +148,11 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = FPCSourceDirButton
Left = 2
Height = 36
Top = 324
Height = 23
Top = 245
Width = 595
Anchors = [akTop, akLeft, akRight]
ItemHeight = 0
ItemHeight = 15
TabOrder = 10
Text = 'FPCSourceDirComboBox'
end
@ -163,8 +163,8 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideBottom.Control = FPCSourceDirComboBox
AnchorSideBottom.Side = asrBottom
Left = 597
Height = 36
Top = 324
Height = 23
Top = 245
Width = 23
Anchors = [akTop, akRight, akBottom]
Caption = '...'
@ -176,9 +176,9 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Control = CompilerPathComboBox
AnchorSideTop.Side = asrBottom
Left = 2
Height = 19
Top = 305
Width = 131
Height = 15
Top = 230
Width = 100
BorderSpacing.Top = 6
Caption = 'FPCSourceDirLabel'
ParentColor = False
@ -188,9 +188,9 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Control = FPCSourceDirComboBox
AnchorSideTop.Side = asrBottom
Left = 2
Height = 19
Top = 366
Width = 102
Height = 15
Top = 274
Width = 81
BorderSpacing.Top = 6
Caption = 'MakePathLabel'
ParentColor = False
@ -200,9 +200,9 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Control = MakePathComboBox
AnchorSideTop.Side = asrBottom
Left = 2
Height = 19
Top = 427
Width = 120
Height = 15
Top = 318
Width = 90
BorderSpacing.Top = 6
Caption = 'TestBuildDirLabel'
ParentColor = False
@ -213,11 +213,11 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = MakePathButton
Left = 2
Height = 36
Top = 385
Height = 23
Top = 289
Width = 595
Anchors = [akTop, akLeft, akRight]
ItemHeight = 0
ItemHeight = 15
TabOrder = 12
Text = 'MakePathComboBox'
end
@ -228,8 +228,8 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideBottom.Control = MakePathComboBox
AnchorSideBottom.Side = asrBottom
Left = 597
Height = 36
Top = 385
Height = 23
Top = 289
Width = 23
Anchors = [akTop, akRight, akBottom]
Caption = '...'
@ -242,11 +242,11 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = TestBuildDirButton
Left = 2
Height = 36
Top = 446
Height = 23
Top = 333
Width = 595
Anchors = [akTop, akLeft, akRight]
ItemHeight = 0
ItemHeight = 15
TabOrder = 14
Text = 'TestBuildDirComboBox'
end
@ -257,8 +257,8 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideBottom.Control = TestBuildDirComboBox
AnchorSideBottom.Side = asrBottom
Left = 597
Height = 36
Top = 446
Height = 23
Top = 333
Width = 23
Anchors = [akTop, akRight, akBottom]
Caption = '...'
@ -271,9 +271,9 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom
Left = 32
Height = 23
Top = 150
Width = 257
Height = 19
Top = 113
Width = 207
BorderSpacing.Left = 30
Caption = 'AutoCloseCompileDialogCheckBox'
TabOrder = 5
@ -283,9 +283,9 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Control = TestBuildDirComboBox
AnchorSideTop.Side = asrBottom
Left = 2
Height = 19
Top = 488
Width = 197
Height = 15
Top = 362
Width = 152
Alignment = taRightJustify
BorderSpacing.Top = 6
Caption = 'CompilerTranslationFileLabel'
@ -300,8 +300,8 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideBottom.Control = CompilerTranslationFileComboBox
AnchorSideBottom.Side = asrBottom
Left = 597
Height = 36
Top = 507
Height = 23
Top = 377
Width = 23
Anchors = [akTop, akRight, akBottom]
Caption = '...'
@ -316,11 +316,11 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = CompilerTranslationFileButton
Left = 2
Height = 36
Top = 507
Height = 23
Top = 377
Width = 595
Anchors = [akTop, akLeft, akRight]
ItemHeight = 0
ItemHeight = 15
ParentShowHint = False
ShowHint = True
TabOrder = 16
@ -342,9 +342,9 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideRight.Control = lblCenter
AnchorSideRight.Side = asrBottom
Left = 2
Height = 36
Height = 23
Hint = 'Value 0 means unlimited.'
Top = 23
Top = 19
Width = 305
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 3
@ -360,9 +360,9 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 316
Height = 36
Height = 23
Hint = 'Value 0 means unlimited.'
Top = 23
Top = 19
Width = 304
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 3
@ -376,9 +376,9 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Control = MultipleInstancesComboBox
AnchorSideTop.Side = asrCenter
Left = 2
Height = 19
Top = 98
Width = 152
Height = 15
Top = 73
Width = 121
Caption = 'MultipleInstancesLabel'
ParentColor = False
end
@ -389,14 +389,14 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 162
Height = 35
Top = 90
Width = 458
Left = 131
Height = 23
Top = 69
Width = 489
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8
BorderSpacing.Top = 2
ItemHeight = 0
ItemHeight = 15
Style = csDropDownList
TabOrder = 3
end
@ -405,9 +405,9 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Control = CompilerTranslationFileComboBox
AnchorSideTop.Side = asrBottom
Left = 2
Height = 19
Top = 549
Width = 191
Height = 15
Top = 406
Width = 153
Alignment = taRightJustify
BorderSpacing.Top = 6
Caption = 'FppkgConfigurationFileLabel'
@ -421,11 +421,11 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = FppkgConfigurationFileButton
Left = 2
Height = 36
Top = 568
Height = 23
Top = 421
Width = 595
Anchors = [akTop, akLeft, akRight]
ItemHeight = 0
ItemHeight = 15
ParentShowHint = False
ShowHint = True
TabOrder = 18
@ -438,8 +438,8 @@ object FilesOptionsFrame: TFilesOptionsFrame
AnchorSideBottom.Control = FppkgConfigurationFileComboBox
AnchorSideBottom.Side = asrBottom
Left = 597
Height = 36
Top = 568
Height = 23
Top = 421
Width = 23
Anchors = [akTop, akRight, akBottom]
Caption = '...'

View File

@ -109,6 +109,7 @@ type
function CheckMake: boolean;
function CheckFPCMsgFile: boolean;
public
constructor Create(AOwner: TComponent); override;
function Check: Boolean; override;
function GetTitle: String; override;
procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override;
@ -127,31 +128,46 @@ implementation
procedure TFilesOptionsFrame.FilesButtonClick(Sender: TObject);
var
OpenDialog: TOpenDialog;
AFilename: string;
lDirText : string;
lExpandedName: string; // Expanded name before Dialog
lDirName, lDirNameF : string;
begin
OpenDialog:=IDEOpenDialogClass.Create(nil);
OpenDialog := IDEOpenDialogClass.Create(nil);
try
InputHistories.ApplyFileDialogSettings(OpenDialog);
OpenDialog.Options:=OpenDialog.Options+[ofPathMustExist];
OpenDialog.Options := OpenDialog.Options+[ofPathMustExist];
// set title
if Sender=CompilerPathButton then
OpenDialog.Title:=Format(lisChooseCompilerExecutable,[GetDefaultCompilerFilename])
else if Sender=MakePathButton then
OpenDialog.Title:=lisChooseMakeExecutable
if Sender = CompilerPathButton then begin
OpenDialog.Title := Format(lisChooseCompilerExecutable,[GetDefaultCompilerFilename]);
lDirText := CompilerPathComboBox.Text;
end
else if Sender=MakePathButton then begin
OpenDialog.Title := lisChooseMakeExecutable;
lDirText := MakePathComboBox.Text;
end
else
exit;
if OpenDialog.Execute then begin
AFilename:=CleanAndExpandFilename(OpenDialog.Filename);
lDirName := EnvironmentOptions.GetParsedValue(eopCompilerFilename, lDirText);
lExpandedName := CleanAndExpandFilename(lDirName);
lDirName := GetValidDirectoryAndFilename(lDirName, {out} lDirNameF);
OpenDialog.InitialDir := lDirName;
OpenDialog.FileName := lDirNameF;
if Sender=CompilerPathButton then begin
// check compiler filename
SetComboBoxText(CompilerPathComboBox,AFilename,cstFilename);
CheckCompiler([mbOk]);
end else if Sender=MakePathButton then begin
// check make filename
SetComboBoxText(MakePathComboBox,AFilename,cstFilename);
CheckMake;
if OpenDialog.Execute then begin
lDirNameF := CleanAndExpandFilename(OpenDialog.Filename);
if UpperCase(lExpandedName) <> UpperCase(lDirNameF) then begin // Changed ?
lDirText := lDirNameF;
if Sender=CompilerPathButton then begin
// check compiler filename
SetComboBoxText(CompilerPathComboBox,lDirText,cstFilename);
CheckCompiler([mbOk]);
end
else if Sender = MakePathButton then begin
// check make filename
SetComboBoxText(MakePathComboBox,lDirText,cstFilename);
CheckMake;
end;
end;
end;
InputHistories.StoreFileDialogSettings(OpenDialog);
@ -185,39 +201,67 @@ end;
procedure TFilesOptionsFrame.DirectoriesButtonClick(Sender: TObject);
var
OpenDialog: TSelectDirectoryDialog;
ADirectoryName: string;
lDirText : string;
lExpandedName: string;
lDirName, lDirNameF: string;
begin
OpenDialog:=TSelectDirectoryDialog.Create(nil);
OpenDialog := TSelectDirectoryDialog.Create(nil);
try
InputHistories.ApplyFileDialogSettings(OpenDialog);
OpenDialog.Options:=OpenDialog.Options+[ofPathMustExist];
OpenDialog.Options := OpenDialog.Options+[ofPathMustExist];
// set title
if Sender=LazarusDirButton then
OpenDialog.Title:=lisChooseLazarusSourceDirectory
else if Sender=FPCSourceDirButton then
OpenDialog.Title:=lisChooseFPCSourceDir
else if Sender=TestBuildDirButton then
OpenDialog.Title:=lisChooseTestBuildDir
if Sender = LazarusDirButton then begin
OpenDialog.Title := lisChooseLazarusSourceDirectory;
lDirText := LazarusDirComboBox.Text;
end
else if Sender = FPCSourceDirButton then begin
OpenDialog.Title := lisChooseFPCSourceDir;
lDirText := FPCSourceDirComboBox.Text;
end
else if Sender=TestBuildDirButton then begin
OpenDialog.Title := lisChooseTestBuildDir;
lDirText := TestBuildDirComboBox.Text;
end
else
exit;
if lDirText = '' then
lDirName := EnvironmentOptions.GetParsedValue(eopLazarusDirectory, '')
else
lDirName := EnvironmentOptions.GetParsedValue(eopLazarusDirectory, lDirText);
lExpandedName := CleanAndExpandDirectory(lDirName);
lDirName := GetValidDirectoryAndFilename(lDirName, lDirNameF);
{
if lDirNameF = '' then begin
lDirName := ExtractFilePath(lDirName);
lDirNameF := ExtractFileName(lDirName);
end;
}
OpenDialog.InitialDir := IncludeTrailingBackslash(lDirName);
OpenDialog.FileName := lDirNameF;
if OpenDialog.Execute then begin
ADirectoryName:=CleanAndExpandDirectory(OpenDialog.Filename);
if Sender=LazarusDirButton then begin
// check lazarus directory
SetComboBoxText(LazarusDirComboBox,ADirectoryName,cstFilename);
CheckLazarusDir([mbOk]);
end else if Sender=FPCSourceDirButton then begin
// check fpc source directory
SetComboBoxText(FPCSourceDirComboBox,ADirectoryName,cstFilename);
CheckFPCSourceDir([mbOK]);
end else if Sender=TestBuildDirButton then begin
// check test directory
SetComboBoxText(TestBuildDirComboBox,ADirectoryName,cstFilename);
CheckTestDir;
lDirName := CleanAndExpandDirectory(OpenDialog.Filename);
if UpperCase(lDirName)<>UpperCase(lExpandedName) then begin
lDirText := lDirName;
if Sender = LazarusDirButton then begin
// check lazarus directory
SetComboBoxText(LazarusDirComboBox,lDirText,cstFilename);
CheckLazarusDir([mbOk]);
end
else if Sender = FPCSourceDirButton then begin
// check fpc source directory
SetComboBoxText(FPCSourceDirComboBox,lDirText,cstFilename);
CheckFPCSourceDir([mbOK]);
end
else if Sender = TestBuildDirButton then begin
// check test directory
SetComboBoxText(TestBuildDirComboBox,lDirText,cstFilename);
CheckTestDir;
end;
end;
end;
InputHistories.StoreFileDialogSettings(OpenDialog);
finally
@ -576,6 +620,11 @@ begin
Result:=true;
end;
constructor TFilesOptionsFrame.Create(AOwner: TComponent); // ~bk to be removed
begin
inherited Create(AOwner);
end;
class function TFilesOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
begin
Result := TEnvironmentOptions;

View File

@ -50,7 +50,7 @@ uses
FileUtil, LazUTF8, LazUTF8Classes, LazFileUtils, LazStringUtils, LazFileCache,
LazLoggerBase,
// IdeIntf
MacroDefIntf, IDEDialogs, IDEImagesIntf,
MacroDefIntf, IDEDialogs, IDEImagesIntf, IDEUtils,
// DebuggerIntf
DbgIntfDebuggerBase,
// LazDebuggerGdbmi
@ -135,6 +135,7 @@ type
FppkgWriteConfigButton: TButton;
procedure CompilerBrowseButtonClick(Sender: TObject);
procedure CompilerComboBoxChange(Sender: TObject);
procedure CompilerComboBoxExit(Sender: TObject);
procedure DebuggerBrowseButtonClick(Sender: TObject);
procedure DebuggerComboBoxChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
@ -175,24 +176,27 @@ type
procedure UpdateCaptions;
procedure SelectPage(const NodeText: string);
function SelectDirectory(aTitle: string): string;
function SelectDirectory(aTitle: string; aPathFileName: string;
aEnvOptParseType: TEnvOptParseType): string; overload;
procedure StartFPCSrcThread;
procedure UpdateLazarusDirCandidates;
procedure UpdateCompilerFilenameCandidates;
procedure UpdateFPCSrcDirCandidates;
procedure UpdateFPCSrcDirCandidate(aFPCSrcDirInfo: TSDFileInfo);
procedure UpdateMakeExeCandidates;
procedure UpdateMakeExeCandidates(aStopIfFits: boolean = False);
procedure UpdateDebuggerCandidates;
procedure UpdateFppkgCandidates;
procedure FillComboboxWithFileInfoList(ABox: TComboBox; List: TSDFileInfoList;
ItemIndex: integer = 0);
procedure SetIdleConnected(const AValue: boolean);
procedure UpdateLazDirNote;
procedure UpdateCompilerNote;
procedure UpdateCompilerNote(aQuiet: boolean = False);
procedure UpdateFPCSrcDirNote;
procedure UpdateMakeExeNote;
procedure UpdateDebuggerNote;
procedure UpdateFppkgNote;
function FirstErrorNode: TTreeNode;
function FirstWarningNode: TTreeNode;
function GetFirstCandidate(Candidates: TSDFileInfoList;
MinQuality: TSDFilenameQuality = sddqCompatible): TSDFileInfo;
function QualityToImgIndex(Quality: TSDFilenameQuality): integer;
@ -553,32 +557,51 @@ end;
procedure TInitialSetupDialog.CompilerComboBoxChange(Sender: TObject);
begin
UpdateCompilerNote;
UpdateCompilerNote({Quiet} True);
UpdateFPCSrcDirNote;
end;
procedure TInitialSetupDialog.CompilerComboBoxExit(Sender: TObject);
begin
UpdateCompilerNote({Quiet} False);
UpdateFPCSrcDirNote;
end;
procedure TInitialSetupDialog.DebuggerBrowseButtonClick(Sender: TObject);
var
Filename: String;
lExpandedName: string; // Expanded name before Dialog
lDirName, lFileName: string;
lTitle: string;
lChanged: boolean=False;
Dlg: TIDEOpenDialog;
Filter: String;
begin
Dlg:=IDEOpenDialogClass.Create(nil);
try
Filename:='gdb'+GetExecutableExt;
Dlg.Title:=SimpleFormat(lisSelectPathTo, [Filename]);
Dlg.Options:=Dlg.Options+[ofFileMustExist];
Filter:=dlgFilterAll+'|'+GetAllFilesMask;
if ExtractFileExt(Filename)<>'' then
Filter:=dlgFilterExecutable+'|*'+ExtractFileExt(Filename)+'|'+Filter;
Dlg.Filter:=Filter;
if not Dlg.Execute then exit;
Filename:=Dlg.FileName;
lTitle := 'gdb'+GetExecutableExt;
Dlg.Title := SimpleFormat(lisSelectPathTo, [lTitle]);
lExpandedName := EnvironmentOptions.GetParsedValue(eopDebuggerFilename, DebuggerComboBox.Text);
lDirName := GetValidDirectory(lExpandedName, {out} lFileName);
Dlg.Options := Dlg.Options+[ofFileMustExist];
if lFileName='' then
lFileName := lTitle;
Filter := dlgFilterAll+'|'+GetAllFilesMask;
if ExtractFileExt(lFileName)<>'' then
Filter := dlgFilterExecutable+'|*'+ExtractFileExt(lFileName)+'|'+Filter;
Dlg.Filter := Filter;
Dlg.InitialDir := lDirName;
Dlg.FileName := lFileName;
if not Dlg.Execute then
exit;
lFileName := CleanAndExpandFilename(Dlg.Filename);
lChanged := UpperCase(lExpandedName)<>UpperCase(lFileName);
finally
Dlg.Free;
end;
DebuggerComboBox.Text:=Filename;
UpdateDebuggerNote;
if lChanged then begin // Avoid loosing $(macros)
DebuggerComboBox.Text := lFileName;
UpdateDebuggerNote;
end;
end;
procedure TInitialSetupDialog.DebuggerComboBoxChange(Sender: TObject);
@ -588,26 +611,39 @@ end;
procedure TInitialSetupDialog.CompilerBrowseButtonClick(Sender: TObject);
var
Filename: String;
lExpandedName: string; // Expanded name before Dialog
lDirName, lFileName: string;
lTitle: string;
lChanged: boolean=False;
Dlg: TIDEOpenDialog;
Filter: String;
begin
Dlg:=IDEOpenDialogClass.Create(nil);
Dlg := IDEOpenDialogClass.Create(nil);
try
Filename:='fpc'+GetExecutableExt;
Dlg.Title:=SimpleFormat(lisSelectPathTo, [Filename]);
Dlg.Options:=Dlg.Options+[ofFileMustExist];
Filter:=dlgFilterAll+'|'+GetAllFilesMask;
if ExtractFileExt(Filename)<>'' then
Filter:=dlgFilterExecutable+'|*'+ExtractFileExt(Filename)+'|'+Filter;
Dlg.Filter:=Filter;
if not Dlg.Execute then exit;
Filename:=Dlg.FileName;
lTitle := 'fpc'+GetExecutableExt;
Dlg.Title := SimpleFormat(lisSelectPathTo, [lTitle]);
lExpandedName := EnvironmentOptions.GetParsedValue(eopCompilerFilename, CompilerComboBox.Text);
lDirName := GetValidDirectory(lExpandedName, {out} lFileName);
Dlg.Options := Dlg.Options+[ofFileMustExist];
if lFileName='' then
lFileName := lTitle;
Filter := dlgFilterAll+'|'+GetAllFilesMask;
if ExtractFileExt(lFileName)<>'' then
Filter := dlgFilterExecutable+'|*'+ExtractFileExt(lFileName)+'|'+Filter;
Dlg.Filter := Filter;
Dlg.InitialDir := lDirName;
Dlg.FileName := lFileName;
if not Dlg.Execute then
exit;
lFileName := CleanAndExpandFilename(Dlg.Filename);
lChanged := UpperCase(lExpandedName)<>UpperCase(lFileName);
finally
Dlg.Free;
end;
CompilerComboBox.Text:=Filename;
UpdateCompilerNote;
if lChanged then begin // Avoid loosing $(macros)
CompilerComboBox.Text := lFileName;
UpdateCompilerNote;
end;
end;
procedure TInitialSetupDialog.FormDestroy(Sender: TObject);
@ -628,8 +664,9 @@ procedure TInitialSetupDialog.FPCSrcDirBrowseButtonClick(Sender: TObject);
var
Dir: String;
begin
Dir:=SelectDirectory(lisSelectFPCSourceDirectory);
if Dir='' then exit;
Dir:=SelectDirectory(lisSelectFPCSourceDirectory, FPCSrcDirComboBox.Text,eopFPCSourceDirectory);
if Dir='' then
exit;
FPCSrcDirComboBox.Text:=Dir;
UpdateFPCSrcDirNote;
end;
@ -643,8 +680,9 @@ procedure TInitialSetupDialog.LazDirBrowseButtonClick(Sender: TObject);
var
Dir: String;
begin
Dir:=SelectDirectory(lisSelectLazarusSourceDirectory);
if Dir='' then exit;
Dir:=SelectDirectory(lisSelectLazarusSourceDirectory,LazDirComboBox.Text,eopLazarusDirectory);
if Dir='' then
exit;
LazDirComboBox.Text:=Dir;
UpdateLazDirNote;
end;
@ -656,26 +694,40 @@ end;
procedure TInitialSetupDialog.MakeExeBrowseButtonClick(Sender: TObject);
var
Filename: String;
lExpandedName: string; // Expanded name before Dialog
lDirName, lFileName: string;
lTitle: string;
lChanged: boolean=False;
Dlg: TIDEOpenDialog;
Filter: String;
begin
Dlg:=IDEOpenDialogClass.Create(nil);
Dlg := IDEOpenDialogClass.Create(nil);
try
Filename:='make'+GetExecutableExt;
Dlg.Title:=SimpleFormat(lisSelectPathTo, [Filename]);
Dlg.Options:=Dlg.Options+[ofFileMustExist];
Filter:=dlgFilterAll+'|'+GetAllFilesMask;
if ExtractFileExt(Filename)<>'' then
Filter:=dlgFilterExecutable+'|*'+ExtractFileExt(Filename)+'|'+Filter;
Dlg.Filter:=Filter;
if not Dlg.Execute then exit;
Filename:=Dlg.FileName;
lTitle := 'make'+GetExecutableExt;
Dlg.Title := SimpleFormat(lisSelectPathTo, [lTitle]);
lExpandedName := EnvironmentOptions.GetParsedValue(eopMakeFilename, MakeExeComboBox.Text);
lDirName := GetValidDirectory(lExpandedName, {out} lFileName);
Dlg.Options := Dlg.Options+[ofFileMustExist];
if lFileName='' then
lFileName := lTitle;
Filter := dlgFilterAll+'|'+GetAllFilesMask;
if ExtractFileExt(lFileName)<>'' then
Filter := dlgFilterExecutable+'|*'+ExtractFileExt(lFileName)+'|'+Filter;
Dlg.Filter := Filter;
Dlg.InitialDir := lDirName;
Dlg.FileName := lFileName;
if not Dlg.Execute then
exit;
lFileName := CleanAndExpandFilename(Dlg.Filename);
lChanged := UpperCase(lExpandedName)<>UpperCase(lFileName);
finally
Dlg.Free;
end;
MakeExeComboBox.Text:=Filename;
UpdateMakeExeNote;
if lChanged then begin // Avoid loosing $(macros)
MakeExeComboBox.Text := lFileName;
UpdateMakeExeNote;
end;
end;
procedure TInitialSetupDialog.MakeExeComboBoxChange(Sender: TObject);
@ -890,6 +942,47 @@ begin
end;
end;
function TInitialSetupDialog.SelectDirectory(aTitle: string;
aPathFileName: string; aEnvOptParseType: TEnvOptParseType): string;
var
DirDlg: TSelectDirectoryDialog;
lCurDirName: string;
lDirPath: string;
lDirName: string;
begin
Result := '';
if aPathFileName='' then
case aEnvOptParseType of
eopLazarusDirectory: lDirPath := EnvironmentOptions.GetParsedLazarusDirectory;
eopFPCSourceDirectory: lDirPath := EnvironmentOptions.GetParsedFPCSourceDirectory;
end
else
lDirPath := EnvironmentOptions.GetParsedValue(eopLazarusDirectory, aPathFileName);
lCurDirName := CleanAndExpandFilename(ExcludeTrailingBackSlash(lDirPath));
lDirPath := GetValidDirectoryAndFilename(lCurDirName, {out} lDirName);
{ ~bk
if lDirName = '' then begin
lDirName := ExtractFileName(lDirPath);
lDirPath := ExtractFilePath(lDirPath);
end;
}
lDirPath := ExcludeTrailingBackSlash(lDirPath);
DirDlg := TSelectDirectoryDialog.Create(nil);
try
DirDlg.Title := aTitle;
DirDlg.InitialDir := lDirPath;
DirDlg.FileName := lDirName;
DirDlg.Options := DirDlg.Options + [ofPathMustExist]; // ~bk, ofFileMustExist];
if DirDlg.Execute then begin
lDirName := CleanAndExpandFilename(DirDlg.FileName);
if UpperCase(lCurDirName)<>UpperCase(lDirName) then
Result := lDirName;
end;
finally
DirDlg.Free;
end;
end;
procedure TInitialSetupDialog.StartFPCSrcThread;
begin
fSearchFpcSourceThread:=TSearchFpcSourceThread.Create(Self);
@ -943,12 +1036,12 @@ begin
FillComboboxWithFileInfoList(FPCSrcDirComboBox,Dirs);
end;
procedure TInitialSetupDialog.UpdateMakeExeCandidates;
procedure TInitialSetupDialog.UpdateMakeExeCandidates(aStopIfFits: boolean);
var
Files: TSDFileInfoList;
begin
Exclude(FFlags,sdfMakeExeFilenameNeedsUpdate);
Files:=SearchMakeExeCandidates(false);
Files:=SearchMakeExeCandidates(aStopIfFits);
FreeAndNil(FCandidates[sddtMakeExeFileName]);
FCandidates[sddtMakeExeFileName]:=Files;
FillComboboxWithFileInfoList(MakeExeComboBox,Files);
@ -1032,7 +1125,7 @@ begin
IdleConnected:=true;
end;
procedure TInitialSetupDialog.UpdateCompilerNote;
procedure TInitialSetupDialog.UpdateCompilerNote(aQuiet: boolean);
var
CurCaption, ParsedC, Note, s: String;
Quality: TSDFilenameQuality;
@ -1055,7 +1148,7 @@ begin
CfgCache.CompilerDate:=0; // force update
if CfgCache.NeedsUpdate then
CfgCache.Update(CodeToolBoss.CompilerDefinesCache.TestFilename);
BuildBoss.SetBuildTargetIDE;
BuildBoss.SetBuildTargetIDE(aQuiet);
end;
case Quality of
sddqInvalid: s:=lisError;
@ -1188,6 +1281,19 @@ begin
Result:=PropertiesTreeView.Items.TopLvlItems[i];
if Result.ImageIndex=ImgIDError then exit;
end;
Result:=FirstWarningNode;
end;
function TInitialSetupDialog.FirstWarningNode: TTreeNode;
var
i: Integer;
begin
for i:=0 to PropertiesTreeView.Items.TopLvlCount-1 do
begin
Result:=PropertiesTreeView.Items.TopLvlItems[i];
if Result.ImageIndex=ImgIDWarning then
exit;
end;
Result:=nil;
end;
@ -1213,6 +1319,8 @@ begin
Result:=ImgIDWarning
else if Quality=sddqIncomplete then
Result:=ImgIDWarning
else if Quality=sddqMakeNotWithFpc then
Result:=ImgIDWarning
else
Result:=ImgIDError;
end;
@ -1257,6 +1365,7 @@ var
begin
IsFirstStart:=not FileExistsCached(EnvironmentOptions.Filename);
if not IsFirstStart then begin
IsFirstStart:= False;
PrimaryFilename:=EnvironmentOptions.Filename;
SecondaryFilename:=AppendPathDelim(GetSecondaryConfigPath)+ExtractFilename(PrimaryFilename);
if FileExistsUTF8(PrimaryFilename)
@ -1276,11 +1385,13 @@ begin
on E: Exception do
debugln(['TInitialSetupDialog.Init unable to read "'+SecondaryFilename+'": '+E.Message]);
end;
IsFirstStart:=PrimaryEnvs.Text=SecondaryEnvs.Text;
// IsFirstStart:=PrimaryEnvs.Text=SecondaryEnvs.Text;
PrimaryEnvs.Free;
SecondaryEnvs.Free;
end;
end;
end
else
IsFirstStart := True;
//debugln(['TInitialSetupDialog.Init IsFirstStart=',IsFirstStart,' ',EnvironmentOptions.Filename]);
// Lazarus directory
@ -1348,7 +1459,7 @@ begin
UpdateFPCSrcDirNote;
// Make executable
UpdateMakeExeCandidates;
UpdateMakeExeCandidates({aStopIfFits} True);
if IsFirstStart
or (EnvironmentOptions.MakeFilename='')
or (not FileExistsCached(EnvironmentOptions.GetParsedMakeFilename)) then
@ -1512,20 +1623,42 @@ begin
FillComboboxWithFileInfoList(FppkgComboBox,Files,-1);
end;
procedure TInitialSetupDialog.FppkgBrowseButtonClick(Sender: TObject);
var
lExpandedName: string; // Expanded name before Dialog
lDirName, lFileName: string;
lTitle: string;
lChanged: boolean=False;
Dlg: TIDEOpenDialog;
Filter: String;
begin
Dlg:=IDEOpenDialogClass.Create(nil);
try
Dlg.Title:=SimpleFormat(lisSelectPathTo, ['fppkg.cfg']);
Dlg.Options:=Dlg.Options+[ofPathMustExist];
if not Dlg.Execute then exit;
FppkgComboBox.Text:=Dlg.FileName;
lTitle:='fppkg.cfg';
Dlg.Title:=SimpleFormat(lisSelectPathTo, [lTitle]);
lExpandedName:=EnvironmentOptions.GetParsedValue(eopFppkgConfigFile, FppkgComboBox.Text);
lDirName := GetValidDirectory(lExpandedName, {out} lFileName);
Dlg.Options:=Dlg.Options+[ofFileMustExist];
if lFileName='' then
lFileName:=lTitle;
Filter:=dlgFilterAll+'|'+GetAllFilesMask;
if ExtractFileExt(lFileName)<>'' then
Filter:=dlgFilterExecutable+'|*'+ExtractFileExt(lFileName)+'|'+Filter;
Dlg.Filter:=Filter;
Dlg.InitialDir:=lDirName;
Dlg.FileName:=lFileName;
if not Dlg.Execute then
exit;
lFileName:=CleanAndExpandFilename(Dlg.Filename);
lChanged := UpperCase(lExpandedName)<>UpperCase(lFileName);
finally
Dlg.Free;
end;
UpdateFppkgNote;
if lChanged then begin // Avoid loosing $(macros)
FppkgComboBox.Text:=lFileName;
UpdateFppkgNote;
end;
end;
procedure TInitialSetupDialog.FppkgWriteConfigButtonClick(Sender: TObject);

View File

@ -48,7 +48,8 @@ type
sddqWrongMinorVersion,
sddqWrongVersion,
sddqIncomplete,
sddqCompatible
sddqCompatible,
sddqMakeNotWithFpc // Make not in the same directory as compiler
);
TSDFileInfo = class
@ -902,7 +903,7 @@ begin
if not FileExistsCached(ExtractFilePath(AFilename)+'fpc.exe') then begin
Note:=Format(lisThereIsNoFpcExeInTheDirectoryOfUsuallyTheMakeExecu, [
ExtractFilename(AFilename)]);
Result:=sddqIncomplete;
Result:=sddqMakeNotWithFpc;
exit;
end;
end;
@ -934,7 +935,7 @@ function SearchMakeExeCandidates(StopIfFits: boolean): TSDFileInfoList;
List:=TSDFileInfoList.create(true);
Item:=List.AddNewItem(RealFilename, AFilename);
Item.Quality:=CheckMakeExeQuality(RealFilename, Item.Note);
Result:=(Item.Quality=sddqCompatible) and StopIfFits;
Result:=(Item.Quality=sddqCompatible) or ((Item.Quality=sddqMakeNotWithFpc) and StopIfFits);
end;
var

View File

@ -1394,6 +1394,8 @@ begin
end;
procedure TMainIDE.SetupInteractive;
const
BOOL_RESULT: array[Boolean] of String = ('False', 'True');
var
CfgCache: TPCTargetConfigCache;
OldLazDir: String;
@ -1404,7 +1406,6 @@ begin
{$IFDEF DebugSearchFPCSrcThread}
ShowSetupDialog:=true;
{$ENDIF}
// check lazarus directory
if (not ShowSetupDialog)
and (CheckLazarusDirectoryQuality(EnvironmentOptions.GetParsedLazarusDirectory,Note)<>sddqCompatible)
@ -1435,6 +1436,14 @@ begin
end;
end;
// check 'make' utility
if (not ShowSetupDialog)
and not (CheckMakeExeQuality(EnvironmentOptions.GetParsedMakeFilename,Note) in [sddqCompatible, sddqMakeNotWithFpc])
then begin
debugln(['Warning: (lazarus) incompatible make utility: ',EnvironmentOptions.GetParsedMakeFilename]);
ShowSetupDialog:=true;
end;
// check debugger
if (not ShowSetupDialog) then begin
// PackageBoss is not yet loaded...
@ -1454,14 +1463,6 @@ begin
end;
end;
// check 'make' utility
if (not ShowSetupDialog)
and (CheckMakeExeQuality(EnvironmentOptions.GetParsedMakeFilename,Note)<>sddqCompatible)
then begin
debugln(['Warning: (lazarus) incompatible make utility: ',EnvironmentOptions.GetParsedMakeFilename]);
ShowSetupDialog:=true;
end;
ConfigFile:=EnvironmentOptions.GetParsedFppkgConfig;
// check fppkg configuration
if (not ShowSetupDialog)