lazarus/ide/editdefinetree.pas
2021-01-19 09:20:34 +00:00

467 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,
// 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 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
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.