paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-03 16:39:36 +01:00
Code Issues Packages Projects Releases Wiki Activity

IDE: added compiler check for relative unit paths, missing directories, wrong * character, ambiguous fpc configs, missing fpc config

Browse Source 
git-svn-id: trunk@11529 -
This commit is contained in:
mattias 2007-07-16 21:23:55 +00:00
parent cc56f513ba
commit f03569a3c1
9 changed files with 439 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/codetools/codetoolmanager.pas
View File

@ -21,8 +21,8 @@
Author: Mattias Gaertner
Abstract:
TCodeToolManager gathers all tools in one single Object and makes it easy
to use the code tools in a program.
TCodeToolManager gathers all tools in one single Object
to easily use the code tools in a program.
}
unit CodeToolManager;

5
components/codetools/fpc.errore.msg
View File

@ -29,6 +29,11 @@ general_t_objectpath=01007_T_Using object path: $1
% looks for object files you link in (files used in \var{\{\$L xxx\}} statements).
% You can set this path with the \var{-Fo} option.
option_using_file=11026_T_Reading options from file $1
% Options are also read from this file
% Options are also read from this environment string
option_handling_option=11028_D_Handling option "$1"
# end.

406
ide/checkcompileropts.pas
View File

@ -1,3 +1,23 @@
{
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
unit CheckCompilerOpts;
{$mode objfpc}{$H+}
@ -5,8 +25,9 @@ unit CheckCompilerOpts;
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Buttons, FileUtil,
Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, FileUtil, Process,
KeywordFuncLists, CodeToolManager,
IDEExternToolIntf,
IDEProcs, EnvironmentOpts, LazarusIDEStrConsts,
CompilerOptions, ExtToolEditDlg, TransferMacros, LazConf;
@ -15,17 +36,18 @@ type
TCompilerOptionsTest = (
cotNone,
cotCheckCompilerExe,
cotCompileBogusFiles
cotCompileBogusFiles,
cotCheckCompilerConfig // e.g. fpc.cfg
);
{ TCheckCompilerOptsDlg }
TCheckCompilerOptsDlg = class(TForm)
CloseButton1: TBitBtn;
TestMemo: TMEMO;
TestGroupbox: TGROUPBOX;
OutputListbox: TLISTBOX;
OutputGroupBox: TGROUPBOX;
TestMemo: TMemo;
TestGroupbox: TGroupBox;
OutputListbox: TListbox;
OutputGroupBox: TGroupBox;
procedure ApplicationOnIdle(Sender: TObject; var Done: Boolean);
procedure CloseButtonCLICK(Sender: TObject);
private
@ -37,6 +59,11 @@ type
procedure SetMacroList(const AValue: TTransferMacroList);
procedure SetOptions(const AValue: TCompilerOptions);
procedure SetMsgDirectory(Index: integer; const CurDir: string);
function CheckCompilerExecutable(const CompilerFilename: string): TModalResult;
function CheckAmbiguousFPCCfg(const CompilerFilename: string): TModalResult;
function CheckCompilerConfig(const CompilerFilename: string;
out FPCCfgUnitPath: string): TModalResult;
function CheckCompileBogusFile(const CompilerFilename: string): TModalResult;
public
function DoTest: TModalResult;
constructor Create(TheOwner: TComponent); override;
@ -46,6 +73,8 @@ type
OriginalIndex: integer);
procedure AddMsg(const Msg, CurDir: String; OriginalIndex: integer);
procedure AddProgress(Line: TIDEScanMessageLine);
procedure AddHint(const Msg: string);
procedure AddWarning(const Msg: string);
public
property Options: TCompilerOptions read FOptions write SetOptions;
property Test: TCompilerOptionsTest read FTest;
@ -85,6 +114,273 @@ begin
FDirectories[Index]:=CurDir;
end;
function TCheckCompilerOptsDlg.CheckCompilerExecutable(
const CompilerFilename: string): TModalResult;
var
CompilerFiles: TStrings;
begin
FTest:=cotCheckCompilerExe;
TestGroupbox.Caption:='Test: Checking compiler ...';
try
CheckIfFileIsExecutable(CompilerFilename);
except
on e: Exception do begin
Result:=QuestionDlg('Invalid compiler',
'The compiler "'+CompilerFilename+'" is not an executable file.'#13
+'Details: '+E.Message,
mtError,[mrCancel,'Skip',mrAbort],0);
exit;
end;
end;
// check if there are several compilers in path
CompilerFiles:=SearchAllFilesInPath(GetDefaultCompilerFilename,'',
SysUtils.GetEnvironmentVariable('PATH'),':',[sffDontSearchInBasePath]);
if (CompilerFiles<>nil) and (CompilerFiles.Count>1) then begin
Result:=MessageDlg('Ambiguous Compiler',
'There are several FreePascal Compilers in your path.'#13#13
+CompilerFiles.Text+#13
+'Maybe you forgot to delete an old compiler?',
mtWarning,[mbCancel,mbIgnore],0);
if Result<>mrIgnore then exit;
end;
Result:=mrOk;
end;
function TCheckCompilerOptsDlg.CheckAmbiguousFPCCfg(
const CompilerFilename: string): TModalResult;
var
CfgFiles: TStringList;
Dir: String;
Filename: String;
i: Integer;
begin
CfgFiles:=TStringList.Create;
// check $HOME/.fpc.cfg
Dir:=SysUtils.GetEnvironmentVariable('HOME');
if Dir<>'' then begin
Filename:=CleanAndExpandDirectory(Dir)+'.fpc.cfg';
if FileExists(Filename) then
CfgFiles.Add(Filename);
end;
// check compiler path + fpc.cfg
Dir:=ExtractFilePath(CompilerFilename);
Dir:=SysUtils.GetEnvironmentVariable('HOME');
if Dir<>'' then begin
Filename:=CleanAndExpandDirectory(Dir)+'fpc.cfg';
if FileExists(Filename) then
CfgFiles.Add(Filename);
end;
// check /etc/fpc.cfg
{$IFDEF Unix}
Dir:=ExtractFilePath(CompilerFilename);
Dir:=SysUtils.GetEnvironmentVariable('HOME');
if Dir<>'' then begin
Filename:='/etc/fpc.cfg';
if FileExists(Filename) then
CfgFiles.Add(Filename);
end;
{$ENDIF}
// warn about missing or too many fpc.cfg
if CfgFiles.Count<1 then begin
AddWarning('no fpc.cfg found');
end else if CfgFiles.Count>1 then begin
for i:=0 to CfgFiles.Count-1 do
AddWarning('multiple compiler configs found: '+CfgFiles[i]);
end;
CfgFiles.Free;
Result:=mrOk;
end;
function TCheckCompilerOptsDlg.CheckCompileBogusFile(
const CompilerFilename: string): TModalResult;
var
TestDir: String;
BogusFilename: String;
CmdLineParams: String;
CompileTool: TExternalToolOptions;
begin
// compile bogus file
FTest:=cotCompileBogusFiles;
TestGroupbox.Caption:='Test: Compiling an empty file ...';
// get Test directory
TestDir:=AppendPathDelim(EnvironmentOptions.TestBuildDirectory);
if not DirPathExists(TestDir) then begin
MessageDlg('Invalid Test Directory',
'Please check the Test directory under'#13
+'Environment -> Environment Options -> Files -> Directory for building test projects',
mtError,[mbCancel],0);
Result:=mrCancel;
exit;
end;
// create bogus file
BogusFilename:=CreateNonExistingFilename(TestDir+'testcompileroptions.pas');
if not CreateEmptyFile(BogusFilename) then begin
MessageDlg('Unable to create Test File',
'Unable to create Test pascal file "'+BogusFilename+'".',
mtError,[mbCancel],0);
Result:=mrCancel;
exit;
end;
try
// create compiler command line options
CmdLineParams:=Options.MakeOptionsString(BogusFilename,nil,
[ccloAddVerboseAll,ccloDoNotAppendOutFileOption])
+' '+BogusFilename;
CompileTool:=TExternalToolOptions.Create;
CompileTool.Title:='Test: Compiling empty file';
CompileTool.ScanOutputForFPCMessages:=true;
CompileTool.ScanOutputForMakeMessages:=true;
CompileTool.WorkingDirectory:=TestDir;
CompileTool.Filename:=CompilerFilename;
CompileTool.CmdLineParams:=CmdLineParams;
Result:=RunTool(CompileTool);
FreeThenNil(CompileTool);
finally
DeleteFile(BogusFilename);
end;
Result:=mrOk;
end;
function TCheckCompilerOptsDlg.CheckCompilerConfig(
const CompilerFilename: string; out FPCCfgUnitPath: string): TModalResult;
procedure ProcessOutputLine(const Line: string);
const
USING_UNIT_PATH = 'USING UNIT PATH: ';
READING_OPTIONS_FROM_FILE = 'READING OPTIONS FROM FILE ';
HANDLING_OPTION = 'HANDLING OPTION ';
var
len, curpos: integer;
NewPath: String;
UpLine: String;
begin
len := length(Line);
if len <= 6 then Exit; // shortest match
CurPos := 1;
// strip timestamp e.g. [0.306]
if Line[CurPos] = '[' then begin
repeat
inc(CurPos);
if CurPos > len then Exit;
until line[CurPos] = ']';
Inc(CurPos, 2); //skip space also
if len - CurPos < 6 then Exit; // shortest match
end;
UpLine:=UpperCaseStr(Line);
case UpLine[CurPos] of
'C':
if (StrLComp(@UpLine[CurPos], READING_OPTIONS_FROM_FILE,
length(READING_OPTIONS_FROM_FILE)) = 0) then
begin
// show a hint what cfg file is read by FPC
AddHint(Line);
end;
'U':
if (StrLComp(@UpLine[CurPos], USING_UNIT_PATH, length(USING_UNIT_PATH)) = 0)
then begin
Inc(CurPos, length(USING_UNIT_PATH));
NewPath:=copy(Line,CurPos,len);
if not FilenameIsAbsolute(NewPath) then begin
AddWarning('relative unit path found in fpc cfg: '+NewPath);
NewPath:=ExpandFileName(NewPath);
end;
//DebugLn(['TCheckCompilerOptsDlg.CheckCompilerConfig: Using unit path: "',NewPath,'"']);
FPCCfgUnitPath:=FPCCfgUnitPath+NewPath+';';
end;
end;
end;
var
TestDir: String;
ATestPascalFile: String;
CurCompilerOptions: String;
TargetOS: String;
TargetCPU: String;
OutputLine: String;
TheProcess: TProcess;
OutLen: Integer;
LineStart: integer;
i: Integer;
CmdLine: string;
Buf: string;
begin
FPCCfgUnitPath:='';
FTest:=cotCheckCompilerConfig;
TestGroupbox.Caption:='Test: Checking compiler configuration ...';
Result:=CheckAmbiguousFPCCfg(CompilerFilename);
if not (Result in [mrOk,mrIgnore]) then exit;
TestDir:=AppendPathDelim(EnvironmentOptions.TestBuildDirectory);
ATestPascalFile:=CreateNonExistingFilename(TestDir+'testcompileroptions.pas');
CurCompilerOptions:='';
TargetOS:=Options.TargetOS;
if TargetOS<>'' then
CurCompilerOptions:=AddCmdLineParameter(CurCompilerOptions,'-T'+TargetOS);
TargetCPU:=Options.TargetCPU;
if TargetCPU<>'' then
CurCompilerOptions:=AddCmdLineParameter(CurCompilerOptions,'-P'+TargetCPU);
CmdLine:=CompilerFilename+' -va ';
if FileExistsCached(CodeToolBoss.DefinePool.EnglishErrorMsgFilename) then
CmdLine:=CmdLine+'-Fr'+CodeToolBoss.DefinePool.EnglishErrorMsgFilename+' ';
if CurCompilerOptions<>'' then
CmdLine:=CmdLine+CurCompilerOptions+' ';
CmdLine:=CmdLine+ATestPascalFile;
TheProcess := TProcess.Create(nil);
TheProcess.CommandLine := CmdLine;
TheProcess.Options:= [poUsePipes, poStdErrToOutPut];
TheProcess.ShowWindow := swoHide;
try
TheProcess.Execute;
OutputLine:='';
SetLength(Buf,1024);
repeat
if (TheProcess.Output<>nil) then begin
OutLen:=TheProcess.Output.Read(Buf[1],length(Buf));
end else
OutLen:=0;
LineStart:=1;
i:=1;
while i<=OutLen do begin
if Buf[i] in [#10,#13] then begin
OutputLine:=OutputLine+copy(Buf,LineStart,i-LineStart);
ProcessOutputLine(OutputLine);
OutputLine:='';
if (i<OutLen) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[i+1])
then
inc(i);
LineStart:=i+1;
end;
inc(i);
end;
OutputLine:=copy(Buf,LineStart,OutLen-LineStart+1);
until OutLen=0;
TheProcess.WaitOnExit;
finally
//DebugLn('TDefinePool.CreateFPCTemplate Run with -va: OutputLine="',OutputLine,'"');
TheProcess.Free;
end;
Result:=mrOk;
end;
procedure TCheckCompilerOptsDlg.SetMacroList(const AValue: TTransferMacroList);
begin
if FMacroList=AValue then exit;
@ -93,12 +389,10 @@ end;
function TCheckCompilerOptsDlg.DoTest: TModalResult;
var
TestDir: String;
BogusFilename: String;
CompilerFilename: String;
CompileTool: TExternalToolOptions;
CmdLineParams: String;
CompilerFiles: TStrings;
FPCCfgUnitPath: string;
begin
Result:=mrCancel;
if Test<>cotNone then exit;
@ -106,77 +400,24 @@ begin
TestMemo.Lines.Clear;
CompilerFiles:=nil;
try
// check compiler filename
FTest:=cotCheckCompilerExe;
TestGroupbox.Caption:='Test: Checking compiler ...';
CompilerFilename:=Options.ParsedOpts.GetParsedValue(pcosCompilerPath);
try
CheckIfFileIsExecutable(CompilerFilename);
except
on e: Exception do begin
Result:=MessageDlg('Invalid compiler',
'The compiler "'+CompilerFilename+'" is not an executable file.',
mtError,[mbCancel,mbAbort],0);
exit;
end;
end;
// check if there are several compilers in path
CompilerFiles:=SearchAllFilesInPath(GetDefaultCompilerFilename,'',
SysUtils.GetEnvironmentVariable('PATH'),':',[sffDontSearchInBasePath]);
if (CompilerFiles<>nil) and (CompilerFiles.Count>1) then begin
Result:=MessageDlg('Ambiguous Compiler',
'There are several FreePascal Compilers in your path.'#13#13
+CompilerFiles.Text+#13
+'Maybe you forgot to delete an old compiler?',
mtWarning,[mbCancel,mbIgnore],0);
if Result<>mrIgnore then exit;
end;
// check compiler filename
Result:=CheckCompilerExecutable(CompilerFilename);
if not (Result in [mrOk,mrIgnore]) then exit;
// TODO: compiler check: check if compiler paths includes base units
// TODO: compiler check: check if compiler is older than fpc units (ppu version)
Result:=CheckCompilerConfig(CompilerFilename,FPCCfgUnitPath);
if not (Result in [mrOk,mrIgnore]) then exit;
// compile bogus file
FTest:=cotCompileBogusFiles;
TestGroupbox.Caption:='Test: Compiling an empty file ...';
// get Test directory
TestDir:=AppendPathDelim(EnvironmentOptions.TestBuildDirectory);
if not DirPathExists(TestDir) then begin
MessageDlg('Invalid Test Directory',
'Please check the Test directory under'#13
+'Environment -> Environment Options -> Files -> Directory for building test projects',
mtError,[mbCancel],0);
Result:=mrCancel;
exit;
end;
// create bogus file
BogusFilename:=CreateNonExistingFilename(TestDir+'testcompileroptions.pas');
if not CreateEmptyFile(BogusFilename) then begin
MessageDlg('Unable to create Test File',
'Unable to create Test pascal file "'+BogusFilename+'".',
mtError,[mbCancel],0);
Result:=mrCancel;
exit;
end;
try
// create compiler command line options
CmdLineParams:=Options.MakeOptionsString(BogusFilename,nil,
[ccloAddVerboseAll,ccloDoNotAppendOutFileOption])
+' '+BogusFilename;
Result:=CheckCompileBogusFile(CompilerFilename);
if not (Result in [mrOk,mrIgnore]) then exit;
CompileTool:=TExternalToolOptions.Create;
CompileTool.Title:='Test: Compiling empty file';
CompileTool.ScanOutputForFPCMessages:=true;
CompileTool.ScanOutputForMakeMessages:=true;
CompileTool.WorkingDirectory:=TestDir;
CompileTool.Filename:=CompilerFilename;
CompileTool.CmdLineParams:=CmdLineParams;
Result:=RunTool(CompileTool);
FreeThenNil(CompileTool);
finally
DeleteFile(BogusFilename);
end;
// TODO: compiler check: check if compiler is older than fpc units (ppu version)
// TODO: compiler check: check if there are ambiguous fpc ppu
finally
CompilerFiles.Free;
@ -184,6 +425,7 @@ begin
FTest:=cotNone;
TestGroupbox.Caption:='Test';
end;
Result:=mrOk;
end;
constructor TCheckCompilerOptsDlg.Create(TheOwner: TComponent);
@ -210,7 +452,7 @@ procedure TCheckCompilerOptsDlg.Add(const Msg, CurDir: String;
ProgressLine: boolean; OriginalIndex: integer);
var
i: Integer;
Begin
begin
if FLastLineIsProgress then begin
OutputListbox.Items[OutputListbox.Items.Count-1]:=Msg;
end else begin
@ -234,6 +476,16 @@ begin
Add(Line.Line,Line.WorkingDirectory,false,Line.LineNumber);
end;
procedure TCheckCompilerOptsDlg.AddHint(const Msg: string);
begin
Add('HINT: '+Msg,'',false,-1);
end;
procedure TCheckCompilerOptsDlg.AddWarning(const Msg: string);
begin
Add('WARNING: '+Msg,'',false,-1);
end;
initialization
{$I checkcompileropts.lrs}

28
ide/compileroptions.pp
View File

@ -63,6 +63,7 @@ type
type
TInheritedCompilerOption = (
icoNone,
icoUnitPath,
icoIncludePath,
icoObjectPath,
@ -83,6 +84,7 @@ type
{ TParsedCompilerOptions }
TParsedCompilerOptString = (
pcosNone,
pcosBaseDir, // the base directory for the relative paths
pcosUnitPath, // search path for pascal units
pcosIncludePath, // search path for pascal include files
@ -108,6 +110,7 @@ const
ParsedCompilerSearchPaths+ParsedCompilerFilenames+ParsedCompilerDirectories;
ParsedCompilerOptStringNames: array[TParsedCompilerOptString] of string = (
'pcosNone',
'pcosBaseDir',
'pcosUnitPath',
'pcosIncludePath',
@ -123,6 +126,7 @@ const
InheritedToParsedCompilerOption: array[TInheritedCompilerOption] of
TParsedCompilerOptString = (
pcosNone,
pcosUnitPath, // icoUnitPath,
pcosIncludePath, // icoIncludePath,
pcosObjectPath, // icoObjectPath,
@ -608,6 +612,7 @@ begin
CurOptions:=InheritedOptionStrings[o];
case o of
icoNone: ;
icoUnitPath,icoIncludePath,icoSrcPath,icoObjectPath,icoLibraryPath:
begin
if CurOptions<>'' then
@ -1551,17 +1556,19 @@ begin
{$ENDIF}
// inherited path
InheritedPath:=GetInheritedOption(InheritedOption,RelativeToBaseDir,coptParsed);
{$IFDEF VerbosePkgUnitPath}
if Option=pcosUnitPath then
debugln('TBaseCompilerOptions.GetParsedPath Inherited ',dbgsName(Self),' InheritedPath="',InheritedPath,'"');
{$ENDIF}
if InheritedOption<>icoNone then begin
InheritedPath:=GetInheritedOption(InheritedOption,RelativeToBaseDir,coptParsed);
{$IFDEF VerbosePkgUnitPath}
if Option=pcosUnitPath then
debugln('TBaseCompilerOptions.GetParsedPath Inherited ',dbgsName(Self),' InheritedPath="',InheritedPath,'"');
{$ENDIF}
Result:=MergeSearchPaths(CurrentPath,InheritedPath);
{$IFDEF VerbosePkgUnitPath}
if Option=pcosUnitPath then
debugln('TBaseCompilerOptions.GetParsedPath Total ',dbgsName(Self),' Result="',Result,'"');
{$ENDIF}
Result:=MergeSearchPaths(CurrentPath,InheritedPath);
{$IFDEF VerbosePkgUnitPath}
if Option=pcosUnitPath then
debugln('TBaseCompilerOptions.GetParsedPath Total ',dbgsName(Self),' Result="',Result,'"');
{$ENDIF}
end;
end;
function TBaseCompilerOptions.GetParsedPIPath(Option: TParsedCompilerOptString;
@ -2734,6 +2741,7 @@ function TAdditionalCompilerOptions.GetOption(AnOption: TInheritedCompilerOption
): string;
begin
case AnOption of
icoNone: Result:='';
icoUnitPath: Result:=UnitPath;
icoIncludePath: Result:=IncludePath;
icoObjectPath: Result:=ObjectPath;

72
ide/compileroptionsdlg.pp
View File

@ -45,6 +45,14 @@ uses
type
{ Compiler options form }
TCheckCompileOptionsMsgLvl = (
ccomlHints,
ccomlWarning,
ccomlErrors,
ccomlNone
);
{ TfrmCompilerOptions }
@ -281,8 +289,8 @@ type
procedure GetCompilerOptions;
procedure GetCompilerOptions(SrcCompilerOptions: TBaseCompilerOptions);
function PutCompilerOptions(CheckAndWarn: boolean): boolean;
function PutCompilerOptions(CheckAndWarn: boolean;
function PutCompilerOptions(CheckAndWarn: TCheckCompileOptionsMsgLvl): boolean;
function PutCompilerOptions(CheckAndWarn: TCheckCompileOptionsMsgLvl;
DestCompilerOptions: TBaseCompilerOptions): boolean;
public
property ReadOnly: boolean read FReadOnly write SetReadOnly;
@ -405,7 +413,7 @@ begin
Assert(False, 'Trace:Accept compiler options changes');
{ Save the options and hide the dialog }
if not PutCompilerOptions(true) then exit;
if not PutCompilerOptions(ccomlErrors) then exit;
ModalResult:=mrOk;
end;
@ -415,7 +423,7 @@ end;
procedure TfrmCompilerOptions.btnTestClicked(Sender: TObject);
begin
// Apply any changes and test
PutCompilerOptions(true);
if not PutCompilerOptions(ccomlHints) then exit;
if Assigned(OnTest) then begin
btnCheck.Enabled:=false;
try
@ -434,7 +442,7 @@ end;
procedure TfrmCompilerOptions.ButtonShowOptionsClicked(Sender: TObject);
begin
// Test MakeOptionsString function
PutCompilerOptions(true);
if not PutCompilerOptions(ccomlWarning) then exit;
ShowCompilerOptionsDialog(CompilerOpts);
end;
@ -735,10 +743,11 @@ begin
end;
end;
{------------------------------------------------------------------------------}
{ TfrmCompilerOptions PutCompilerOptions }
{------------------------------------------------------------------------------}
function TfrmCompilerOptions.PutCompilerOptions(CheckAndWarn: boolean;
{------------------------------------------------------------------------------
TfrmCompilerOptions PutCompilerOptions
------------------------------------------------------------------------------}
function TfrmCompilerOptions.PutCompilerOptions(
CheckAndWarn: TCheckCompileOptionsMsgLvl;
DestCompilerOptions: TBaseCompilerOptions): boolean;
function MakeCompileReasons(const ACompile, ABuild, ARun: TCheckBox): TCompileReasons;
@ -748,6 +757,34 @@ function TfrmCompilerOptions.PutCompilerOptions(CheckAndWarn: boolean;
if ABuild.Checked then Include(Result, crBuild);
if ARun.Checked then Include(Result, crRun);
end;
function CheckSearchPath(const Context, ExpandedPath: string): boolean;
var
CurPath: String;
p: Integer;
begin
Result:=false;
if ord(CheckAndWarn)<=ord(ccomlHints) then begin
if System.Pos('*',ExpandedPath)>0 then begin
if MessageDlg('Warning','The '+Context+' contains a star * character.'#13
+'Lazarus uses this as normal character and does not expand them as file mask.',
mtWarning,[mbOk,mbCancel],0) <> mrOk then exit;
end;
p:=0;
repeat
DebugLn(['CheckSearchPath ',ExpandedPath,' ',p,' ',length(ExpandedPath)]);
CurPath:=GetNextDirectoryInSearchPath(ExpandedPath,p);
if CurPath<>'' then begin
if not DirPathExistsCached(CurPath) then begin
if MessageDlg('Warning','The '+Context+' contains a not existing directory:'#13
+CurPath,
mtWarning,[mbIgnore,mbCancel],0) <> mrIgnore then exit;
end;
end;
until p>length(ExpandedPath);
end;
Result:=true;
end;
var
code: LongInt;
@ -775,7 +812,7 @@ begin
NewCustomConfigFile:=chkCustomConfigFile.Checked;
NewConfigFilePath:=edtConfigPath.Text;
if CheckAndWarn then begin
if ord(CheckAndWarn)<=ord(ccomlWarning) then begin
if ((NewDontUseConfigFile<>Options.DontUseConfigFile)
or (NewCustomConfigFile<>Options.CustomConfigFile)
or (NewConfigFilePath<>Options.ConfigFilePath))
@ -805,11 +842,23 @@ begin
// paths
Options.IncludePath := edtIncludeFiles.Text;
if not CheckSearchPath('include search path',Options.GetIncludePath(false)) then
exit(false);
Options.Libraries := edtLibraries.Text;
if not CheckSearchPath('library search path',Options.GetLibraryPath(false)) then
exit(false);
Options.OtherUnitFiles := edtOtherUnits.Text;
if not CheckSearchPath('unit search path',Options.GetUnitPath(false)) then
exit(false);
Options.SrcPath := edtOtherSources.Text;
if not CheckSearchPath('source search path',Options.GetSrcPath(false)) then
exit(false);
Options.UnitOutputDirectory := edtUnitOutputDir.Text;
Options.DebugPath := edtDebugPath.Text;
if not CheckSearchPath('debugger search path',
Options.GetParsedPath(pcosDebugPath,icoNone,false))
then
exit(false);
i:=LCLWidgetTypeComboBox.Itemindex;
if i<=0 then
@ -979,7 +1028,8 @@ begin
OldCompOpts.Free;
end;
function TfrmCompilerOptions.PutCompilerOptions(CheckAndWarn: boolean): boolean;
function TfrmCompilerOptions.PutCompilerOptions(
CheckAndWarn: TCheckCompileOptionsMsgLvl): boolean;
begin
Result:=PutCompilerOptions(CheckAndWarn,nil);
end;

24
ide/ideprocs.pp
View File

@ -581,16 +581,20 @@ var
CurStartPos: Integer;
begin
PathLen:=length(SearchPath);
repeat
while (NextStartPos<=PathLen)
and (SearchPath[NextStartPos] in [';',#0..#32]) do
inc(NextStartPos);
CurStartPos:=NextStartPos;
while (NextStartPos<=PathLen) and (SearchPath[NextStartPos]<>';') do
inc(NextStartPos);
Result:=TrimFilename(copy(SearchPath,CurStartPos,NextStartPos-CurStartPos));
if Result<>'' then exit;
until (NextStartPos>PathLen);
if PathLen>0 then begin
repeat
while (NextStartPos<=PathLen)
and (SearchPath[NextStartPos] in [';',#0..#32]) do
inc(NextStartPos);
CurStartPos:=NextStartPos;
while (NextStartPos<=PathLen) and (SearchPath[NextStartPos]<>';') do
inc(NextStartPos);
Result:=TrimFilename(copy(SearchPath,CurStartPos,NextStartPos-CurStartPos));
if Result<>'' then exit;
until (NextStartPos>PathLen);
end else begin
NextStartPos:=1;
end;
Result:='';
end;

10
ide/imexportcompileropts.pas
View File

@ -79,9 +79,9 @@ type
function ShowImExportCompilerOptionsDialog(
CompOpts: TBaseCompilerOptions; var Filename: string): TImExportCompOptsResult;
function DoImportComilerOptions(CompOptsDialog: TfrmCompilerOptions;
function DoImportCompilerOptions(CompOptsDialog: TfrmCompilerOptions;
CompilerOpts: TBaseCompilerOptions; const Filename: string): TModalResult;
function DoExportComilerOptions(CompOptsDialog: TfrmCompilerOptions;
function DoExportCompilerOptions(CompOptsDialog: TfrmCompilerOptions;
CompilerOpts: TBaseCompilerOptions; const Filename: string): TModalResult;
function GetXMLPathForCompilerOptions(XMLConfig: TXMLConfig): string;
function ReadIntFromXMLConfig(const Filename, Path: string;
@ -104,7 +104,7 @@ begin
ImExportCompOptsDlg.Free;
end;
function DoImportComilerOptions(CompOptsDialog: TfrmCompilerOptions;
function DoImportCompilerOptions(CompOptsDialog: TfrmCompilerOptions;
CompilerOpts: TBaseCompilerOptions; const Filename: string): TModalResult;
var
XMLConfig: TXMLConfig;
@ -138,7 +138,7 @@ begin
end;
end;
function DoExportComilerOptions(CompOptsDialog: TfrmCompilerOptions;
function DoExportCompilerOptions(CompOptsDialog: TfrmCompilerOptions;
CompilerOpts: TBaseCompilerOptions; const Filename: string): TModalResult;
var
XMLConfig: TXMLConfig;
@ -149,7 +149,7 @@ begin
if (CompOptsDialog<>nil) then begin
CompilerOpts:=TBaseCompilerOptions.Create(nil);
FreeCompilerOpts:=true;
CompOptsDialog.PutCompilerOptions(true,CompilerOpts);
CompOptsDialog.PutCompilerOptions(ccomlNone,CompilerOpts);
end;
try
Result:=mrCancel;

8
ide/main.pp
View File

@ -7582,11 +7582,11 @@ begin
CompOptsDialog.CompilerOpts,Filename);
if (ImExportResult=iecorCancel) or (Filename='') then exit;
if ImExportResult=iecorImport then
Result:=DoImportComilerOptions(CompOptsDialog,CompOptsDialog.CompilerOpts,
Filename)
Result:=DoImportCompilerOptions(CompOptsDialog,CompOptsDialog.CompilerOpts,
Filename)
else if ImExportResult=iecorExport then
Result:=DoExportComilerOptions(CompOptsDialog,CompOptsDialog.CompilerOpts,
Filename);
Result:=DoExportCompilerOptions(CompOptsDialog,CompOptsDialog.CompilerOpts,
Filename);
end;
function TMainIDE.DoShowProjectInspector: TModalResult;

2
lcl/interfaces/gtk/gtk1extra.inc
View File

@ -271,7 +271,7 @@ end;
procedure GDK_WINDOW_SHOW_IN_TASKBAR(Window: PGdkWindowPrivate; Show: Boolean);
// this is a try to hide windows from the taskbar.
// Unpleasantly, some windowmangers like metacity also hides form the Alt-Tab
// Unpleasantly, some windowmangers like metacity also hides from the Alt-Tab
// cycle.
// This feature is therefore disabled on default.
{$IFDEF EnableHideFromTaskBar}