mirror of
				https://gitlab.com/freepascal.org/lazarus/lazarus.git
				synced 2025-10-31 07:21:32 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			464 lines
		
	
	
		
			15 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			464 lines
		
	
	
		
			15 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| { /***************************************************************************
 | |
|                      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 <http://www.gnu.org/copyleft/gpl.html>. 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, FileProcs, FileUtil, IDEProcs, CodeToolManager,
 | |
|   DefineTemplates, LinkScanner,
 | |
|   CompOptsIntf,
 | |
|   CompilerOptions, TransferMacros,
 | |
|   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 (i<length(s))
 | |
|     and ((s[i]='$') and (s[i+1] in ['(','{']))
 | |
|     and ((i=1) or (s[i-1]<>FileProcs.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
 | |
|     RaiseException('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.
 | |
| 
 | 
