IDE: setup dialog for lazarus directory, compiler and fpc source directory

git-svn-id: trunk@29905 -
This commit is contained in:
mattias 2011-03-19 11:36:10 +00:00
parent c2071ea3cb
commit 971311d658
4 changed files with 150 additions and 42 deletions

View File

@ -66,6 +66,7 @@ object InitialSetupDialog: TInitialSetupDialog
AutoSize = True
Caption = 'StartIDEBitBtn'
Constraints.MinWidth = 100
OnClick = StartIDEBitBtnClick
TabOrder = 0
end
end

View File

@ -105,6 +105,7 @@ type
procedure LazDirComboBoxChange(Sender: TObject);
procedure PropertiesPageControlChange(Sender: TObject);
procedure PropertiesTreeViewSelectionChanged(Sender: TObject);
procedure StartIDEBitBtnClick(Sender: TObject);
procedure WelcomePaintBoxPaint(Sender: TObject);
procedure OnIdle(Sender: TObject; var Done: Boolean);
private
@ -130,6 +131,10 @@ type
procedure UpdateLazDirNote;
procedure UpdateCompilerNote;
procedure UpdateFPCSrcDirNote;
function FirstErrorNode: TTreeNode;
function GetCurrentLazarusDir: string;
function GetCurrentCompilerFilename: string;
function GetCurrentFPCSrcDir: string;
public
TVNodeLazarus: TTreeNode;
TVNodeCompiler: TTreeNode;
@ -140,7 +145,7 @@ type
property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
end;
procedure ShowInitialSetupDialog;
function ShowInitialSetupDialog: TModalResult;
procedure SetupCompilerFilename(var InteractiveSetup: boolean);
procedure SetupFPCSourceDirectory(var InteractiveSetup: boolean);
@ -623,6 +628,7 @@ var
SrcVer: String;
begin
Result:=sddqInvalid;
Note:='';
ADirectory:=TrimFilename(ADirectory);
if not DirPathExistsCached(ADirectory) then
begin
@ -810,14 +816,14 @@ begin
end;
end;
procedure ShowInitialSetupDialog;
function ShowInitialSetupDialog: TModalResult;
var
InitialSetupDialog: TInitialSetupDialog;
begin
InitialSetupDialog:=TInitialSetupDialog.Create(nil);
try
InitialSetupDialog.Init;
InitialSetupDialog.ShowModal;
Result:=InitialSetupDialog.ShowModal;
finally
InitialSetupDialog.Free;
end;
@ -863,7 +869,6 @@ end;
procedure TInitialSetupDialog.FormCreate(Sender: TObject);
var
i: Integer;
Node: TTreeNode;
begin
Caption:='Welcome to Lazarus IDE '+GetLazarusVersionString;
@ -892,16 +897,10 @@ begin
FPCSrcDirLabel.Caption:='The sources of the Free Pascal packages are required for browsing and code completion. For example it has the file "'+SetDirSeparators('rtl/linux/system.pp')+'".';
// select first error
for i:=0 to PropertiesTreeView.Items.TopLvlCount-1 do
begin
Node:=PropertiesTreeView.Items.TopLvlItems[i];
if Node.ImageIndex=ImgIDError then begin
SelectPage(Node.Text);
break;
end;
end;
if PropertiesTreeView.Selected=nil then
PropertiesTreeView.Selected:=TVNodeLazarus;
Node:=FirstErrorNode;
if Node=nil then
Node:=TVNodeLazarus;
PropertiesTreeView.Selected:=Node;
end;
procedure TInitialSetupDialog.CompilerComboBoxChange(Sender: TObject);
@ -925,7 +924,7 @@ var
begin
IdleConnected:=false;
for d:=low(FDirs) to high(FDirs) do
FreeAndNil(FDirs);
FreeAndNil(FDirs[d]);
FreeAndNil(FHeadGraphic);
end;
@ -980,6 +979,31 @@ begin
SelectPage(PropertiesTreeView.Selected.Text);
end;
procedure TInitialSetupDialog.StartIDEBitBtnClick(Sender: TObject);
var
Node: TTreeNode;
s: String;
MsgResult: TModalResult;
begin
Node:=FirstErrorNode;
if Node=TVNodeLazarus then
s:='Without a proper Lazarus directory you will get a lot of warnings.'
else if Node=TVNodeCompiler then
s:='Without a proper compiler the code browsing and compiling will be disappointing.'
else if Node=TVNodeFPCSources then
s:='Without the proper FPC sources code browsing and completion will be very limited.';
if s<>'' then begin
MsgResult:=MessageDlg('Warning',s,mtWarning,[mbIgnore,mbCancel],0);
if MsgResult<>mrIgnore then exit;
end;
EnvironmentOptions.LazarusDirectory:=GetCurrentLazarusDir;
EnvironmentOptions.CompilerFilename:=GetCurrentCompilerFilename;
EnvironmentOptions.FPCSourceDirectory:=GetCurrentFPCSrcDir;
ModalResult:=mrOk;
end;
procedure TInitialSetupDialog.WelcomePaintBoxPaint(Sender: TObject);
begin
with WelcomePaintBox.Canvas do begin
@ -1295,6 +1319,68 @@ begin
TVNodeFPCSources.StateIndex:=ImageIndex;
end;
function TInitialSetupDialog.FirstErrorNode: TTreeNode;
var
i: Integer;
begin
for i:=0 to PropertiesTreeView.Items.TopLvlCount-1 do
begin
Result:=PropertiesTreeView.Items.TopLvlItems[i];
if Result.ImageIndex=ImgIDError then exit;
end;
Result:=nil;
end;
function TInitialSetupDialog.GetCurrentLazarusDir: string;
var
Dirs: TObjectList;
i: Integer;
begin
Dirs:=FDirs[sddtLazarusSrcDir];
Result:=LazDirComboBox.Text;
if Dirs<>nil then begin
i:=Dirs.Count-1;
while (i>=0) and (TSDFileInfo(Dirs[i]).Caption<>Result) do dec(i);
end;
if i>=0 then
Result:=TSDFileInfo(Dirs[i]).Filename;
Result:=ChompPathDelim(TrimFilename(Result));
if Result<>'' then
Result:=ChompPathDelim(TrimFilename(ExpandFileNameUTF8(Result)));
end;
function TInitialSetupDialog.GetCurrentCompilerFilename: string;
var
Dirs: TObjectList;
i: Integer;
begin
Dirs:=FDirs[sddtCompilerFilename];
Result:=CompilerComboBox.Text;
if Dirs<>nil then begin
i:=Dirs.Count-1;
while (i>=0) and (TSDFileInfo(Dirs[i]).Caption<>Result) do dec(i);
end;
if i>=0 then
Result:=TSDFileInfo(Dirs[i]).Filename;
Result:=TrimFilename(Result);
end;
function TInitialSetupDialog.GetCurrentFPCSrcDir: string;
var
Dirs: TObjectList;
i: Integer;
begin
Dirs:=FDirs[sddtFPCSrcDir];
Result:=FPCSrcDirComboBox.Text;
if Dirs<>nil then begin
i:=Dirs.Count-1;
while (i>=0) and (TSDFileInfo(Dirs[i]).Caption<>Result) do dec(i);
end;
if i>=0 then
Result:=TSDFileInfo(Dirs[i]).Filename;
Result:=ChompPathDelim(TrimFilename(Result));
end;
procedure TInitialSetupDialog.Init;
begin
InitLazarusDir;

View File

@ -105,19 +105,22 @@ begin
end;
MainIDE:=TMainIDE.Create(Application);
MainIDE.CreateOftenUsedForms;
try
MainIDE.StartIDE;
except
Application.HandleException(MainIDE);
end;
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('lazarus.pp: TMainIDE created');{$ENDIF}
if not Application.Terminated then
begin
MainIDE.CreateOftenUsedForms;
try
MainIDE.StartIDE;
except
Application.HandleException(MainIDE);
end;
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('lazarus.pp: TMainIDE created');{$ENDIF}
try
Application.Run;
except
debugln('lazarus.pp - unhandled exception');
Halt;
try
Application.Run;
except
debugln('lazarus.pp - unhandled exception');
Halt;
end;
end;
if (SplashForm<>nil) then begin
SplashForm.Free;

View File

@ -963,7 +963,7 @@ type
procedure UnhideIDE; override;
// methods for codetools
procedure InitCodeToolBoss;
function InitCodeToolBoss: boolean;
procedure ActivateCodeToolAbortableMode;
function BeginCodeTools: boolean; override;
function BeginCodeTool(var ActiveSrcEdit: TSourceEditor;
@ -1179,11 +1179,9 @@ begin
AddHelp(['']);
AddHelp(['-v or --version ', lisShowVersionAndExit]);
AddHelp(['']);
{$IFDEF EnableSetupDlg}
AddHelp([ShowSetupDialogOptLong]);
AddHelp([BreakString(space+lisShowSetupDialogForMostImportantSettings, 75, 22)]);
AddHelp(['']);
{$ENDIF}
AddHelp([PrimaryConfPathOptLong, ' <path>']);
AddHelp(['or ', PrimaryConfPathOptShort, ' <path>']);
AddHelp([BreakString(space+lisprimaryConfigDirectoryWhereLazarusStoresItsConfig,
@ -1341,7 +1339,10 @@ begin
SetupCodeMacros;
// setup the code tools
InitCodeToolBoss;
if not InitCodeToolBoss then begin
Application.Terminate;
exit;
end;
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TMainIDE.Create CODETOOLS');{$ENDIF}
// build and position the MainIDE form
@ -13997,13 +13998,16 @@ end;
// -----------------------------------------------------------------------------
procedure TMainIDE.InitCodeToolBoss;
function TMainIDE.InitCodeToolBoss: boolean;
// initialize the CodeToolBoss, which is the frontend for the codetools.
// - sets a basic set of compiler macros
var
AFilename: string;
InteractiveSetup: boolean;
Note: string;
CfgCache: TFPCTargetConfigCache;
begin
Result:=true;
InteractiveSetup:=true;
OpenEditorsOnCodeToolChange:=false;
@ -14036,7 +14040,8 @@ begin
DebugLn(
'NOTE: Lazarus source directory not set! (see Environment / Options ... / Environment / Files)');
end;
if (EnvironmentOptions.FPCSourceDirectory='') then begin
if (EnvironmentOptions.FPCSourceDirectory='') then
begin
// Note: the FPCSourceDirectory can contain the macro FPCVer, which depend
// on the compiler. Do not check if file exists here.
DebugLn('');
@ -14046,15 +14051,27 @@ begin
// create a test unit needed to get from the compiler all macros and search paths
CodeToolBoss.FPCDefinesCache.TestFilename:=CreateCompilerTestPascalFilename;
if ShowSetupDialog and InteractiveSetup then
ShowInitialSetupDialog;
// find the lazarus source directory
SetupLazarusDirectory(InteractiveSetup);
// find the compiler executable
SetupCompilerFilename(InteractiveSetup);
// find the FPC source directory
SetupFPCSourceDirectory(InteractiveSetup);
if InteractiveSetup then
begin
if (not ShowSetupDialog)
and ((CheckLazarusDirectoryQuality(EnvironmentOptions.LazarusDirectory,Note)=sddqInvalid)
or (CheckCompilerQuality(EnvironmentOptions.GetCompilerFilename,Note,
CodeToolBoss.FPCDefinesCache.TestFilename)=sddqInvalid))
then
ShowSetupDialog:=true;
if (not ShowSetupDialog) then
begin
CfgCache:=CodeToolBoss.FPCDefinesCache.ConfigCaches.Find(
EnvironmentOptions.GetCompilerFilename,'','','',true);
if CheckFPCSrcDirQuality(EnvironmentOptions.GetFPCSourceDirectory,Note,
CfgCache.GetFPCVer)=sddqInvalid
then
ShowSetupDialog:=true;
end;
if ShowSetupDialog then
if ShowInitialSetupDialog<>mrOk then
exit(false);
end;
// set global macros
with CodeToolBoss.GlobalValues do begin
@ -14064,6 +14081,7 @@ begin
Variables[ExternalMacroStart+'FPCSrcDir']:=EnvironmentOptions.GetFPCSourceDirectory;
end;
debugln(['TMainIDE.InitCodeToolBoss AAA2']);
// the first template is the "use default" flag
CreateUseDefaultsFlagTemplate;