diff --git a/components/buildintf/macrodefintf.pas b/components/buildintf/macrodefintf.pas index a8b80b7bdb..1a3fe0cd89 100644 --- a/components/buildintf/macrodefintf.pas +++ b/components/buildintf/macrodefintf.pas @@ -29,18 +29,26 @@ Type var Abort: boolean): string of object; TTransferMacroFlag = ( - tmfInteractive + tmfInteractive, + tmfLazbuild // store value for lazbuild ); TTransferMacroFlags = set of TTransferMacroFlag; + { TTransferMacro } + TTransferMacro = class + private + FLazbuildValue: string; + protected + procedure SetLazbuildValue(const AValue: string); virtual; public Name: string; Value: string; Description: string; MacroFunction: TMacroFunction; Flags: TTransferMacroFlags; - constructor Create(AName, AValue, ADescription:string; + property LazbuildValue: string read FLazbuildValue write SetLazbuildValue; + constructor Create(const AName, AValue, ADescription:string; AMacroFunction: TMacroFunction; TheFlags: TTransferMacroFlags); end; @@ -49,7 +57,13 @@ implementation { TTransferMacro } -constructor TTransferMacro.Create(AName, AValue, ADescription:string; +procedure TTransferMacro.SetLazbuildValue(const AValue: string); +begin + if FLazbuildValue=AValue then Exit; + FLazbuildValue:=AValue; +end; + +constructor TTransferMacro.Create(const AName, AValue, ADescription: string; AMacroFunction: TMacroFunction; TheFlags: TTransferMacroFlags); begin Name:=AName; diff --git a/components/buildintf/macrointf.pas b/components/buildintf/macrointf.pas index 72f350a941..cd225bd5ed 100644 --- a/components/buildintf/macrointf.pas +++ b/components/buildintf/macrointf.pas @@ -22,6 +22,7 @@ uses MacroDefIntf; type + { TIDEMacros - macros for paths and compiler settings } TIDEMacros = class @@ -39,7 +40,9 @@ type // file utility functions function CreateAbsoluteSearchPath(var SearchPath: string; const BaseDirectory: string): boolean; - procedure Add(NewMacro: TTransferMacro); virtual; abstract; + procedure Add(NewMacro: TTransferMacro); virtual; abstract; overload; + function Add(const AName, AValue, ADescription: string; + AMacroFunction: TMacroFunction; TheFlags: TTransferMacroFlags): TTransferMacro; virtual; overload; end; const @@ -121,5 +124,13 @@ begin SearchPath:=MinimizeSearchPath(LazFileUtils.CreateAbsoluteSearchPath(SearchPath,BaseDir)); end; +function TIDEMacros.Add(const AName, AValue, ADescription: string; + AMacroFunction: TMacroFunction; TheFlags: TTransferMacroFlags + ): TTransferMacro; +begin + Result:=TTransferMacro.Create(AName,AValue,ADescription,AMacroFunction,TheFlags); + Add(Result); +end; + end. diff --git a/ide/compileroptions.pp b/ide/compileroptions.pp index 61565839e8..18d3da8d8c 100644 --- a/ide/compileroptions.pp +++ b/ide/compileroptions.pp @@ -97,7 +97,7 @@ type end; { TIDEBuildMacros - - every package and project has this list of build macros + - every package and project has this list of build macros (editable via GUI) every build macro has - a list of possible values - and has a default value, or an expression to define the default diff --git a/ide/ideprocs.pp b/ide/ideprocs.pp index fd426ba218..1b37296161 100644 --- a/ide/ideprocs.pp +++ b/ide/ideprocs.pp @@ -34,7 +34,7 @@ uses Classes, SysUtils, Laz_AVL_Tree, // LazUtils FileUtil, LazFileUtils, LazUtilities, LazFileCache, LazUTF8, - Laz2_XMLCfg, AvgLvlTree, LazLoggerBase, LazTracer, + Laz2_XMLCfg, LazLoggerBase, LazTracer, // LCL StdCtrls, ExtCtrls, // CodeTools diff --git a/ide/lazbuild.lpr b/ide/lazbuild.lpr index f1c904c33b..794f495f2a 100644 --- a/ide/lazbuild.lpr +++ b/ide/lazbuild.lpr @@ -1229,6 +1229,8 @@ end; procedure TLazBuildApplication.SetupMacros; begin MainBuildBoss.SetupTransferMacros; + + (IDEMacros as TLazIDEMacros).LoadLazbuildMacros; end; procedure TLazBuildApplication.SetupCodetools; diff --git a/ide/main.pp b/ide/main.pp index 85a31c65dc..27a3d37ea9 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -5313,6 +5313,7 @@ begin DebuggerOptions.Save; // before environment EnvironmentOptions.Save(false); EditorMacroListViewer.SaveGlobalInfo; + (IDEMacros as TLazIDEMacros).SaveLazbuildMacros; //debugln('TMainIDE.SaveEnvironment A ',dbgsName(ObjectInspector1.Favorites)); if (ObjectInspector1<>nil) and (ObjectInspector1.Favorites<>nil) then SaveOIFavoriteProperties(ObjectInspector1.Favorites); diff --git a/ide/transfermacros.pp b/ide/transfermacros.pp index 731f075a8b..6ebc16f413 100644 --- a/ide/transfermacros.pp +++ b/ide/transfermacros.pp @@ -35,18 +35,21 @@ unit TransferMacros; interface uses - Classes, SysUtils, Types, + Classes, SysUtils, // LazUtils - LazFileUtils, LazUTF8, + LazFileUtils, LazUTF8, LazFileCache, LazConfigStorage, // CodeTools FileProcs, CodeToolManager, // BuildIntf - MacroIntf, MacroDefIntf, + MacroIntf, MacroDefIntf, BaseIDEIntf, // IdeConfig - TransferMacrosIntf, + TransferMacrosIntf, LazConf, // IDE LazarusIDEStrConsts; +const + LazbuildMacrosFileName = 'lazbuildmacros.xml'; + type { TTransferMacroList } @@ -76,10 +79,10 @@ type public constructor Create; destructor Destroy; override; + function Count: integer; override; property Items[Index: integer]: TTransferMacro read GetItems write SetItems; default; procedure SetValue(const MacroName, NewValue: string); override; - function Count: integer; override; procedure Clear; override; procedure Delete(Index: integer); override; procedure Add(NewMacro: TTransferMacro); override; @@ -98,15 +101,22 @@ type property MaxUsePerMacro: integer read FMaxUsePerMacro write FMaxUsePerMacro default 3; end; -{ TLazIDEMacros } + { TLazIDEMacros } -type TLazIDEMacros = class(TIDEMacros) + private + FLazbuildMacroFileAge: longint; // file age when last time the lazbuild macros were stored + FLazbuildMacros: TStringListUTF8Fast; // last stored lazbuild macros public + destructor Destroy; override; function StrHasMacros(const s: string): boolean; override; function SubstituteMacros(var s: string): boolean; override; function IsMacro(const Name: string): boolean; override; - procedure Add(NewMacro: TTransferMacro);override; + procedure Add(NewMacro: TTransferMacro);override; overload; + public + // lazbuild macros + procedure LoadLazbuildMacros; // called by lazbuild + procedure SaveLazbuildMacros; // called by IDE end; function GetGlobalMacroList: TTransferMacroList; inline; @@ -543,6 +553,12 @@ end; { TLazIDEMacros } +destructor TLazIDEMacros.Destroy; +begin + FreeAndNil(FLazbuildMacros); + inherited Destroy; +end; + function TLazIDEMacros.StrHasMacros(const s: string): boolean; begin Result:=GlobalMacroList.StrHasMacros(s); @@ -563,6 +579,147 @@ Begin GlobalMacroList.Add(NewMacro); end; +procedure TLazIDEMacros.LoadLazbuildMacros; +var + aFilename, s, aMacroName, Value: String; + Macros: TTransferMacroList; + Cfg: TConfigStorage; + i: Integer; + p: SizeInt; + EnvVars: TStringListUTF8Fast; + aMacro: TTransferMacro; +begin + aFilename:=AppendPathDelim(GetPrimaryConfigPath)+LazbuildMacrosFileName; + if not FileExistsCached(aFilename) then exit; + + Macros:=GlobalMacroList; + FLazbuildMacros:=TStringListUTF8Fast.Create; + EnvVars:=TStringListUTF8Fast.Create; + Cfg:=GetIDEConfigStorage(aFilename,true); + try + Cfg.GetValue('Macros',FLazbuildMacros); + + for i:=0 to FLazbuildMacros.Count-1 do + begin + s:=FLazbuildMacros[i]; + p:=Pos('=',s); + if (p<2) then continue; + aMacroName:=LeftStr(s,p-1); + Value:=copy(s,p+1,length(s)); + aMacro:=Macros.FindByName(aMacroName); + if aMacro<>nil then + continue; // macro exists + Macros.Add(TTransferMacro.Create(aMacroName,Value,'From IDE lazbuild macro list',nil,[])); + end; + finally + EnvVars.Free; + Cfg.Free; + end; +end; + +procedure TLazIDEMacros.SaveLazbuildMacros; +var + aFilename, Value, s, aMacroName: String; + i: Integer; + aMacro: TTransferMacro; + NeedSave: Boolean; + Cfg: TConfigStorage; + Macros: TTransferMacroList; + p: SizeInt; +begin + aFilename:=AppendPathDelim(GetPrimaryConfigPath)+LazbuildMacrosFileName; + + Macros:=GlobalMacroList; + + NeedSave:=false; + + // load old config + if FLazbuildMacros=nil then + begin + FLazbuildMacros:=TStringListUTF8Fast.Create; + Cfg:=GetIDEConfigStorage(aFilename,true); + try + Cfg.GetValue('Macros',FLazbuildMacros); + finally + Cfg.Free; + end; + FLazbuildMacroFileAge:=FileAgeUTF8(aFilename); + end; + + // clean up old macros + for i:=FLazbuildMacros.Count-1 downto 0 do begin + s:=FLazbuildMacros[i]; + p:=Pos('=',s); + if (p>1) then + begin + aMacroName:=LeftStr(s,p-1); + aMacro:=Macros.FindByName(aMacroName); + if (aMacro<>nil) and (tmfLazbuild in aMacro.Flags) then + continue; + end; + FLazbuildMacros.Delete(i); + NeedSave:=true; + end; + + // check new values + for i:=0 to Macros.Count-1 do + begin + aMacro:=Macros[i]; + if not (tmfLazbuild in aMacro.Flags) then continue; + if aMacro.LazbuildValue<>'' then + Value:=aMacro.LazbuildValue + else + Value:=aMacro.Value; + if Value='' then + begin + // currently the macro is not set -> keep the old value + continue; + end; + if FLazbuildMacros.Values[aMacro.Name]<>Value then + begin + FLazbuildMacros.Values[aMacro.Name]:=Value; + NeedSave:=true; + end; + end; + + if FLazbuildMacros.Count=0 then + begin + // no lazbuild macros -> delete config + if FileExistsCached(aFilename) then + DeleteFile(aFilename); + exit; + end; + + if (not NeedSave) then + begin + if (not FileExistsCached(aFilename)) + or ((FLazbuildMacroFileAge<>0) and (FileAgeCached(aFilename)<>FLazbuildMacroFileAge)) then + NeedSave:=true; + end; + + if not NeedSave then exit; + + Cfg:=GetIDEConfigStorage(aFilename,false); + try + FLazbuildMacros.Clear; + for i:=0 to Macros.Count-1 do + begin + aMacro:=Macros[i]; + if not (tmfLazbuild in aMacro.Flags) then continue; + if aMacro.LazbuildValue<>'' then + Value:=aMacro.LazbuildValue + else + Value:=aMacro.Value; + FLazbuildMacros.Add(aMacro.Name+'='+Value); + end; + Cfg.SetValue('Macros',FLazbuildMacros); + finally + Cfg.Free; + end; + FLazbuildMacroFileAge:=FileAgeUTF8(aFilename); +end; + + procedure InternalInit; var c: char;