{ *************************************************************************** * * * 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 . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * * * *************************************************************************** Author: Mattias Gaertner Abstract: This unit is a support unit for the code tools. It manages compilation information, which is not stored in the source, like Makefile information and compiler command line options. This information is needed to successfully find the right units, include files, predefined variables, etc.. The information is stored in a TDefineTree, which contains nodes of type TDefineTemplate. Each TDefineTemplate is a tree of defines, undefines, definerecurses, ifdefs, ifndefs, elses, elseifs, directories ... . Simply give a TDefineTree a directory and it will return all predefined variables for that directory. These values can be used to parse a unit in the directory. TDefineTree can be saved to and loaded from a XML file. The TDefinePool contains a list of TDefineTemplate trees, and can generate some default templates for Lazarus and FPC sources. ToDo: Better Error handling of DefinePool } unit DefineTemplates; {$mode objfpc}{$H+} { $Define VerboseDefineCache} { $Define VerboseFPCSrcScan} { $Define ShowTriedFiles} interface uses Classes, SysUtils, CodeToolsStrConsts, ExprEval, DirectoryCacher, Laz_XMLCfg, AVL_Tree, Process, KeywordFuncLists, FileProcs; const ExternalMacroStart = ExprEval.ExternalMacroStart; // Standard Template Names (do not translate them) StdDefTemplFPC = 'Free Pascal Compiler'; StdDefTemplFPCSrc = 'Free Pascal sources'; StdDefTemplLazarusSources = 'Lazarus sources'; StdDefTemplLazarusSrcDir = 'Lazarus source directory'; StdDefTemplLazarusBuildOpts = 'Lazarus build options'; StdDefTemplLCLProject = 'LCL project'; // Standard macros DefinePathMacroName = ExternalMacroStart+'DefinePath'; UnitPathMacroName = ExternalMacroStart+'UnitPath'; IncludePathMacroName = ExternalMacroStart+'IncPath'; SrcPathMacroName = ExternalMacroStart+'SrcPath'; PPUSrcPathMacroName = ExternalMacroStart+'PPUSrcPath'; PPWSrcPathMacroName = ExternalMacroStart+'PPWSrcPath'; DCUSrcPathMacroName = ExternalMacroStart+'DCUSrcPath'; CompiledSrcPathMacroName = ExternalMacroStart+'CompiledSrcPath'; UnitLinksMacroName = ExternalMacroStart+'UnitLinks'; FPCUnitPathMacroName = ExternalMacroStart+'FPCUnitPath'; TargetOSMacroName = ExternalMacroStart+'TargetOS'; TargetCPUMacroName = ExternalMacroStart+'TargetCPU'; DefinePathMacro = '$('+DefinePathMacroName+')'; UnitPathMacro = '$('+UnitPathMacroName+')'; IncludePathMacro = '$('+IncludePathMacroName+')'; SrcPathMacro = '$('+SrcPathMacroName+')'; PPUSrcPathMacro = '$('+PPUSrcPathMacroName+')'; PPWSrcPathMacro = '$('+PPWSrcPathMacroName+')'; DCUSrcPathMacro = '$('+DCUSrcPathMacroName+')'; CompiledSrcPathMacro = '$('+CompiledSrcPathMacroName+')'; UnitLinksMacro = '$('+UnitLinksMacroName+')'; FPCUnitPathMacro = '$('+FPCUnitPathMacroName+')'; TargetOSMacro = '$('+TargetOSMacroName+')'; TargetCPUMacro = '$('+TargetCPUMacroName+')'; // virtual directories VirtualDirectory='VIRTUALDIRECTORY'; VirtualTempDir='TEMPORARYDIRECTORY'; // FPC operating systems and processor types FPCOperatingSystemNames: array[1..28] of shortstring =( 'linux', 'win32','win64','wince', 'darwin','macos', 'freebsd','netbsd','openbsd', 'go32v2', 'os2', 'beos','haiku', 'amiga','atari','solaris', 'qnx', 'netware','wdosx', 'palmos','emx','watcom','morphos','netwlibc', 'gba','nds','embedded','symbian' ); FPCOperatingSystemAlternativeNames: array[1..2] of shortstring =( 'unix', 'win' // see GetDefaultSrcOSForTargetOS ); FPCOperatingSystemAlternative2Names: array[1..1] of shortstring =( 'bsd' // see GetDefaultSrcOS2ForTargetOS ); FPCProcessorNames: array[1..6] of shortstring =( 'i386', 'powerpc', 'm68k', 'x86_64', 'sparc', 'arm' ); Lazarus_CPU_OS_Widget_Combinations: array[1..46] of shortstring = ( 'i386-linux-gtk', 'i386-linux-gtk2', 'i386-linux-qt', 'i386-linux-fpgui', 'i386-freebsd-gtk', 'i386-freebsd-gtk2', 'i386-freebsd-qt', 'i386-openbsd-gtk', 'i386-openbsd-gtk2', 'i386-openbsd-qt', 'i386-netbsd-gtk', 'i386-netbsd-gtk2', 'i386-netbsd-qt', 'i386-win32-win32', 'i386-win32-gtk2', 'i386-win32-qt', 'i386-win32-fpgui', 'i386-wince-wince', 'i386-wince-fpgui', 'i386-darwin-gtk', 'i386-darwin-gtk2', 'i386-darwin-carbon', 'i386-darwin-qt', 'i386-darwin-fpgui', 'powerpc-darwin-gtk', 'powerpc-darwin-gtk2', 'powerpc-darwin-carbon', 'powerpc-linux-gtk', 'powerpc-linux-gtk2', 'sparc-linux-gtk', 'sparc-linux-gtk2', 'arm-wince-wince', 'arm-wince-fpgui', 'arm-linux-gtk', 'arm-linux-gtk2', 'arm-linux-qt', 'x86_64-freebsd-gtk', 'x86_64-freebsd-gtk2', 'x86_64-freebsd-qt', 'x86_64-freebsd-fpgui', 'x86_64-linux-gtk', 'x86_64-linux-gtk2', 'x86_64-linux-qt', 'x86_64-linux-fpgui', 'x86_64-win64-win32', 'x86_64-win64-fpgui' ); type //--------------------------------------------------------------------------- // TDefineTemplate stores a define action, the variablename and the value TDefineAction = ( da_None, da_Block, da_Define, da_DefineRecurse, da_Undefine, da_UndefineRecurse, da_UndefineAll, da_If, da_IfDef, da_IfNDef, da_ElseIf, da_Else, da_Directory ); const DefineActionBlocks = [da_Block, da_Directory, da_If, da_IfDef, da_IfNDef, da_ElseIf, da_Else]; DefineActionDefines = [da_Define,da_DefineRecurse,da_Undefine, da_UndefineRecurse,da_UndefineAll]; DefineActionNames: array[TDefineAction] of string = ( 'None', 'Block', 'Define', 'DefineRecurse', 'Undefine', 'UndefineRecurse', 'UndefineAll', 'If', 'IfDef', 'IfNDef', 'ElseIf', 'Else', 'Directory' ); var DefineActionImages: array[TDefineAction] of integer; AutogeneratedImage: Integer; type TDefineTree = class; TDefineTemplateFlag = ( dtfAutoGenerated ); TDefineTemplateFlags = set of TDefineTemplateFlag; TDefineTemplate = class private FChildCount: integer; FFirstChild: TDefineTemplate; FLastChild: TDefineTemplate; FMarked: boolean; FMergeNameBehind: string; FMergeNameInFront: string; FNext: TDefineTemplate; FParent: TDefineTemplate; FPrior: TDefineTemplate; public Name: string; Description: string; Variable: string; Value: string; Action: TDefineAction; Flags: TDefineTemplateFlags; Owner: TObject; class procedure MergeTemplates(ParentDefTempl: TDefineTemplate; var FirstSibling, LastSibling:TDefineTemplate; SourceTemplate: TDefineTemplate; WithSiblings: boolean; const NewNamePrefix: string); class procedure MergeXMLConfig(ParentDefTempl: TDefineTemplate; var FirstSibling, LastSibling:TDefineTemplate; XMLConfig: TXMLConfig; const Path, NewNamePrefix: string); constructor Create(const AName, ADescription, AVariable, AValue: string; AnAction: TDefineAction); constructor Create; destructor Destroy; override; procedure ConsistencyCheck; function CreateCopy(OnlyMarked: boolean = false; WithSiblings: boolean = true; WithChilds: boolean = true): TDefineTemplate; function CreateMergeCopy: TDefineTemplate; function FindByName(const AName: string; WithSubChilds, WithNextSiblings: boolean): TDefineTemplate; function FindChildByName(const AName: string): TDefineTemplate; function FindRoot: TDefineTemplate; function FindUniqueName(const Prefix: string): string; function GetFirstSibling: TDefineTemplate; function HasDefines(OnlyMarked, WithSiblings: boolean): boolean; function IsAutoGenerated: boolean; function IsEqual(ADefineTemplate: TDefineTemplate; CheckSubNodes, CheckNextSiblings: boolean): boolean; function Level: integer; function LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; ClearOldSiblings, WithMergeInfo: boolean): boolean; function SelfOrParentContainsFlag(AFlag: TDefineTemplateFlag): boolean; procedure AddChild(ADefineTemplate: TDefineTemplate); procedure ReplaceChild(ADefineTemplate: TDefineTemplate); function DeleteChild(const AName: string): boolean; procedure Assign(ADefineTemplate: TDefineTemplate; WithSubNodes, WithNextSiblings, ClearOldSiblings: boolean); virtual; procedure AssignValues(ADefineTemplate: TDefineTemplate); procedure Clear(WithSiblings: boolean); procedure CreateMergeInfo(WithSiblings, OnlyMarked: boolean); procedure InheritMarks(WithSiblings, WithChilds, Down, Up: boolean); procedure InsertBehind(APrior: TDefineTemplate); procedure InsertInFront(ANext: TDefineTemplate); procedure LoadValuesFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; WithMergeInfo: boolean); procedure MarkFlags(const MustFlags, NotFlags: TDefineTemplateFlags; WithSiblings, WithChilds: boolean); procedure MarkNodes(WithSiblings, WithChilds: boolean); procedure MarkOwnedBy(TheOwner: TObject; const MustFlags, NotFlags: TDefineTemplateFlags; WithSiblings, WithChilds: boolean); procedure RemoveFlags(TheFlags: TDefineTemplateFlags); procedure RemoveLeaves(TheOwner: TObject; const MustFlags, NotFlags: TDefineTemplateFlags; WithSiblings: boolean; var FirstDefTemplate: TDefineTemplate); procedure RemoveMarked(WithSiblings: boolean; var FirstDefTemplate: TDefineTemplate); procedure RemoveOwner(TheOwner: TObject; WithSiblings: boolean); procedure ReverseMarks(WithSiblings, WithChilds: boolean); procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; WithSiblings, OnlyMarked, WithMergeInfo, UpdateMergeInfo: boolean); procedure SaveValuesToXMLConfig(XMLConfig: TXMLConfig; const Path: string; WithMergeInfo: boolean); procedure SetDefineOwner(NewOwner: TObject; WithSiblings: boolean); procedure SetFlags(AddFlags, SubFlags: TDefineTemplateFlags; WithSiblings: boolean); procedure Unbind; procedure UnmarkNodes(WithSiblings, WithChilds: boolean); procedure WriteDebugReport(OnlyMarked: boolean); public property ChildCount: integer read FChildCount; property FirstChild: TDefineTemplate read FFirstChild; property LastChild: TDefineTemplate read FLastChild; property Marked: boolean read FMarked write FMarked; property Next: TDefineTemplate read FNext; property Parent: TDefineTemplate read FParent; property Prior: TDefineTemplate read FPrior; property MergeNameInFront: string read FMergeNameInFront write FMergeNameInFront; property MergeNameBehind: string read FMergeNameBehind write FMergeNameBehind; end; //--------------------------------------------------------------------------- // TDirectoryDefines = class public Path: string; Values: TExpressionEvaluator; constructor Create; destructor Destroy; override; end; TOnGetVirtualDirectoryDefines = procedure(Sender: TDefineTree; Defines: TDirectoryDefines) of object; //--------------------------------------------------------------------------- // TDefineTree caches the define values for directories TOnReadValue = procedure(Sender: TObject; const VariableName: string; var Value: string; var Handled: boolean) of object; TOnGetVirtualDirectoryAlias = procedure(Sender: TObject; var RealDir: string) of object; TReadFunctionData = record Param: string; Result: string; end; PReadFunctionData = ^TReadFunctionData; TDefTreeCalculate = procedure(Tree: TDefineTree; Node: TDefineTemplate; ValueParsed: boolean; const ParsedValue: string; ExpressionCalculated: boolean; const ExpressionResult: string; Execute: boolean) of object; TDefineTree = class private FDirectoryCachePool: TCTDirectoryCachePool; FFirstDefineTemplate: TDefineTemplate; FCache: TAVLTree; // tree of TDirectoryDefines FChangeStep: integer; FErrorDescription: string; FErrorTemplate: TDefineTemplate; FMacroFunctions: TKeyWordFunctionList; FMacroVariables: TKeyWordFunctionList; FOnCalculate: TDefTreeCalculate; FOnGetVirtualDirectoryAlias: TOnGetVirtualDirectoryAlias; FOnGetVirtualDirectoryDefines: TOnGetVirtualDirectoryDefines; FOnPrepareTree: TNotifyEvent; FOnReadValue: TOnReadValue; FVirtualDirCache: TDirectoryDefines; function Calculate(DirDef: TDirectoryDefines): boolean; procedure IncreaseChangeStep; procedure SetDirectoryCachePool(const AValue: TCTDirectoryCachePool); protected function FindDirectoryInCache(const Path: string): TDirectoryDefines; function GetDirDefinesForDirectory(const Path: string; WithVirtualDir: boolean): TDirectoryDefines; function GetDirDefinesForVirtualDirectory: TDirectoryDefines; function MacroFuncExtractFileExt(Data: Pointer): boolean; function MacroFuncExtractFilePath(Data: Pointer): boolean; function MacroFuncExtractFileName(Data: Pointer): boolean; function MacroFuncExtractFileNameOnly(Data: Pointer): boolean; procedure DoClearCache; procedure DoPrepareTree; public property RootTemplate: TDefineTemplate read FFirstDefineTemplate write FFirstDefineTemplate; property ChangeStep: integer read FChangeStep; property ErrorTemplate: TDefineTemplate read FErrorTemplate; property ErrorDescription: string read FErrorDescription; property OnGetVirtualDirectoryAlias: TOnGetVirtualDirectoryAlias read FOnGetVirtualDirectoryAlias write FOnGetVirtualDirectoryAlias; property OnGetVirtualDirectoryDefines: TOnGetVirtualDirectoryDefines read FOnGetVirtualDirectoryDefines write FOnGetVirtualDirectoryDefines; property OnReadValue: TOnReadValue read FOnReadValue write FOnReadValue; property OnPrepareTree: TNotifyEvent read FOnPrepareTree write FOnPrepareTree; property OnCalculate: TDefTreeCalculate read FOnCalculate write FOnCalculate; property MacroFunctions: TKeyWordFunctionList read FMacroFunctions; property MacroVariables: TKeyWordFunctionList read FMacroVariables; public constructor Create; destructor Destroy; override; procedure ConsistencyCheck; function ExtractNonAutoCreated: TDefineTemplate; function ExtractTemplatesOwnedBy(TheOwner: TObject; const MustFlags, NotFlags: TDefineTemplateFlags): TDefineTemplate; function FindDefineTemplateByName(const AName: string; OnlyRoots: boolean): TDefineTemplate; function GetCompiledSrcPathForDirectory(const Directory: string): string; function GetDCUSrcPathForDirectory(const Directory: string): string; function GetDefinesForDirectory(const Path: string; WithVirtualDir: boolean): TExpressionEvaluator; function GetDefinesForVirtualDirectory: TExpressionEvaluator; function GetIncludePathForDirectory(const Directory: string): string; function GetLastRootTemplate: TDefineTemplate; function GetPPUSrcPathForDirectory(const Directory: string): string; function GetPPWSrcPathForDirectory(const Directory: string): string; function GetSrcPathForDirectory(const Directory: string): string; function GetUnitPathForDirectory(const Directory: string): string; function IsEqual(SrcDefineTree: TDefineTree): boolean; procedure Add(ADefineTemplate: TDefineTemplate); procedure AddChild(ParentTemplate, NewDefineTemplate: TDefineTemplate); procedure AddFirst(ADefineTemplate: TDefineTemplate); procedure Assign(SrcDefineTree: TDefineTree); procedure AssignNonAutoCreated(SrcDefineTree: TDefineTree); procedure Clear; procedure ClearCache; procedure MarkNonAutoCreated; procedure MarkTemplatesOwnedBy(TheOwner: TObject; const MustFlags, NotFlags: TDefineTemplateFlags); procedure MergeDefineTemplates(SourceTemplate: TDefineTemplate; const NewNamePrefix: string); procedure MergeTemplates(SourceTemplate: TDefineTemplate; const NewNamePrefix: string); procedure ReadValue(const DirDef: TDirectoryDefines; const PreValue, CurDefinePath: string; out NewValue: string); procedure RemoveDefineTemplate(ADefTempl: TDefineTemplate); procedure RemoveMarked; procedure RemoveRootDefineTemplateByName(const AName: string); procedure RemoveTemplatesOwnedBy(TheOwner: TObject; const MustFlags, NotFlags: TDefineTemplateFlags); procedure ReplaceChild(ParentTemplate, NewDefineTemplate: TDefineTemplate; const ChildName: string); procedure ReplaceRootSameName(ADefineTemplate: TDefineTemplate); procedure ReplaceRootSameName(const Name: string; ADefineTemplate: TDefineTemplate); procedure ReplaceRootSameNameAddFirst(ADefineTemplate: TDefineTemplate); procedure WriteDebugReport; property DirectoryCachePool: TCTDirectoryCachePool read FDirectoryCachePool write SetDirectoryCachePool; end; //--------------------------------------------------------------------------- TDefinePool = class private FEnglishErrorMsgFilename: string; FItems: TFPList; // list of TDefineTemplate; function GetItems(Index: integer): TDefineTemplate; procedure SetEnglishErrorMsgFilename(const AValue: string); public property Items[Index: integer]: TDefineTemplate read GetItems; default; function Count: integer; procedure Add(ADefineTemplate: TDefineTemplate); procedure Insert(Index: integer; ADefineTemplate: TDefineTemplate); procedure Delete(Index: integer); procedure Move(SrcIndex, DestIndex: integer); property EnglishErrorMsgFilename: string read FEnglishErrorMsgFilename write SetEnglishErrorMsgFilename; // FPC templates function CreateFPCTemplate(const CompilerPath, CompilerOptions, TestPascalFile: string; out UnitSearchPath, TargetOS, TargetProcessor: string; Owner: TObject): TDefineTemplate; function CreateFPCSrcTemplate(const FPCSrcDir, UnitSearchPath, PPUExt, DefaultTargetOS, DefaultProcessorName: string; UnitLinkListValid: boolean; var UnitLinkList: string; Owner: TObject): TDefineTemplate; function CreateFPCCommandLineDefines(const Name, CmdLine: string; RecursiveDefines: boolean; Owner: TObject; AlwaysCreate: boolean = false): TDefineTemplate; // Lazarus templates function CreateLazarusSrcTemplate( const LazarusSrcDir, WidgetType, ExtraOptions: string; Owner: TObject): TDefineTemplate; function CreateLCLProjectTemplate(const LazarusSrcDir, WidgetType, ProjectDir: string; Owner: TObject): TDefineTemplate; // Delphi templates function CreateDelphiSrcPath(DelphiVersion: integer; const PathPrefix: string): string; function CreateDelphiCompilerDefinesTemplate(DelphiVersion: integer; Owner: TObject): TDefineTemplate; function CreateDelphiDirectoryTemplate(const DelphiDirectory: string; DelphiVersion: integer; Owner: TObject): TDefineTemplate; function CreateDelphiProjectTemplate(const ProjectDir, DelphiDirectory: string; DelphiVersion: integer; Owner: TObject): TDefineTemplate; // Kylix templates function CreateKylixCompilerDefinesTemplate(KylixVersion: integer; Owner: TObject): TDefineTemplate; function CreateKylixSrcPath(KylixVersion: integer; const PathPrefix: string): string; function CreateKylixDirectoryTemplate(const KylixDirectory: string; KylixVersion: integer; Owner: TObject): TDefineTemplate; function CreateKylixProjectTemplate(const ProjectDir, KylixDirectory: string; KylixVersion: integer; Owner: TObject): TDefineTemplate; procedure Clear; constructor Create; destructor Destroy; override; procedure ConsistencyCheck; procedure WriteDebugReport; end; const DefineTemplateFlagNames: array[TDefineTemplateFlag] of shortstring = ( 'AutoGenerated' ); function DefineActionNameToAction(const s: string): TDefineAction; function DefineTemplateFlagsToString(Flags: TDefineTemplateFlags): string; function GetDefaultSrcOSForTargetOS(const TargetOS: string): string; function GetDefaultSrcOS2ForTargetOS(const TargetOS: string): string; procedure SplitLazarusCPUOSWidgetCombo(const Combination: string; var CPU, OS, WidgetSet: string); function GetCompiledTargetOS: string; function GetDefaultCompilerFilename: string; // functions to quickly setup some defines function CreateDefinesInDirectories(const SourcePaths, FlagName: string ): TDefineTemplate; procedure ReadMakefileFPC(const Filename: string; List: TStrings); procedure ParseMakefileFPC(const Filename, SrcOS: string; var Dirs, SubDirs: string); implementation type TDefTemplUnitNameLink = class public UnitName: string; Filename: string; MacroCount: integer; UsedMacroCount: integer; Priority: integer; end; // some useful functions procedure ReadMakefileFPC(const Filename: string; List: TStrings); var MakefileFPC: TStringList; i: Integer; Line: string; p: LongInt; NameValue: String; begin MakefileFPC:=TStringList.Create; MakefileFPC.LoadFromFile(UTF8ToSys(Filename)); i:=0; while i=1) and (NameValue[p] in [' ',#9]) do dec(p); //List.Add(' NameValue="'+NameValue+'" p='+IntToStr(p)+' "'+NameValue[p]+'"'); if (p>=1) and (NameValue[p]='\') and ((p=1) or (NameValue[p-1]<>'\')) then begin // append next line NameValue:=copy(NameValue,1,p-1); inc(i); if i>=MakefileFPC.Count then break; NameValue:=NameValue+MakefileFPC[i]; end else break; until false; List.Add(NameValue); end; inc(i); end; MakefileFPC.Free; end; procedure ParseMakefileFPC(const Filename, SrcOS: string; var Dirs, SubDirs: string); function MakeSearchPath(const s: string): string; var SrcPos: Integer; DestPos: Integer; begin // check how much space is needed SrcPos:=1; DestPos:=0; while (SrcPos<=length(s)) do begin if s[SrcPos] in [#0..#31] then begin // space is a delimiter inc(SrcPos); // skip multiple spaces while (SrcPos<=length(s)) and (s[SrcPos] in [#0..#31]) do inc(SrcPos); if (DestPos>0) and (SrcPos<=length(s)) then begin inc(DestPos);// add semicolon end; end else begin inc(DestPos); inc(SrcPos); end; end; // allocate space SetLength(Result,DestPos); // create semicolon delimited search path SrcPos:=1; DestPos:=0; while (SrcPos<=length(s)) do begin if s[SrcPos] in [#0..#32] then begin // space is a delimiter inc(SrcPos); // skip multiple spaces while (SrcPos<=length(s)) and (s[SrcPos] in [#0..#32]) do inc(SrcPos); if (DestPos>0) and (SrcPos<=length(s)) then begin inc(DestPos);// add semicolon Result[DestPos]:=';'; end; end else begin inc(DestPos); Result[DestPos]:=s[SrcPos]; inc(SrcPos); end; end; end; var Params: TStringList; i: Integer; Line: string; p: LongInt; Name: String; SubDirsName: String; begin SubDirs:=''; Dirs:=''; Params:=TStringList.Create; try ReadMakefileFPC(Filename,Params); SubDirsName:=''; if SrcOS<>'' then SubDirsName:='dirs_'+SrcOS; for i:=0 to Params.Count-1 do begin Line:=Params[i]; if Line='' then continue; if (Line[1] in ['a'..'z','A'..'Z','0'..'9','_']) then begin p:=System.Pos('=',Line); if p<1 then continue; Name:=copy(Line,1,p-1); if Name=SubDirsName then begin SubDirs:=MakeSearchPath(copy(Line,p+1,length(Line))); end else if Name='dirs' then begin Dirs:=MakeSearchPath(copy(Line,p+1,length(Line))); end; end; end; except on e: Exception do begin debugln('ParseMakefileFPC Filename=',Filename,' E.Message=',E.Message); end; end; Params.Free; end; function DefineActionNameToAction(const s: string): TDefineAction; begin for Result:=Low(TDefineAction) to High(TDefineAction) do if CompareText(s,DefineActionNames[Result])=0 then exit; Result:=da_None; end; function DefineTemplateFlagsToString(Flags: TDefineTemplateFlags): string; var f: TDefineTemplateFlag; begin Result:=''; for f:=Low(TDefineTemplateFlag) to High(TDefineTemplateFlag) do begin if f in Flags then begin if Result<>'' then Result:=Result+','; Result:=Result+DefineTemplateFlagNames[f]; end; end; end; function CompareUnitLinkNodes(NodeData1, NodeData2: pointer): integer; var Link1, Link2: TDefTemplUnitNameLink; begin Link1:=TDefTemplUnitNameLink(NodeData1); Link2:=TDefTemplUnitNameLink(NodeData2); Result:=CompareText(Link1.UnitName,Link2.UnitName); end; function CompareUnitNameWithUnitLinkNode(UnitName: Pointer; NodeData: pointer): integer; begin Result:=CompareText(String(UnitName),TDefTemplUnitNameLink(NodeData).UnitName); end; function CompareDirectoryDefines(NodeData1, NodeData2: pointer): integer; var DirDef1, DirDef2: TDirectoryDefines; begin DirDef1:=TDirectoryDefines(NodeData1); DirDef2:=TDirectoryDefines(NodeData2); Result:=CompareFilenames(DirDef1.Path,DirDef2.Path); end; function GetDefaultSrcOSForTargetOS(const TargetOS: string): string; begin Result:=''; if (CompareText(TargetOS,'linux')=0) or (CompareText(TargetOS,'freebsd')=0) or (CompareText(TargetOS,'netbsd')=0) or (CompareText(TargetOS,'openbsd')=0) or (CompareText(TargetOS,'darwin')=0) or (CompareText(TargetOS,'solaris')=0) then Result:='unix' else if (CompareText(TargetOS,'win32')=0) or (CompareText(TargetOS,'win64')=0) or (CompareText(TargetOS,'wince')=0) then Result:='win'; end; function GetDefaultSrcOS2ForTargetOS(const TargetOS: string): string; begin Result:=''; if (CompareText(TargetOS,'freebsd')=0) or (CompareText(TargetOS,'netbsd')=0) or (CompareText(TargetOS,'openbsd')=0) or (CompareText(TargetOS,'darwin')=0) then Result:='bsd'; end; procedure SplitLazarusCPUOSWidgetCombo(const Combination: string; var CPU, OS, WidgetSet: string); var StartPos, EndPos: integer; begin StartPos:=1; EndPos:=StartPos; while (EndPos<=length(Combination)) and (Combination[EndPos]<>'-') do inc(EndPos); CPU:=copy(Combination,StartPos,EndPos-StartPos); StartPos:=EndPos+1; EndPos:=StartPos; while (EndPos<=length(Combination)) and (Combination[EndPos]<>'-') do inc(EndPos); OS:=copy(Combination,StartPos,EndPos-StartPos); StartPos:=EndPos+1; EndPos:=StartPos; while (EndPos<=length(Combination)) and (Combination[EndPos]<>'-') do inc(EndPos); WidgetSet:=copy(Combination,StartPos,EndPos-StartPos); end; function GetCompiledTargetOS: string; begin Result:=lowerCase({$I %FPCTARGETCPU%}); end; function GetDefaultCompilerFilename: string; begin Result:='fpc'+ExeExt; (* {$IFDEF CPUi386} Result:='ppc386'+ExeExt; {$ENDIF} {$IFDEF CPUPowerPC} Result:='ppcppc'; {$ENDIF} {$IFDEF CPUSparc} Result:='ppcsparc'; {$ENDIF} {$IFDEF CPUM68K} Result:='ppc86k'; {$ENDIF} {$IFDEF CPUALPHA} Result:='ppcaxp'+ExeExt; {$ENDIF} {$IFDEF CPUX86_64} Result:='ppcx64'+ExeExt; {$ENDIF} {$IFDEF CPUARM} Result:='ppcarm'+ExeExt; {$ENDIF} *) end; function CreateDefinesInDirectories(const SourcePaths, FlagName: string ): TDefineTemplate; var StartPos: Integer; EndPos: LongInt; CurDirectory: String; DirsTempl: TDefineTemplate; DirTempl: TDefineTemplate; SetFlagTempl: TDefineTemplate; begin // create a block template for the directories DirsTempl:=TDefineTemplate.Create(FlagName, 'Block of directories to set '+FlagName, '','',da_Block); // create a define flag for every directory StartPos:=1; while StartPos<=length(SourcePaths) do begin EndPos:=StartPos; while (EndPos<=length(SourcePaths)) and (SourcePaths[EndPos]<>';') do inc(EndPos); if EndPos>StartPos then begin CurDirectory:=copy(SourcePaths,StartPos,EndPos-StartPos); DirTempl:=TDefineTemplate.Create('FlagDirectory','FlagDirectory', '',CurDirectory,da_Directory); SetFlagTempl:=TDefineTemplate.Create(FlagName,FlagName, FlagName,'1',da_Define); DirTempl.AddChild(SetFlagTempl); DirsTempl.AddChild(DirTempl); end; StartPos:=EndPos+1; end; Result:=DirsTempl; end; { TDefineTemplate } procedure TDefineTemplate.MarkFlags( const MustFlags, NotFlags: TDefineTemplateFlags; WithSiblings, WithChilds: boolean); var ANode: TDefineTemplate; begin ANode:=Self; while ANode<>nil do begin ANode.FMarked:=ANode.FMarked or (((ANode.Flags*MustFlags)=MustFlags) and (ANode.Flags*NotFlags=[])); if (ANode.FirstChild<>nil) and WithChilds then ANode.FirstChild.MarkFlags(MustFlags,NotFlags,true,true); if not WithSiblings then break; ANode:=ANode.Next; end; end; procedure TDefineTemplate.MarkOwnedBy(TheOwner: TObject; const MustFlags, NotFlags: TDefineTemplateFlags; WithSiblings, WithChilds: boolean); var ANode: TDefineTemplate; begin ANode:=Self; while ANode<>nil do begin ANode.FMarked:=ANode.FMarked or ((ANode.Owner=TheOwner) and ((ANode.Flags*MustFlags)=MustFlags) and (ANode.Flags*NotFlags=[])); if (ANode.FirstChild<>nil) and WithChilds then ANode.FirstChild.MarkOwnedBy(TheOwner,MustFlags,NotFlags,true,true); if not WithSiblings then break; ANode:=ANode.Next; end; end; procedure TDefineTemplate.MarkNodes(WithSiblings, WithChilds: boolean); var ANode: TDefineTemplate; begin ANode:=Self; while ANode<>nil do begin ANode.FMarked:=true; if (ANode.FirstChild<>nil) and WithChilds then ANode.FirstChild.MarkNodes(true,true); if not WithSiblings then break; ANode:=ANode.Next; end; end; procedure TDefineTemplate.ReverseMarks(WithSiblings, WithChilds: boolean); var ANode: TDefineTemplate; begin ANode:=Self; while ANode<>nil do begin ANode.FMarked:=not ANode.FMarked; if (ANode.FirstChild<>nil) and WithChilds then ANode.FirstChild.MarkNodes(true,true); if not WithSiblings then break; ANode:=ANode.Next; end; end; procedure TDefineTemplate.InheritMarks(WithSiblings, WithChilds, Down, Up: boolean); var ANode: TDefineTemplate; ChildNode: TDefineTemplate; begin ANode:=Self; while ANode<>nil do begin if WithChilds then begin ChildNode:=ANode.FirstChild; while ChildNode<>nil do begin if Down and ANode.FMarked then ChildNode.FMarked:=true; ChildNode.InheritMarks(false,true,Down,Up); if Up and ChildNode.FMarked then ANode.FMarked:=true; ChildNode:=ChildNode.Next; end; end; if not WithSiblings then break; ANode:=ANode.Next; end; end; procedure TDefineTemplate.UnmarkNodes(WithSiblings, WithChilds: boolean); var ANode: TDefineTemplate; begin ANode:=Self; while ANode<>nil do begin ANode.FMarked:=false; if (ANode.FirstChild<>nil) and WithChilds then ANode.FirstChild.UnmarkNodes(true,true); if not WithSiblings then break; ANode:=ANode.Next; end; end; procedure TDefineTemplate.RemoveMarked(WithSiblings: boolean; var FirstDefTemplate: TDefineTemplate); var ANode, NextNode: TDefineTemplate; begin ANode:=Self; while ANode<>nil do begin NextNode:=ANode.Next; if ANode.FirstChild<>nil then begin ANode.FirstChild.RemoveMarked(true,FirstDefTemplate); end; if ANode.FMarked and (ANode.FirstChild=nil) then begin if ANode=FirstDefTemplate then FirstDefTemplate:=ANode.Next; ANode.Unbind; ANode.Free; end; if not WithSiblings then break; ANode:=NextNode; end; end; procedure TDefineTemplate.RemoveOwner(TheOwner: TObject; WithSiblings: boolean); var ANode: TDefineTemplate; begin ANode:=Self; while ANode<>nil do begin if ANode.FFirstChild<>nil then ANode.FFirstChild.RemoveOwner(TheOwner,true); if ANode.Owner=TheOwner then ANode.Owner:=nil; if not WithSiblings then break; ANode:=ANode.Next; end; end; procedure TDefineTemplate.RemoveLeaves(TheOwner: TObject; const MustFlags, NotFlags: TDefineTemplateFlags; WithSiblings: boolean; var FirstDefTemplate: TDefineTemplate); var ANode, NextNode: TDefineTemplate; begin ANode:=Self; while ANode<>nil do begin NextNode:=ANode.Next; if ANode.FirstChild<>nil then ANode.FirstChild.RemoveLeaves(TheOwner,MustFlags,NotFlags,true, FirstDefTemplate); if ANode.FirstChild=nil then begin // this is a leaf if ((ANode.Owner=TheOwner) and ((ANode.Flags*MustFlags)=MustFlags) and (ANode.Flags*NotFlags=[])) then begin if ANode=FirstDefTemplate then FirstDefTemplate:=ANode.Next; ANode.Unbind; ANode.Free; end; end; if not WithSiblings then break; ANode:=NextNode; end; end; procedure TDefineTemplate.AddChild(ADefineTemplate: TDefineTemplate); // add as last child begin if ADefineTemplate=nil then exit; if ADefineTemplate.Parent<>nil then raise Exception.Create('TDefineTemplate.AddChild'); if LastChild=nil then begin while ADefineTemplate<>nil do begin ADefineTemplate.fParent:=Self; if ADefineTemplate.Prior=nil then FFirstChild:=ADefineTemplate; if ADefineTemplate.Next=nil then FLastChild:=ADefineTemplate; inc(FChildCount); ADefineTemplate:=ADefineTemplate.Next; end; end else begin ADefineTemplate.InsertBehind(LastChild); end; end; procedure TDefineTemplate.ReplaceChild(ADefineTemplate: TDefineTemplate); var OldTempl: TDefineTemplate; begin OldTempl:=FindChildByName(ADefineTemplate.Name); if OldTempl<>nil then begin ADefineTemplate.InsertInFront(OldTempl); OldTempl.UnBind; OldTempl.Free; end else AddChild(ADefineTemplate); end; function TDefineTemplate.DeleteChild(const AName: string): boolean; var OldTempl: TDefineTemplate; begin OldTempl:=FindChildByName(AName); if OldTempl<>nil then begin Result:=true; OldTempl.Unbind; OldTempl.Free; end else Result:=false; end; procedure TDefineTemplate.InsertBehind(APrior: TDefineTemplate); // insert this and all next siblings behind APrior var ANode, LastSibling, NewParent: TDefineTemplate; begin if APrior=nil then exit; NewParent:=APrior.Parent; if Parent<>nil then begin ANode:=Self; while ANode<>nil do begin if ANode=APrior then raise Exception.Create('internal error: ' +'TDefineTemplate.InsertBehind: APrior=ANode'); dec(Parent.FChildCount); ANode.FParent:=nil; ANode:=ANode.Next; end; end; LastSibling:=Self; while LastSibling.Next<>nil do LastSibling:=LastSibling.Next; FParent:=NewParent; if Parent<>nil then begin ANode:=Self; while (ANode<>nil) do begin ANode.FParent:=Parent; inc(Parent.FChildCount); ANode:=ANode.Next; end; if Parent.LastChild=APrior then Parent.FLastChild:=LastSibling; end; FPrior:=APrior; LastSibling.FNext:=APrior.Next; APrior.FNext:=Self; if LastSibling.Next<>nil then LastSibling.Next.FPrior:=LastSibling; end; procedure TDefineTemplate.InsertInFront(ANext: TDefineTemplate); // insert this and all next siblings in front of ANext var ANode, LastSibling: TDefineTemplate; begin if ANext=nil then exit; if FParent<>nil then begin ANode:=Self; while ANode<>nil do begin if ANode=ANext then raise Exception.Create('internal error: ' +'TDefineTemplate.InsertInFront: ANext=ANode'); dec(FParent.FChildCount); ANode.FParent:=nil; ANode:=ANode.Next; end; end; LastSibling:=Self; while LastSibling.Next<>nil do LastSibling:=LastSibling.Next; FParent:=ANext.Parent; if Parent<>nil then begin ANode:=Self; while ANode<>nil do begin ANode.FParent:=Parent; inc(Parent.FChildCount); ANode:=ANode.Next; end; if Parent.FirstChild=ANext then Parent.FFirstChild:=Self; end; FPrior:=ANext.Prior; if Prior<>nil then Prior.FNext:=Self; LastSibling.FNext:=ANext; ANext.FPrior:=LastSibling; end; procedure TDefineTemplate.Assign(ADefineTemplate: TDefineTemplate; WithSubNodes, WithNextSiblings, ClearOldSiblings: boolean); var ChildTemplate, CopyTemplate, NextTemplate: TDefineTemplate; begin Clear(ClearOldSiblings); if ADefineTemplate=nil then exit; AssignValues(ADefineTemplate); if WithSubNodes then begin ChildTemplate:=ADefineTemplate.FirstChild; if ChildTemplate<>nil then begin CopyTemplate:=TDefineTemplate.Create; AddChild(CopyTemplate); CopyTemplate.Assign(ChildTemplate,true,true,false); end; end; if WithNextSiblings then begin NextTemplate:=ADefineTemplate.Next; if NextTemplate<>nil then begin CopyTemplate:=TDefineTemplate.Create; CopyTemplate.InsertBehind(Self); CopyTemplate.Assign(NextTemplate,WithSubNodes,true,false); end; end; end; procedure TDefineTemplate.AssignValues(ADefineTemplate: TDefineTemplate); begin Name:=ADefineTemplate.Name; Description:=ADefineTemplate.Description; Variable:=ADefineTemplate.Variable; Value:=ADefineTemplate.Value; Action:=ADefineTemplate.Action; Flags:=ADefineTemplate.Flags; MergeNameInFront:=ADefineTemplate.MergeNameInFront; MergeNameBehind:=ADefineTemplate.MergeNameBehind; Owner:=ADefineTemplate.Owner; end; procedure TDefineTemplate.Unbind; begin if FPrior<>nil then FPrior.FNext:=FNext; if FNext<>nil then FNext.FPrior:=FPrior; if FParent<>nil then begin if FParent.FFirstChild=Self then FParent.FFirstChild:=FNext; if FParent.FLastChild=Self then FParent.FLastChild:=FPrior; dec(FParent.FChildCount); end; FNext:=nil; FPrior:=nil; FParent:=nil; end; procedure TDefineTemplate.Clear(WithSiblings: boolean); begin while FFirstChild<>nil do FFirstChild.Free; if WithSiblings then while FNext<>nil do FNext.Free; Name:=''; Description:=''; Value:=''; Variable:=''; Flags:=[]; end; constructor TDefineTemplate.Create; begin inherited Create; end; constructor TDefineTemplate.Create(const AName, ADescription, AVariable, AValue: string; AnAction: TDefineAction); begin inherited Create; Name:=AName; Description:=ADescription; Variable:=AVariable; Value:=AValue; Action:=AnAction; end; function TDefineTemplate.CreateCopy(OnlyMarked: boolean; WithSiblings: boolean; WithChilds: boolean): TDefineTemplate; var LastNewNode, NewNode, ANode: TDefineTemplate; begin Result:=nil; LastNewNode:=nil; ANode:=Self; while ANode<>nil do begin if (not OnlyMarked) or (ANode.FMarked) then begin // copy node NewNode:=TDefineTemplate.Create; NewNode.Assign(ANode,false,false,false); if LastNewNode<>nil then NewNode.InsertBehind(LastNewNode) else Result:=NewNode; LastNewNode:=NewNode; // copy childs if WithChilds and (ANode.FirstChild<>nil) then begin NewNode:=ANode.FirstChild.CreateCopy(OnlyMarked,true,true); if NewNode<>nil then LastNewNode.AddChild(NewNode); end; end; if not WithSiblings then break; ANode:=ANode.Next; end; end; function TDefineTemplate.CreateMergeCopy: TDefineTemplate; begin CreateMergeInfo(false,false); Result:=TDefineTemplate.Create; Result.Assign(Self,true,false,false); end; function TDefineTemplate.FindRoot: TDefineTemplate; begin Result:=Self; repeat if Result.Parent<>nil then Result:=Result.Parent else if Result.Prior<>nil then Result:=Result.Prior else break; until false; end; destructor TDefineTemplate.Destroy; begin Clear(false); Unbind; inherited Destroy; end; function TDefineTemplate.LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; ClearOldSiblings, WithMergeInfo: boolean): boolean; var IndexedPath: string; i, LvlCount: integer; DefTempl, LastDefTempl: TDefineTemplate; NewChild: TDefineTemplate; begin Clear(ClearOldSiblings); LvlCount:=XMLConfig.GetValue(Path+'Count/Value',0); DefTempl:=nil; for i:=1 to LvlCount do begin if i=1 then begin DefTempl:=Self; LastDefTempl:=Prior; end else begin LastDefTempl:=DefTempl; DefTempl:=TDefineTemplate.Create; DefTempl.InsertBehind(LastDefTempl); end; IndexedPath:=Path+'Node'+IntToStr(i)+'/'; DefTempl.LoadValuesFromXMLConfig(XMLConfig,IndexedPath,WithMergeInfo); // load childs if XMLConfig.GetValue(IndexedPath+'Count/Value',0)>0 then begin NewChild:=TDefineTemplate.Create; DefTempl.AddChild(NewChild); if not NewChild.LoadFromXMLConfig(XMLConfig,IndexedPath, false,WithMergeInfo) then begin Result:=false; exit; end; end; end; Result:=true; end; procedure TDefineTemplate.LoadValuesFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; WithMergeInfo: boolean); var f: TDefineTemplateFlag; begin Name:=XMLConfig.GetValue(Path+'Name/Value','no name'); Description:=XMLConfig.GetValue(Path+'Description/Value',''); Value:=XMLConfig.GetValue(Path+'Value/Value',''); Variable:=XMLConfig.GetValue(Path+'Variable/Value',''); Action:=DefineActionNameToAction( XMLConfig.GetValue(Path+'Action/Value','')); Flags:=[]; for f:=Low(TDefineTemplateFlag) to High(TDefineTemplateFlag) do begin if (f<>dtfAutoGenerated) and (XMLConfig.GetValue(Path+'Flags/'+DefineTemplateFlagNames[f],false)) then Include(Flags,f); end; if WithMergeInfo then begin MergeNameInFront:=XMLConfig.GetValue(Path+'MergeNameInFront/Value',''); MergeNameBehind:=XMLConfig.GetValue(Path+'MergeNameInFront/Value',''); end else begin MergeNameInFront:=''; MergeNameBehind:=''; end; end; procedure TDefineTemplate.SaveValuesToXMLConfig(XMLConfig: TXMLConfig; const Path: string; WithMergeInfo: boolean); var f: TDefineTemplateFlag; begin XMLConfig.SetDeleteValue(Path+'Name/Value',Name,''); XMLConfig.SetDeleteValue(Path+'Description/Value',Description,''); XMLConfig.SetDeleteValue(Path+'Value/Value',Value,''); XMLConfig.SetDeleteValue(Path+'Variable/Value',Variable,''); XMLConfig.SetDeleteValue(Path+'Action/Value', DefineActionNames[Action], DefineActionNames[da_None]); for f:=Low(TDefineTemplateFlag) to High(TDefineTemplateFlag) do begin if (f<>dtfAutoGenerated) then XMLConfig.SetDeleteValue( Path+'Flags/'+DefineTemplateFlagNames[f] ,f in Flags,false); end; if WithMergeInfo then begin XMLConfig.SetDeleteValue(Path+'MergeNameInFront/Value', MergeNameInFront,''); XMLConfig.SetDeleteValue(Path+'MergeNameBehind/Value', MergeNameBehind,''); end else begin XMLConfig.SetDeleteValue(Path+'MergeNameInFront/Value','',''); XMLConfig.SetDeleteValue(Path+'MergeNameBehind/Value','',''); end; end; procedure TDefineTemplate.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; WithSiblings, OnlyMarked, WithMergeInfo, UpdateMergeInfo: boolean); var IndexedPath: string; Index, LvlCount: integer; DefTempl: TDefineTemplate; begin if UpdateMergeInfo then CreateMergeInfo(WithSiblings,OnlyMarked); DefTempl:=Self; LvlCount:=0; while DefTempl<>nil do begin inc(LvlCount); DefTempl:=DefTempl.Next; end; DefTempl:=Self; Index:=0; repeat if (DefTempl.FMarked) or (not OnlyMarked) then begin // save node inc(Index); IndexedPath:=Path+'Node'+IntToStr(Index)+'/'; DefTempl.SaveValuesToXMLConfig(XMLConfig,IndexedPath,WithMergeInfo); // save childs if DefTempl.FFirstChild<>nil then DefTempl.FirstChild.SaveToXMLConfig(XMLConfig,IndexedPath, true,OnlyMarked, WithMergeInfo,false) else XMLConfig.SetDeleteValue(IndexedPath+'Count/Value',0,0); end; if not WithSiblings then break; DefTempl:=DefTempl.Next; until DefTempl=nil; XMLConfig.SetDeleteValue(Path+'Count/Value',Index,0); end; procedure TDefineTemplate.CreateMergeInfo(WithSiblings, OnlyMarked: boolean); var DefTempl: TDefineTemplate; begin DefTempl:=Self; repeat if (DefTempl.FMarked) or (not OnlyMarked) then begin if DefTempl.Prior<>nil then DefTempl.MergeNameInFront:=DefTempl.Prior.Name else DefTempl.MergeNameInFront:=''; if DefTempl.Next<>nil then DefTempl.MergeNameBehind:=DefTempl.Next.Name else DefTempl.MergeNameBehind:=''; // update childs if DefTempl.FFirstChild<>nil then DefTempl.FirstChild.CreateMergeInfo(true,OnlyMarked); end; if not WithSiblings then break; DefTempl:=DefTempl.Next; until DefTempl=nil; end; class procedure TDefineTemplate.MergeXMLConfig(ParentDefTempl: TDefineTemplate; var FirstSibling, LastSibling: TDefineTemplate; XMLConfig: TXMLConfig; const Path, NewNamePrefix: string); var SrcNode: TDefineTemplate; begin SrcNode:=TDefineTemplate.Create; SrcNode.LoadFromXMLConfig(XMLConfig,Path,false,true); MergeTemplates(ParentDefTempl,FirstSibling,LastSibling,SrcNode,true, NewNamePrefix); SrcNode.Clear(true); SrcNode.Free; end; class procedure TDefineTemplate.MergeTemplates(ParentDefTempl: TDefineTemplate; var FirstSibling, LastSibling: TDefineTemplate; SourceTemplate: TDefineTemplate; WithSiblings: boolean; const NewNamePrefix: string); // merge SourceTemplate. This will keep SourceTemplate untouched var NewNode, PosNode: TDefineTemplate; Inserted: boolean; SrcNode: TDefineTemplate; begin SrcNode:=SourceTemplate; while SrcNode<>nil do begin // merge all source nodes NewNode:=SrcNode.CreateCopy(false,false,false); Inserted:=false; if NewNode.Name<>'' then begin // node has a name -> test if already exists PosNode:=FirstSibling; while (PosNode<>nil) and (CompareText(PosNode.Name,NewNode.Name)<>0) do PosNode:=PosNode.Next; if PosNode<>nil then begin // node with same name already exists -> check if it is a copy if NewNode.IsEqual(PosNode,false,false) then begin // node already exists NewNode.Free; NewNode:=PosNode; end else begin // node has same name, but different values // -> rename node NewNode.Name:=NewNode.FindUniqueName(NewNamePrefix+NewNode.Name); // insert behind PosNode NewNode.InsertBehind(PosNode); end; Inserted:=true; end; end; if not Inserted then begin // node name is unique or empty -> insert node if NewNode.MergeNameInFront<>'' then begin // last time, node was inserted behind MergeNameInFront // -> search MergeNameInFront PosNode:=LastSibling; while (PosNode<>nil) and (CompareText(PosNode.Name,NewNode.MergeNameInFront)<>0) do PosNode:=PosNode.Prior; if PosNode<>nil then begin // MergeNameInFront found -> insert behind NewNode.InsertBehind(PosNode); Inserted:=true; end; end; if not Inserted then begin if NewNode.MergeNameBehind<>'' then begin // last time, node was inserted in front of MergeNameBehind // -> search MergeNameBehind PosNode:=FirstSibling; while (PosNode<>nil) and (CompareText(PosNode.Name,NewNode.MergeNameBehind)<>0) do PosNode:=PosNode.Next; if PosNode<>nil then begin // MergeNameBehind found -> insert in front NewNode.InsertInFront(PosNode); Inserted:=true; end; end; end; if not Inserted then begin // no merge position found -> add as last if LastSibling<>nil then begin NewNode.InsertBehind(LastSibling); end else if ParentDefTempl<>nil then begin ParentDefTempl.AddChild(NewNode); end; end; end; // NewNode is now inserted -> update FirstSibling and LastSibling if FirstSibling=nil then begin FirstSibling:=NewNode; LastSibling:=NewNode; end; while FirstSibling.Prior<>nil do FirstSibling:=FirstSibling.Prior; while LastSibling.Next<>nil do LastSibling:=LastSibling.Next; // merge childs MergeTemplates(NewNode,NewNode.FFirstChild,NewNode.FLastChild, SrcNode.FirstChild,true,NewNamePrefix); if not WithSiblings then break; SrcNode:=SrcNode.Next; end; end; procedure TDefineTemplate.ConsistencyCheck; var RealChildCount: integer; DefTempl: TDefineTemplate; begin RealChildCount:=0; DefTempl:=FFirstChild; if DefTempl<>nil then begin if DefTempl.Prior<>nil then begin // not first child RaiseCatchableException(''); end; while DefTempl<>nil do begin if DefTempl.Parent<>Self then begin DebugLn(' C: DefTempl.Parent<>Self: ',Name,',',DefTempl.Name); RaiseCatchableException(''); end; if (DefTempl.Next<>nil) and (DefTempl.Next.Prior<>DefTempl) then RaiseCatchableException(''); if (DefTempl.Prior<>nil) and (DefTempl.Prior.Next<>DefTempl) then RaiseCatchableException(''); DefTempl.ConsistencyCheck; DefTempl:=DefTempl.Next; inc(RealChildCount); end; end; if (Parent<>nil) then begin if (Prior=nil) and (Parent.FirstChild<>Self) then RaiseCatchableException(''); if (Next=nil) and (Parent.LastChild<>Self) then RaiseCatchableException(''); end; if RealChildCount<>FChildCount then RaiseCatchableException(''); end; procedure TDefineTemplate.SetDefineOwner(NewOwner: TObject; WithSiblings: boolean); var ANode: TDefineTemplate; begin ANode:=Self; while ANode<>nil do begin ANode.Owner:=NewOwner; if ANode.FFirstChild<>nil then ANode.FFirstChild.SetDefineOwner(NewOwner,true); if not WithSiblings then exit; ANode:=ANode.Next; end; end; procedure TDefineTemplate.SetFlags(AddFlags, SubFlags: TDefineTemplateFlags; WithSiblings: boolean); var ANode: TDefineTemplate; begin ANode:=Self; while ANode<>nil do begin ANode.Flags:=ANode.Flags+AddFlags-SubFlags; if ANode.FFirstChild<>nil then ANode.FFirstChild.SetFlags(AddFlags,SubFlags,true); if not WithSiblings then exit; ANode:=ANode.Next; end; end; procedure TDefineTemplate.WriteDebugReport(OnlyMarked: boolean); procedure WriteNode(ANode: TDefineTemplate; const Prefix: string); var ActionStr: string; begin if ANode=nil then exit; if (not OnlyMarked) or (ANode.Marked) then begin ActionStr:=DefineActionNames[ANode.Action]; DebugLn(Prefix+'Self='+DbgS(ANode), ' Name="'+ANode.Name,'"', ' Next='+DbgS(ANode.Next), ' Prior='+DbgS(ANode.Prior), ' Action='+ActionStr, ' Flags=['+DefineTemplateFlagsToString(ANode.Flags),']', ' Marked='+dbgs(ANode.Marked) ); DebugLn(Prefix+' + Description="',ANode.Description,'"'); DebugLn(Prefix+' + Variable="',ANode.Variable,'"'); DebugLn(Prefix+' + Value="',ANode.Value,'"'); end; WriteNode(ANode.FirstChild,Prefix+' '); WriteNode(ANode.Next,Prefix); end; begin WriteNode(Self,' '); end; function TDefineTemplate.HasDefines(OnlyMarked, WithSiblings: boolean): boolean; var CurTempl: TDefineTemplate; begin Result:=true; CurTempl:=Self; while CurTempl<>nil do begin if ((not OnlyMarked) or (CurTempl.FMarked)) and (CurTempl.Action in DefineActionDefines) then exit; // go to next if CurTempl.FFirstChild<>nil then CurTempl:=CurTempl.FFirstChild else if (CurTempl.FNext<>nil) and (WithSiblings or (CurTempl.Parent<>Parent)) then CurTempl:=CurTempl.FNext else begin // search uncle repeat CurTempl:=CurTempl.Parent; if (CurTempl=Parent) or ((CurTempl.Parent=Parent) and not WithSiblings) then begin Result:=false; exit; end; until (CurTempl.FNext<>nil); CurTempl:=CurTempl.FNext; end; end; Result:=false; end; function TDefineTemplate.IsEqual(ADefineTemplate: TDefineTemplate; CheckSubNodes, CheckNextSiblings: boolean): boolean; var SrcNode, DestNode: TDefineTemplate; begin Result:=(ADefineTemplate<>nil) and (Name=ADefineTemplate.Name) and (Description=ADefineTemplate.Description) and (Variable=ADefineTemplate.Variable) and (Value=ADefineTemplate.Value) and (Action=ADefineTemplate.Action) and (Flags=ADefineTemplate.Flags) and (Owner=ADefineTemplate.Owner); if not Result then begin exit; end; if CheckSubNodes then begin if (ChildCount<>ADefineTemplate.ChildCount) then begin Result:=false; exit; end; SrcNode:=FirstChild; DestNode:=ADefineTemplate.FirstChild; if SrcNode<>nil then begin Result:=SrcNode.IsEqual(DestNode,CheckSubNodes,true); if not Result then exit; end; end; if CheckNextSiblings then begin SrcNode:=Next; DestNode:=ADefineTemplate.Next; while (SrcNode<>nil) and (DestNode<>nil) do begin Result:=SrcNode.IsEqual(DestNode,CheckSubNodes,false); if not Result then exit; SrcNode:=SrcNode.Next; DestNode:=DestNode.Next; end; Result:=(SrcNode=nil) and (DestNode=nil); if not Result then begin DebugLn('TDefineTemplate.IsEqual DIFF 3 ',Name,' ', ADefineTemplate.Name,' ',dbgs(ChildCount),' ',dbgs(ADefineTemplate.ChildCount)); end; end; end; function TDefineTemplate.IsAutoGenerated: boolean; begin Result:=SelfOrParentContainsFlag(dtfAutoGenerated); end; procedure TDefineTemplate.RemoveFlags(TheFlags: TDefineTemplateFlags); var ANode: TDefineTemplate; begin ANode:=Self; while ANode<>nil do begin Flags:=Flags-TheFlags; if FirstChild<>nil then FirstChild.RemoveFlags(TheFlags); ANode:=ANode.Next; end; end; function TDefineTemplate.Level: integer; var ANode: TDefineTemplate; begin Result:=-1; ANode:=Self; while ANode<>nil do begin inc(Result); ANode:=ANode.Parent; end; end; function TDefineTemplate.GetFirstSibling: TDefineTemplate; begin Result:=Self; while Result.Prior<>nil do Result:=Result.Prior; end; function TDefineTemplate.SelfOrParentContainsFlag( AFlag: TDefineTemplateFlag): boolean; var Node: TDefineTemplate; begin Node:=Self; while (Node<>nil) do begin if AFlag in Node.Flags then begin Result:=true; exit; end; Node:=Node.Parent; end; Result:=false; end; function TDefineTemplate.FindChildByName(const AName: string): TDefineTemplate; begin if FirstChild<>nil then begin Result:=FirstChild.FindByName(AName,false,true) end else Result:=nil; end; function TDefineTemplate.FindByName(const AName: string; WithSubChilds, WithNextSiblings: boolean): TDefineTemplate; var ANode: TDefineTemplate; begin if CompareText(AName,Name)=0 then begin Result:=Self; end else begin if WithSubChilds and (FirstChild<>nil) then Result:=FirstChild.FindByName(AName,true,true) else Result:=nil; if (Result=nil) and WithNextSiblings then begin ANode:=Next; while (ANode<>nil) do begin Result:=ANode.FindByName(AName,WithSubChilds,false); if Result<>nil then break; ANode:=ANode.Next; end; end; end; end; function TDefineTemplate.FindUniqueName(const Prefix: string): string; var Root: TDefineTemplate; i: integer; begin Root:=FindRoot; i:=0; repeat inc(i); Result:=Prefix+IntToStr(i); until Root.FindByName(Result,true,true)=nil; end; { TDirectoryDefines } constructor TDirectoryDefines.Create; begin inherited Create; Values:=TExpressionEvaluator.Create; Path:=''; end; destructor TDirectoryDefines.Destroy; begin Values.Free; inherited Destroy; end; { TDefineTree } procedure TDefineTree.Clear; begin if FFirstDefineTemplate<>nil then begin FFirstDefineTemplate.Clear(true); FFirstDefineTemplate.Free; FFirstDefineTemplate:=nil; end; ClearCache; end; function TDefineTree.IsEqual(SrcDefineTree: TDefineTree): boolean; begin Result:=false; if SrcDefineTree=nil then exit; if (FFirstDefineTemplate=nil) xor (SrcDefineTree.FFirstDefineTemplate=nil) then exit; if (FFirstDefineTemplate<>nil) and (not FFirstDefineTemplate.IsEqual( SrcDefineTree.FFirstDefineTemplate,true,true)) then exit; Result:=true; end; procedure TDefineTree.Assign(SrcDefineTree: TDefineTree); begin if IsEqual(SrcDefineTree) then exit; Clear; if SrcDefineTree.FFirstDefineTemplate<>nil then begin FFirstDefineTemplate:=TDefineTemplate.Create; FFirstDefineTemplate.Assign(SrcDefineTree.FFirstDefineTemplate, true,true,true); end; end; procedure TDefineTree.AssignNonAutoCreated(SrcDefineTree: TDefineTree); var SrcNonAutoCreated: TDefineTemplate; begin MarkNonAutoCreated; RemoveMarked; SrcNonAutoCreated:=SrcDefineTree.ExtractNonAutoCreated; if SrcNonAutoCreated=nil then exit; //DebugLn('TDefineTree.AssignNonAutoCreated A Front=',SrcNonAutoCreated.MergeNameInFront,' Behind=',SrcNonAutoCreated.MergeNameBehind); MergeTemplates(SrcNonAutoCreated,''); SrcNonAutoCreated.Clear(true); SrcNonAutoCreated.Free; FFirstDefineTemplate.CreateMergeInfo(true,false); //DebugLn('TDefineTree.AssignNonAutoCreated B Front=',FFirstDefineTemplate.MergeNameInFront,' Behind=',FFirstDefineTemplate.MergeNameBehind); end; procedure TDefineTree.ClearCache; begin if (FCache.Count=0) and (FVirtualDirCache=nil) then exit; DoClearCache; end; constructor TDefineTree.Create; begin inherited Create; FFirstDefineTemplate:=nil; FCache:=TAVLTree.Create(@CompareDirectoryDefines); FMacroFunctions:=TKeyWordFunctionList.Create; FMacroFunctions.AddExtended('Ext',nil,@MacroFuncExtractFileExt); FMacroFunctions.AddExtended('PATH',nil,@MacroFuncExtractFilePath); FMacroFunctions.AddExtended('NAME',nil,@MacroFuncExtractFileName); FMacroFunctions.AddExtended('NAMEONLY',nil,@MacroFuncExtractFileNameOnly); FMacroVariables:=TKeyWordFunctionList.Create; end; destructor TDefineTree.Destroy; begin Clear; FMacroVariables.Free; FMacroFunctions.Free; FCache.Free; inherited Destroy; end; function TDefineTree.GetLastRootTemplate: TDefineTemplate; begin Result:=FFirstDefineTemplate; if Result=nil then exit; while Result.Next<>nil do Result:=Result.Next; end; function TDefineTree.FindDirectoryInCache( const Path: string): TDirectoryDefines; var cmp: integer; ANode: TAVLTreeNode; begin ANode:=FCache.Root; while (ANode<>nil) do begin cmp:=CompareFilenames(Path,TDirectoryDefines(ANode.Data).Path); if cmp<0 then ANode:=ANode.Left else if cmp>0 then ANode:=ANode.Right else break; end; if ANode<>nil then Result:=TDirectoryDefines(ANode.Data) else Result:=nil; end; function TDefineTree.GetDirDefinesForDirectory(const Path: string; WithVirtualDir: boolean): TDirectoryDefines; var ExpPath: String; begin //DebugLn('[TDefineTree.GetDirDefinesForDirectory] "',Path,'"'); if (Path<>'') or (not WithVirtualDir) then begin DoPrepareTree; ExpPath:=TrimFilename(Path); if (ExpPath<>'') and (ExpPath[length(ExpPath)]<>PathDelim) then ExpPath:=ExpPath+PathDelim; Result:=FindDirectoryInCache(ExpPath); if Result=nil then begin Result:=TDirectoryDefines.Create; Result.Path:=ExpPath; //DebugLn('[TDefineTree.GetDirDefinesForDirectory] B ',ExpPath,' '); if Calculate(Result) then begin //DebugLn('[TDefineTree.GetDirDefinesForDirectory] C success'); FCache.Add(Result); end else begin //DebugLn('[TDefineTree.GetDirDefinesForDirectory] D failed'); Result.Free; Result:=nil; end; end; end else begin Result:=GetDirDefinesForVirtualDirectory; end; end; function TDefineTree.GetDirDefinesForVirtualDirectory: TDirectoryDefines; begin DoPrepareTree; if FVirtualDirCache=nil then begin //DebugLn('################ TDefineTree.GetDirDefinesForVirtualDirectory'); FVirtualDirCache:=TDirectoryDefines.Create; FVirtualDirCache.Path:=VirtualDirectory; if Calculate(FVirtualDirCache) then begin //DebugLn('TDefineTree.GetDirDefinesForVirtualDirectory '); end else begin FVirtualDirCache.Free; FVirtualDirCache:=nil; end; end; Result:=FVirtualDirCache; end; function TDefineTree.MacroFuncExtractFileExt(Data: Pointer): boolean; var FuncData: PReadFunctionData; begin FuncData:=PReadFunctionData(Data); FuncData^.Result:=ExtractFileExt(FuncData^.Param); Result:=true; end; function TDefineTree.MacroFuncExtractFilePath(Data: Pointer): boolean; var FuncData: PReadFunctionData; begin FuncData:=PReadFunctionData(Data); FuncData^.Result:=ExtractFilePath(FuncData^.Param); Result:=true; end; function TDefineTree.MacroFuncExtractFileName(Data: Pointer): boolean; var FuncData: PReadFunctionData; begin FuncData:=PReadFunctionData(Data); FuncData^.Result:=ExtractFileName(FuncData^.Param); Result:=true; end; function TDefineTree.MacroFuncExtractFileNameOnly(Data: Pointer): boolean; var FuncData: PReadFunctionData; begin FuncData:=PReadFunctionData(Data); FuncData^.Result:=ExtractFileNameOnly(FuncData^.Param); Result:=true; end; procedure TDefineTree.DoClearCache; begin {$IFDEF VerboseDefineCache} DebugLn('TDefineTree.DoClearCache A +++++++++'); {$ENDIF} if FCache<>nil then FCache.FreeAndClear; if FVirtualDirCache<>nil then begin FVirtualDirCache.Free; FVirtualDirCache:=nil; end; IncreaseChangeStep; end; procedure TDefineTree.DoPrepareTree; begin if Assigned(OnPrepareTree) then OnPrepareTree(Self); end; procedure TDefineTree.RemoveMarked; begin if FFirstDefineTemplate=nil then exit; FFirstDefineTemplate.RemoveMarked(true,FFirstDefineTemplate); ClearCache; end; procedure TDefineTree.MarkNonAutoCreated; begin if FFirstDefineTemplate=nil then exit; with FFirstDefineTemplate do begin // clear marks UnmarkNodes(true,true); // mark each non autocreated node MarkFlags([],[dtfAutoGenerated],true,true); // mark every parent with a marked child InheritMarks(true,true,false,true); end; end; function TDefineTree.GetUnitPathForDirectory(const Directory: string): string; var Evaluator: TExpressionEvaluator; begin Evaluator:=GetDefinesForDirectory(Directory,true); if Evaluator<>nil then begin Result:=Evaluator.Variables[UnitPathMacroName]; end else begin Result:=''; end; end; function TDefineTree.GetIncludePathForDirectory(const Directory: string ): string; var Evaluator: TExpressionEvaluator; begin Evaluator:=GetDefinesForDirectory(Directory,true); if Evaluator<>nil then begin Result:=Evaluator.Variables[IncludePathMacroName]; end else begin Result:=''; end; end; function TDefineTree.GetSrcPathForDirectory(const Directory: string): string; var Evaluator: TExpressionEvaluator; begin Evaluator:=GetDefinesForDirectory(Directory,true); if Evaluator<>nil then begin Result:=Evaluator.Variables[SrcPathMacroName]; end else begin Result:=''; end; end; function TDefineTree.GetPPUSrcPathForDirectory(const Directory: string ): string; var Evaluator: TExpressionEvaluator; begin Evaluator:=GetDefinesForDirectory(Directory,true); if Evaluator<>nil then begin Result:=Evaluator.Variables[PPUSrcPathMacroName]; end else begin Result:=''; end; end; function TDefineTree.GetPPWSrcPathForDirectory(const Directory: string ): string; var Evaluator: TExpressionEvaluator; begin Evaluator:=GetDefinesForDirectory(Directory,true); if Evaluator<>nil then begin Result:=Evaluator.Variables[PPWSrcPathMacroName]; end else begin Result:=''; end; end; function TDefineTree.GetDCUSrcPathForDirectory(const Directory: string ): string; var Evaluator: TExpressionEvaluator; begin Evaluator:=GetDefinesForDirectory(Directory,true); if Evaluator<>nil then begin Result:=Evaluator.Variables[DCUSrcPathMacroName]; end else begin Result:=''; end; end; function TDefineTree.GetCompiledSrcPathForDirectory(const Directory: string ): string; var Evaluator: TExpressionEvaluator; begin Evaluator:=GetDefinesForDirectory(Directory,true); if Evaluator<>nil then begin Result:=Evaluator.Variables[CompiledSrcPathMacroName]; end else begin Result:=''; end; end; function TDefineTree.GetDefinesForDirectory( const Path: string; WithVirtualDir: boolean): TExpressionEvaluator; var DirDef: TDirectoryDefines; begin DirDef:=GetDirDefinesForDirectory(Path,WithVirtualDir); if DirDef<>nil then Result:=DirDef.Values else Result:=nil; end; function TDefineTree.GetDefinesForVirtualDirectory: TExpressionEvaluator; var DirDef: TDirectoryDefines; begin DirDef:=GetDirDefinesForVirtualDirectory; if DirDef<>nil then Result:=DirDef.Values else Result:=nil; end; procedure TDefineTree.ReadValue(const DirDef: TDirectoryDefines; const PreValue, CurDefinePath: string; out NewValue: string); var Buffer: PChar; BufferPos: integer; BufferSize: integer; ValuePos: integer; function SearchBracketClose(const s: string; Position:integer): integer; var BracketClose:char; sLen: Integer; begin if s[Position]='(' then BracketClose:=')' else BracketClose:='{'; inc(Position); sLen:=length(s); while (Position<=sLen) and (s[Position]<>BracketClose) do begin if s[Position]=SpecialChar then inc(Position) else if (s[Position] in ['(','{']) then Position:=SearchBracketClose(s,Position); inc(Position); end; Result:=Position; end; function ExecuteMacroFunction(const FuncName, Params: string): string; var FuncData: TReadFunctionData; begin FuncData.Param:=Params; FuncData.Result:=''; FMacroFunctions.DoDataFunction(PChar(Pointer(FuncName)),length(FuncName), @FuncData); Result:=FuncData.Result; end; function ExecuteMacroVariable(var MacroVariable: string): boolean; var FuncData: TReadFunctionData; begin FuncData.Param:=MacroVariable; FuncData.Result:=''; Result:=FMacroVariables.DoDataFunction( PChar(Pointer(MacroVariable)),length(MacroVariable),@FuncData); if Result then MacroVariable:=FuncData.Result; end; procedure GrowBuffer(MinSize: integer); var NewSize: Integer; begin if MinSize<=BufferSize then exit; NewSize:=MinSize*2+100; ReAllocMem(Buffer,NewSize); BufferSize:=NewSize; end; procedure CopyStringToBuffer(const Src: string); begin if Src='' then exit; Move(Src[1],Buffer[BufferPos],length(Src)); inc(BufferPos,length(Src)); end; procedure CopyFromValueToBuffer(Len: integer); begin if Len=0 then exit; Move(NewValue[ValuePos],Buffer[BufferPos],Len); inc(BufferPos,Len); inc(ValuePos,Len); end; function Substitute(const CurValue: string; ValueLen: integer; MacroStart: integer; var MacroEnd: integer): boolean; var MacroFuncNameEnd: Integer; MacroFuncNameLen: Integer; MacroStr: String; MacroFuncName: String; NewMacroLen: Integer; MacroParam: string; OldMacroLen: Integer; Handled: Boolean; MacroVarName: String; begin Result:=false; MacroFuncNameEnd:=MacroEnd; MacroFuncNameLen:=MacroFuncNameEnd-MacroStart-1; MacroEnd:=SearchBracketClose(CurValue,MacroFuncNameEnd)+1; if MacroEnd>ValueLen+1 then exit; OldMacroLen:=MacroEnd-MacroStart; // Macro found if MacroFuncNameLen>0 then begin MacroFuncName:=copy(CurValue,MacroStart+1,MacroFuncNameLen); // Macro function -> substitute macro parameter first ReadValue(DirDef,copy(CurValue,MacroFuncNameEnd+1 ,MacroEnd-MacroFuncNameEnd-2),CurDefinePath,MacroParam); // execute the macro function //debugln('Substitute MacroFuncName="',MacroFuncName,'" MacroParam="',MacroParam,'"'); MacroStr:=ExecuteMacroFunction(MacroFuncName,MacroParam); end else begin // Macro variable MacroVarName:=copy(CurValue,MacroStart+2,MacroEnd-MacroStart-3); MacroStr:=MacroVarName; //DebugLn('**** MacroVarName=',MacroVarName,' ',DirDef.Values.Variables[MacroVarName]); //DebugLn('DirDef.Values=',DirDef.Values.AsString); if MacroVarName=DefinePathMacroName then begin MacroStr:=CurDefinePath; end else if DirDef.Values.IsDefined(MacroVarName) then begin MacroStr:=DirDef.Values.Variables[MacroVarName]; end else begin Handled:=false; if Assigned(FOnReadValue) then begin MacroParam:=MacroVarName; MacroStr:=''; FOnReadValue(Self,MacroParam,MacroStr,Handled); end; if not Handled then begin MacroStr:=MacroVarName; Handled:=ExecuteMacroVariable(MacroStr); end; if not Handled then begin MacroStr:=''; end; end; end; NewMacroLen:=length(MacroStr); GrowBuffer(BufferPos+NewMacroLen-OldMacroLen+ValueLen-ValuePos+1); // copy text between this macro and last macro CopyFromValueToBuffer(MacroStart-ValuePos); // copy macro value to buffer CopyStringToBuffer(MacroStr); ValuePos:=MacroEnd; Result:=true; end; procedure SetNewValue; var RestLen: Integer; begin if Buffer=nil then exit; // write rest to buffer RestLen:=length(NewValue)-ValuePos+1; if RestLen>0 then begin GrowBuffer(BufferPos+RestLen); Move(NewValue[ValuePos],Buffer[BufferPos],RestLen); inc(BufferPos,RestLen); end; // copy the buffer into NewValue //DebugLn(' [ReadValue] Old="',copy(NewValue,1,100),'"'); SetLength(NewValue,BufferPos); if BufferPos>0 then Move(Buffer^,NewValue[1],BufferPos); //DebugLn(' [ReadValue] New="',copy(NewValue,1,100),'"'); // clean up FreeMem(Buffer); Buffer:=nil; end; var MacroStart,MacroEnd: integer; ValueLen: Integer; begin // DebugLn(' [ReadValue] A "',copy(PreValue,1,100),'"'); NewValue:=PreValue; if NewValue='' then exit; MacroStart:=1; ValueLen:=length(NewValue); Buffer:=nil; BufferSize:=0; BufferPos:=0; // position in buffer ValuePos:=1; // same position in value while MacroStart<=ValueLen do begin // search for macro while (MacroStart<=ValueLen) and (NewValue[MacroStart]<>'$') do begin if (NewValue[MacroStart]=SpecialChar) then inc(MacroStart); inc(MacroStart); end; if MacroStart>ValueLen then break; // read macro function name MacroEnd:=MacroStart+1; while (MacroEnd<=ValueLen) and (NewValue[MacroEnd] in ['0'..'9','A'..'Z','a'..'z','_']) do inc(MacroEnd); // read macro name / parameters if (MacroEndnil then SetNewValue; end; procedure TDefineTree.MarkTemplatesOwnedBy(TheOwner: TObject; const MustFlags, NotFlags: TDefineTemplateFlags); begin if FFirstDefineTemplate=nil then exit; with FFirstDefineTemplate do begin // unmark all nodes UnmarkNodes(true,true); // mark each node in filter MarkOwnedBy(TheOwner,MustFlags,NotFlags,true,true); // mark every parent, that has a marked child InheritMarks(true,true,false,true); end; end; procedure TDefineTree.RemoveTemplatesOwnedBy(TheOwner: TObject; const MustFlags, NotFlags: TDefineTemplateFlags); begin if FFirstDefineTemplate=nil then exit; FFirstDefineTemplate.RemoveLeaves(TheOwner,MustFlags,NotFlags,true, FFirstDefineTemplate); FFirstDefineTemplate.RemoveOwner(TheOwner,true); ClearCache; end; function TDefineTree.ExtractTemplatesOwnedBy(TheOwner: TObject; const MustFlags, NotFlags: TDefineTemplateFlags): TDefineTemplate; begin Result:=nil; if FFirstDefineTemplate=nil then exit; MarkTemplatesOwnedBy(TheOwner,MustFlags,NotFlags); with FFirstDefineTemplate do begin // store some information, so that merging the nodes will result in old order CreateMergeInfo(true,false); // extract marked nodes Result:=CreateCopy(true,true,true); end; end; function TDefineTree.ExtractNonAutoCreated: TDefineTemplate; begin Result:=nil; if FFirstDefineTemplate=nil then exit; MarkNonAutoCreated; with FFirstDefineTemplate do begin // store some information, so that merging the nodes will result in old order CreateMergeInfo(true,false); // extract marked nodes Result:=CreateCopy(true,true,true); end; end; procedure TDefineTree.MergeTemplates(SourceTemplate: TDefineTemplate; const NewNamePrefix: string); var LastDefTempl: TDefineTemplate; begin LastDefTempl:=GetLastRootTemplate; TDefineTemplate.MergeTemplates(nil,FFirstDefineTemplate,LastDefTempl, SourceTemplate,true,NewNamePrefix); ClearCache; end; function TDefineTree.Calculate(DirDef: TDirectoryDefines): boolean; // calculates the values for a single directory // returns false on error var ExpandedDirectory, EvalResult, TempValue: string; procedure CalculateTemplate(DefTempl: TDefineTemplate; const CurPath: string); procedure CalculateIfChilds; begin // execute childs CalculateTemplate(DefTempl.FirstChild,CurPath); // jump to end of else templates while (DefTempl.Next<>nil) and (DefTempl.Next.Action in [da_Else,da_ElseIf]) do begin if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,false,'',false,'',false); DefTempl:=DefTempl.Next; end; end; // procedure CalculateTemplate(DefTempl: TDefineTemplate; const CurPath: string); var SubPath, TempValue: string; begin while DefTempl<>nil do begin //DebugLn(' [CalculateTemplate] CurPath="',CurPath,'" DefTempl.Name="',DefTempl.Name,'"'); case DefTempl.Action of da_Block: // calculate children begin if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,false,'',false,'',true); CalculateTemplate(DefTempl.FirstChild,CurPath); end; da_Define: // Define for a single Directory (not SubDirs) begin if FilenameIsMatching(CurPath,ExpandedDirectory,true) then begin ReadValue(DirDef,DefTempl.Value,CurPath,TempValue); if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,true,TempValue,false,'',true); DirDef.Values.Variables[DefTempl.Variable]:=TempValue; end else begin if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,false,'',false,'',false); end; end; da_DefineRecurse: // Define for current and sub directories begin ReadValue(DirDef,DefTempl.Value,CurPath,TempValue); if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,true,TempValue,false,'',true); DirDef.Values.Variables[DefTempl.Variable]:=TempValue; end; da_Undefine: // Undefine for a single Directory (not SubDirs) if FilenameIsMatching(CurPath,ExpandedDirectory,true) then begin if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,false,'',false,'',true); DirDef.Values.Undefine(DefTempl.Variable); end else begin if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,false,'',false,'',false); end; da_UndefineRecurse: // Undefine for current and sub directories begin if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,false,'',false,'',true); DirDef.Values.Undefine(DefTempl.Variable); end; da_UndefineAll: // Undefine every value for current and sub directories begin if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,false,'',false,'',true); DirDef.Values.Clear; end; da_If, da_ElseIf: begin // test expression in value ReadValue(DirDef,DefTempl.Value,CurPath,TempValue); EvalResult:=DirDef.Values.Eval(TempValue); if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,true,TempValue,true,EvalResult,EvalResult='1'); //debugln('da_If,da_ElseIf: DefTempl.Value="',DbgStr(DefTempl.Value),'" CurPath="',CurPath,'" TempValue="',TempValue,'" EvalResult=',EvalResult); if DirDef.Values.ErrorPosition>=0 then begin FErrorDescription:=Format(ctsSyntaxErrorInExpr,[TempValue]); FErrorTemplate:=DefTempl; end else if EvalResult='1' then CalculateIfChilds; end; da_IfDef: // test if variable is defined begin //DebugLn('da_IfDef A Name=',DefTempl.Name, // ' Variable=',DefTempl.Variable, // ' Is=',dbgs(DirDef.Values.IsDefined(DefTempl.Variable)), // ' CurPath="',CurPath,'"', // ' Values.Count=',dbgs(DirDef.Values.Count)); if DirDef.Values.IsDefined(DefTempl.Variable) then begin if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,false,'',false,'',true); CalculateIfChilds; end else begin if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,false,'',false,'',false); end; end; da_IfNDef: // test if variable is not defined if not DirDef.Values.IsDefined(DefTempl.Variable) then begin if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,false,'',false,'',true); CalculateIfChilds; end else begin if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,false,'',false,'',false); end; da_Else: // execute childs begin if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,false,'',false,'',true); CalculateTemplate(DefTempl.FirstChild,CurPath); end; da_Directory: begin // template for a sub directory ReadValue(DirDef,DefTempl.Value,CurPath,TempValue); // CurPath can be '' SubPath:=AppendPathDelim(CurPath)+TempValue; // test if ExpandedDirectory is part of SubPath if FilenameIsMatching(SubPath,ExpandedDirectory,false) then begin if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,true,SubPath,false,'',true); CalculateTemplate(DefTempl.FirstChild,SubPath); end else begin if Assigned(OnCalculate) then OnCalculate(Self,DefTempl,true,SubPath,false,'',false); end; end; end; if ErrorTemplate<>nil then exit; if DefTempl<>nil then DefTempl:=DefTempl.Next; end; end; // function TDefineTree.Calculate(DirDef: TDirectoryDefines): boolean; begin {$IFDEF VerboseDefineCache} DebugLn('[TDefineTree.Calculate] ++++++ "',DirDef.Path,'"'); {$ENDIF} Result:=true; FErrorTemplate:=nil; ExpandedDirectory:=DirDef.Path; if (ExpandedDirectory=VirtualDirectory) and Assigned(OnGetVirtualDirectoryAlias) then OnGetVirtualDirectoryAlias(Self,ExpandedDirectory); if (ExpandedDirectory<>VirtualDirectory) then begin ReadValue(DirDef,ExpandedDirectory,'',TempValue); ExpandedDirectory:=TempValue; end; DirDef.Values.Clear; // compute the result of all matching DefineTemplates CalculateTemplate(FFirstDefineTemplate,''); if (ExpandedDirectory=VirtualDirectory) and (Assigned(OnGetVirtualDirectoryDefines)) then OnGetVirtualDirectoryDefines(Self,DirDef); Result:=(ErrorTemplate=nil); end; procedure TDefineTree.IncreaseChangeStep; begin if FChangeStep<>$7fffffff then inc(FChangeStep) else FChangeStep:=-$7fffffff; if DirectoryCachePool<>nil then DirectoryCachePool.IncreaseTimeStamp; end; procedure TDefineTree.SetDirectoryCachePool(const AValue: TCTDirectoryCachePool ); begin if FDirectoryCachePool=AValue then exit; FDirectoryCachePool:=AValue; end; procedure TDefineTree.Add(ADefineTemplate: TDefineTemplate); // add as last var LastDefTempl: TDefineTemplate; begin if ADefineTemplate=nil then exit; if RootTemplate=nil then RootTemplate:=ADefineTemplate else begin // add as last LastDefTempl:=RootTemplate; while LastDefTempl.Next<>nil do LastDefTempl:=LastDefTempl.Next; ADefineTemplate.InsertBehind(LastDefTempl); end; ClearCache; end; procedure TDefineTree.AddFirst(ADefineTemplate: TDefineTemplate); // add as first begin if ADefineTemplate=nil then exit; if RootTemplate=nil then RootTemplate:=ADefineTemplate else begin RootTemplate.InsertBehind(ADefineTemplate); RootTemplate:=ADefineTemplate; end; ClearCache; end; function TDefineTree.FindDefineTemplateByName( const AName: string; OnlyRoots: boolean): TDefineTemplate; begin Result:=RootTemplate; if RootTemplate<>nil then Result:=RootTemplate.FindByName(AName,not OnlyRoots,true) else Result:=nil; end; procedure TDefineTree.ReplaceRootSameName(const Name: string; ADefineTemplate: TDefineTemplate); // if there is a DefineTemplate with the same name then replace it // else add as last var OldDefineTemplate: TDefineTemplate; begin if (Name='') then exit; OldDefineTemplate:=FindDefineTemplateByName(Name,true); if OldDefineTemplate<>nil then begin if not OldDefineTemplate.IsEqual(ADefineTemplate,true,false) then begin ClearCache; end; if ADefineTemplate<>nil then ADefineTemplate.InsertBehind(OldDefineTemplate); if OldDefineTemplate=FFirstDefineTemplate then FFirstDefineTemplate:=FFirstDefineTemplate.Next; OldDefineTemplate.Unbind; OldDefineTemplate.Free; end else Add(ADefineTemplate); end; procedure TDefineTree.RemoveRootDefineTemplateByName(const AName: string); var ADefTempl: TDefineTemplate; begin ADefTempl:=FindDefineTemplateByName(AName,true); if ADefTempl<>nil then RemoveDefineTemplate(ADefTempl); end; procedure TDefineTree.RemoveDefineTemplate(ADefTempl: TDefineTemplate); var HadDefines: Boolean; begin if ADefTempl=FFirstDefineTemplate then FFirstDefineTemplate:=FFirstDefineTemplate.Next; HadDefines:=ADefTempl.HasDefines(false,false); ADefTempl.Unbind; ADefTempl.Free; if HadDefines then ClearCache; end; procedure TDefineTree.ReplaceChild(ParentTemplate, NewDefineTemplate: TDefineTemplate; const ChildName: string); // if there is a DefineTemplate with the same name then replace it // else add as last var OldDefineTemplate: TDefineTemplate; begin if (ChildName='') or (ParentTemplate=nil) then exit; OldDefineTemplate:=ParentTemplate.FindChildByName(ChildName); if OldDefineTemplate<>nil then begin if not OldDefineTemplate.IsEqual(NewDefineTemplate,true,false) then begin ClearCache; end; if NewDefineTemplate<>nil then NewDefineTemplate.InsertBehind(OldDefineTemplate); if OldDefineTemplate=FFirstDefineTemplate then FFirstDefineTemplate:=FFirstDefineTemplate.Next; OldDefineTemplate.Unbind; OldDefineTemplate.Free; end else begin ClearCache; ParentTemplate.AddChild(NewDefineTemplate); end; end; procedure TDefineTree.AddChild(ParentTemplate, NewDefineTemplate: TDefineTemplate); begin ClearCache; ParentTemplate.AddChild(NewDefineTemplate); end; procedure TDefineTree.ReplaceRootSameName(ADefineTemplate: TDefineTemplate); begin if (ADefineTemplate=nil) then exit; ReplaceRootSameName(ADefineTemplate.Name,ADefineTemplate); end; procedure TDefineTree.ReplaceRootSameNameAddFirst( ADefineTemplate: TDefineTemplate); var OldDefineTemplate: TDefineTemplate; begin if ADefineTemplate=nil then exit; OldDefineTemplate:=FindDefineTemplateByName(ADefineTemplate.Name,true); if OldDefineTemplate<>nil then begin if not OldDefineTemplate.IsEqual(ADefineTemplate,true,false) then begin ClearCache; end; ADefineTemplate.InsertBehind(OldDefineTemplate); if OldDefineTemplate=FFirstDefineTemplate then FFirstDefineTemplate:=FFirstDefineTemplate.Next; OldDefineTemplate.Unbind; OldDefineTemplate.Free; end else AddFirst(ADefineTemplate); end; procedure TDefineTree.MergeDefineTemplates(SourceTemplate: TDefineTemplate; const NewNamePrefix: string); var LastDefTempl: TDefineTemplate; begin if SourceTemplate=nil then exit; // import new defines LastDefTempl:=GetLastRootTemplate; TDefineTemplate.MergeTemplates(nil,FFirstDefineTemplate,LastDefTempl, SourceTemplate,true,NewNamePrefix); ClearCache; end; procedure TDefineTree.ConsistencyCheck; var CurResult: LongInt; begin if FFirstDefineTemplate<>nil then FFirstDefineTemplate.ConsistencyCheck; CurResult:=FCache.ConsistencyCheck; if CurResult<>0 then RaiseCatchableException(IntToStr(CurResult)); end; procedure TDefineTree.WriteDebugReport; begin DebugLn('TDefineTree.WriteDebugReport'); if FFirstDefineTemplate<>nil then FFirstDefineTemplate.WriteDebugReport(false) else DebugLn(' No templates defined'); DebugLn(FCache.ReportAsString); DebugLn(''); ConsistencyCheck; end; { TDefinePool } constructor TDefinePool.Create; begin inherited Create; FItems:=TFPList.Create; end; destructor TDefinePool.Destroy; begin Clear; FItems.Free; inherited Destroy; end; procedure TDefinePool.Clear; var i: integer; begin for i:=0 to Count-1 do begin Items[i].Clear(true); Items[i].Free; end; FItems.Clear; end; function TDefinePool.GetItems(Index: integer): TDefineTemplate; begin Result:=TDefineTemplate(FItems[Index]); end; procedure TDefinePool.SetEnglishErrorMsgFilename(const AValue: string); begin if FEnglishErrorMsgFilename=AValue then exit; FEnglishErrorMsgFilename:=AValue; end; procedure TDefinePool.Add(ADefineTemplate: TDefineTemplate); begin if ADefineTemplate<>nil then FItems.Add(ADefineTemplate); end; procedure TDefinePool.Insert(Index: integer; ADefineTemplate: TDefineTemplate); begin FItems.Insert(Index,ADefineTemplate); end; procedure TDefinePool.Delete(Index: integer); begin Items[Index].Clear(true); Items[Index].Free; FItems.Delete(Index); end; procedure TDefinePool.Move(SrcIndex, DestIndex: integer); begin FItems.Move(SrcIndex,DestIndex); end; function TDefinePool.Count: integer; begin Result:=FItems.Count; end; function TDefinePool.CreateFPCTemplate( const CompilerPath, CompilerOptions, TestPascalFile: string; out UnitSearchPath, TargetOS, TargetProcessor: string; Owner: TObject): TDefineTemplate; // create symbol definitions for the freepascal compiler // To get reliable values the compiler itself is asked for var LastDefTempl: TDefineTemplate; procedure AddTemplate(NewDefTempl: TDefineTemplate); begin if NewDefTempl=nil then exit; if LastDefTempl<>nil then NewDefTempl.InsertBehind(LastDefTempl); LastDefTempl:=NewDefTempl; end; function FindSymbol(const SymbolName: string): TDefineTemplate; begin Result:=LastDefTempl; while (Result<>nil) and (Comparetext(Result.Variable,SymbolName)<>0) do Result:=Result.Prior; end; procedure DefineSymbol(const SymbolName, SymbolValue: string; const Description: string = ''); var NewDefTempl: TDefineTemplate; Desc: String; begin NewDefTempl:=FindSymbol(SymbolName); if NewDefTempl=nil then begin if Description<>'' then Desc:=Description else Desc:=ctsDefaultppc386Symbol; NewDefTempl:=TDefineTemplate.Create('Define '+SymbolName, Desc,SymbolName,SymbolValue,da_DefineRecurse); AddTemplate(NewDefTempl); end else begin NewDefTempl.Value:=SymbolValue; end; end; procedure UndefineSymbol(const SymbolName: string); var ADefTempl: TDefineTemplate; begin ADefTempl:=FindSymbol(SymbolName); if ADefTempl=nil then exit; if LastDefTempl=ADefTempl then LastDefTempl:=ADefTempl.Prior; ADefTempl.Unbind; ADefTempl.Free; end; procedure ProcessOutputLine(var Line: string); var SymbolName, SymbolValue, UpLine, NewPath: string; i, len, curpos: integer; 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 too if len - CurPos < 6 then Exit; // shortest match end; UpLine:=UpperCaseStr(Line); //DebugLn(['ProcessOutputLine ',Line]); case UpLine[CurPos] of 'M': if StrLComp(@UpLine[CurPos], 'MACRO ', 6) = 0 then begin // no macro Inc(CurPos, 6); if (StrLComp(@UpLine[CurPos], 'DEFINED: ', 9) = 0) then begin Inc(CurPos, 9); SymbolName:=copy(UpLine, CurPos, len); DefineSymbol(SymbolName,''); Exit; end; if (StrLComp(@UpLine[CurPos], 'UNDEFINED: ', 11) = 0) then begin Inc(CurPos, 11); SymbolName:=copy(UpLine,CurPos,len); UndefineSymbol(SymbolName); Exit; end; // MACRO something... i := CurPos; while (i <= len) and (Line[i]<>' ') do inc(i); SymbolName:=copy(UpLine,CurPos,i-CurPos); CurPos := i + 1; // skip space if StrLComp(@UpLine[CurPos], 'SET TO ', 7) = 0 then begin Inc(CurPos, 7); SymbolValue:=copy(Line, CurPos, len); DefineSymbol(SymbolName, SymbolValue); end; end; 'U': if (StrLComp(@UpLine[CurPos], 'USING UNIT PATH: ', 17) = 0) then begin Inc(CurPos, 17); NewPath:=copy(Line,CurPos,len); if not FilenameIsAbsolute(NewPath) then NewPath:=ExpandFileNameUTF8(NewPath); {$IFDEF VerboseFPCSrcScan} DebugLn('Using unit path: "',NewPath,'"'); {$ENDIF} UnitSearchPath:=UnitSearchPath+NewPath+';'; end; end; end; var CmdLine: string; i, OutLen, LineStart: integer; TheProcess: TProcess; OutputLine, Buf: String; NewDefTempl: TDefineTemplate; SrcOS: string; SrcOS2: String; Step: String; begin Result:=nil; //DebugLn('TDefinePool.CreateFPCTemplate PPC386Path="',CompilerPath,'" FPCOptions="',CompilerOptions,'"'); if TestPascalFile='' then begin DebugLn(['WARNING: TDefinePool.CreateFPCTemplate TestPascalFile empty']); end; UnitSearchPath:=''; TargetOS:=''; SrcOS:=''; TargetProcessor:=''; if (CompilerPath='') or (not FileIsExecutable(CompilerPath)) then exit; LastDefTempl:=nil; // find all initial compiler macros and all unit paths // -> ask compiler with the -vm -vt switch SetLength(Buf,1024); Step:='Init'; try CmdLine:=CompilerPath+' -va '; if FileExistsCached(EnglishErrorMsgFilename) then CmdLine:=CmdLine+'-Fr'+EnglishErrorMsgFilename+' '; if CompilerOptions<>'' then CmdLine:=CmdLine+CompilerOptions+' '; CmdLine:=CmdLine+TestPascalFile; //DebugLn('TDefinePool.CreateFPCTemplate CmdLine="',CmdLine,'"'); TheProcess := TProcess.Create(nil); TheProcess.CommandLine := UTF8ToSys(CmdLine); TheProcess.Options:= [poUsePipes, poStdErrToOutPut]; TheProcess.ShowWindow := swoHide; Step:='Running '+CmdLine; try TheProcess.Execute; OutputLine:=''; 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 (iBuf[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; DefineSymbol(FPCUnitPathMacroName,UnitSearchPath,'FPC default unit search path'); //DebugLn('TDefinePool.CreateFPCTemplate First done UnitSearchPath="',UnitSearchPath,'"'); // ask for target operating system -> ask compiler with switch -iTO CmdLine:=CompilerPath; if CompilerOptions<>'' then CmdLine:=CmdLine+' '+CompilerOptions; CmdLine:=CmdLine+' -iTO'; TheProcess := TProcess.Create(nil); TheProcess.CommandLine := UTF8ToSys(CmdLine); TheProcess.Options:= [poUsePipes, poStdErrToOutPut]; TheProcess.ShowWindow := swoHide; Step:='Running '+CmdLine; try TheProcess.Execute; if (TheProcess.Output<>nil) then OutLen:=TheProcess.Output.Read(Buf[1],length(Buf)) else OutLen:=0; i:=1; while i<=OutLen do begin if Buf[i] in [#10,#13] then begin // define #TargetOS TargetOS:=copy(Buf,1,i-1); NewDefTempl:=TDefineTemplate.Create('Define TargetOS', ctsDefaultppc386TargetOperatingSystem, ExternalMacroStart+'TargetOS',TargetOS,da_DefineRecurse); AddTemplate(NewDefTempl); // define #SrcOS SrcOS:=GetDefaultSrcOSForTargetOS(TargetOS); if SrcOS='' then SrcOS:=TargetOS; NewDefTempl:=TDefineTemplate.Create('Define SrcOS', ctsDefaultppc386SourceOperatingSystem, ExternalMacroStart+'SrcOS',SrcOS,da_DefineRecurse); AddTemplate(NewDefTempl); // define #SrcOS2 SrcOS2:=GetDefaultSrcOS2ForTargetOS(TargetOS); if SrcOS2='' then SrcOS2:=TargetOS; NewDefTempl:=TDefineTemplate.Create('Define SrcOS2', ctsDefaultppc386Source2OperatingSystem, ExternalMacroStart+'SrcOS2',SrcOS2,da_DefineRecurse); AddTemplate(NewDefTempl); break; end; inc(i); end; TheProcess.WaitOnExit; //DebugLn('TDefinePool.CreateFPCTemplate target OS done'); finally //DebugLn('TDefinePool.CreateFPCTemplate Run with -iTO: OutputLine="',OutputLine,'"'); TheProcess.Free; end; // ask for target processor -> ask compiler with switch -iTP TheProcess := TProcess.Create(nil); CmdLine:=CompilerPath; if CompilerOptions<>'' then CmdLine:=CmdLine+' '+CompilerOptions; CmdLine:=CmdLine+' -iTP'; TheProcess.CommandLine := UTF8ToSys(CmdLine); TheProcess.Options:= [poUsePipes, poStdErrToOutPut]; TheProcess.ShowWindow := swoHide; Step:='Running '+CmdLine; try TheProcess.Execute; if TheProcess.Output<>nil then OutLen:=TheProcess.Output.Read(Buf[1],length(Buf)) else OutLen:=0; i:=1; while i<=OutLen do begin if Buf[i] in [#10,#13] then begin TargetProcessor:=copy(Buf,1,i-1); NewDefTempl:=TDefineTemplate.Create('Define TargetProcessor', ctsDefaultppc386TargetProcessor, ExternalMacroStart+'TargetProcessor',TargetProcessor, da_DefineRecurse); AddTemplate(NewDefTempl); break; end; inc(i); end; TheProcess.WaitOnExit; //DebugLn('TDefinePool.CreateFPCTemplate target CPU done'); finally //DebugLn('TDefinePool.CreateFPCTemplate Run with -iTP: OutputLine="',OutputLine,'"'); TheProcess.Free; end; // add if (LastDefTempl<>nil) then begin Result:=TDefineTemplate.Create('Free Pascal Compiler', ctsFreePascalCompilerInitialMacros,'','',da_Block); Result.AddChild(LastDefTempl.GetFirstSibling); Result.SetFlags([dtfAutoGenerated],[],false); //DebugLn('TDefinePool.CreateFPCTemplate FPC defines done'); end; except on E: Exception do begin DebugLn('ERROR: TDefinePool.CreateFPCTemplate (',Step,'): ',E.Message); end; end; if Result<>nil then Result.SetDefineOwner(Owner,true); end; function TDefinePool.CreateFPCSrcTemplate( const FPCSrcDir, UnitSearchPath, PPUExt, DefaultTargetOS, DefaultProcessorName: string; UnitLinkListValid: boolean; var UnitLinkList: string; Owner: TObject): TDefineTemplate; var Dir, SrcOS, SrcOS2, TargetProcessor, UnitLinks, IncPathMacro: string; DS: char; // dir separator UnitTree: TAVLTree; // tree of TDefTemplUnitNameLink DefaultSrcOS, DefaultSrcOS2: string; function d(const Filenames: string): string; begin Result:=SetDirSeparators(Filenames); end; procedure GatherUnits; forward; function FindUnitLink(const AnUnitName: string): TDefTemplUnitNameLink; var ANode: TAVLTreeNode; cmp: integer; begin if UnitTree=nil then GatherUnits; ANode:=UnitTree.Root; while ANode<>nil do begin Result:=TDefTemplUnitNameLink(ANode.Data); cmp:=CompareText(AnUnitName,Result.UnitName); if cmp<0 then ANode:=ANode.Left else if cmp>0 then ANode:=ANode.Right else exit; end; Result:=nil; end; procedure GatherUnits; function FileNameMacroCount(const AFilename: string): integer; // count number of macros in filename // a macro looks like this '$(name)' without a SpecialChar in front // macronames can contain macros themselves var i: integer; begin Result:=0; i:=1; while (i<=length(AFilename)) do begin if (AFilename[i]=SpecialChar) then inc(i,2) else if (AFilename[i]='$') then begin inc(i); if (i<=length(AFilename)) and (AFilename[i]='(') then inc(Result); end else inc(i); end; end; function BuildMacroFilename(const AFilename: string; var MacroCount, UsedMacroCount: integer): string; // replace Operating System and Processor Type with macros // MacroCount = number of macros are in the filename // UsedMacroCount = number of macros fitting to the current settings var DirStart, DirEnd, i: integer; DirName: string; function ReplaceDir(const MacroValue, DefaultMacroValue, MacroName: string): boolean; begin Result:=false; if CompareText(MacroValue,DirName)=0 then begin // this is a macro if CompareText(DirName,DefaultMacroValue)=0 then begin // the current settings would replace the macro to fit this filename inc(UsedMacroCount); end; BuildMacroFilename:=copy(BuildMacroFilename,1,DirStart-1)+MacroName+ copy(BuildMacroFilename,DirEnd,length(BuildMacroFilename)-DirEnd+1); inc(DirEnd,length(MacroName)-length(DirName)); DirName:=MacroName; Result:=true; end; end; begin MacroCount:=0; Result:=copy(AFilename,length(Dir)+1,length(AFilename)-length(Dir)); DirStart:=1; while (DirStart<=length(Result)) do begin while (DirStart<=length(Result)) and (Result[DirStart]=PathDelim) do inc(DirStart); DirEnd:=DirStart; while (DirEnd<=length(Result)) and (Result[DirEnd]<>PathDelim) do inc(DirEnd); if DirEnd>length(Result) then break; if DirEnd>DirStart then begin DirName:=copy(Result,DirStart,DirEnd-DirStart); // replace operating system for i:=Low(FPCOperatingSystemNames) to High(FPCOperatingSystemNames) do if ReplaceDir(FPCOperatingSystemNames[i],DefaultTargetOS,TargetOSMacro) then break; // replace operating system class for i:=Low(FPCOperatingSystemAlternativeNames) to High(FPCOperatingSystemAlternativeNames) do if ReplaceDir(FPCOperatingSystemAlternativeNames[i],DefaultSrcOS, SrcOS) then break; // replace operating system secondary class for i:=Low(FPCOperatingSystemAlternative2Names) to High(FPCOperatingSystemAlternative2Names) do if ReplaceDir(FPCOperatingSystemAlternative2Names[i],DefaultSrcOS2, SrcOS2) then break; // replace processor type for i:=Low(FPCProcessorNames) to High(FPCProcessorNames) do if ReplaceDir(FPCProcessorNames[i],DefaultProcessorName, TargetProcessor) then break; end; DirStart:=DirEnd; end; Result:=Dir+Result; end; procedure BrowseDirectory(ADirPath: string; Priority: integer); const IgnoreDirs: array[1..16] of shortstring =( '.', '..', 'CVS', '.svn', 'examples', 'example', 'tests', 'fake', 'ide', 'demo', 'docs', 'template', 'fakertl', 'install', 'installer', 'compiler' ); var AFilename, Ext, UnitName, MacroFileName: string; FileInfo: TSearchRec; NewUnitLink, OldUnitLink: TDefTemplUnitNameLink; i: integer; MacroCount, UsedMacroCount: integer; MakeFileFPC: String; SubDirs, GlobalSubDirs, TargetSubDirs: String; SubPriority: Integer; begin {$IFDEF VerboseFPCSrcScan} DebugLn('Browse ',ADirPath); {$ENDIF} if ADirPath='' then exit; ADirPath:=AppendPathDelim(ADirPath); // read Makefile.fpc to get some hints MakeFileFPC:=ADirPath+'Makefile.fpc'; SubDirs:=''; if FileExistsUTF8(MakeFileFPC) then begin ParseMakefileFPC(MakeFileFPC,DefaultTargetOS,GlobalSubDirs,TargetSubDirs); SubDirs:=GlobalSubDirs; if TargetSubDirs<>'' then begin if SubDirs<>'' then SubDirs:=SubDirs+';'; SubDirs:=SubDirs+TargetSubDirs; end; //debugln('BrowseDirectory ADirPath="',ADirPath,'" SubDirs="',SubDirs,'" SrcOS="',DefaultTargetOS,'"'); end; // set directory priority if System.Pos(Dir+'rtl'+PathDelim,ADirPath)>0 then inc(Priority); // search sources .pp,.pas if FindFirstUTF8(ADirPath+FileMask,faAnyFile,FileInfo)=0 then begin repeat AFilename:=FileInfo.Name; if (AFilename='') or (AFilename='.') or (AFilename='..') then continue; //debugln('Browse Filename=',AFilename,' IsDir=',(FileInfo.Attr and faDirectory)>0); i:=High(IgnoreDirs); while (i>=Low(IgnoreDirs)) and (AFilename<>IgnoreDirs[i]) do dec(i); //if CompareText(AFilename,'fcl')=0 then // debugln('Browse ',AFilename,' IsDir=',(FileInfo.Attr and faDirectory)>0,' Ignore=',i>=Low(IgnoreDirs)); if i>=Low(IgnoreDirs) then continue; AFilename:=ADirPath+AFilename; if (FileInfo.Attr and faDirectory)>0 then begin // directory -> recursively // ToDo: prevent cycling in links SubPriority:=0; if CompareFilenames(AFilename,Dir+'rtl')=0 then begin // units in 'rtl' have higher priority than other directories inc(SubPriority); end; if (SubDirs<>'') and (FindPathInSearchPath(@FileInfo.Name[1],length(FileInfo.Name), PChar(SubDirs),length(SubDirs))<>nil) then begin // units in directories compiled by the Makefile have higher prio inc(SubPriority); end; BrowseDirectory(AFilename,SubPriority); end else begin Ext:=UpperCaseStr(ExtractFileExt(AFilename)); if (Ext='.PP') or (Ext='.PAS') or (Ext='.P') then begin // pascal unit found UnitName:=FileInfo.Name; UnitName:=copy(UnitName,1,length(UnitName)-length(Ext)); if UnitName<>'' then begin OldUnitLink:=FindUnitLink(UnitName); MacroCount:=0; UsedMacroCount:=0; MacroFileName:= BuildMacroFileName(AFilename,MacroCount,UsedMacroCount); if OldUnitLink=nil then begin // first unit with this name NewUnitLink:=TDefTemplUnitNameLink.Create; NewUnitLink.UnitName:=UnitName; NewUnitLink.FileName:=MacroFileName; NewUnitLink.MacroCount:=MacroCount; NewUnitLink.UsedMacroCount:=UsedMacroCount; NewUnitLink.Priority:=Priority; UnitTree.Add(NewUnitLink); end else begin { there is another unit with this name the decision which filename is the right one is based on a simple heuristic: - a filename with macros is preferred above one without This skips the templates. - A macro fitting better with the current settings is preferred. For example: If the current OS is linux then on fpc 1.0.x: $(#FPCSrcDir)/fcl/classes/$(#TargetOS)/classes.pp - A unit in the rtl is preferred above one in the fcl FPC stores a unit many times, if there is different version for each Operating System or Processor Type. And sometimes units are stored in a combined OS (e.g. 'unix'). Therefore every occurence of such values is replaced by a macro. And filenames without macros are always deleted if there is a filename with a macro. (The filename without macro is only used by the FPC team as a template source for the OS specific). If there are several macro filenames for the same unit, the filename with the highest number of default values is used. For example: classes.pp can be found in several places In fpc 1.0.x: /rtl/amiga/classes.pp /fcl/amiga/classes.pp /fcl/beos/classes.pp /fcl/qnx/classes.pp /fcl/sunos/classes.pp /fcl/template/classes.pp /fcl/classes/freebsd/classes.pp /fcl/classes/go32v2/classes.pp /fcl/classes/linux/classes.pp /fcl/classes/netbsd/classes.pp /fcl/classes/openbsd/classes.pp /fcl/classes/os2/classes.pp /fcl/classes/win32/classes.pp In fpc 1.9.x/2.0.x: /rtl/win32/classes.pp /rtl/watcom/classes.pp /rtl/go32v2/classes.pp /rtl/netwlibc/classes.pp /rtl/netbsd/classes.pp /rtl/linux/classes.pp /rtl/os2/classes.pp /rtl/freebsd/classes.pp /rtl/openbsd/classes.pp /rtl/netware/classes.pp /rtl/darwin/classes.pp /rtl/morphos/classes.pp /fcl/sunos/classes.pp /fcl/beos/classes.pp /fcl/qnx/classes.pp /fcl/classes/win32/classes.pp /fcl/classes/go32v2/classes.pp /fcl/classes/netbsd/classes.pp /fcl/classes/linux/classes.pp /fcl/classes/os2/classes.pp /fcl/classes/freebsd/classes.pp /fcl/classes/openbsd/classes.pp /fcl/template/classes.pp /fcl/amiga/classes.pp This means, there are several possible macro filenames: $(#FPCSrcDir)/rtl/$(#TargetOS)/classes.pp $(#FPCSrcDir)/fcl/$(#TargetOS)/classes.pp $(#FPCSrcDir)/fcl/classes/$(#TargetOS)/classes.pp Example: libc.pp /rtl/netwlibc/libc.pp /packages/base/libc/libc.pp There are no macros and no templates. This is a special case. } if (UnitName='libc') and (System.Pos(AppendPathDelim(FPCSrcDir)+'packages'+PathDelim,ADirPath)>0) then begin // /rtl/netwlibc/libc.pp // /packages/base/libc/libc.pp inc(Priority,2); end; if (UsedMacroCount>OldUnitLink.UsedMacroCount) or ((UsedMacroCount=OldUnitLink.UsedMacroCount) and ((Priority>OldUnitLink.Priority) or ((Priority=OldUnitLink.Priority) and (OldUnitLink.MacroCount0; end; FindCloseUTF8(FileInfo); end; begin if UnitTree=nil then UnitTree:=TAVLTree.Create(@CompareUnitLinkNodes) else UnitTree.FreeAndClear; BrowseDirectory(Dir,0); end; procedure AddFPCSourceLinkForUnit(const AnUnitName: string); var UnitLink: TDefTemplUnitNameLink; s: string; begin // search if AnUnitName='' then exit; UnitLink:=FindUnitLink(AnUnitName); {$IFDEF VerboseFPCSrcScan} DbgOut('AddFPCSourceLinkForUnit ',AnUnitName,' '); if UnitLink<>nil then DebugLn(' -> ',UnitLink.Filename) else DebugLn('MISSING'); {$ELSE} if UnitLink=nil then DebugLn(['WARNING: unable to find source of fpc unit ',AnUnitName]); {$ENDIF} if UnitLink=nil then exit; s:=AnUnitName+' '+UnitLink.Filename+LineEnding; UnitLinkList:=UnitLinkList+s; end; procedure FindStandardPPUSources; var PathStart, PathEnd: integer; ADirPath, UnitName: string; FileInfo: TSearchRec; CurMask: String; begin {$IFDEF VerboseFPCSrcScan} DebugLn('FindStandardPPUSources ..'); {$ENDIF} // try every ppu file in every reachable directory (CompUnitPath) if UnitLinkListValid then exit; UnitLinkList:=''; PathStart:=1; CurMask:=PPUExt; if CurMask='' then CurMask:='.ppu'; if CurMask[1]<>'.' then CurMask:='.'+CurMask; CurMask:='*'+CurMask; //DebugLn('FindStandardPPUSources UnitSearchPath="',UnitSearchPath,'"'); while PathStart<=length(UnitSearchPath) do begin while (PathStart<=length(UnitSearchPath)) and (UnitSearchPath[PathStart]=';') do inc(PathStart); PathEnd:=PathStart; // extract single path from unit search path while (PathEnd<=length(UnitSearchPath)) and (UnitSearchPath[PathEnd]<>';') do inc(PathEnd); if PathEnd>PathStart then begin ADirPath:=copy(UnitSearchPath,PathStart,PathEnd-PathStart); {$IFDEF VerboseFPCSrcScan} DebugLn('FindStandardPPUSources Searching ',CurMask,' in ',ADirPath); {$ENDIF} // search all ppu files in this directory if FindFirstUTF8(ADirPath+CurMask,faAnyFile,FileInfo)=0 then begin repeat UnitName:=lowercase(ExtractFileNameOnly(FileInfo.Name)); {$IFDEF VerboseFPCSrcScan} DebugLn('FindStandardPPUSources Found: ',UnitName); {$ENDIF} AddFPCSourceLinkForUnit(UnitName); if (UnitTree=nil) or (UnitTree.Count=0) then exit; until FindNextUTF8(FileInfo)<>0; end; FindCloseUTF8(FileInfo); end; PathStart:=PathEnd; end; UnitLinkListValid:=true; end; procedure AddProcessorTypeDefine(ParentDefTempl: TDefineTemplate); // some FPC source files expects defines 'i386' instead of 'CPUi386' // define them automatically with IF..THEN constructs var i: Integer; CPUName: String; IfTemplate: TDefineTemplate; begin // FPC defines CPUxxx defines (e.g. CPUI386, CPUPOWERPC). // These defines are created by the compiler depending // on xxx defines (i386, powerpc). // Create: // IF CPUi386 then define i386 // IF CPUpowerpc then define powerpc // ... for i:=Low(FPCProcessorNames) to high(FPCProcessorNames) do begin CPUName:=FPCProcessorNames[i]; IfTemplate:=TDefineTemplate.Create('IFDEF CPU'+CPUName, 'IFDEF CPU'+CPUName,'CPU'+CPUName,'',da_IfDef); IfTemplate.AddChild(TDefineTemplate.Create('DEFINE '+CPUName, 'DEFINE '+CPUName,CPUName,'',da_DefineRecurse)); ParentDefTempl.AddChild(IfTemplate); end; end; procedure AddSrcOSDefines(ParentDefTempl: TDefineTemplate); var IfTargetOSIsNotSrcOS: TDefineTemplate; RTLSrcOSDir: TDefineTemplate; IfTargetOSIsNotSrcOS2: TDefineTemplate; RTLSrcOS2Dir: TDefineTemplate; begin // if TargetOS<>SrcOS IfTargetOSIsNotSrcOS:=TDefineTemplate.Create( 'IF TargetOS<>SrcOS', ctsIfTargetOSIsNotSrcOS,'',''''+TargetOSMacro+'''<>'''+SrcOS+'''',da_If); // rtl/$(#SrcOS) RTLSrcOSDir:=TDefineTemplate.Create('SrcOS',SrcOS,'', SrcOS,da_Directory); IfTargetOSIsNotSrcOS.AddChild(RTLSrcOSDir); RTLSrcOSDir.AddChild(TDefineTemplate.Create('Include Path', 'include path', ExternalMacroStart+'IncPath',IncPathMacro+';inc', da_Define)); RTLSrcOSDir.AddChild(TDefineTemplate.Create('Include Path', 'include path to TargetProcessor directories', ExternalMacroStart+'IncPath',IncPathMacro+';'+TargetProcessor, da_Define)); ParentDefTempl.AddChild(IfTargetOSIsNotSrcOS); // if TargetOS<>SrcOS2 IfTargetOSIsNotSrcOS2:=TDefineTemplate.Create( 'IF TargetOS is not SrcOS2', ctsIfTargetOSIsNotSrcOS,'',''''+TargetOSMacro+'''<>'''+SrcOS2+'''',da_If); // rtl/$(#SrcOS2) RTLSrcOS2Dir:=TDefineTemplate.Create('SrcOS2',SrcOS2,'', SrcOS2,da_Directory); IfTargetOSIsNotSrcOS2.AddChild(RTLSrcOS2Dir); RTLSrcOS2Dir.AddChild(TDefineTemplate.Create('Include Path', 'include path to TargetProcessor directories', ExternalMacroStart+'IncPath',IncPathMacro+';'+TargetProcessor, da_DefineRecurse)); ParentDefTempl.AddChild(IfTargetOSIsNotSrcOS2); end; var DefTempl, MainDir, FCLDir, RTLDir, RTLOSDir, PackagesDir, CompilerDir, UtilsDir, DebugSvrDir: TDefineTemplate; s: string; FCLDBDir: TDefineTemplate; FCLDBInterbaseDir: TDefineTemplate; InstallerDir: TDefineTemplate; IFTempl: TDefineTemplate; FCLBaseDir: TDefineTemplate; FCLBaseSrcDir: TDefineTemplate; PackagesBaseDir: TDefineTemplate; LibasyncDir: TDefineTemplate; PackagesExtraDir: TDefineTemplate; PkgExtraGraphDir: TDefineTemplate; PkgExtraAMunitsDir: TDefineTemplate; FCLSubSrcDir: TDefineTemplate; FCLSubDir: TDefineTemplate; begin {$IFDEF VerboseFPCSrcScan} DebugLn('CreateFPCSrcTemplate ',FPCSrcDir,': length(UnitSearchPath)=',DbgS(length(UnitSearchPath)),' Valid=',DbgS(UnitLinkListValid),' PPUExt=',PPUExt); {$ENDIF} if UnitSearchPath='' then begin DebugLn(['Note: TDefinePool.CreateFPCSrcTemplate UnitSearchPath empty']); end; Result:=nil; if (FPCSrcDir='') or (not DirPathExists(FPCSrcDir)) then begin DebugLn(['TDefinePool.CreateFPCSrcTemplate FPCSrcDir does not exist: FPCSrcDir="',FPCSrcDir,'"']); exit; end; DS:=PathDelim; Dir:=AppendPathDelim(FPCSrcDir); SrcOS:='$('+ExternalMacroStart+'SrcOS)'; SrcOS2:='$('+ExternalMacroStart+'SrcOS2)'; TargetProcessor:='$('+ExternalMacroStart+'TargetProcessor)'; IncPathMacro:='$('+ExternalMacroStart+'IncPath)'; UnitLinks:=UnitLinksMacroName; UnitTree:=nil; DefaultSrcOS:=GetDefaultSrcOSForTargetOS(DefaultTargetOS); DefaultSrcOS2:=GetDefaultSrcOS2ForTargetOS(DefaultTargetOS); Result:=TDefineTemplate.Create(StdDefTemplFPCSrc, Format(ctsFreePascalSourcesPlusDesc,['RTL, FCL, Packages, Compiler']), '','',da_Block); // try to find for every reachable ppu file the unit file in the FPC sources FindStandardPPUSources; DefTempl:=TDefineTemplate.Create('FPC Unit Links', ctsSourceFilenamesForStandardFPCUnits, UnitLinks,UnitLinkList,da_DefineRecurse); Result.AddChild(DefTempl); // The free pascal sources build a world of their own, // reset search paths MainDir:=TDefineTemplate.Create('Free Pascal Source Directory', ctsFreePascalSourceDir,'',FPCSrcDir,da_Directory); Result.AddChild(MainDir); DefTempl:=TDefineTemplate.Create('Reset SrcPath', ctsSrcPathInitialization,ExternalMacroStart+'SrcPath','',da_DefineRecurse); MainDir.AddChild(DefTempl); DefTempl:=TDefineTemplate.Create('Reset UnitPath', ctsUnitPathInitialization,ExternalMacroStart+'UnitPath','',da_DefineRecurse); MainDir.AddChild(DefTempl); // turn Nested comments on DefTempl:=TDefineTemplate.Create('Nested Comments', ctsNestedCommentsOn,ExternalMacroStart+'NestedComments','',da_DefineRecurse); MainDir.AddChild(DefTempl); // enable FPDocSystem to find compiler functions like writeln and readln {DefTempl:=TDefineTemplate.Create('FPDocSystem', ctsFPDocSystemOn,'FPDocSystem','',da_DefineRecurse); MainDir.AddChild(DefTempl);} // rtl RTLDir:=TDefineTemplate.Create('RTL',ctsRuntimeLibrary,'','rtl',da_Directory); MainDir.AddChild(RTLDir); // rtl include paths s:=IncPathMacro +';'+Dir+'rtl'+DS+'objpas'+DS +';'+Dir+'rtl'+DS+'objpas'+DS+'sysutils' +';'+Dir+'rtl'+DS+'objpas'+DS+'classes' +';'+Dir+'rtl'+DS+'inc'+DS +';'+Dir+'rtl'+DS+'inc'+DS+'graph'+DS +';'+Dir+'rtl'+DS+SrcOS+DS +';'+Dir+'rtl'+DS+TargetOSMacro+DS +';'+Dir+'rtl'+DS+SrcOS2+DS +';'+Dir+'rtl'+DS+SrcOS2+DS+TargetProcessor +';'+Dir+'rtl'+DS+TargetProcessor+DS +';'+Dir+'rtl'+DS+TargetOSMacro+DS+TargetProcessor+DS; RTLDir.AddChild(TDefineTemplate.Create('Include Path', Format(ctsIncludeDirectoriesPlusDirs, ['objpas, inc,'+TargetProcessor+','+SrcOS]), ExternalMacroStart+'IncPath',s,da_DefineRecurse)); // rtl/$(#TargetOS) RTLOSDir:=TDefineTemplate.Create('TargetOS','Target OS','', TargetOSMacro,da_Directory); s:=IncPathMacro +';'+Dir+'rtl'+DS+TargetOSMacro+DS+SrcOS+'inc' // e.g. rtl/win32/inc/ +';'+Dir+'rtl'+DS+TargetOSMacro+DS+TargetProcessor+DS ; RTLOSDir.AddChild(TDefineTemplate.Create('Include Path', Format(ctsIncludeDirectoriesPlusDirs,[TargetProcessor]), ExternalMacroStart+'IncPath', s,da_DefineRecurse)); s:=SrcPathMacro +';'+Dir+'rtl'+DS+'objpas'+DS; RTLOSDir.AddChild(TDefineTemplate.Create('Src Path', Format(ctsAddsDirToSourcePath,[TargetProcessor]), ExternalMacroStart+'SrcPath',s,da_DefineRecurse)); RTLDir.AddChild(RTLOSDir); // rtl: IF SrcOS=win then add include path rtl/win/wininc IFTempl:=TDefineTemplate.Create('If SrcOS=win','If SrcOS=win', '',''''+SrcOS+'''=''win''',da_If); IFTempl.AddChild(TDefineTemplate.Create('Include Path', Format(ctsIncludeDirectoriesPlusDirs,['wininc']), ExternalMacroStart+'IncPath', IncPathMacro +';'+Dir+'rtl'+DS+'win'+DS+'wininc' +';'+Dir+'rtl'+DS+'win', da_DefineRecurse)); RTLDir.AddChild(IFTempl); // rtl: IF TargetOS=darwin then add include path rtl/freebsd IFTempl:=TDefineTemplate.Create('If TargetOS=darwin','If TargetOS=darwin', '',''''+TargetOSMacro+'''=''darwin''',da_If); IFTempl.AddChild(TDefineTemplate.Create('Include Path', Format(ctsIncludeDirectoriesPlusDirs,['rtl'+DS+'freebsd']), ExternalMacroStart+'IncPath', IncPathMacro +';'+Dir+'rtl'+DS+'freebsd', da_DefineRecurse)); RTLDir.AddChild(IFTempl); // add processor and SrcOS alias defines for the RTL AddProcessorTypeDefine(RTLDir); AddSrcOSDefines(RTLDir); // fcl FCLDir:=TDefineTemplate.Create('FCL',ctsFreePascalComponentLibrary,'','fcl', da_Directory); MainDir.AddChild(FCLDir); FCLDir.AddChild(TDefineTemplate.Create('Include Path', Format(ctsIncludeDirectoriesPlusDirs,['inc,'+SrcOS]), ExternalMacroStart+'IncPath', d( DefinePathMacro+'/inc/' +';'+DefinePathMacro+'/classes/' +';'+DefinePathMacro+'/'+TargetOSMacro+DS // TargetOS before SrcOS ! +';'+DefinePathMacro+'/'+SrcOS+DS +';'+IncPathMacro) ,da_DefineRecurse)); // fcl/db FCLDBDir:=TDefineTemplate.Create('DB','DB','','db',da_Directory); FCLDir.AddChild(FCLDBDir); FCLDBInterbaseDir:=TDefineTemplate.Create('interbase','interbase','', 'interbase',da_Directory); FCLDBDir.AddChild(FCLDBInterbaseDir); FCLDBInterbaseDir.AddChild(TDefineTemplate.Create('SrcPath', 'SrcPath addition', ExternalMacroStart+'SrcPath', d(Dir+'/packages/base/ibase;'+SrcPathMacro) ,da_Define)); // packages PackagesDir:=TDefineTemplate.Create('Packages',ctsPackageDirectories,'', 'packages',da_Directory); MainDir.AddChild(PackagesDir); // packages/fcl-base FCLBaseDir:=TDefineTemplate.Create('FCL-base', ctsFreePascalComponentLibrary,'','fcl-base', da_Directory); PackagesDir.AddChild(FCLBaseDir); // packages/fcl-base/src FCLBaseSrcDir:=TDefineTemplate.Create('src', 'src','','src', da_Directory); FCLBaseDir.AddChild(FCLBaseSrcDir); FCLBaseSrcDir.AddChild(TDefineTemplate.Create('Include Path', Format(ctsIncludeDirectoriesPlusDirs,['inc,'+SrcOS]), ExternalMacroStart+'IncPath', d( DefinePathMacro+'/inc/' +';'+DefinePathMacro+'/'+TargetOSMacro+DS // TargetOS before SrcOS ! +';'+DefinePathMacro+'/'+SrcOS+DS +';'+IncPathMacro) ,da_DefineRecurse)); // packages/fcl-process FCLSubDir:=TDefineTemplate.Create('FCL-process', 'fcl-process','','fcl-process', da_Directory); PackagesDir.AddChild(FCLSubDir); // packages/fcl-process/src FCLSubSrcDir:=TDefineTemplate.Create('src', 'src','','src', da_Directory); FCLSubDir.AddChild(FCLSubSrcDir); FCLSubSrcDir.AddChild(TDefineTemplate.Create('Include Path', Format(ctsIncludeDirectoriesPlusDirs,['inc,'+SrcOS]), ExternalMacroStart+'IncPath', d( DefinePathMacro+'/'+TargetOSMacro+DS // TargetOS before SrcOS ! +';'+DefinePathMacro+'/'+SrcOS+DS +';'+IncPathMacro) ,da_DefineRecurse)); // packages/base PackagesBaseDir:=TDefineTemplate.Create('base','base','','base',da_Directory); PackagesDir.AddChild(PackagesBaseDir); // packages/base/libasync LibasyncDir:=TDefineTemplate.Create('libasync','libasync','','libasync', da_Directory); PackagesBaseDir.AddChild(LibasyncDir); LibasyncDir.AddChild(TDefineTemplate.Create('Include Path', Format(ctsIncludeDirectoriesPlusDirs,['packages/base/libasync']), ExternalMacroStart+'IncPath', d( DefinePathMacro+'/' +';'+IncPathMacro) ,da_DefineRecurse)); // packages/extra PackagesExtraDir:=TDefineTemplate.Create('extra','extra','','extra',da_Directory); PackagesDir.AddChild(PackagesExtraDir); // packages/extra/graph PkgExtraGraphDir:=TDefineTemplate.Create('graph','graph','','graph', da_Directory); PackagesExtraDir.AddChild(PkgExtraGraphDir); PkgExtraGraphDir.AddChild(TDefineTemplate.Create('Include Path', Format(ctsIncludeDirectoriesPlusDirs,['inc']), ExternalMacroStart+'IncPath', d( DefinePathMacro+'/inc/' +';'+IncPathMacro) ,da_DefineRecurse)); // packages/extra/amunits PkgExtraAMunitsDir:=TDefineTemplate.Create('amunits','amunits','','amunits', da_Directory); PackagesExtraDir.AddChild(PkgExtraAMunitsDir); PkgExtraAMunitsDir.AddChild(TDefineTemplate.Create('Include Path', Format(ctsIncludeDirectoriesPlusDirs,['inc']), ExternalMacroStart+'IncPath', d( DefinePathMacro+'/inc/' +';'+IncPathMacro) ,da_DefineRecurse)); // utils UtilsDir:=TDefineTemplate.Create('Utils',ctsUtilsDirectories,'', 'utils',da_Directory); MainDir.AddChild(UtilsDir); // utils/debugsvr DebugSvrDir:=TDefineTemplate.Create('DebugSvr','Debug Server','', 'debugsvr',da_Directory); UtilsDir.AddChild(DebugSvrDir); DebugSvrDir.AddChild(TDefineTemplate.Create('Interface Path', Format(ctsAddsDirToSourcePath,['..']),ExternalMacroStart+'SrcPath', '..;'+ExternalMacroStart+'SrcPath',da_DefineRecurse)); // installer InstallerDir:=TDefineTemplate.Create('Installer',ctsInstallerDirectories,'', 'installer',da_Directory); InstallerDir.AddChild(TDefineTemplate.Create('SrcPath','SrcPath addition', ExternalMacroStart+'SrcPath', SrcPathMacro+';'+Dir+'ide;'+Dir+'fv',da_Define)); MainDir.AddChild(InstallerDir); // compiler CompilerDir:=TDefineTemplate.Create('Compiler',ctsCompiler,'','compiler', da_Directory); AddProcessorTypeDefine(CompilerDir); CompilerDir.AddChild(TDefineTemplate.Create('SrcPath','SrcPath addition', ExternalMacroStart+'SrcPath', SrcPathMacro+';'+Dir+TargetProcessor,da_Define)); CompilerDir.AddChild(TDefineTemplate.Create('IncPath','IncPath addition', ExternalMacroStart+'IncPath', IncPathMacro+';'+Dir+'compiler',da_DefineRecurse)); MainDir.AddChild(CompilerDir); // compiler/utils UtilsDir:=TDefineTemplate.Create('utils',ctsUtilsDirectories,'', 'utils',da_Directory); UtilsDir.AddChild(TDefineTemplate.Create('SrcPath','SrcPath addition', ExternalMacroStart+'SrcPath', SrcPathMacro+';..',da_Define)); CompilerDir.AddChild(UtilsDir); // clean up if UnitTree<>nil then begin UnitTree.FreeAndClear; UnitTree.Free; end; Result.SetDefineOwner(Owner,true); Result.SetFlags([dtfAutoGenerated],[],false); end; function TDefinePool.CreateDelphiSrcPath(DelphiVersion: integer; const PathPrefix: string): string; begin case DelphiVersion of 1..5: Result:=PathPrefix+'Source/Rtl/Win;' +PathPrefix+'Source/Rtl/Sys;' +PathPrefix+'Source/Rtl/Corba;' +PathPrefix+'Source/Vcl;'; else // 6 and above Result:=PathPrefix+'Source/Rtl/Win;' +PathPrefix+'Source/Rtl/Sys;' +PathPrefix+'Source/Rtl/Common;' +PathPrefix+'Source/Rtl/Corba40;' +PathPrefix+'Source/Vcl;'; end; end; function TDefinePool.CreateLazarusSrcTemplate( const LazarusSrcDir, WidgetType, ExtraOptions: string; Owner: TObject): TDefineTemplate; function D(const Filename: string): string; begin Result:=SetDirSeparators(Filename); end; var MainDir, DirTempl, SubDirTempl, IntfDirTemplate, IfTemplate, ElseTemplate, LCLUnitsDir, LCLUnitsCPUOSDir, LCLUnitsCPUOSWidgetSetDir, SubTempl: TDefineTemplate; TargetOS, SrcOS, SrcPath, IncPath: string; i: Integer; CurCPU, CurOS, CurWidgetSet, ExtraSrcPath: string; LCLWidgetSetDir: TDefineTemplate; IDEIntfDir: TDefineTemplate; ToolsInstallDirTempl: TDefineTemplate; CurCPUOS: String; SynEditDirTempl: TDefineTemplate; SynEditUnitsDirTempl: TDefineTemplate; CodeToolsDirTempl: TDefineTemplate; CodeToolsUnitsDirTempl: TDefineTemplate; FPGUIPlatformTempl: TDefineTemplate; AllWidgetSets: String; p: Integer; begin Result:=nil; if (LazarusSrcDir='') or (WidgetType='') then exit; //TargetCPU:='$('+ExternalMacroStart+'TargetCPU)'; TargetOS:='$('+ExternalMacroStart+'TargetOS)'; SrcOS:='$('+ExternalMacroStart+'SrcOS)'; SrcPath:='$('+ExternalMacroStart+'SrcPath)'; IncPath:='$('+ExternalMacroStart+'IncPath)'; AllWidgetSets:=''; for i:=Low(Lazarus_CPU_OS_Widget_Combinations) to High(Lazarus_CPU_OS_Widget_Combinations) do begin SplitLazarusCPUOSWidgetCombo(Lazarus_CPU_OS_Widget_Combinations[i], CurCPU,CurOS,CurWidgetSet); if not HasDelimitedItem(AllWidgetSets,';',CurWidgetSet) then begin if AllWidgetSets<>'' then AllWidgetSets:=AllWidgetSets+';'; AllWidgetSets:=AllWidgetSets+CurWidgetSet; end; end; // MainDir:=TDefineTemplate.Create( StdDefTemplLazarusSrcDir, ctsDefsForLazarusSources,'',LazarusSrcDir, da_Directory); // clear src path MainDir.AddChild(TDefineTemplate.Create('Clear SrcPath','Clear SrcPath', ExternalMacroStart+'SrcPath','',da_DefineRecurse)); // if SrcOS<>win IfTemplate:=TDefineTemplate.Create('IF '''+SrcOS+'''<>''win''', ctsIfTargetOSIsNotWin32,'',''''+SrcOS+'''<>''win''',da_If); // then define #SrcPath := #SrcPath;lcl/nonwin32 IfTemplate.AddChild(TDefineTemplate.Create('win32api for non win', Format(ctsAddsDirToSourcePath,[d(LazarusSrcDir+'/lcl/nonwin32')]), ExternalMacroStart+'SrcPath', d(LazarusSrcDir+'/lcl/nonwin32;')+SrcPath,da_DefineRecurse)); MainDir.AddChild(IfTemplate); // turn Nested comments on MainDir.AddChild(TDefineTemplate.Create('Nested Comments', ctsNestedCommentsOn,ExternalMacroStart+'NestedComments','',da_DefineRecurse)); // define 'LCL' MainDir.AddChild(TDefineTemplate.Create('define LCL', ctsDefineLCL,'LCL',WidgetType,da_DefineRecurse)); // define LCLwidgetset, e.g. LCLcarbon, LCLgtk, LCLgtk2 p:=1; repeat CurWidgetSet:=GetNextDelimitedItem(AllWidgetSets,';',p); if CurWidgetSet='' then break; IfTemplate:=TDefineTemplate.Create('IF '''+WidgetType+'''='''+CurWidgetSet+'''', ctsDefineLCLWidgetset,'',''''+WidgetType+'''='''+CurWidgetSet+'''',da_If); // then define LCLgtk, LCLgtk2, LCLcarbon, ... IfTemplate.AddChild(TDefineTemplate.Create('Define LCL'+CurWidgetSet, ctsDefineLCLWidgetset,'LCL'+CurWidgetSet,'',da_DefineRecurse)); MainDir.AddChild(IfTemplate); until false; // /include // (does not need special setup) // /ide DirTempl:=TDefineTemplate.Create('ide',ctsIDEDirectory, '','ide',da_Directory); DirTempl.AddChild(TDefineTemplate.Create('IDE path addition', Format(ctsAddsDirToSourcePath,['designer, debugger, synedit, ...']), ExternalMacroStart+'SrcPath', d(LazarusSrcDir+'/ide;' +LazarusSrcDir+'/ide/frames;' +LazarusSrcDir+'/designer;' +LazarusSrcDir+'/designer/jitform;' +LazarusSrcDir+'/debugger;' +LazarusSrcDir+'/debugger/frames;' +LazarusSrcDir+'/converter;' +LazarusSrcDir+'/packager;' +LazarusSrcDir+'/packager/registration;' +LazarusSrcDir+'/components/custom;' +LazarusSrcDir+'/components/mpaslex;') ,da_DefineRecurse)); DirTempl.AddChild(TDefineTemplate.Create('IDEIntf path addition', Format(ctsAddsDirToSourcePath,['ideintf']), ExternalMacroStart+'SrcPath', d(LazarusSrcDir+'/ideintf;' +SrcPath) ,da_DefineRecurse)); DirTempl.AddChild(TDefineTemplate.Create('SynEdit path addition', Format(ctsAddsDirToSourcePath,['synedit']), ExternalMacroStart+'SrcPath', d(LazarusSrcDir+'/components/synedit;' +SrcPath) ,da_DefineRecurse)); DirTempl.AddChild(TDefineTemplate.Create('CodeTools path addition', Format(ctsAddsDirToSourcePath,['codetools']), ExternalMacroStart+'SrcPath', d(LazarusSrcDir+'/components/codetools;' +SrcPath) ,da_DefineRecurse)); DirTempl.AddChild(TDefineTemplate.Create('LCL path addition', Format(ctsAddsDirToSourcePath,['lcl']), ExternalMacroStart+'SrcPath', d(LazarusSrcDir+'/lcl;' +LazarusSrcDir+'/lcl/interfaces/'+WidgetType+';' +SrcPath) ,da_DefineRecurse)); // include path addition DirTempl.AddChild(TDefineTemplate.Create('includepath addition', Format(ctsSetsIncPathTo,['include, include/TargetOS, include/SrcOS']), ExternalMacroStart+'IncPath', d(LazarusSrcDir+'/ide/include;' +LazarusSrcDir+'/ide/include/'+TargetOS+';' +LazarusSrcDir+'/ide/include/'+SrcOS), da_DefineRecurse)); MainDir.AddChild(DirTempl); // /designer DirTempl:=TDefineTemplate.Create('Designer',ctsDesignerDirectory, '','designer',da_Directory); DirTempl.AddChild(TDefineTemplate.Create('LCL path addition', Format(ctsAddsDirToSourcePath,['lcl']), SrcPathMacroName, d('../lcl' +';../lcl/interfaces/'+WidgetType) +';'+SrcPath ,da_Define)); DirTempl.AddChild(TDefineTemplate.Create('main path addition', Format(ctsAddsDirToSourcePath,[ctsLazarusMainDirectory]), SrcPathMacroName, d('../ide;../packager;')+SrcPath ,da_Define)); DirTempl.AddChild(TDefineTemplate.Create('components path addition', Format(ctsAddsDirToSourcePath,['synedit']), ExternalMacroStart+'SrcPath', d('../ideintf;' +'../components/synedit;' +'../components/codetools;' +'../components/custom;' +'jitform;') +SrcPath ,da_Define)); DirTempl.AddChild(TDefineTemplate.Create('includepath addition', Format(ctsIncludeDirectoriesPlusDirs,['include']), ExternalMacroStart+'IncPath', d('../ide/include;../ide/include/'+TargetOS), da_Define)); // /designer/jitform SubDirTempl:=TDefineTemplate.Create('JITForm',ctsJITFormDirectory, '','jitform',da_Directory); SubDirTempl.AddChild(TDefineTemplate.Create('LCL path addition', Format(ctsAddsDirToSourcePath,['lcl']), SrcPathMacroName, d('../../lcl' +';../../lcl/interfaces/'+WidgetType) +';'+SrcPath ,da_Define)); DirTempl.AddChild(SubDirTempl); // /designer/units SubDirTempl:=TDefineTemplate.Create('Designer Units', ctsDesignerUnitsDirectory,'','units',da_Directory); SubDirTempl.AddChild(TDefineTemplate.Create('CompiledSrcPath', ctsCompiledSrcPath,CompiledSrcPathMacroName,d('../jitform/'), da_Define)); DirTempl.AddChild(SubDirTempl); MainDir.AddChild(DirTempl); // /images // /debugger DirTempl:=TDefineTemplate.Create('Debugger',ctsDebuggerDirectory, '','debugger',da_Directory); DirTempl.AddChild(TDefineTemplate.Create('LCL path addition', Format(ctsAddsDirToSourcePath,['lcl, components']), ExternalMacroStart+'SrcPath', d('../ide' +';../ideintf' +';../components/codetools' +';../lcl' +';../lcl/interfaces/'+WidgetType) +';'+SrcPath ,da_DefineRecurse)); MainDir.AddChild(DirTempl); // /converter DirTempl:=TDefineTemplate.Create('Converter',ctsDebuggerDirectory, '','converter',da_Directory); DirTempl.AddChild(TDefineTemplate.Create('LCL path addition', Format(ctsAddsDirToSourcePath,['lcl, components']), ExternalMacroStart+'SrcPath', d('../ide' +';../ideintf' +';../components/codetools' +';../components/synedit' +';../packager' +';../debugger' +';../designer' +';../lcl' +';../lcl/interfaces/'+WidgetType) +';'+SrcPath ,da_DefineRecurse)); MainDir.AddChild(DirTempl); // /doceditor DirTempl:=TDefineTemplate.Create('Doc Editor',ctsDocEditorDirectory, '','doceditor',da_Directory); DirTempl.AddChild(TDefineTemplate.Create('Unit path addition', Format(ctsAddsDirToSourcePath,['lcl, components']), SrcPathMacroName, d('../ideintf' +';../components/codetools' +';../lcl' +';../lcl/interfaces/'+WidgetType) +';'+SrcPath ,da_DefineRecurse)); MainDir.AddChild(DirTempl); // /packager DirTempl:=TDefineTemplate.Create('Packager',ctsDesignerDirectory, '','packager',da_Directory); DirTempl.AddChild(TDefineTemplate.Create('LCL path addition', Format(ctsAddsDirToSourcePath,['lcl']), SrcPathMacroName, d('../lcl' +';../lcl/interfaces/'+WidgetType) +';'+SrcPath ,da_Define)); DirTempl.AddChild(TDefineTemplate.Create('main path addition', Format(ctsAddsDirToSourcePath,[ctsLazarusMainDirectory]), SrcPathMacroName, d('../ide;'+SrcPath) ,da_Define)); DirTempl.AddChild(TDefineTemplate.Create('components path addition', Format(ctsAddsDirToSourcePath,['synedit']), SrcPathMacroName, d('registration;' +'../ideintf;' +'../components/synedit;' +'../components/codetools;' +'../components/custom;') +SrcPath ,da_Define)); DirTempl.AddChild(TDefineTemplate.Create('includepath addition', Format(ctsIncludeDirectoriesPlusDirs,['include']), ExternalMacroStart+'IncPath', d('../ide/include;../ide/include/'+TargetOS), da_Define)); // /packager/registration SubDirTempl:=TDefineTemplate.Create('Registration', ctsPackagerRegistrationDirectory,'','registration',da_Directory); DirTempl.AddChild(SubDirTempl); // /packager/units SubDirTempl:=TDefineTemplate.Create('Packager Units', ctsPackagerUnitsDirectory,'','units',da_Directory); SubDirTempl.AddChild(TDefineTemplate.Create('CompiledSrcPath', ctsCompiledSrcPath,CompiledSrcPathMacroName, LazarusSrcDir+d('/packager/registration'), da_DefineRecurse)); DirTempl.AddChild(SubDirTempl); MainDir.AddChild(DirTempl); // /ideintf IDEIntfDir:=TDefineTemplate.Create('IDEIntf',ctsIDEIntfDirectory, '','ideintf',da_Directory); IDEIntfDir.AddChild(TDefineTemplate.Create('LCL path addition', Format(ctsAddsDirToSourcePath,['lcl']), SrcPathMacroName, d('../components/codetools' +';../packager/registration' +';../lcl' +';../lcl/interfaces/'+WidgetType) +';'+SrcPath ,da_Define)); IDEIntfDir.AddChild(TDefineTemplate.Create('CompiledSrcPath', ctsCompiledSrcPath,CompiledSrcPathMacroName, LazarusSrcDir+d('/ideintf'), da_DefineRecurse)); MainDir.AddChild(IDEIntfDir); // /examples DirTempl:=TDefineTemplate.Create('Examples', Format(ctsNamedDirectory,['Examples']), '','examples',da_Directory); DirTempl.AddChild(TDefineTemplate.Create('LCL path addition', Format(ctsAddsDirToSourcePath,['lcl']), ExternalMacroStart+'SrcPath', d('../lcl' +';../lcl/interfaces/'+WidgetType+';'+SrcPath) ,da_Define)); MainDir.AddChild(DirTempl); // /lcl DirTempl:=TDefineTemplate.Create('LCL',Format(ctsNamedDirectory,['LCL']), '','lcl',da_Directory); DirTempl.AddChild(TDefineTemplate.Create('IncludePath', Format(ctsIncludeDirectoriesPlusDirs,['include']), ExternalMacroStart+'IncPath', 'include',da_Define)); DirTempl.AddChild(TDefineTemplate.Create('LCL path addition', Format(ctsAddsDirToSourcePath,['forms']), ExternalMacroStart+'SrcPath','forms;'+SrcPath,da_Define)); DirTempl.AddChild(TDefineTemplate.Create('LCL path addition', Format(ctsAddsDirToSourcePath,['widgetset']), ExternalMacroStart+'SrcPath','widgetset;'+SrcPath,da_Define)); // #FPGUIPlatform FPGUIPlatformTempl:=TDefineTemplate.Create('Define FPGUIPlatform', 'Define FPGUIPlatform','','',da_Block); IfTemplate:=TDefineTemplate.Create('IFDEF windows', ctsIfDefWindows, 'windows', '', da_IfDef); // then set #FPGUIPlatform to gdi IfTemplate.AddChild(TDefineTemplate.Create('#FPGUIPlatform:=gdi', '#FPGUIPlatform:=gdi', ExternalMacroStart+'FPGUIPlatform','gdi',da_DefineRecurse)); FPGUIPlatformTempl.AddChild(IfTemplate); ElseTemplate:=TDefineTemplate.Create('Else', ctsElse, '', '', da_Else); // then set #FPGUIPlatform to x11 ElseTemplate.AddChild(TDefineTemplate.Create('#FPGUIPlatform:=x11', '#FPGUIPlatform:=x11', ExternalMacroStart+'FPGUIPlatform','x11',da_DefineRecurse)); FPGUIPlatformTempl.AddChild(ElseTemplate); DirTempl.AddChild(FPGUIPlatformTempl); MainDir.AddChild(DirTempl); // /lcl/forms LCLWidgetSetDir:=TDefineTemplate.Create('forms',Format(ctsNamedDirectory,['WidgetSet']), '','forms',da_Directory); LCLWidgetSetDir.AddChild(TDefineTemplate.Create('LCL path addition', Format(ctsAddsDirToSourcePath,['..']), ExternalMacroStart+'SrcPath','..;'+SrcPath,da_Define)); DirTempl.AddChild(LCLWidgetSetDir); // /lcl/widgetset LCLWidgetSetDir:=TDefineTemplate.Create('widgetset',Format(ctsNamedDirectory,['WidgetSet']), '','widgetset',da_Directory); LCLWidgetSetDir.AddChild(TDefineTemplate.Create('LCL path addition', Format(ctsAddsDirToSourcePath,['..']), ExternalMacroStart+'SrcPath','..;'+SrcPath,da_Define)); DirTempl.AddChild(LCLWidgetSetDir); // /lcl/units LCLUnitsDir:=TDefineTemplate.Create('units',Format(ctsNamedDirectory,['Units']), '','units',da_Directory); DirTempl.AddChild(LCLUnitsDir); for i:=Low(Lazarus_CPU_OS_Widget_Combinations) to High(Lazarus_CPU_OS_Widget_Combinations) do begin SplitLazarusCPUOSWidgetCombo(Lazarus_CPU_OS_Widget_Combinations[i], CurCPU,CurOS,CurWidgetSet); // /lcl/units/- // these directories contain the output of the LCL (excluding the interfaces) CurCPUOS:=CurCPU+'-'+CurOS; LCLUnitsCPUOSDir:=LCLUnitsDir.FindChildByName(CurCPUOS); if LCLUnitsCPUOSDir=nil then begin LCLUnitsCPUOSDir:=TDefineTemplate.Create(CurCPUOS, Format(ctsNamedDirectory,[CurCPUOS]), '',CurCPUOS,da_Directory); LCLUnitsDir.AddChild(LCLUnitsCPUOSDir); ExtraSrcPath:='../..;../../widgetset'; if CurOS<>'win32' then ExtraSrcPath:=ExtraSrcPath+';../../nonwin32'; LCLUnitsCPUOSDir.AddChild(TDefineTemplate.Create('CompiledSrcPath', ctsSrcPathForCompiledUnits,CompiledSrcPathMacroName, d(ExtraSrcPath),da_Define)); end; // /lcl/units/-/ // these directories contain the output of the LCL interfaces LCLUnitsCPUOSWidgetSetDir:=LCLUnitsCPUOSDir.FindChildByName(CurWidgetSet); if LCLUnitsCPUOSWidgetSetDir=nil then begin LCLUnitsCPUOSWidgetSetDir:=TDefineTemplate.Create(CurWidgetSet, Format(ctsNamedDirectory,[CurWidgetSet]), '',CurWidgetSet,da_Directory); LCLUnitsCPUOSDir.AddChild(LCLUnitsCPUOSWidgetSetDir); ExtraSrcPath:='../../../interfaces/'+CurWidgetSet; if (CurWidgetSet='gtk2') then ExtraSrcPath:=ExtraSrcPath+';../../../interfaces/gtk'; if (CurWidgetSet='fpgui') then ExtraSrcPath:=ExtraSrcPath +';../../../interfaces/fpgui/corelib' +';../../../interfaces/fpgui/corelib/$('+ExternalMacroStart+'FPGUIPlatform)' +';../../../interfaces/fpgui/gui'; LCLUnitsCPUOSWidgetSetDir.AddChild( TDefineTemplate.Create('CompiledSrcPath', ctsSrcPathForCompiledUnits,CompiledSrcPathMacroName, d(ExtraSrcPath),da_Define)); end; end; // /lcl/interfaces SubDirTempl:=TDefineTemplate.Create('interfaces', ctsWidgetDirectory,'','interfaces',da_Directory); // add lcl to the source path of all widget set directories SubDirTempl.AddChild(TDefineTemplate.Create('LCL Path', Format(ctsAddsDirToSourcePath,['lcl']),ExternalMacroStart+'SrcPath', LazarusSrcDir+d('/lcl;') +LazarusSrcDir+d('/lcl/widgetset;') +SrcPath, da_DefineRecurse)); DirTempl.AddChild(SubDirTempl); // /lcl/interfaces/gtk IntfDirTemplate:=TDefineTemplate.Create('gtk', ctsIntfDirectory,'','gtk',da_Directory); // if LCLWidgetType=gtk2 IfTemplate:=TDefineTemplate.Create('IF '''+WidgetType+'''=''gtk2''', ctsIfLCLWidgetTypeEqualsGtk2,'',''''+WidgetType+'''=''gtk2''',da_If); // then define gtk2 IfTemplate.AddChild(TDefineTemplate.Create('Define gtk2', ctsDefineMacroGTK2,'gtk2','',da_Define)); IfTemplate.AddChild(TDefineTemplate.Create('add gtk2 to unit path', Format(ctsAddsDirToSourcePath,[d('../gtk2')]),ExternalMacroStart+'SrcPath', d('../gtk2;')+SrcPath,da_Define)); IfTemplate.AddChild(TDefineTemplate.Create('adds gtk2 as include path', Format(ctsAddsDirToIncludePath,[d('../gtk2')]),ExternalMacroStart+'IncPath', d('../gtk2;')+IncPath,da_Define)); IntfDirTemplate.AddChild(IfTemplate); // else LCLWidgetType=gtk2 ElseTemplate:=TDefineTemplate.Create('ELSE', ctsElse,'','',da_Else); // then define gtk1 ElseTemplate.AddChild(TDefineTemplate.Create('Define gtk1', ctsDefineMacroGTK1,'gtk1','',da_Define)); IntfDirTemplate.AddChild(ElseTemplate); SubDirTempl.AddChild(IntfDirTemplate); // /lcl/interfaces/gtk2 IntfDirTemplate:=TDefineTemplate.Create('gtk2', ctsGtk2IntfDirectory,'','gtk2',da_Directory); // add '../gtk' to the SrcPath IntfDirTemplate.AddChild(TDefineTemplate.Create('SrcPath', Format(ctsAddsDirToSourcePath,['gtk']),ExternalMacroStart+'SrcPath', d('../gtk;')+SrcPath,da_Define)); // add '../gtk' to the IncPath IntfDirTemplate.AddChild(TDefineTemplate.Create('IncPath', Format(ctsAddsDirToIncludePath,['gtk']),ExternalMacroStart+'IncPath', d('../gtk;')+IncPath,da_Define)); SubDirTempl.AddChild(IntfDirTemplate); // /lcl/interfaces/win32 // no special // /lcl/interfaces/wince IntfDirTemplate:=TDefineTemplate.Create('wince', ctsIntfDirectory,'','wince',da_Directory); // then define wince1 IntfDirTemplate.AddChild(TDefineTemplate.Create('Define wince1', ctsDefineMacroWinCE1,'wince1','',da_Define)); SubDirTempl.AddChild(IntfDirTemplate); // /lcl/interfaces/carbon IntfDirTemplate:=TDefineTemplate.Create('carbon', ctsIntfDirectory,'','carbon',da_Directory); // then define carbon1 IntfDirTemplate.AddChild(TDefineTemplate.Create('Define carbon1', ctsDefineMacroCarbon1,'carbon1','',da_Define)); SubDirTempl.AddChild(IntfDirTemplate); // /lcl/interfaces/qt IntfDirTemplate:=TDefineTemplate.Create('qt', ctsIntfDirectory,'','qt',da_Directory); // then define qt1 IntfDirTemplate.AddChild(TDefineTemplate.Create('Define qt1', ctsDefineMacroQT1,'qt1','',da_Define)); SubDirTempl.AddChild(IntfDirTemplate); // /lcl/interfaces/fpgui IntfDirTemplate:=TDefineTemplate.Create('fpgui', ctsIntfDirectory,'','fpgui',da_Directory); // add unit paths IntfDirTemplate.AddChild(TDefineTemplate.Create('Add gui, corelib to SrcPath', Format(ctsAddsDirToSourcePath,['gui, corelib']), ExternalMacroStart+'SrcPath', d(LazarusSrcDir+'/lcl/interfaces/fpgui/gui') +';'+d(LazarusSrcDir+'/lcl/interfaces/fpgui/corelib') +';'+d(LazarusSrcDir+'/lcl/interfaces/fpgui/corelib/$('+ExternalMacroStart+'FPGUIPlatform)') +';'+SrcPath ,da_DefineRecurse)); // and include path IntfDirTemplate.AddChild(TDefineTemplate.Create('Add corelib to IncPath', Format(ctsAddsDirToIncludePath,['corelib']), ExternalMacroStart+'IncPath', d(LazarusSrcDir+'/lcl/interfaces/fpgui/corelib') +';'+d(LazarusSrcDir+'/lcl/interfaces/fpgui/corelib/$('+ExternalMacroStart+'FPGUIPlatform)') +';'+IncPath ,da_Define)); SubDirTempl.AddChild(IntfDirTemplate); // /components DirTempl:=TDefineTemplate.Create('Components',ctsComponentsDirectory, '','components',da_Directory); DirTempl.AddChild(TDefineTemplate.Create('LCL Path', Format(ctsAddsDirToSourcePath,['lcl']), ExternalMacroStart+'SrcPath', d(LazarusSrcDir+'/lcl' +';'+LazarusSrcDir+'/lcl/interfaces/'+WidgetType) +';'+SrcPath ,da_DefineRecurse)); // /components/synedit/units SynEditDirTempl:=TDefineTemplate.Create('synedit', 'SynEdit','','synedit',da_Directory); SynEditUnitsDirTempl:=TDefineTemplate.Create('synedit output directory', 'units','','units',da_Directory); SynEditDirTempl.AddChild(SynEditUnitsDirTempl); SynEditUnitsDirTempl.AddChild(TDefineTemplate.Create('CompiledSrcPath', ctsSrcPathForCompiledUnits, ExternalMacroStart+'CompiledSrcPath', d(LazarusSrcDir+'components/synedit') ,da_DefineRecurse)); DirTempl.AddChild(SynEditDirTempl); // /components/codetools/units CodeToolsDirTempl:=TDefineTemplate.Create('codetools', 'CodeTools','','codetools',da_Directory); CodeToolsUnitsDirTempl:=TDefineTemplate.Create('codetools output directory', 'units','','units',da_Directory); CodeToolsDirTempl.AddChild(CodeToolsUnitsDirTempl); CodeToolsUnitsDirTempl.AddChild(TDefineTemplate.Create('CompiledSrcPath', ctsSrcPathForCompiledUnits, ExternalMacroStart+'CompiledSrcPath', d(LazarusSrcDir+'components/codetools') ,da_DefineRecurse)); DirTempl.AddChild(CodeToolsDirTempl); // /components/custom SubDirTempl:=TDefineTemplate.Create('Custom Components', ctsCustomComponentsDirectory, '','custom',da_Directory); SubDirTempl.AddChild(TDefineTemplate.Create('lazarus standard components', Format(ctsAddsDirToSourcePath,['synedit']), ExternalMacroStart+'SrcPath', d('../synedit;') +SrcPath ,da_DefineRecurse)); DirTempl.AddChild(SubDirTempl); MainDir.AddChild(DirTempl); // /tools DirTempl:=TDefineTemplate.Create('Tools', ctsToolsDirectory,'','tools',da_Directory); DirTempl.AddChild(TDefineTemplate.Create('LCL path addition', Format(ctsAddsDirToSourcePath,['lcl']), ExternalMacroStart+'SrcPath', d('../lcl;../lcl/interfaces/'+WidgetType +';../components/codetools') +';'+SrcPath ,da_Define)); // /tools/install ToolsInstallDirTempl:=TDefineTemplate.Create('Install', ctsInstallDirectory,'','install',da_Directory); DirTempl.AddChild(ToolsInstallDirTempl); ToolsInstallDirTempl.AddChild(TDefineTemplate.Create('LCL path addition', Format(ctsAddsDirToSourcePath,['lcl']), ExternalMacroStart+'SrcPath', d('../../lcl;../../lcl/interfaces/'+WidgetType +';../../components/codetools') +';'+SrcPath ,da_Define)); MainDir.AddChild(DirTempl); // extra options SubTempl:=CreateFPCCommandLineDefines(StdDefTemplLazarusBuildOpts, ExtraOptions,true,Owner); MainDir.AddChild(SubTempl); // put it all into a block if MainDir<>nil then begin Result:=TDefineTemplate.Create(StdDefTemplLazarusSources, ctsLazarusSources,'','',da_Block); Result.AddChild(MainDir); end; Result.SetDefineOwner(Owner,true); Result.SetFlags([dtfAutoGenerated],[],false); end; function TDefinePool.CreateLCLProjectTemplate( const LazarusSrcDir, WidgetType, ProjectDir: string; Owner: TObject): TDefineTemplate; var DirTempl: TDefineTemplate; begin Result:=nil; if (LazarusSrcDir='') or (WidgetType='') or (ProjectDir='') then exit; DirTempl:=TDefineTemplate.Create('ProjectDir',ctsAnLCLProject, '',ProjectDir,da_Directory); DirTempl.AddChild(TDefineTemplate.Create('LCL', Format(ctsAddsDirToSourcePath,['lcl']), ExternalMacroStart+'SrcPath', LazarusSrcDir+PathDelim+'lcl;' +LazarusSrcDir+PathDelim+'lcl'+PathDelim+'interfaces' +PathDelim+WidgetType +';$('+ExternalMacroStart+'SrcPath)' ,da_DefineRecurse)); Result:=TDefineTemplate.Create(StdDefTemplLCLProject, 'LCL Project','','',da_Block); Result.AddChild(DirTempl); Result.SetDefineOwner(Owner,true); Result.SetFlags([dtfAutoGenerated],[],false); end; function TDefinePool.CreateDelphiCompilerDefinesTemplate( DelphiVersion: integer; Owner: TObject): TDefineTemplate; var DefTempl: TDefineTemplate; VerMacro: String; begin DefTempl:=TDefineTemplate.Create('Delphi'+IntToStr(DelphiVersion) +' Compiler Defines', Format(ctsOtherCompilerDefines,['Delphi'+IntToStr(DelphiVersion)]), '','',da_Block); DefTempl.AddChild(TDefineTemplate.Create('Reset', ctsResetAllDefines, '','',da_UndefineAll)); DefTempl.AddChild(TDefineTemplate.Create('Define macro DELPHI', Format(ctsDefineMacroName,['DELPHI']), 'DELPHI','',da_DefineRecurse)); DefTempl.AddChild(TDefineTemplate.Create('Define macro FPC_DELPHI', Format(ctsDefineMacroName,['FPC_DELPHI']), 'FPC_DELPHI','',da_DefineRecurse)); DefTempl.AddChild(TDefineTemplate.Create('Define macro MSWINDOWS', Format(ctsDefineMacroName,['MSWINDOWS']), 'MSWINDOWS','',da_DefineRecurse)); // version case DelphiVersion of 3: VerMacro:='VER_110'; 4: VerMacro:='VER_125'; 5: VerMacro:='VER_130'; 6: VerMacro:='VER_140'; else // else define Delphi 7 VerMacro:='VER_150'; end; DefTempl.AddChild(TDefineTemplate.Create('Define macro '+VerMacro, Format(ctsDefineMacroName,[VerMacro]), VerMacro,'',da_DefineRecurse)); DefTempl.AddChild(TDefineTemplate.Create( Format(ctsDefineMacroName,[ExternalMacroStart+'Compiler']), 'Define '+ExternalMacroStart+'Compiler variable', ExternalMacroStart+'Compiler','DELPHI',da_DefineRecurse)); Result:=DefTempl; Result.SetDefineOwner(Owner,true); end; function TDefinePool.CreateDelphiDirectoryTemplate( const DelphiDirectory: string; DelphiVersion: integer; Owner: TObject): TDefineTemplate; var MainDirTempl: TDefineTemplate; begin MainDirTempl:=TDefineTemplate.Create('Delphi'+IntToStr(DelphiVersion) +' Directory', Format(ctsNamedDirectory,['Delphi'+IntToStr(DelphiVersion)]), '',DelphiDirectory,da_Directory); MainDirTempl.AddChild(CreateDelphiCompilerDefinesTemplate(DelphiVersion,Owner)); MainDirTempl.AddChild(TDefineTemplate.Create('SrcPath', Format(ctsSetsSrcPathTo,['RTL, VCL']), ExternalMacroStart+'SrcPath', SetDirSeparators( CreateDelphiSrcPath(DelphiVersion,DefinePathMacro+'/')+'$(#SrcPath)'), da_DefineRecurse)); Result:=MainDirTempl; Result.SetDefineOwner(Owner,true); end; function TDefinePool.CreateDelphiProjectTemplate( const ProjectDir, DelphiDirectory: string; DelphiVersion: integer; Owner: TObject): TDefineTemplate; var MainDirTempl: TDefineTemplate; begin MainDirTempl:=TDefineTemplate.Create('Delphi'+IntToStr(DelphiVersion)+' Project', Format(ctsNamedProject,['Delphi'+IntToStr(DelphiVersion)]), '',ProjectDir,da_Directory); MainDirTempl.AddChild( CreateDelphiCompilerDefinesTemplate(DelphiVersion,Owner)); MainDirTempl.AddChild(TDefineTemplate.Create( 'Define '+ExternalMacroStart+'DelphiDir', Format(ctsDefineMacroName,[ExternalMacroStart+'DelphiDir']), ExternalMacroStart+'DelphiDir',DelphiDirectory,da_DefineRecurse)); MainDirTempl.AddChild(TDefineTemplate.Create('SrcPath', Format(ctsAddsDirToSourcePath,['Delphi RTL+VCL']), ExternalMacroStart+'SrcPath', SetDirSeparators(CreateDelphiSrcPath(DelphiVersion,'$(#DelphiDir)/') +'$(#SrcPath)'), da_DefineRecurse)); Result:=MainDirTempl; Result.SetDefineOwner(Owner,true); end; function TDefinePool.CreateKylixCompilerDefinesTemplate(KylixVersion: integer; Owner: TObject): TDefineTemplate; var DefTempl: TDefineTemplate; begin DefTempl:=TDefineTemplate.Create('Kylix'+IntToStr(KylixVersion) +' Compiler Defines', Format(ctsOtherCompilerDefines,['Kylix'+IntToStr(KylixVersion)]), '','',da_Block); DefTempl.AddChild(TDefineTemplate.Create('Reset', ctsResetAllDefines, '','',da_UndefineAll)); DefTempl.AddChild(TDefineTemplate.Create('Define macro KYLIX', Format(ctsDefineMacroName,['KYLIX']), 'KYLIX','',da_DefineRecurse)); DefTempl.AddChild(TDefineTemplate.Create('Define macro FPC_DELPHI', Format(ctsDefineMacroName,['FPC_DELPHI']), 'FPC_DELPHI','',da_DefineRecurse)); DefTempl.AddChild(TDefineTemplate.Create('Define macro LINUX', Format(ctsDefineMacroName,['LINUX']), 'LINUX','',da_DefineRecurse)); DefTempl.AddChild(TDefineTemplate.Create('Define macro CPU386', Format(ctsDefineMacroName,['CPU386']), 'CPU386','',da_DefineRecurse)); // version case KylixVersion of 1: DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_125', Format(ctsDefineMacroName,['VER_125']), 'VER_125','',da_DefineRecurse)); 2: DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_130', Format(ctsDefineMacroName,['VER_130']), 'VER_130','',da_DefineRecurse)); else // else define Kylix 3 DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_140', Format(ctsDefineMacroName,['VER_140']), 'VER_140','',da_DefineRecurse)); end; DefTempl.AddChild(TDefineTemplate.Create( Format(ctsDefineMacroName,[ExternalMacroStart+'Compiler']), 'Define '+ExternalMacroStart+'Compiler variable', ExternalMacroStart+'Compiler','DELPHI',da_DefineRecurse)); Result:=DefTempl; Result.SetDefineOwner(Owner,true); end; function TDefinePool.CreateKylixSrcPath(KylixVersion: integer; const PathPrefix: string): string; begin Result:=PathPrefix+'source/rtl/linux;' +PathPrefix+'source/rtl/sys;' +PathPrefix+'source/rtl/common;' +PathPrefix+'source/rtl/corba40;' +PathPrefix+'source/rtle;' +PathPrefix+'source/rtl/clx'; end; function TDefinePool.CreateKylixDirectoryTemplate(const KylixDirectory: string; KylixVersion: integer; Owner: TObject): TDefineTemplate; var MainDirTempl: TDefineTemplate; begin MainDirTempl:=TDefineTemplate.Create('Kylix'+IntToStr(KylixVersion) +' Directory', Format(ctsNamedDirectory,['Kylix'+IntToStr(KylixVersion)]), '',KylixDirectory,da_Directory); MainDirTempl.AddChild(CreateKylixCompilerDefinesTemplate(KylixVersion,Owner)); MainDirTempl.AddChild(TDefineTemplate.Create('SrcPath', Format(ctsSetsSrcPathTo,['RTL, CLX']), ExternalMacroStart+'SrcPath', SetDirSeparators(CreateKylixSrcPath(KylixVersion,DefinePathMacro+'/') +'$(#SrcPath)'), da_DefineRecurse)); Result:=MainDirTempl; Result.SetDefineOwner(Owner,true); end; function TDefinePool.CreateKylixProjectTemplate(const ProjectDir, KylixDirectory: string; KylixVersion: integer; Owner: TObject ): TDefineTemplate; var MainDirTempl: TDefineTemplate; begin MainDirTempl:=TDefineTemplate.Create('Kylix'+IntToStr(KylixVersion)+' Project', Format(ctsNamedProject,['Kylix'+IntToStr(KylixVersion)]), '',ProjectDir,da_Directory); MainDirTempl.AddChild( CreateDelphiCompilerDefinesTemplate(KylixVersion,Owner)); MainDirTempl.AddChild(TDefineTemplate.Create( 'Define '+ExternalMacroStart+'KylixDir', Format(ctsDefineMacroName,[ExternalMacroStart+'KylixDir']), ExternalMacroStart+'KylixDir',KylixDirectory,da_DefineRecurse)); MainDirTempl.AddChild(TDefineTemplate.Create('SrcPath', Format(ctsAddsDirToSourcePath,['Kylix RTL+VCL']), ExternalMacroStart+'SrcPath', SetDirSeparators(CreateKylixSrcPath(KylixVersion,'$(#KylixDir)/') +'$(#SrcPath)'), da_DefineRecurse)); Result:=MainDirTempl; Result.SetDefineOwner(Owner,true); end; function TDefinePool.CreateFPCCommandLineDefines(const Name, CmdLine: string; RecursiveDefines: boolean; Owner: TObject; AlwaysCreate: boolean): TDefineTemplate; procedure CreateMainTemplate; begin if Result=nil then Result:=TDefineTemplate.Create(Name,ctsCommandLineParameters,'','', da_Block); end; procedure AddDefine(const AName, ADescription, AVariable, AValue: string; AnAction: TDefineAction); var NewTempl: TDefineTemplate; begin if AName='' then exit; NewTempl:=TDefineTemplate.Create(AName, ADescription, AVariable, AValue, AnAction); CreateMainTemplate; Result.AddChild(NewTempl); end; procedure AddDefine(const AName, ADescription, AVariable, AValue: string); var NewAction: TDefineAction; begin if RecursiveDefines then NewAction:=da_DefineRecurse else NewAction:=da_Define; AddDefine(AName,ADescription,AVariable,AValue,NewAction); end; procedure AddDefine(const AName: string; const AValue: string = ''); begin AddDefine('Define '+AName,ctsDefine+AName,AName,AValue); end; procedure AddUndefine(const AName: string); var NewAction: TDefineAction; begin if RecursiveDefines then NewAction:=da_UndefineRecurse else NewAction:=da_Undefine; AddDefine('Undefine '+AName,ctsUndefine+AName,AName,'',NewAction); end; procedure AddDefineUndefine(const AName: string; Define: boolean); begin if Define then AddDefine(AName) else AddUndefine(AName); end; var StartPos, EndPos: Integer; s: string; CompilerMode: String; begin Result:=nil; if AlwaysCreate then CreateMainTemplate; EndPos:=1; CompilerMode:=''; while ReadNextFPCParameter(CmdLine,EndPos,StartPos) do begin if (StartPos'' then begin AddDefineUndefine('FPC_FPC',SysUtils.CompareText(CompilerMode,'FPC')=0); AddDefineUndefine('FPC_ObjFPC',SysUtils.CompareText(CompilerMode,'ObjFPC')=0); AddDefineUndefine('FPC_Delphi',SysUtils.CompareText(CompilerMode,'Delphi')=0); AddDefineUndefine('FPC_TP',SysUtils.CompareText(CompilerMode,'TP')=0); AddDefineUndefine('FPC_GPC',SysUtils.CompareText(CompilerMode,'GPC')=0); AddDefineUndefine('FPC_MACPAS',SysUtils.CompareText(CompilerMode,'MACPAS')=0); end; Result.SetDefineOwner(Owner,true); end; procedure TDefinePool.ConsistencyCheck; var i: integer; begin for i:=0 to Count-1 do Items[i].ConsistencyCheck; end; procedure TDefinePool.WriteDebugReport; var i: integer; begin DebugLn('TDefinePool.WriteDebugReport'); for i:=0 to Count-1 do Items[i].WriteDebugReport(false); ConsistencyCheck; end; end.