{ /*************************************************************************** editdefinetree.pas - Lazarus IDE unit --------------------------------------- ***************************************************************************/ *************************************************************************** * * * 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., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * * * *************************************************************************** Author: Mattias Gaertner Abstract: - procedures to transfer the compiler options to the CodeTools } unit EditDefineTree; {$mode objfpc}{$H+} interface uses Classes, SysUtils, // LazUtils FileUtil, LazTracer, // CodeTools FileProcs, CodeToolManager, DefineTemplates, LinkScanner, // IdeIntf CompOptsIntf, // IDE IDEProcs, CompilerOptions, LazarusIDEStrConsts; // global function FindRootTemplate(AName: string): TDefineTemplate; // global defaults function FindUseDefaultsFlagTemplate: TDefineTemplate; function CreateUseDefaultsFlagTemplate: TDefineTemplate; procedure DisableDefaultsInDirectories(DefTempl: TDefineTemplate; Recurse: boolean); // FPC sources function CreateFPCSourceTemplate(Config: TFPCUnitSetCache; Owner: TObject): TDefineTemplate; overload; function CreateLazarusSourceTemplate( const LazarusSrcDir, WidgetType, ExtraOptions: string; Owner: TObject): TDefineTemplate; // projects function FindProjectsTemplate: TDefineTemplate; function FindProjectTemplateWithID(const ProjectID: string): TDefineTemplate; function CreateProjectsTemplate: TDefineTemplate; function CreateProjectTemplateWithID(const ProjectID: string): TDefineTemplate; // packages function FindPackagesTemplate: TDefineTemplate; function FindPackageTemplateWithID(const PkgID: string): TDefineTemplate; function CreatePackagesTemplate: TDefineTemplate; function CreatePackageTemplateWithID(const PkgID: string): TDefineTemplate; // miscellaneous function UpdateCompilerOptionsTemplates(ParentTemplate: TDefineTemplate; CompOpts: TCompilerOptions; RecursiveDefines, ClearCache: boolean): boolean; function ReplaceAutoGeneratedDefine(ParentTemplate: TDefineTemplate; const Name, Description, Variable, Value: string; RecursiveDefine: boolean): boolean; function RemoveAutoGeneratedDefine(ParentTemplate: TDefineTemplate; const Name: string): boolean; const UseDefaultsFlagTemplName = 'Use defaults'; UseDefaultsFlagName = ExternalMacroStart+'UseDefaults'; NotUseDefaultsFlagTemplName = 'Do not use defaults'; ProjectDefTemplName = 'Current Project'; ProjectDirDefTemplName = 'Current Project Directory'; ProjectsDefTemplName = 'Projects'; ProjectDirSrcPathDefTemplName = 'Project SrcPath'; ProjectDirUnitPathDefTemplName = 'Project UnitPath'; ProjectDirIncPathDefTemplName = 'Project IncPath'; ProjectOutputDirDefTemplName = 'Project Output Directory'; PackagesDefTemplName = 'Packages'; PkgOutputDirDefTemplName = 'Output Directory'; FPCModeDefTemplName = 'MODE'; IOChecksOnDefTemplName = 'IOCHECKS on'; RangeChecksOnDefTemplName = 'RANGECHECKS on'; OverflowChecksOnDefTemplName = 'OVERFLOWCHECKS on'; UseLineInfoUnitDefTemplName = 'use LINEINFO unit'; UseHeapTrcUnitDefTemplName = 'use HEAPTRC unit'; FPCCmdLineDefTemplName = 'Custom Options'; implementation function FindPackagesTemplate: TDefineTemplate; begin Result:=FindRootTemplate(PackagesDefTemplName); end; function FindPackageTemplateWithID(const PkgID: string): TDefineTemplate; var PkgTempl: TDefineTemplate; begin PkgTempl:=FindPackagesTemplate; if PkgTempl=nil then Result:=nil else Result:=PkgTempl.FindChildByName(PkgID); end; function CreateFPCSourceTemplate(Config: TFPCUnitSetCache; Owner: TObject ): TDefineTemplate; begin Result:=DefineTemplates.CreateFPCSourceTemplate(Config,Owner); DisableDefaultsInDirectories(Result,true); end; function CreateLazarusSourceTemplate(const LazarusSrcDir, WidgetType, ExtraOptions: string; Owner: TObject): TDefineTemplate; begin Result:=CodeToolBoss.DefinePool.CreateLazarusSrcTemplate(LazarusSrcDir, WidgetType, ExtraOptions, Owner); DisableDefaultsInDirectories(Result,true); end; function FindProjectsTemplate: TDefineTemplate; begin Result:=FindRootTemplate(ProjectsDefTemplName); end; function FindProjectTemplateWithID(const ProjectID: string): TDefineTemplate; var ProjectTempl: TDefineTemplate; begin ProjectTempl:=FindProjectsTemplate; if ProjectTempl=nil then Result:=nil else Result:=ProjectTempl.FindChildByName(ProjectID); end; function CreateProjectsTemplate: TDefineTemplate; begin Result:=FindProjectsTemplate; if Result<>nil then begin CodeToolBoss.DefineTree.MoveToLast(Result); exit; end; Result:=TDefineTemplate.Create(ProjectsDefTemplName, lisEdtDefsAllProjects, '', '', da_Block); Result.Flags:=[dtfAutoGenerated]; // insert behind all CodeToolBoss.DefineTree.ReplaceRootSameName(Result); end; function CreateProjectTemplateWithID(const ProjectID: string): TDefineTemplate; var ProjTempl: TDefineTemplate; begin ProjTempl:=CreateProjectsTemplate; Result:=ProjTempl.FindChildByName(ProjectID); if Result<>nil then exit; Result:=TDefineTemplate.Create(ProjectID,ProjectID,'','',da_Block); Result.Flags:=[dtfAutoGenerated]; ProjTempl.AddChild(Result); end; function CreatePackagesTemplate: TDefineTemplate; begin Result:=FindPackagesTemplate; if Result<>nil then exit; Result:=TDefineTemplate.Create(PackagesDefTemplName, lisEdtDefAllPackages, '', '', da_Block); Result.Flags:=[dtfAutoGenerated]; // insert behind all CodeToolBoss.DefineTree.ReplaceRootSameName(Result); // move projects behind CreateProjectsTemplate; end; function CreatePackageTemplateWithID(const PkgID: string): TDefineTemplate; var PkgTempl: TDefineTemplate; begin PkgTempl:=CreatePackagesTemplate; Result:=PkgTempl.FindChildByName(PkgID); if Result<>nil then exit; Result:=TDefineTemplate.Create(PkgID,PkgID,'','',da_Block); Result.Flags:=[dtfAutoGenerated]; PkgTempl.AddChild(Result); end; function ConvertTransferMacrosToExternalMacros(const s: string): string; var Count, i, j: integer; begin Count:=0; for i:=1 to length(s)-1 do begin if ((i=1) or (s[i-1]<>FileProcs.SpecialChar)) and (s[i]='$') and (s[i+1] in ['(','{']) then inc(Count); end; if Count=0 then begin Result:=s; exit; end; SetLength(Result,Length(s)+Count); i:=1; j:=1; while (i<=length(s)) do begin if (iFileProcs.SpecialChar)) then begin Result[j]:=s[i]; Result[j+1]:='('; inc(j,2); inc(i); Result[j]:=ExternalMacroStart; end else if (i>=2) and (s[i-1]<>SpecialChar) and (s[i]='}') then begin Result[j]:=')'; end else begin Result[j]:=s[i]; end; inc(j); inc(i); end; end; function UpdateCompilerOptionsTemplates(ParentTemplate: TDefineTemplate; CompOpts: TCompilerOptions; RecursiveDefines, ClearCache: boolean): boolean; // returns true on change, false on no change var CustomOpts: TDefineTemplate; begin Result:=false; // no change if ParentTemplate=nil then RaiseGDBException('UpdateCompilerOptionsTemplates internal error'); { ToDo: StackChecks DontUseConfigFile CustomConfigFile } // FPC modes ---------------------------------------------------------------- if SysUtils.CompareText(CompOpts.SyntaxMode,'Delphi')=0 then begin // set mode DELPHI Result:=Result or ReplaceAutoGeneratedDefine(ParentTemplate,FPCModeDefTemplName, lisEdtDefsetFPCModeToDELPHI, CompilerModeVars[cmDELPHI], '1', RecursiveDefines); end else if SysUtils.CompareText(CompOpts.SyntaxMode,'TP')=0 then begin // set mode TP Result:=Result or ReplaceAutoGeneratedDefine(ParentTemplate,FPCModeDefTemplName, lisEdtDefsetFPCModeToTP, CompilerModeVars[cmTP], '1', RecursiveDefines); end else if SysUtils.CompareText(CompOpts.SyntaxMode,'GPC')=0 then begin // set mode GPC Result:=Result or ReplaceAutoGeneratedDefine(ParentTemplate,FPCModeDefTemplName, lisEdtDefsetFPCModeToGPC, CompilerModeVars[cmGPC], '1', RecursiveDefines ); end else if SysUtils.CompareText(CompOpts.SyntaxMode,'MacPas')=0 then begin // set mode MacPas Result:=Result or ReplaceAutoGeneratedDefine(ParentTemplate,FPCModeDefTemplName, lisEdtDefsetFPCModeToMacPas, CompilerModeVars[cmMacPas], '1', RecursiveDefines ); end else if SysUtils.CompareText(CompOpts.SyntaxMode,'FPC')=0 then begin // set mode FPC Result:=Result or ReplaceAutoGeneratedDefine(ParentTemplate,FPCModeDefTemplName, lisEdtDefsetFPCModeToFPC, CompilerModeVars[cmFPC], '1', RecursiveDefines ); end else begin // set no mode Result:=Result or RemoveAutoGeneratedDefine(ParentTemplate,FPCModeDefTemplName); end; // Checks ------------------------------------------------------------------- // IO Checks if CompOpts.IOChecks then begin Result:=Result or ReplaceAutoGeneratedDefine(ParentTemplate,IOChecksOnDefTemplName, lisEdtDefsetIOCHECKSOn, 'IOCHECKS', '1', RecursiveDefines); end else begin Result:=Result or RemoveAutoGeneratedDefine(ParentTemplate,IOChecksOnDefTemplName); end; // Range checking if CompOpts.RangeChecks then begin Result:=Result or ReplaceAutoGeneratedDefine(ParentTemplate,RangeChecksOnDefTemplName, lisEdtDefsetRANGECHECKSOn, 'RANGECHECKS', '1', RecursiveDefines); end else begin Result:=Result or RemoveAutoGeneratedDefine(ParentTemplate,RangeChecksOnDefTemplName); end; // Overflow checking if CompOpts.OverflowChecks then begin Result:=Result or ReplaceAutoGeneratedDefine(ParentTemplate,OverflowChecksOnDefTemplName, lisEdtDefsetOVERFLOWCHECKSOn, 'OVERFLOWCHECKS', '1', RecursiveDefines); end else begin Result:=Result or RemoveAutoGeneratedDefine(ParentTemplate,OverflowChecksOnDefTemplName); end; // Hidden used units -------------------------------------------------------- // use lineinfo unit if CompOpts.UseLineInfoUnit then begin Result:=Result or ReplaceAutoGeneratedDefine(ParentTemplate,UseLineInfoUnitDefTemplName, lisEdtDefuseLineInfoUnit, ExternalMacroStart+'UseLineInfo', '1', RecursiveDefines); end else begin Result:=Result or RemoveAutoGeneratedDefine(ParentTemplate,UseLineInfoUnitDefTemplName); end; // use heaptrc unit if CompOpts.UseHeaptrc then begin Result:=Result or ReplaceAutoGeneratedDefine(ParentTemplate,UseHeapTrcUnitDefTemplName, lisEdtDefuseHeapTrcUnit, ExternalMacroStart+'UseHeapTrcUnit', '1', RecursiveDefines); end else begin Result:=Result or RemoveAutoGeneratedDefine(ParentTemplate,UseHeapTrcUnitDefTemplName); end; // custom options ----------------------------------------------------------- CustomOpts:=CodeToolBoss.DefinePool.CreateFPCCommandLineDefines( FPCCmdLineDefTemplName,CompOpts.GetCustomOptions(coptParsed), RecursiveDefines,nil); if CustomOpts<>nil then begin ParentTemplate.ReplaceChild(CustomOpts); end else begin ParentTemplate.DeleteChild(FPCCmdLineDefTemplName); end; // clear cache if ClearCache and Result then CodeToolBoss.DefineTree.ClearCache; end; function ReplaceAutoGeneratedDefine(ParentTemplate: TDefineTemplate; const Name, Description, Variable, Value: string; RecursiveDefine: boolean): boolean; // returns true on change, false on no change var DefType: TDefineAction; NewDefine: TDefineTemplate; OldNode: TDefineTemplate; begin Result:=false; // no change OldNode:=ParentTemplate.FindChildByName(Name); if RecursiveDefine then DefType:=da_DefineRecurse else DefType:=da_Define; if OldNode=nil then begin NewDefine:=TDefineTemplate.Create(Name,Description,Variable,Value,DefType); ParentTemplate.AddChild(NewDefine); NewDefine.Flags:=[dtfAutoGenerated]; Result:=true; end else begin if (OldNode.Name=Name) and (OldNode.Description=Description) and (OldNode.Variable=Variable) and (OldNode.Value=Value) and (OldNode.Action=DefType) and (dtfAutoGenerated in OldNode.Flags) then exit; OldNode.Name:=Name; OldNode.Description:=Description; OldNode.Variable:=Variable; OldNode.Value:=Value; OldNode.Action:=DefType; OldNode.Flags:=[dtfAutoGenerated]; Result:=true; end; end; function RemoveAutoGeneratedDefine(ParentTemplate: TDefineTemplate; const Name: string): boolean; // returns true on change, false on no change var OldNode: TDefineTemplate; begin Result:=false; // no change if ParentTemplate=nil then exit; OldNode:=ParentTemplate.FindChildByName(Name); if OldNode<>nil then begin OldNode.Unbind; OldNode.Free; Result:=true; end; end; function FindRootTemplate(AName: string): TDefineTemplate; begin if (CodeToolBoss<>nil) then Result:=CodeToolBoss.DefineTree.FindDefineTemplateByName(AName,true) else Result:=nil; end; function FindUseDefaultsFlagTemplate: TDefineTemplate; begin Result:=FindRootTemplate(UseDefaultsFlagTemplName); end; function CreateUseDefaultsFlagTemplate: TDefineTemplate; begin Result:=FindUseDefaultsFlagTemplate; if Result<>nil then exit; Result:=TDefineTemplate.Create(UseDefaultsFlagTemplName, 'Not used directory flag', UseDefaultsFlagName, '1', da_DefineRecurse); Result.Flags:=[dtfAutoGenerated]; // insert in front of all CodeToolBoss.DefineTree.ReplaceRootSameNameAddFirst(Result); end; procedure DisableDefaultsInDirectories(DefTempl: TDefineTemplate; Recurse: boolean); // add to each directory a template to undefine the UseDefaults flag var Action: TDefineAction; begin if Recurse then Action:=da_UndefineRecurse else Action:=da_Undefine; while DefTempl<>nil do begin if DefTempl.Action=da_Directory then begin DefTempl.AddChild(TDefineTemplate.Create(NotUseDefaultsFlagTemplName, NotUseDefaultsFlagTemplName,UseDefaultsFlagName,'',Action)); DefTempl:=DefTempl.GetNextSkipChildren; end else begin DefTempl:=DefTempl.GetNext; end; end; end; end.