compile.pas

East make Tray Icon in delphi

          AbortReason := RsErrorCompilingPackages;
          Exit;
        end;
        DoPackageProgress(nil, '', FPkgCount, FPkgCount);
      end
      else
        CaptureLine(RsPackagesAreUpToDate, FAborted);
    end;

    // *****************************************************************

    if (FPkgCount > 0) and
       ((not ProjectGroup.TargetConfig.DeveloperInstall) or
        (TargetConfig.Target.IsBCB)) then
    begin
{**}  DoProjectProgress(RsCopyingFiles, GetProjectIndex, ProjectMax);
      { The .dfm/.xfm files are deleted from the lib directory in the
        resource generation section in this method.
        The files are only copied for a non-developer installation and for
        BCB. }
      CopyFormDataFiles(ProjectGroup, DebugUnits);
    end
    else
{**}  GetProjectIndex; // increase progress

  finally
{**}DoProjectProgress(RsFinished, ProjectMax, ProjectMax);
    FCurrentProjectGroup := nil;
  end;
  Result := True;

  { Delete the generated "xx Package.mak" file. }
  DeleteFile(ChangeFileExt(ProjectGroup.Filename, '.mak'));
end;

function ReplaceTargetMacros(const S: string; TargetConfig: ITargetConfig): string;
var
  ps: Integer;
begin
  Result := S;
  ps := Pos('%t', Result);
  if ps > 0 then
  begin
    Delete(Result, ps, 2);
    Insert(Format('%s%d', [LowerCase(TargetTypes[TargetConfig.Target.IsBCB]), TargetConfig.Target.Version]),
      Result, ps);
  end;
end;

/// <summary>
/// CreateProjectGroupMakefile creates the make file for the project group.
/// If AutoDepend is true, this function will add dependency information into
/// the make file for a faster compilation process.
/// </summary>
procedure TJVCLCompiler.CreateProjectGroupMakefile(ProjectGroup: TProjectGroup;
  AutoDepend: Boolean);
var
  Lines: TStrings;
  i, depI: Integer;
  Pkg: TPackageTarget;
  Dependencies, S, PasFile, DcuFile, ObjFile, FormFile: string;
  FilenameOnly: string;
  DeleteFiles: Boolean;
  BplFilename, MapFilename: string;
  PasFileSearchDirs: string;
begin
  BplFilename := ProjectGroup.TargetConfig.BplDir + '\' + ProjectGroup.BpgName;

  Lines := TStringList.Create;
  try
    Lines.Add('!ifndef ROOT');
    Lines.Add('ROOT = $(MAKEDIR)\..');
    Lines.Add('!endif');
    Lines.Add('!ifndef DCCOPT');
    Lines.Add('DCCOPT = -Q- -M');
    Lines.Add('!endif');
    Lines.Add('');
    Lines.Add('BPR2MAK = "$(ROOT)\bin\bpr2mak" -t..\BCB.bmk');
    Lines.Add('MAKE = "$(ROOT)\bin\make"'{-$(MAKEFLAGS)'});
    Lines.Add('DCC = "$(ROOT)\bin\dcc32.exe" $(DCCOPT)');
    Lines.Add('');

    // for JCL .dcp files
    Lines.Add(Format('.path.dcp = "%s";"%s";"%s";"%s"',
      [ProjectGroup.TargetConfig.BplDir, ProjectGroup.TargetConfig.DcpDir,
       ProjectGroup.Target.BplDir, ProjectGroup.Target.DcpDir]));

    if AutoDepend then
    begin
      S := ProjectGroup.TargetConfig.JVCLDir;
      PasFileSearchDirs :=
        Format('"%s\common";"%s\run";"%s\design";"%s\qcommon";"%s\qrun";"%s\qdesign"',//;"%s"',
               [S, S, S, S, S, S{, ProjectGroup.TargetConfig.DxgettextDir}]);
      Lines.Add('.path.pas = ' + PasFileSearchDirs);
      Lines.Add(Format('.path.dfm = "%s\run";"%s\design"',
        [S, S]));
      Lines.Add(Format('.path.xfm = "%s\qrun";"%s\qdesign"',
        [S, S]));
      Lines.Add(Format('.path.inc = "%s\common"', [S]));
      Lines.Add(Format('.path.res = "%s\Resources"', [S]));
      Lines.Add(Format('.path.bpl = "%s";"%s"',
        [ProjectGroup.TargetConfig.BplDir, ProjectGroup.TargetConfig.DcpDir]));
      Lines.Add('');

      // add files like jvcl.inc
      Dependencies := '';
      for depI := 0 to High(CommonDependencyFiles) do
        Dependencies := Dependencies + '\' + sLineBreak + #9#9 +
          ExtractFileName(ReplaceTargetMacros(CommonDependencyFiles[depI], ProjectGroup.TargetConfig));

      Lines.Add('CommonDependencies = ' + Dependencies);
      Lines.Add('');
    end;
    Lines.Add('');

    Lines.Add('default: \');
    for i := 0 to ProjectGroup.Count - 1 do
    begin
      Pkg := ProjectGroup.Packages[i];
      if Pkg.Compile then
        Lines.Add('  ' + Pkg.TargetName + '\');
    end;
    Lines.Add(''); // for last "\"

    Lines.Add('');
    for i := 0 to ProjectGroup.Count - 1 do
    begin
      Pkg := ProjectGroup.Packages[i];
      // add package dependency lists
      Dependencies := '';
      for depI := 0 to Pkg.JvDependencies.Count - 1 do
      begin
        if IsPackageUsed(ProjectGroup, Pkg.JvDependenciesReqPkg[depI]) then
        begin
          if not ProjectGroup.TargetConfig.GenerateMapFiles then
          begin
            // delete the old .map file
            MapFilename := ProjectGroup.TargetConfig.BplDir + PathDelim +
              ChangeFileExt(ExtractFileName(Pkg.TargetName), '.map');
            if FileExists(MapFilename) then
              DeleteFile(MapFilename);
          end;

          Dependencies := Dependencies + '\' + sLineBreak + #9#9 +
             ProjectGroup.FindPackageByXmlName(Pkg.JvDependencies[depI]).TargetName;
        end;
      end;

      // add JCL dependencies
      for depI := 0 to Pkg.JclDependencies.Count - 1 do
      begin
        if IsPackageUsed(ProjectGroup, Pkg.JclDependenciesReqPkg[depI]) then
          Dependencies := Dependencies + '\' + sLineBreak + #9#9 +
             Pkg.JclDependencies[depI] + '.dcp';
      end;

      if AutoDepend then
      begin
        // Add all contained files and test for their condition.
        for depI := 0 to Pkg.Info.ContainCount - 1 do
        begin
          if IsFileUsed(ProjectGroup, Pkg.Info.Contains[depI]) then
          begin
            PasFile := Pkg.Info.Contains[depI].Name;
            FilenameOnly := ExtractFileName(PasFile);
            PasFile := FollowRelativeFilename(Data.JVCLPackagesXmlDir, PasFile);
            if not FileExists(PasFile) then
              PasFile := FindFilename(PasFileSearchDirs, FilenameOnly);

            if FileExists(PasFile) then // add the file only if it exists
            begin
              Dependencies := Dependencies + '\' + sLineBreak + #9#9 +
                FilenameOnly;

              { Check for a .dfm/.xfm file }
              if Pkg.Info.Contains[depI].FormName <> '' then
              begin
                if ProjectGroup.IsVCLX then
                  FormFile := ChangeFileExt(PasFile, '.xfm')
                else
                  FormFile := ChangeFileExt(PasFile, '.dfm');
                if FileExists(FormFile) then
                  Dependencies := Dependencies + '\' + sLineBreak + #9#9 +
                    ExtractFileName(FormFile);
              end;

            end;
          end;
        end;
        Dependencies := Dependencies + '\' + sLineBreak + #9#9'$(CommonDependencies)';
      end;

      Lines.Add(Pkg.TargetName + ': ' + Pkg.SourceName + ' ' + Dependencies);
      Lines.Add(#9'@echo [Compiling: ' + Pkg.TargetName + ']');
      Lines.Add(#9'@cd ' + Pkg.RelSourceDir);
      if ProjectGroup.Target.IsBCB then
      begin
        if not ProjectGroup.TargetConfig.Build then
        begin
          // dcc32.exe does not recreate the .obj files when they already exist.
          // So we must delete them before compilation. This is not needed when
          // building the JVCL for BCB because all .obj files will be deleted by
          // the Installer before entering the compilation process.
          DeleteFiles := False;
          for depI := 0 to Pkg.Info.ContainCount - 1 do
          begin
            if IsFileUsed(ProjectGroup, Pkg.Info.Contains[depI]) then
            begin
              FilenameOnly := ExtractFileName(Pkg.Info.Contains[depI].Name);
              PasFile := FollowRelativeFilename(Data.JVCLPackagesXmlDir, Pkg.Info.Contains[depI].Name);
              if CompareText(ExtractFileExt(FilenameOnly), '.pas') = 0 then
              begin
                ObjFile := ProjectGroup.TargetConfig.UnitOutDir + '\obj\' + ChangeFileExt(FilenameOnly, '.obj');
                if not FileExists(PasFile) then
                  PasFile := FindFilename(PasFileSearchDirs, FilenameOnly);

                {
                if FileExists(ObjFile) and not FileExists(PasFile) then
                  Continue; // a little optimization: foreign units should not force the package to be built.
                }

                if not FileExists(ObjFile) or // dcc32.exe will not create the missing .obj file if the other files exist
                   not FileExists(PasFile) or // unknown directory for the .pas file
                   (CompareFileAge(ObjFile, [], PasFile, []) < 0) or
                   (FileExists(BplFilename) and (
                    (CompareFileAge(ObjFile, [], BplFilename, []) < 0) or
                    (CompareFileAge(PasFile, [], BplFilename, []) < 0))
                   ) then
                begin
                  DeleteFiles := True;
                  Break;
                end;
              end;
            end;
          end;

          if DeleteFiles then
          begin
            for depI := 0 to Pkg.Info.ContainCount - 1 do
            begin
              if IsFileUsed(ProjectGroup, Pkg.Info.Contains[depI]) then
              begin
                FilenameOnly := ExtractFileName(Pkg.Info.Contains[depI].Name);
                if CompareText(ExtractFileExt(FilenameOnly), '.pas') = 0 then
                begin
                  ObjFile := ProjectGroup.TargetConfig.UnitOutDir + '\obj\' + ChangeFileExt(FilenameOnly, '.obj');
                  if FileExists(ObjFile) then
                  begin
                    if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
                      Lines.Add(#9'-@del "' + ObjFile + '" >NUL')
                    else
                      Lines.Add(#9'-@del /f /q "' + ObjFile + '" 2>NUL');
                  end;
                  DcuFile := ProjectGroup.TargetConfig.UnitOutDir + '\obj\' + ChangeFileExt(FilenameOnly, '.dcu');
                  if FileExists(DcuFile) then
                  begin
                    if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
                      Lines.Add(#9'-@del "' + DcuFile + '" >NUL')
                    else
                      Lines.Add(#9'-@del /f /q "' + DcuFile + '" 2>NUL');
                  end;
                end;
              end;
            end;
          end;
        end;
        Lines.Add(#9'$(BPR2MAK) $&.bpk');
        Lines.Add(#9'@echo.');                 // prevent "......Borland De"
        Lines.Add(#9'$(MAKE) -f $&.mak');
      end
      else
        Lines.Add(#9'$(DCC) $&.dpk');
      Lines.Add(#9'@cd ' + GetReturnPath(Pkg.RelSourceDir));
      Lines.Add('');
    end;

    FileSetReadOnly(ChangeFileExt(ProjectGroup.Filename, '.mak'), False);
    Lines.SaveToFile(ChangeFileExt(ProjectGroup.Filename, '.mak'));
  finally
    Lines.Free;
  end;
end;

function TJVCLCompiler.IsFileUsed(ProjectGroup: TProjectGroup;
  ContainedFile: TContainedFile): Boolean;
begin
  Result := ContainedFile.IsUsedByTarget(ProjectGroup.TargetConfig.TargetSymbol) and
            IsCondition(ContainedFile.Condition, ProjectGroup.TargetConfig);
end;

function TJVCLCompiler.IsPackageUsed(ProjectGroup: TProjectGroup;
  RequiredPackage: TRequiredPackage): Boolean;
begin
  Result := RequiredPackage.IsRequiredByTarget(ProjectGroup.TargetConfig.TargetSymbol) and
            IsCondition(RequiredPackage.Condition, ProjectGroup.TargetConfig);
end;

type
  { TListConditionParser searches for the idents in the List. If an ident is in
    the list the ident is returned as True. }
  TListConditionParser = class(TConditionParser)
  private
    FTargetConfig: ITargetConfig;
  protected
    procedure MissingRightParenthesis; override;
    function GetIdentValue(const Ident: String): Boolean; override;
  public
    constructor Create(ATargetConfig: ITargetConfig);
  end;


function TJVCLCompiler.IsCondition(const Condition: string; TargetConfig: ITargetConfig): Boolean;
var
  Parser: TListConditionParser;
begin
  Result := True;
  if Condition <> '' then
  begin
    Parser := TListConditionParser.Create(TargetConfig);
    try
      Result := Parser.Parse(Condition);
    finally
      Parser.Free;
    end;
  end;
end;

{ TListConditionParser }

constructor TListConditionParser.Create(ATargetConfig: ITargetConfig);
begin
  inherited Create;
  FTargetConfig := ATargetConfig;
end;

function TListConditionParser.GetIdentValue(const Ident: String): Boolean;
begin
  Result := FTargetConfig.JVCLConfig.Enabled[Ident];
end;

procedure TListConditionParser.MissingRightParenthesis;
begin
  raise Exception.Create('Missing ")" in conditional expression');
end;


initialization
  StartupEnvVarPath := GetEnvironmentVariable('PATH');

end.