compile.pas

East make Tray Icon in delphi

    DoResourceProgress('', 0, FResCount);
    // generate .res and .dcr files
    if Make(TargetConfig, '-f makefile.mak', CaptureLineResourceCompilation, TargetConfig.JVCLDir + '\images') <> 0 then
    begin
      AbortReason := RsErrorCompilingResources;
      Exit;
    end;
    DoResourceProgress('', FResCount, FResCount);
  end;
  Result := True;
end;

/// <summary>
/// DeleteFormDataFiles deletes the .dfm, .xfm files from the lib-path.
/// </summary>
function TJVCLCompiler.DeleteFormDataFiles(ProjectGroup: TProjectGroup): Boolean;
var
  Files: TStrings;
  i: Integer;
  Dir: string;
begin
  Result := True;
  Files := TStringList.Create;
  try
    Dir := ProjectGroup.TargetConfig.UnitOutDir;
    FindFiles(Dir, '*.*', False, Files, ['.dfm', '.xfm']);
    for i := 0 to Files.Count - 1 do
      DeleteFile(Files[i]);
  finally
    Files.Free;
  end;
end;

/// <summary>
/// CopyFormDataFiles copies the .dfm, .xfm files to the lib-path.
/// This function is only called for non developer installations.
/// </summary>
function TJVCLCompiler.CopyFormDataFiles(ProjectGroup: TProjectGroup; DebugUnits: Boolean): Boolean;
var
  Files: TStrings;
  i: Integer;
  Dir, DestDir, DestFile, DebugDestDir: string;
begin
  Result := True;
  Files := TStringList.Create;
  try
{**}DoProgress('', 0, 100, pkOther);

    DestDir := ProjectGroup.TargetConfig.UnitOutDir;
    DebugDestDir := DestDir + PathDelim + 'debug';

    if ProjectGroup.IsVCLX then
    begin
      Dir := ProjectGroup.TargetConfig.JVCLDir + PathDelim + 'qrun';
      FindFiles(Dir, '*.xfm', False, Files, ['.xfm']);
    end
    else
    begin
      Dir := ProjectGroup.TargetConfig.JVCLDir + PathDelim + 'run';
      FindFiles(Dir, '*.dfm', False, Files, ['.dfm']);
    end;

    CaptureLine(RsCopyingFiles, FAborted);
    for i := 0 to Files.Count - 1 do
    begin
      DestFile := DestDir + PathDelim + ExtractFileName(Files[i]);
      if FileAge(Files[i]) > FileAge(DestFile) then
      begin
{**}    DoProgress(ExtractFileName(Files[i]), i, Files.Count, pkOther);
        CopyFile(PChar(Files[i]), PChar(DestFile), False);
      end;
      if DebugUnits then
      begin
        DestFile := DebugDestDir + PathDelim + ExtractFileName(Files[i]);
        if FileAge(Files[i]) > FileAge(DestFile) then
          CopyFile(PChar(Files[i]), PChar(DestFile), False);
      end;
    end;
{**}  DoProgress('', 0, Files.Count, pkOther);
  finally
    Files.Free;
  end;
end;

function GetWindowsDir: string;
begin
  SetLength(Result, MAX_PATH);
  SetLength(Result, GetWindowsDirectory(PChar(Result), Length(Result)));
end;

function GetSystemDir: string;
begin
  SetLength(Result, MAX_PATH);
  SetLength(Result, GetSystemDirectory(PChar(Result), Length(Result)));
end;

/// <summary>
/// CompileProjectGroup starts the make file for the templates, starts the
/// packages generator, calls the GenerateResource method and compiles all
/// selected packages of the project group.
/// </summary>
function TJVCLCompiler.CompileProjectGroup(ProjectGroup: TProjectGroup;
  DebugUnits, ForceJclDcp: Boolean): Boolean;
var
  AProjectIndex, i: Integer;
  Args: string;
  Edition, PkgDir, JVCLPackagesDir: string;
  AutoDepend: Boolean;
  TargetConfig: ITargetConfig;
  DccOpt: string;
  Path: string;
  PathList, BplPaths: TStringList;
  S, SearchPaths: string;

  function GetProjectIndex: Integer;
  begin
    Result := AProjectIndex;
    Inc(AProjectIndex);
  end;

begin
  // ClearEnvironment; // remove almost all environment variables for "make.exe long command line"
  // ahuser (2005-01-22): make.exe fails only if a path with spaces is in the PATH envvar

  SetEnvironmentVariable('MAKEOPTIONS', nil);
  Result := False;
  FCurrentProjectGroup := ProjectGroup;
  try
    TargetConfig := ProjectGroup.TargetConfig;
    AutoDepend := TargetConfig.AutoDependencies;

    // obtain information for progress bar
    FPkgCount := 0;
    for i := 0 to ProjectGroup.Count - 1 do
      if ProjectGroup.Packages[i].Compile then
        Inc(FPkgCount);

    Edition := TargetConfig.TargetSymbol;
    if ProjectGroup.IsVCLX then
      Edition := Edition + 'clx';
    JVCLPackagesDir := TargetConfig.JVCLPackagesDir;
    Args := '-f Makefile.mak';

    PkgDir := Edition;
    if not ProjectGroup.IsVCLX then // only PRO and ENT versions have CLX support
    begin
      if PkgDir[3] in ['p', 'P', 's', 'S'] then
      begin
        if PkgDir[2] = '5' then
          PkgDir := Copy(PkgDir, 1, 2) + 'std'
        else
          PkgDir := Copy(PkgDir, 1, 2) + 'per';
      end;
    end;

    DccOpt := '-Q- -M';
    // setup environment variables
    if TargetConfig.Build then
      DccOpt := '-Q- -M -B';
    if TargetConfig.GenerateMapFiles then
      DccOpt := DccOpt + ' -GD';

    if (not DebugUnits) then
      DccOpt := DccOpt + ' -DJVCL_NO_DEBUGINFO'
    else
      { DeveloperInstall always use Debug units in the Jvcl\Lib\xx directory }
    if not TargetConfig.DeveloperInstall then
      CreateDir(TargetConfig.UnitOutDir + '\debug');

    { set PATH envvar and add all directories that contain .bpl files }
    PathList := TStringList.Create;
    try
      PathList.Duplicates := dupIgnore;

      PathList.Add(GetWindowsDir);
      PathList.Add(GetSystemDir);
      PathList.Add(GetWindowsDir + '\Command'); // Win9x

      PathList.Add(ExtractShortPathName(TargetConfig.Target.RootDir));
      PathList.Add(ExtractShortPathName(TargetConfig.BplDir));
      PathList.Add(ExtractShortPathName(TargetConfig.DcpDir));
      { Add original BPL directory for "common" BPLs, but add it as the very
        last path to prevent collisions between packages in TargetConfig.BplDir
        and Target.BplDir. }
      PathList.Add(ExtractShortPathName(TargetConfig.Target.BplDir));

      { Add paths with .bpl files from the PATH environment variable }
      BplPaths := TStringList.Create;
      try
        StrToPathList(StartupEnvVarPath, BplPaths);
        for i := 0 to BplPaths.Count - 1 do
          if DirContainsFiles(ExcludeTrailingPathDelimiter(BplPaths[i]), '*.bpl') then
            PathList.Add(ExtractShortPathName(ExcludeTrailingPathDelimiter(BplPaths[i])));
      finally
        BplPaths.Free;
      end;

      Path := PathListToStr(PathList);
    finally
      PathList.Free;
    end;

    SearchPaths := '';
    for i := 0 to TargetConfig.Target.SearchPaths.Count - 1 do
    begin
      S := ExtractShortPathName(ExcludeTrailingPathDelimiter(TargetConfig.Target.ExpandDirMacros(TargetConfig.Target.SearchPaths[i])));
      if SearchPaths <> '' then
        SearchPaths := SearchPaths + ';' + S
      else
        SearchPaths := S;
    end;

    SetEnvironmentVariable('PATH', PChar(Path));
    SetEnvironmentVariable('DCCOPT', Pointer(DccOpt));
    // especially for BCB generated make file
    SetEnvironmentVariable('DCC', PChar('"' + TargetConfig.Target.RootDir + '\bin\dcc32.exe" ' + DccOpt));
    SetEnvironmentVariable('UNITDIRS', PChar(SearchPaths));

    SetEnvironmentVariable('QUIET', Pointer(Copy(FQuiet, 2, MaxInt))); // make command line option " -s"

    SetEnvironmentVariable('TARGETS', nil); // we create our own makefile so do not allow a user defined TARGETS envvar
    SetEnvironmentVariable('MASTEREDITION', nil);

    SetEnvironmentVariable('ROOT', Pointer(TargetConfig.Target.RootDir));
    SetEnvironmentVariable('JCLROOT', Pointer(TargetConfig.JCLDir));
    SetEnvironmentVariable('JVCLROOT', Pointer(TargetConfig.JVCLDir));
    SetEnvironmentVariable('VERSION', Pointer(IntToStr(TargetConfig.Target.Version)));
    if DebugUnits then
      SetEnvironmentVariable('UNITOUTDIR', Pointer(TargetConfig.UnitOutDir + '\debug'))
    else
      SetEnvironmentVariable('UNITOUTDIR', Pointer(TargetConfig.UnitOutDir));
    SetEnvironmentVariable('MAINBPLDIR', Pointer(TargetConfig.Target.BplDir));
    SetEnvironmentVariable('MAINDCPDIR', Pointer(TargetConfig.Target.DcpDir));
    SetEnvironmentVariable('MAINLIBDIR', Pointer(TargetConfig.Target.DcpDir)); // for BCB
    SetEnvironmentVariable('BPLDIR', Pointer(TargetConfig.BplDir));
    SetEnvironmentVariable('DCPDIR', Pointer(TargetConfig.DcpDir));
    SetEnvironmentVariable('LIBDIR', Pointer(TargetConfig.DcpDir));  // for BCB
    SetEnvironmentVariable('HPPDIR', Pointer(TargetConfig.HppDir)); // for BCB
    SetEnvironmentVariable('BPILIBDIR', Pointer(TargetConfig.DcpDir)); // for BCB

    // add dxgettext unit directory
    { Dxgettext is now included in the JVCL as JvGnugettext
    if Data.JVCLConfig.Enabled['USE_DXGETTEXT'] then
      SetEnvironmentVariable('EXTRAUNITDIRS', Pointer(TargetConfig.DxgettextDir))
    else}
      SetEnvironmentVariable('EXTRAUNITDIRS', nil);
    SetEnvironmentVariable('EXTRAINCLUDEDIRS', nil);
    SetEnvironmentVariable('EXTRARESDIRS', nil);

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

{**}DoProjectProgress(RsGeneratingPackages, GetProjectIndex, ProjectMax);
    if ProjectGroup.Target.IsPersonal then
    begin
      // generate template.cfg for the "master" PkgDir
      SetEnvironmentVariable('EDITION', PChar(Copy(Edition, 1, 2)));
      SetEnvironmentVariable('PKGDIR', PChar(Copy(PkgDir, 1, 2)));
      SetEnvironmentVariable('PKGDIR_MASTEREDITION', PChar(Copy(PkgDir, 1, 2)));
      if Make(TargetConfig, Args + ' Templates', CaptureLine) <> 0 then
      begin
        AbortReason := Format(RsErrorGeneratingTemplatesForDir, [Copy(PkgDir, 1, 2)]);
        Exit;
      end;
    end;

    // generate template.cfg file for PkgDir
    SetEnvironmentVariable('EDITION', PChar(Edition));
    SetEnvironmentVariable('PKGDIR', PChar(PkgDir));
    SetEnvironmentVariable('PKGDIR_MASTEREDITION', PChar(PkgDir));
    if Make(TargetConfig, Args + ' Templates', CaptureLine) <> 0 then
    begin
      AbortReason := Format(RsErrorGeneratingTemplatesForDir, [PkgDir]);
      Exit;
    end;

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

{**}DoProjectProgress(RsGeneratingPackages, GetProjectIndex, ProjectMax);
    if ProjectGroup.Target.IsPersonal then
    begin
      // generate the packages and .cfg files for the "master" PkgDir
      if not GeneratePackages('JVCL', Copy(Edition, 1, 2),
                              TargetConfig.JVCLPackagesDir) then
        Exit; // AbortReason is set in GeneratePackages
    end;

    // generate the packages and .cfg files for PkgDir
    if not GeneratePackages('JVCL', Edition, TargetConfig.JVCLPackagesDir) then
      Exit; // AbortReason is set in GeneratePackages

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

    if ProjectGroup.Target.IsBCB and Data.CompileJclDcp then
    begin
{**}  DoProjectProgress(RsCompilingJCL, GetProjectIndex, ProjectMax);
      if not PrepareJCL(TargetConfig, ForceJclDcp) then
        Exit; // AbortReason was set in PrepareJCL
    end
    else
{**}  GetProjectIndex; // increase progress

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

{**}DoProjectProgress(RsGeneratingResources, GetProjectIndex, ProjectMax);
    if not GenerateResources(TargetConfig) then
      Exit; // AbortReason is set in GenerateResources

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

{**}DoProjectProgress(RsCompilingPackages, GetProjectIndex, ProjectMax);
    FPkgIndex := 0;
    if FPkgCount > 0 then
    begin
      // ==== changed Resources ====
      // As long as no dependency information about resources is in the .xml
      // files we let the Delphi compiler decide if he wants to compile the
      // package.
      if (FResCount > 0) then
        AutoDepend := False;
      // ===========================

      { Now it is time to write the "xx Packages.mak" file. }
      CreateProjectGroupMakefile(ProjectGroup, AutoDepend);

      { Are there any packages that have to be compiled? Ask make.exe for this
        information. }
      if AutoDepend then
      begin
        SetEnvironmentVariable('MAKEOPTIONS', '-n');
          // get the number of packages that needs compilation
        FCount := 0;
        if Make(TargetConfig, Args + ' CompilePackages', CaptureLineGetCompileCount) <> 0 then
        begin
          AbortReason := RsErrorCompilingPackages;
          Exit;
        end;
        // update FPkgCount with the number of packages that MAKE will compile
        FPkgCount := FCount;
      end;
      SetEnvironmentVariable('MAKEOPTIONS', nil);

      if FPkgCount > 0 then
      begin
        { Remove .dfm/.xfm files from the lib directory so the compiler takes the
          correct one and we do not have unused files in the lib directory. }
        DeleteFormDataFiles(ProjectGroup);

        { Now compile the packages }
        DoPackageProgress(nil, '', 0, FPkgCount);
        // compile packages
        if Make(TargetConfig, Args + FQuiet + ' CompilePackages', CaptureLinePackageCompilation) <> 0 then
        begin