lazarus-src-0.9.30.4 0.9.30.4-6 / usr / lib / lazarus / 0.9.30.4 / ide / editdefinetree.pas

{ /***************************************************************************
                     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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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, CompilerOptions, TransferMacros, LinkScanner,
  LazarusIDEStrConsts;


// global
function FindRootTemplate(AName: string): TDefineTemplate;
procedure SetAdditionalGlobalSrcPathToCodeToolBoss(const SrcPath: string);

// 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 CreateFPCSourceTemplate(const FPCSrcDir, UnitSearchPath, PPUExt,
                      DefaultTargetOS, DefaultProcessorName: string;
                      UnitLinkListValid: boolean; var UnitLinkList: string;
                      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:=CreateFPCSrcTemplate(Config,Owner);
  DisableDefaultsInDirectories(Result,true);
end;

function CreateFPCSourceTemplate(const FPCSrcDir, UnitSearchPath, PPUExt,
  DefaultTargetOS, DefaultProcessorName: string; UnitLinkListValid: boolean;
  var UnitLinkList: string; Owner: TObject): TDefineTemplate;
begin
  Result:=CodeToolBoss.DefinePool.CreateFPCSrcTemplate(FPCSrcDir,
                                        UnitSearchPath, PPUExt,
                                        DefaultTargetOS, DefaultProcessorName,
                                        UnitLinkListValid, UnitLinkList, 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;

procedure SetAdditionalGlobalSrcPathToCodeToolBoss(const SrcPath: string);
var DefTempl: TDefineTemplate;
begin
  if SrcPath<>'' then begin
    DefTempl:=TDefineTemplate.Create('GlobalSrcPathAdd',
      lisEdtDefGlobalSourcePathAddition, ExternalMacroStart+'SRCPATH',
      ConvertTransferMacrosToExternalMacros(SrcPath)+';'
        +'$('+ExternalMacroStart+'SRCPATH)',
        da_DefineRecurse);
    DefTempl.Flags:=[dtfAutoGenerated];
    CodeToolBoss.DefineTree.ReplaceRootSameName(DefTempl);
  end else begin
    CodeToolBoss.DefineTree.RemoveRootDefineTemplateByName('GlobalSrcPathAdd');
  end;
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.