mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-01 22:40:27 +02:00
Merged revision(s) 59041-59044 #aaef9c6884-#aaef9c6884 from trunk:
IDE: Use safe typecast for TProjectCompilationToolOptions when building project. ........ Revert r59006 #b06f6da4af "IdeIntf: Add API for ExecuteCommand in CompOptsIntf." Must be done better. ........ IdeIntf: A new interface class TLazCompilationToolOptions with a Command and CompileReasons. Issue #34283. ........ IdeIntf: Improve the CompilationTool stuff. Remove and clean code. Issue #34283. ........ git-svn-id: branches/fixes_2_0@59097 -
This commit is contained in:
maxim
parent
9849f88090
commit
a0b6a9e8c9
@ -18,7 +18,7 @@ interface
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
// LazUtils
|
||||
LazMethodList,
|
||||
LazMethodList, LazFileCache,
|
||||
// IdeIntf
|
||||
IDEOptionsIntf;
|
||||
|
||||
@ -116,6 +116,31 @@ const
|
||||
crAll = [crCompile, crBuild, crRun];
|
||||
|
||||
type
|
||||
{ TLazCompilationToolOptions }
|
||||
|
||||
TLazCompilationToolOptions = class
|
||||
private
|
||||
FOwner: TObject;
|
||||
FChangeStamp: int64;
|
||||
FCommand: string;
|
||||
FOnChanged: TNotifyEvent;
|
||||
procedure SetCommand(AValue: string);
|
||||
protected
|
||||
FCompileReasons: TCompileReasons;
|
||||
procedure SetCompileReasons(const {%H-}AValue: TCompileReasons); virtual;
|
||||
public
|
||||
constructor Create(TheOwner: TObject); virtual;
|
||||
procedure Clear; virtual;
|
||||
procedure Assign(Src: TLazCompilationToolOptions); virtual;
|
||||
procedure IncreaseChangeStamp;
|
||||
public
|
||||
property Owner: TObject read FOwner;
|
||||
property ChangeStamp: int64 read FChangeStamp;
|
||||
property Command: string read FCommand write SetCommand;
|
||||
property CompileReasons: TCompileReasons read FCompileReasons write SetCompileReasons;
|
||||
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
|
||||
end;
|
||||
|
||||
{ TLazCompilerOptions }
|
||||
|
||||
TLazCompilerOptions = class(TAbstractIDEOptions)
|
||||
@ -271,6 +296,10 @@ type
|
||||
// Turn specific types of compiler messages on or off
|
||||
fMessageFlags: TAbstractCompilerMsgIDFlags;
|
||||
|
||||
// Other tools:
|
||||
fExecuteBefore: TLazCompilationToolOptions;
|
||||
fExecuteAfter: TLazCompilationToolOptions;
|
||||
|
||||
// Other:
|
||||
fDontUseConfigFile: Boolean;
|
||||
fCustomConfigFile: Boolean;
|
||||
@ -288,8 +317,6 @@ type
|
||||
function GetSrcPath: string; virtual; abstract;
|
||||
function GetUnitOutputDir: string; virtual; abstract;
|
||||
function GetUnitPaths: String; virtual; abstract;
|
||||
function GetExecuteBeforeCommand: string; virtual; abstract;
|
||||
function GetExecuteAfterCommand: string; virtual; abstract;
|
||||
procedure SetCompilerPath(const AValue: String); virtual; abstract;
|
||||
procedure SetConditionals(AValue: string); virtual; abstract;
|
||||
procedure SetCustomOptions(const AValue: string); virtual; abstract;
|
||||
@ -308,8 +335,6 @@ type
|
||||
procedure SetTargetProc(const AValue: string); virtual; abstract;
|
||||
procedure SetUnitOutputDir(const AValue: string); virtual; abstract;
|
||||
procedure SetUnitPaths(const AValue: String); virtual; abstract;
|
||||
procedure SetExecuteBeforeCommand(const ACommand: string); virtual; abstract;
|
||||
procedure SetExecuteAfterCommand(const ACommand: string); virtual; abstract;
|
||||
public
|
||||
constructor Create(const TheOwner: TObject); virtual;
|
||||
destructor Destroy; override;
|
||||
@ -444,7 +469,9 @@ type
|
||||
property WriteFPCLogo: Boolean read fWriteFPCLogo write SetWriteFPCLogo;
|
||||
property StopAfterErrCount: integer read fStopAfterErrCount write SetStopAfterErrCount;
|
||||
property MessageFlags: TAbstractCompilerMsgIDFlags read fMessageFlags;
|
||||
|
||||
// other tools
|
||||
property ExecuteBefore: TLazCompilationToolOptions read fExecuteBefore;
|
||||
property ExecuteAfter: TLazCompilationToolOptions read fExecuteAfter;
|
||||
// other
|
||||
property DontUseConfigFile: Boolean read fDontUseConfigFile write SetDontUseConfigFile;
|
||||
property CustomConfigFile: Boolean read fCustomConfigFile write SetCustomConfigFile;
|
||||
@ -454,13 +481,52 @@ type
|
||||
write SetUseCommentsInCustomOptions;
|
||||
// execute
|
||||
property CompilerPath: String read GetCompilerPath write SetCompilerPath;
|
||||
property ExecuteBeforeCommand: String read GetExecuteBeforeCommand write SetExecuteBeforeCommand;
|
||||
property ExecuteAfterCommand: String read GetExecuteAfterCommand write SetExecuteAfterCommand;
|
||||
procedure SetAlternativeCompile(const Command: string; ScanFPCMsgs: boolean); virtual; abstract; // disable normal compile and call this instead
|
||||
// disable normal compile and call this instead
|
||||
procedure SetAlternativeCompile(const Command: string; ScanFPCMsgs: boolean); virtual; abstract;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TLazCompilationToolOptions }
|
||||
|
||||
constructor TLazCompilationToolOptions.Create(TheOwner: TObject);
|
||||
begin
|
||||
FOwner:=TheOwner;
|
||||
FCompileReasons:=crAll; // This default can be used in some comparisons.
|
||||
end;
|
||||
|
||||
procedure TLazCompilationToolOptions.Clear;
|
||||
begin
|
||||
Command:='';
|
||||
FCompileReasons := crAll;
|
||||
end;
|
||||
|
||||
procedure TLazCompilationToolOptions.Assign(Src: TLazCompilationToolOptions);
|
||||
begin
|
||||
Command:=Src.Command;
|
||||
FCompileReasons := Src.CompileReasons;
|
||||
end;
|
||||
|
||||
procedure TLazCompilationToolOptions.IncreaseChangeStamp;
|
||||
begin
|
||||
LUIncreaseChangeStamp64(FChangeStamp);
|
||||
if Assigned(OnChanged) then
|
||||
OnChanged(Self);
|
||||
end;
|
||||
|
||||
procedure TLazCompilationToolOptions.SetCommand(AValue: string);
|
||||
begin
|
||||
if FCommand=AValue then exit;
|
||||
FCommand:=AValue;
|
||||
IncreaseChangeStamp;
|
||||
end;
|
||||
|
||||
procedure TLazCompilationToolOptions.SetCompileReasons(const AValue: TCompileReasons);
|
||||
begin
|
||||
raise Exception.Create('TLazCompilationToolOptions does not support CompileReasons.'
|
||||
+' Use an inherited class instead.');
|
||||
end;
|
||||
|
||||
{ TLazBuildMacros }
|
||||
|
||||
constructor TLazBuildMacros.Create(TheOwner: TObject);
|
||||
|
||||
@ -333,42 +333,32 @@ type
|
||||
|
||||
{ TCompilationToolOptions }
|
||||
|
||||
TCompilationToolOptions = class
|
||||
TCompilationToolOptions = class(TLazCompilationToolOptions)
|
||||
private
|
||||
FChangeStamp: int64;
|
||||
FCommand: string;
|
||||
FOnChanged: TNotifyEvent;
|
||||
FOwner: TObject;
|
||||
FParsers: TStrings;
|
||||
FParsedCommandStamp: integer;
|
||||
FParsedCommand: string;
|
||||
function GetHasParser(aParserName: string): boolean;
|
||||
procedure SetCommand(const AValue: string);
|
||||
procedure SetHasParser(aParserName: string; const AValue: boolean);
|
||||
procedure SetParsers(const AValue: TStrings);
|
||||
protected
|
||||
procedure SubstituteMacros(var s: string); virtual;
|
||||
public
|
||||
constructor Create(TheOwner: TObject); virtual;
|
||||
constructor Create(TheOwner: TObject); override;
|
||||
destructor Destroy; override;
|
||||
procedure Clear; virtual;
|
||||
procedure Clear; override;
|
||||
function CreateDiff(CompOpts: TCompilationToolOptions;
|
||||
Tool: TCompilerDiffTool = nil): boolean; virtual;
|
||||
procedure Assign(Src: TCompilationToolOptions); virtual;
|
||||
procedure Assign(Src: TLazCompilationToolOptions); override;
|
||||
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
||||
DoSwitchPathDelims: boolean); virtual;
|
||||
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
||||
UsePathDelim: TPathDelimSwitch); virtual;
|
||||
function Execute(const WorkingDir, ToolTitle, CompileHint: string): TModalResult;
|
||||
function CreateExtTool(const WorkingDir, ToolTitle, CompileHint: string): TAbstractExternalTool;
|
||||
property ChangeStamp: int64 read FChangeStamp;
|
||||
procedure IncreaseChangeStamp;
|
||||
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
|
||||
function GetParsedCommand: string; // resolved macros
|
||||
function HasCommands: boolean; // true if there is something to execute
|
||||
public
|
||||
property Owner: TObject read FOwner;
|
||||
property Command: string read FCommand write SetCommand;
|
||||
property Parsers: TStrings read FParsers write SetParsers;
|
||||
property HasParser[aParserName: string]: boolean read GetHasParser write SetHasParser;
|
||||
end;
|
||||
@ -433,12 +423,9 @@ type
|
||||
FStorePathDelim: TPathDelimSwitch;
|
||||
FOtherDefines: TStrings; // list of user selectable defines for custom options
|
||||
FFPCMsgFile: TFPCMsgFilePoolItem;
|
||||
|
||||
// other tools
|
||||
fExecuteBefore: TCompilationToolOptions;
|
||||
fExecuteAfter: TCompilationToolOptions;
|
||||
FCreateMakefileOnBuild: boolean;
|
||||
|
||||
function GetExecuteAfter: TCompilationToolOptions;
|
||||
function GetExecuteBefore: TCompilationToolOptions;
|
||||
procedure OnItemChanged(Sender: TObject);
|
||||
procedure SetCreateMakefileOnBuild(AValue: boolean);
|
||||
protected
|
||||
@ -453,8 +440,6 @@ type
|
||||
function GetSrcPath: string; override;
|
||||
function GetUnitOutputDir: string; override;
|
||||
function GetUnitPaths: String; override;
|
||||
function GetExecuteBeforeCommand: string; override;
|
||||
function GetExecuteAfterCommand: string; override;
|
||||
procedure SetBaseDirectory(AValue: string);
|
||||
procedure SetCompilerPath(const AValue: String); override;
|
||||
procedure SetConditionals(AValue: string); override;
|
||||
@ -473,8 +458,6 @@ type
|
||||
procedure SetTargetOS(const AValue: string); override;
|
||||
procedure SetTargetFileExt(const AValue: String); override;
|
||||
procedure SetTargetFilename(const AValue: String); override;
|
||||
procedure SetExecuteBeforeCommand(const ACommand: string); override;
|
||||
procedure SetExecuteAfterCommand(const ACommand: string); override;
|
||||
protected
|
||||
function GetModified: boolean; override;
|
||||
procedure SetModified(const AValue: boolean); override;
|
||||
@ -584,14 +567,12 @@ type
|
||||
property BaseDirectory: string read GetBaseDirectory write SetBaseDirectory;
|
||||
property DefaultMakeOptionsFlags: TCompilerCmdLineOptions
|
||||
read FDefaultMakeOptionsFlags write SetDefaultMakeOptionsFlags;
|
||||
|
||||
// stored properties
|
||||
property StorePathDelim: TPathDelimSwitch read FStorePathDelim write FStorePathDelim;
|
||||
property OtherDefines: TStrings read FOtherDefines;
|
||||
|
||||
// compilation
|
||||
property ExecuteBefore: TCompilationToolOptions read fExecuteBefore;
|
||||
property ExecuteAfter: TCompilationToolOptions read fExecuteAfter;
|
||||
property ExecuteBefore: TCompilationToolOptions read GetExecuteBefore;
|
||||
property ExecuteAfter: TCompilationToolOptions read GetExecuteAfter;
|
||||
property CreateMakefileOnBuild: boolean read FCreateMakefileOnBuild
|
||||
write SetCreateMakefileOnBuild;
|
||||
end;
|
||||
@ -1397,6 +1378,16 @@ begin
|
||||
Result:=ParsedOpts.Values[pcosUnitPath].UnparsedValue;
|
||||
end;
|
||||
|
||||
function TBaseCompilerOptions.GetExecuteAfter: TCompilationToolOptions;
|
||||
begin
|
||||
Result:=TCompilationToolOptions(fExecuteAfter);
|
||||
end;
|
||||
|
||||
function TBaseCompilerOptions.GetExecuteBefore: TCompilationToolOptions;
|
||||
begin
|
||||
Result:=TCompilationToolOptions(fExecuteBefore);
|
||||
end;
|
||||
|
||||
procedure TBaseCompilerOptions.SetBaseDirectory(AValue: string);
|
||||
begin
|
||||
if BaseDirectory=AValue then exit;
|
||||
@ -3707,28 +3698,6 @@ begin
|
||||
ExecuteBefore.Parsers.Clear;
|
||||
end;
|
||||
|
||||
function TBaseCompilerOptions.GetExecuteBeforeCommand: string;
|
||||
begin
|
||||
Result := ExecuteBefore.Command;
|
||||
end;
|
||||
|
||||
function TBaseCompilerOptions.GetExecuteAfterCommand: string;
|
||||
begin
|
||||
Result := ExecuteAfter.Command;
|
||||
end;
|
||||
|
||||
procedure TBaseCompilerOptions.SetExecuteBeforeCommand(const ACommand: string);
|
||||
begin
|
||||
ExecuteBefore.Command := ACommand;
|
||||
IncreaseChangeStamp;
|
||||
end;
|
||||
|
||||
procedure TBaseCompilerOptions.SetExecuteAfterCommand(const ACommand: string);
|
||||
begin
|
||||
ExecuteAfter.Command := ACommand;
|
||||
IncreaseChangeStamp;
|
||||
end;
|
||||
|
||||
|
||||
{ TAdditionalCompilerOptions }
|
||||
|
||||
@ -4263,16 +4232,6 @@ end;
|
||||
|
||||
{ TCompilationToolOptions }
|
||||
|
||||
procedure TCompilationToolOptions.SetCommand(const AValue: string);
|
||||
begin
|
||||
if FCommand=AValue then exit;
|
||||
FCommand:=AValue;
|
||||
{$IFDEF VerboseIDEModified}
|
||||
debugln(['TCompilationToolOptions.SetCommand ',AValue]);
|
||||
{$ENDIF}
|
||||
IncreaseChangeStamp;
|
||||
end;
|
||||
|
||||
function TCompilationToolOptions.GetHasParser(aParserName: string): boolean;
|
||||
begin
|
||||
Result:=FParsers.IndexOf(aParserName)>=0;
|
||||
@ -4311,7 +4270,7 @@ end;
|
||||
|
||||
constructor TCompilationToolOptions.Create(TheOwner: TObject);
|
||||
begin
|
||||
FOwner:=TheOwner;
|
||||
inherited Create(TheOwner);
|
||||
FParsers:=TStringList.Create;
|
||||
end;
|
||||
|
||||
@ -4323,14 +4282,15 @@ end;
|
||||
|
||||
procedure TCompilationToolOptions.Clear;
|
||||
begin
|
||||
Command:='';
|
||||
inherited Clear;
|
||||
Parsers.Clear;
|
||||
end;
|
||||
|
||||
procedure TCompilationToolOptions.Assign(Src: TCompilationToolOptions);
|
||||
procedure TCompilationToolOptions.Assign(Src: TLazCompilationToolOptions);
|
||||
begin
|
||||
Command:=Src.Command;
|
||||
Parsers.Assign(Src.Parsers);
|
||||
inherited Assign(Src);
|
||||
if Src is TCompilationToolOptions then
|
||||
Parsers.Assign(TCompilationToolOptions(Src).Parsers);
|
||||
end;
|
||||
|
||||
procedure TCompilationToolOptions.LoadFromXMLConfig(XMLConfig: TXMLConfig;
|
||||
@ -4358,7 +4318,6 @@ begin
|
||||
//debugln(['TCompilationToolOptions.SaveToXMLConfig ',Command,' Path=',Path]);
|
||||
XMLConfig.SetDeleteValue(Path+'Command/Value',
|
||||
SwitchPathDelims(Command,UsePathDelim),'');
|
||||
|
||||
// Parsers
|
||||
NeedNewFormat:=false;
|
||||
for i:=0 to Parsers.Count-1 do begin
|
||||
@ -4374,12 +4333,9 @@ begin
|
||||
SaveStringList(XMLConfig,Parsers,Path+'Parsers/')
|
||||
else begin
|
||||
// save backward compatible
|
||||
XMLConfig.SetDeleteValue(Path+'ScanForFPCMsgs/Value',
|
||||
HasParser[SubToolFPC],false);
|
||||
XMLConfig.SetDeleteValue(Path+'ScanForMakeMsgs/Value',
|
||||
HasParser[SubToolMake],false);
|
||||
XMLConfig.SetDeleteValue(Path+'ShowAllMessages/Value',
|
||||
HasParser[SubToolDefault],false);
|
||||
XMLConfig.SetDeleteValue(Path+'ScanForFPCMsgs/Value', HasParser[SubToolFPC],false);
|
||||
XMLConfig.SetDeleteValue(Path+'ScanForMakeMsgs/Value',HasParser[SubToolMake],false);
|
||||
XMLConfig.SetDeleteValue(Path+'ShowAllMessages/Value',HasParser[SubToolDefault],false);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -4462,12 +4418,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCompilationToolOptions.IncreaseChangeStamp;
|
||||
begin
|
||||
CTIncreaseChangeStamp64(FChangeStamp);
|
||||
if assigned(OnChanged) then OnChanged(Self);
|
||||
end;
|
||||
|
||||
function TCompilationToolOptions.GetParsedCommand: string;
|
||||
begin
|
||||
if FParsedCommandStamp<>CompilerParseStamp then begin
|
||||
|
||||
@ -286,7 +286,10 @@ end;
|
||||
procedure TCompilerCompilationOptionsFrame.ReadSettings(AOptions: TAbstractIDEOptions);
|
||||
var
|
||||
Options: TBaseCompilerOptions absolute AOptions;
|
||||
Syy: TCompileReasons;
|
||||
IsProj: Boolean;
|
||||
begin
|
||||
IsProj := Options is TProjectCompilerOptions;
|
||||
chkCreateMakefile.Checked := Options.CreateMakefileOnBuild;
|
||||
|
||||
// execute before
|
||||
@ -296,24 +299,14 @@ begin
|
||||
SetComboBoxText(ExecuteBeforeCommandComboBox,Options.ExecuteBefore.Command,cstCaseSensitive);
|
||||
Items.EndUpdate;
|
||||
end;
|
||||
if Options.ExecuteBefore is TProjectCompilationToolOptions then
|
||||
with TProjectCompilationToolOptions(Options.ExecuteBefore) do
|
||||
begin
|
||||
chkExecBeforeCompile.Checked := crCompile in CompileReasons;
|
||||
chkExecBeforeBuild.Checked := crBuild in CompileReasons;
|
||||
chkExecBeforeRun.Checked := crRun in CompileReasons;
|
||||
lblRunIfExecBefore.Visible := True;
|
||||
chkExecBeforeCompile.Visible := True;
|
||||
chkExecBeforeBuild.Visible := True;
|
||||
chkExecBeforeRun.Visible := True;
|
||||
end
|
||||
else
|
||||
begin
|
||||
lblRunIfExecBefore.Visible := False;
|
||||
chkExecBeforeCompile.Visible := False;
|
||||
chkExecBeforeBuild.Visible := False;
|
||||
chkExecBeforeRun.Visible := False;
|
||||
end;
|
||||
Syy := Options.ExecuteBefore.CompileReasons;
|
||||
chkExecBeforeCompile.Checked := crCompile in Syy;
|
||||
chkExecBeforeBuild.Checked := crBuild in Syy;
|
||||
chkExecBeforeRun.Checked := crRun in Syy;
|
||||
lblRunIfExecBefore.Visible := IsProj;
|
||||
chkExecBeforeCompile.Visible := IsProj;
|
||||
chkExecBeforeBuild.Visible := IsProj;
|
||||
chkExecBeforeRun.Visible := IsProj;
|
||||
ReadSettingsParsers(Options.ExecuteBefore,ExecBeforeParsersCheckListBox);
|
||||
|
||||
// compiler path
|
||||
@ -368,24 +361,14 @@ begin
|
||||
SetComboBoxText(ExecuteAfterCommandComboBox,Options.ExecuteAfter.Command,cstCaseSensitive);
|
||||
Items.EndUpdate;
|
||||
end;
|
||||
if Options.ExecuteAfter is TProjectCompilationToolOptions then
|
||||
with TProjectCompilationToolOptions(Options.ExecuteAfter) do
|
||||
begin
|
||||
chkExecAfterCompile.Checked := crCompile in CompileReasons;
|
||||
chkExecAfterBuild.Checked := crBuild in CompileReasons;
|
||||
chkExecAfterRun.Checked := crRun in CompileReasons;
|
||||
lblRunIfExecAfter.Visible := True;
|
||||
chkExecAfterCompile.Visible := True;
|
||||
chkExecAfterBuild.Visible := True;
|
||||
chkExecAfterRun.Visible := True;
|
||||
end
|
||||
else
|
||||
begin
|
||||
lblRunIfExecAfter.Visible := False;
|
||||
chkExecAfterCompile.Visible := False;
|
||||
chkExecAfterBuild.Visible := False;
|
||||
chkExecAfterRun.Visible := False;
|
||||
end;
|
||||
Syy := Options.ExecuteAfter.CompileReasons;
|
||||
chkExecAfterCompile.Checked := crCompile in Syy;
|
||||
chkExecAfterBuild.Checked := crBuild in Syy;
|
||||
chkExecAfterRun.Checked := crRun in Syy;
|
||||
lblRunIfExecAfter.Visible := IsProj;
|
||||
chkExecAfterCompile.Visible := IsProj;
|
||||
chkExecAfterBuild.Visible := IsProj;
|
||||
chkExecAfterRun.Visible := IsProj;
|
||||
ReadSettingsParsers(Options.ExecuteAfter,ExecAfterParsersCheckListBox);
|
||||
end;
|
||||
|
||||
@ -414,10 +397,8 @@ begin
|
||||
WriteSettingsParsers(Options.ExecuteBefore,ExecBeforeParsersCheckListBox);
|
||||
|
||||
if Options.ExecuteBefore is TProjectCompilationToolOptions then
|
||||
begin
|
||||
TProjectCompilationToolOptions(Options.ExecuteBefore).CompileReasons :=
|
||||
Options.ExecuteBefore.CompileReasons :=
|
||||
MakeCompileReasons(chkExecBeforeCompile, chkExecBeforeBuild, chkExecBeforeRun);
|
||||
end;
|
||||
|
||||
// compiler path
|
||||
Options.CompilerPath := cobCompiler.Text;
|
||||
@ -440,10 +421,8 @@ begin
|
||||
end;
|
||||
WriteSettingsParsers(Options.ExecuteAfter,ExecAfterParsersCheckListBox);
|
||||
if Options.ExecuteAfter is TProjectCompilationToolOptions then
|
||||
begin
|
||||
TProjectCompilationToolOptions(Options.ExecuteAfter).CompileReasons :=
|
||||
Options.ExecuteAfter.CompileReasons :=
|
||||
MakeCompileReasons(chkExecAfterCompile, chkExecAfterBuild, chkExecAfterRun);
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TCompilerCompilationOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
|
||||
|
||||
63
ide/main.pp
63
ide/main.pp
@ -6620,22 +6620,14 @@ end;
|
||||
|
||||
function CheckCompileReasons(Reason: TCompileReason;
|
||||
Options: TProjectCompilerOptions; Quiet: boolean): TModalResult;
|
||||
var
|
||||
ProjToolOpts: TProjectCompilationToolOptions;
|
||||
// The ExecuteBefore/After tools for project are TProjectCompilationToolOptions.
|
||||
begin
|
||||
if (Reason in Options.CompileReasons)
|
||||
and (Options.CompilerPath<>'') then
|
||||
if (Reason in Options.CompileReasons) and (Options.CompilerPath<>'') then
|
||||
exit(mrOk);
|
||||
if (Reason in Options.ExecuteBefore.CompileReasons) and (Options.ExecuteBefore.Command<>'') then
|
||||
exit(mrOk);
|
||||
if (Reason in Options.ExecuteAfter.CompileReasons) and (Options.ExecuteAfter.Command<>'') then
|
||||
exit(mrOk);
|
||||
if Options.ExecuteBefore is TProjectCompilationToolOptions then begin
|
||||
ProjToolOpts:=TProjectCompilationToolOptions(Options.ExecuteBefore);
|
||||
if (Reason in ProjToolOpts.CompileReasons) and (ProjToolOpts.Command<>'') then
|
||||
exit(mrOk);
|
||||
end;
|
||||
if Options.ExecuteAfter is TProjectCompilationToolOptions then begin
|
||||
ProjToolOpts:=TProjectCompilationToolOptions(Options.ExecuteAfter);
|
||||
if (Reason in ProjToolOpts.CompileReasons) and (ProjToolOpts.Command<>'') then
|
||||
exit(mrOk);
|
||||
end;
|
||||
// reason is not handled
|
||||
if Quiet then exit(mrCancel);
|
||||
Result:=IDEMessageDialog('Nothing to do',
|
||||
@ -6650,8 +6642,6 @@ function TMainIDE.DoBuildProject(const AReason: TCompileReason;
|
||||
Flags: TProjectBuildFlags; FinalizeResources: boolean): TModalResult;
|
||||
var
|
||||
SrcFilename: string;
|
||||
ToolBefore: TProjectCompilationToolOptions;
|
||||
ToolAfter: TProjectCompilationToolOptions;
|
||||
PkgFlags: TPkgCompileFlags;
|
||||
CompilerFilename: String;
|
||||
WorkingDir: String;
|
||||
@ -6801,18 +6791,15 @@ begin
|
||||
aCompileHint:='Compile Reason: '+aCompileHint;
|
||||
|
||||
// execute compilation tool 'Before'
|
||||
if not (pbfSkipTools in Flags) then begin
|
||||
ToolBefore:=TProjectCompilationToolOptions(
|
||||
Project1.CompilerOptions.ExecuteBefore);
|
||||
if (AReason in ToolBefore.CompileReasons) then begin
|
||||
Result:=Project1.CompilerOptions.ExecuteBefore.Execute(
|
||||
WorkingDir, lisProject2+lisExecutingCommandBefore,
|
||||
aCompileHint);
|
||||
if Result<>mrOk then
|
||||
begin
|
||||
debugln(['Error: (lazarus) [TMainIDE.DoBuildProject] CompilerOptions.ExecuteBefore.Execute failed']);
|
||||
exit;
|
||||
end;
|
||||
if not (pbfSkipTools in Flags)
|
||||
and (AReason in Project1.CompilerOptions.ExecuteBefore.CompileReasons) then
|
||||
begin
|
||||
Result:=Project1.CompilerOptions.ExecuteBefore.Execute(WorkingDir,
|
||||
lisProject2+lisExecutingCommandBefore, aCompileHint);
|
||||
if Result<>mrOk then
|
||||
begin
|
||||
debugln(['Error: (lazarus) [TMainIDE.DoBuildProject] CompilerOptions.ExecuteBefore.Execute failed']);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -6961,17 +6948,15 @@ begin
|
||||
end;
|
||||
|
||||
// execute compilation tool 'After'
|
||||
if not (pbfSkipTools in Flags) then begin
|
||||
ToolAfter:=TProjectCompilationToolOptions(Project1.CompilerOptions.ExecuteAfter);
|
||||
// no need to check for mrOk, we are exit if it wasn't
|
||||
if (AReason in ToolAfter.CompileReasons) then begin
|
||||
Result:=Project1.CompilerOptions.ExecuteAfter.Execute(
|
||||
WorkingDir,lisProject2+lisExecutingCommandAfter,aCompileHint);
|
||||
if Result<>mrOk then
|
||||
begin
|
||||
debugln(['Error: (lazarus) [TMainIDE.DoBuildProject] CompilerOptions.ExecuteAfter.Execute failed']);
|
||||
exit;
|
||||
end;
|
||||
if not (pbfSkipTools in Flags) // no need to check for mrOk, we are exit if it wasn't
|
||||
and (AReason in Project1.CompilerOptions.ExecuteAfter.CompileReasons) then
|
||||
begin
|
||||
Result:=Project1.CompilerOptions.ExecuteAfter.Execute(WorkingDir,
|
||||
lisProject2+lisExecutingCommandAfter, aCompileHint);
|
||||
if Result<>mrOk then
|
||||
begin
|
||||
debugln(['Error: (lazarus) [TMainIDE.DoBuildProject] CompilerOptions.ExecuteAfter.Execute failed']);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
132
ide/project.pp
132
ide/project.pp
@ -485,24 +485,21 @@ type
|
||||
|
||||
TProjectCompilationToolOptions = class(TCompilationToolOptions)
|
||||
private
|
||||
FCompileReasons: TCompileReasons;
|
||||
FDefaultCompileReasons: TCompileReasons;
|
||||
procedure SetCompileReasons(const AValue: TCompileReasons);
|
||||
procedure SetDefaultCompileReasons(const AValue: TCompileReasons);
|
||||
protected
|
||||
procedure SetCompileReasons(const AValue: TCompileReasons); override;
|
||||
procedure SubstituteMacros(var s: string); override;
|
||||
public
|
||||
procedure Clear; override;
|
||||
constructor Create(TheOwner: TObject); override;
|
||||
function CreateDiff(CompOpts: TCompilationToolOptions;
|
||||
Tool: TCompilerDiffTool): boolean; override;
|
||||
procedure Assign(Src: TCompilationToolOptions); override;
|
||||
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
||||
DoSwitchPathDelims: boolean); override;
|
||||
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
||||
UsePathDelim: TPathDelimSwitch); override;
|
||||
function GetProject: TProject;
|
||||
public
|
||||
property CompileReasons: TCompileReasons read FCompileReasons write SetCompileReasons;
|
||||
property DefaultCompileReasons: TCompileReasons read FDefaultCompileReasons write SetDefaultCompileReasons;
|
||||
end;
|
||||
|
||||
@ -544,7 +541,6 @@ type
|
||||
function GetDefaultMainSourceFileName: string; override;
|
||||
procedure GetInheritedCompilerOptions(var OptionsList: TFPList); override;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
function IsEqual(CompOpts: TBaseCompilerOptions): boolean; override;
|
||||
function CreateDiff(CompOpts: TBaseCompilerOptions;
|
||||
Tool: TCompilerDiffTool = nil): boolean; override; // true if differ
|
||||
procedure InvalidateOptions;
|
||||
@ -5989,70 +5985,20 @@ end;
|
||||
|
||||
{ TProjectCompilationToolOptions }
|
||||
|
||||
procedure TProjectCompilationToolOptions.SetCompileReasons(
|
||||
const AValue: TCompileReasons);
|
||||
constructor TProjectCompilationToolOptions.Create(TheOwner: TObject);
|
||||
begin
|
||||
if FCompileReasons=AValue then exit;
|
||||
FCompileReasons:=AValue;
|
||||
{$IFDEF VerboseIDEModified}
|
||||
debugln(['TProjectCompilationToolOptions.SetCompileReasons']);
|
||||
{$ENDIF}
|
||||
IncreaseChangeStamp;
|
||||
end;
|
||||
|
||||
procedure TProjectCompilationToolOptions.SetDefaultCompileReasons(
|
||||
const AValue: TCompileReasons);
|
||||
begin
|
||||
if FDefaultCompileReasons=AValue then exit;
|
||||
FDefaultCompileReasons:=AValue;
|
||||
{$IFDEF VerboseIDEModified}
|
||||
debugln(['TProjectCompilationToolOptions.SetDefaultCompileReasons']);
|
||||
{$ENDIF}
|
||||
IncreaseChangeStamp;
|
||||
end;
|
||||
|
||||
procedure TProjectCompilationToolOptions.SubstituteMacros(var s: string);
|
||||
var
|
||||
CompOpts: TProjectCompilerOptions;
|
||||
begin
|
||||
if Owner is TProjectCompilerOptions then begin
|
||||
CompOpts:=TProjectCompilerOptions(Owner);
|
||||
//debugln(['TProjectCompilationToolOptions.SubstituteMacros ',DbgSName(Owner),' ',CompOpts.LazProject<>nil]);
|
||||
s:=CompOpts.SubstituteProjectMacros(s,false);
|
||||
end else
|
||||
inherited SubstituteMacros(s);
|
||||
end;
|
||||
|
||||
procedure TProjectCompilationToolOptions.Clear;
|
||||
begin
|
||||
inherited Clear;
|
||||
CompileReasons := crAll;
|
||||
inherited Create(TheOwner);
|
||||
FDefaultCompileReasons:=crAll;
|
||||
end;
|
||||
|
||||
function TProjectCompilationToolOptions.CreateDiff(
|
||||
CompOpts: TCompilationToolOptions; Tool: TCompilerDiffTool): boolean;
|
||||
begin
|
||||
if (CompOpts is TProjectCompilationToolOptions) then begin
|
||||
Result:=AddCompileReasonsDiff('CompileReasons',CompileReasons,
|
||||
TProjectCompilationToolOptions(CompOpts).CompileReasons,Tool);
|
||||
end else begin
|
||||
Result:=true;
|
||||
if Tool<>nil then Tool.Differ:=true;
|
||||
end;
|
||||
if (Tool=nil) and Result then exit;
|
||||
if (inherited CreateDiff(CompOpts, Tool)) then Result:=true;
|
||||
end;
|
||||
|
||||
procedure TProjectCompilationToolOptions.Assign(Src: TCompilationToolOptions);
|
||||
begin
|
||||
inherited Assign(Src);
|
||||
if Src is TProjectCompilationToolOptions
|
||||
then begin
|
||||
CompileReasons := TProjectCompilationToolOptions(Src).CompileReasons;
|
||||
end
|
||||
else begin
|
||||
CompileReasons := crAll;
|
||||
end;
|
||||
Assert(Assigned(Tool),'TProjectCompilationToolOptions.CreateDiff: Tool=Nil.');
|
||||
Result:=AddCompileReasonsDiff('CompileReasons', CompileReasons,
|
||||
CompOpts.CompileReasons, Tool);
|
||||
if Result then exit;
|
||||
if inherited CreateDiff(CompOpts, Tool) then Result:=true;
|
||||
end;
|
||||
|
||||
procedure TProjectCompilationToolOptions.LoadFromXMLConfig(XMLConfig: TXMLConfig;
|
||||
@ -6081,30 +6027,47 @@ begin
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
procedure TProjectCompilationToolOptions.SetCompileReasons(const AValue: TCompileReasons);
|
||||
begin
|
||||
if FCompileReasons=AValue then exit;
|
||||
FCompileReasons:=AValue;
|
||||
IncreaseChangeStamp;
|
||||
end;
|
||||
|
||||
procedure TProjectCompilationToolOptions.SetDefaultCompileReasons(const AValue: TCompileReasons);
|
||||
begin
|
||||
if FDefaultCompileReasons=AValue then exit;
|
||||
FDefaultCompileReasons:=AValue;
|
||||
IncreaseChangeStamp;
|
||||
end;
|
||||
|
||||
procedure TProjectCompilationToolOptions.SubstituteMacros(var s: string);
|
||||
var
|
||||
CompOpts: TProjectCompilerOptions;
|
||||
begin
|
||||
if Owner is TProjectCompilerOptions then begin
|
||||
CompOpts:=TProjectCompilerOptions(Owner);
|
||||
//debugln(['TProjectCompilationToolOptions.SubstituteMacros ',DbgSName(Owner),' ',CompOpts.LazProject<>nil]);
|
||||
s:=CompOpts.SubstituteProjectMacros(s,false);
|
||||
end else
|
||||
inherited SubstituteMacros(s);
|
||||
end;
|
||||
|
||||
{ TProjectCompilerOptions }
|
||||
|
||||
procedure TProjectCompilerOptions.LoadFromXMLConfig(AXMLConfig: TXMLConfig;
|
||||
const Path: string);
|
||||
begin
|
||||
inherited LoadFromXMLConfig(AXMLConfig,Path);
|
||||
|
||||
//FileVersion:=aXMLConfig.GetValue(Path+'Version/Value', 0);
|
||||
|
||||
// old compatibility
|
||||
if AXMLConfig.GetValue(Path+'SkipCompiler/Value',false) then
|
||||
FCompileReasons := []
|
||||
else
|
||||
FCompileReasons := LoadXMLCompileReasons(AXMLConfig,Path+'CompileReasons/',crAll);
|
||||
//debugln(['TProjectCompilerOptions.LoadFromXMLConfig ',Path+'CompileReasons/ ',crCompile in FCompileReasons]);
|
||||
FCompileReasons := LoadXMLCompileReasons(AXMLConfig,Path+'CompileReasons/',crAll);
|
||||
end;
|
||||
|
||||
procedure TProjectCompilerOptions.SaveToXMLConfig(AXMLConfig: TXMLConfig;
|
||||
const Path: string);
|
||||
begin
|
||||
inherited SaveToXMLConfig(AXMLConfig,Path);
|
||||
|
||||
SaveXMLCompileReasons(AXMLConfig, Path+'CompileReasons/', FCompileReasons, crAll);
|
||||
//debugln(['TProjectCompilerOptions.SaveToXMLConfig ',Path+'CompileReasons/ ',crCompile in FCompileReasons]);
|
||||
end;
|
||||
|
||||
procedure TProjectCompilerOptions.SetTargetCPU(const AValue: string);
|
||||
@ -6224,11 +6187,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TProjectCompilerOptions.IsEqual(CompOpts: TBaseCompilerOptions): boolean;
|
||||
begin
|
||||
Result:=inherited IsEqual(CompOpts);
|
||||
end;
|
||||
|
||||
function TProjectCompilerOptions.CreateDiff(CompOpts: TBaseCompilerOptions;
|
||||
Tool: TCompilerDiffTool): boolean;
|
||||
begin
|
||||
@ -6248,7 +6206,7 @@ end;
|
||||
|
||||
procedure TProjectCompilerOptions.InvalidateOptions;
|
||||
begin
|
||||
if (LazProject=nil) then exit;
|
||||
//if (LazProject=nil) then exit;
|
||||
end;
|
||||
|
||||
procedure TProjectCompilerOptions.SetAlternativeCompile(const Command: string;
|
||||
@ -6270,18 +6228,10 @@ end;
|
||||
|
||||
constructor TProjectCompilerOptions.Create(const AOwner: TObject);
|
||||
begin
|
||||
FCompileReasons := [crCompile, crBuild, crRun];
|
||||
FCompileReasons := crAll;
|
||||
inherited Create(AOwner, TProjectCompilationToolOptions);
|
||||
with TProjectCompilationToolOptions(ExecuteBefore) do begin
|
||||
DefaultCompileReasons:=crAll;
|
||||
CompileReasons:=DefaultCompileReasons;
|
||||
end;
|
||||
with TProjectCompilationToolOptions(ExecuteAfter) do begin
|
||||
DefaultCompileReasons:=crAll;
|
||||
CompileReasons:=DefaultCompileReasons;
|
||||
end;
|
||||
if AOwner <> nil
|
||||
then FProject := AOwner as TProject;
|
||||
if AOwner <> nil then
|
||||
FProject := AOwner as TProject;
|
||||
ParsedOpts.OnLocalSubstitute:=@SubstituteProjectMacros;
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user