generateutils.pas

East make Tray Icon in delphi

  // Empty the binary file cache
  IsBinaryCache.Clear;

  if incFileName = '' then
    incFileName := GIncFileName;
  GenericIncFile := LoadDefines('', incFileName);

  GCallBack := CallBack;

  if path = '' then
  begin
    if PathIsAbsolute(PackagesLocation) then
      path := PackagesLocation
    else
      path := PathNoInsideRelative(StrEnsureSuffix(PathSeparator, StartupDir) + PackagesLocation);
  end;

  path := StrEnsureSuffix(PathSeparator, path);

  if prefix <> '' then
    GPrefix := Prefix;
  if format <> '' then
    GFormat := Format;

  // for all targets
  for i := 0 to targets.Count - 1 do
  begin
    target := targets[i];
    if GenericIncFile then
      LoadDefines(target, incFileName);

    SendMsg(SysUtils.Format('Generating packages for %s', [target]));
    // find all template files for that target
    if FindFirst(path+TargetToDir(target)+PathSeparator+'template.*', 0, rec) = 0 then
    begin
      repeat
        template := TStringList.Create;
        templatePers := TStringList.Create;
        try
          SendMsg(SysUtils.Format(#9'Loaded %s', [rec.Name]));

          templateName := path+TargetToDir(target)+PathSeparator+rec.Name;
          if IsBinaryFile(templateName) then
            template.Clear
          else
            template.LoadFromFile(templateName);

          // Try to find a template file named the same as the
          // current one in the perso directory so it can
          // be used instead
          templateNamePers := templateName;
          templatePers.Assign(template);
          persoTarget := GetPersoTarget(target);
          if (persoTarget <> '') and
             DirectoryExists(path+TargetToDir(persoTarget)) then
          begin
            templateNamePers := path+TargetToDir(persoTarget)+PathSeparator+rec.Name;
            if FileExists(templateNamePers) then
            begin
              if IsBinaryFile(templateNamePers) then
                templatePers.Clear
              else
                templatePers.LoadFromFile(templateNamePers);
            end
            else
            begin
              templateNamePers := templateName;
            end
          end;

          // apply the template for all packages
          for j := 0 to packages.Count - 1 do
          begin
           // load (buffered) xml file
            xmlName := path+'xml'+PathSeparator+packages[j]+'.xml';
            xml := GetPackageXmlInfo(xmlName);

            persoTarget := ApplyTemplateAndSave(
                                 path,
                                 target,
                                 packages[j],
                                 ExtractFileExt(rec.Name),
                                 template,
                                 xml,
                                 templateName,
                                 xmlName);

            // if the generation requested a perso target to be done
            // then generate it now, using the perso template
            if persoTarget <> '' then
            begin
              ApplyTemplateAndSave(
                 path,
                 persoTarget,
                 packages[j],
                 ExtractFileExt(rec.Name),
                 templatePers,
                 xml,
                 templateNamePers,
                 xmlName);
            end;
          end;
        finally
          template.Free;
          templatePers.Free;
        end;
      until FindNext(rec) <> 0;
    end
    else
      SendMsg(SysUtils.Format(#9'No template found for %s' , [target]));
    FindClose(rec);
  end;
{  if makeDof then
  begin
    SendMsg('Calling MakeDofs.bat');
    ShellExecute(0,
                '',
                PChar(StrEnsureSuffix(PathSeparator, ExtractFilePath(ParamStr(0))) + 'MakeDofs.bat'),
                '',
                PChar(ExtractFilePath(ParamStr(0))),
                SW_SHOW);
  end;}
end;

procedure EnumerateTargets(targets : TStrings);
var
  i : integer;
begin
  targets.clear;
  for i := 0 to TargetList.Count - 1 do
    targets.Add(TargetList.Items[I].Name);
end;

procedure EnumeratePackages(const Path : string; packages : TStrings);
var
  rec : TSearchRec;
begin
  packages.Clear;
  if FindFirst(StrEnsureSuffix(PathSeparator, path) +'xml'+PathSeparator+'*.xml', 0, rec) = 0 then
  begin
    repeat
      packages.Add(PathExtractFileNameNoExt(rec.Name));
    until FindNext(rec) <> 0;
  end;
  FindClose(rec);
end;

{ TTarget }

constructor TTarget.Create(Node: TJvSimpleXmlElem);
begin
  inherited Create;
  FName := AnsiLowerCase(Node.Properties.ItemNamed['name'].Value);
  if Assigned(Node.Properties.ItemNamed['dir']) then
    FDir := Node.Properties.ItemNamed['dir'].Value;
  if Assigned(Node.Properties.ItemNamed['pname']) then
    FPName := AnsiLowerCase(Node.Properties.ItemNamed['pname'].Value);
  if Assigned(Node.Properties.ItemNamed['pdir']) then
    FPDir := Node.Properties.ItemNamed['pdir'].Value;
  if Assigned(Node.Properties.ItemNamed['env']) then
    FEnv := AnsiUpperCase(Node.Properties.ItemNamed['env'].Value)[1];
  if Assigned(Node.Properties.ItemNamed['ver']) then
    FVer := AnsiLowerCase(Node.Properties.ItemNamed['ver'].Value)[1];

  FDefines := TStringList.Create;
  if Assigned(Node.Properties.ItemNamed['defines']) then
    StrToStrings(Node.Properties.ItemNamed['defines'].Value,
                 ',',
                 FDefines,
                 False);

  FPathSep := '\';
  if Assigned(Node.Properties.ItemNamed['pathsep']) then
    FPathSep := Node.Properties.ItemNamed['pathsep'].Value;
  FIsCLX := False;
  if Assigned(Node.Properties.ItemNamed['IsCLX']) then
    FIsCLX := Node.Properties.ItemNamed['IsCLX'].BoolValue;
end;

destructor TTarget.Destroy;
begin
  FDefines.Free;
  inherited Destroy;
end;

function TTarget.GetDir: string;
begin
  if FDir <> '' then
    Result := FDir
  else
    Result := Name;
end;

function TTarget.GetEnv: string;
begin
  if FEnv <> '' then
    Result := FEnv
  else
    Result := AnsiUpperCase(Name[1]);
end;

function TTarget.GetPDir: string;
begin
  if FPDir <> '' then
    Result := FPDir
  else
    Result := FPName;
end;

function TTarget.GetVer: string;
begin
  if FVer <> '' then
    Result := FVer
  else if Length(Name)>1 then
    Result := AnsiLowerCase(Name[2])
  else
    Result := '';
end;

{ TTargetList }

constructor TTargetList.Create(Node: TJvSimpleXmlElem);
var
  i : integer;
begin
  inherited Create(True);
  if Assigned(Node) then
    for i := 0 to Node.Items.Count - 1 do
    begin
      Add(TTarget.Create(Node.Items[i]));
    end;
end;

function TTargetList.GetItems(index: integer): TTarget;
begin
  Result := TTarget(inherited Items[index]);
end;

function TTargetList.GetItemsByName(name: string): TTarget;
var
  i : integer;
begin
  Result := nil;
  for i := 0 to Count - 1 do
    if SameText(TTarget(Items[i]).Name, name) then
    begin
      Result := TTarget(Items[i]);
      Break;
    end;
end;

procedure TTargetList.SetItems(index: integer; const Value: TTarget);
begin
  inherited Items[index] := Value;
end;

{ TAlias }

constructor TAlias.Create(Node: TJvSimpleXmlElem);
begin
  inherited Create;
  FName := AnsiLowerCase(Node.Properties.ItemNamed['name'].Value);
  FValue := AnsiLowerCase(Node.Properties.ItemNamed['value'].Value);
  FValueAsTStrings := nil;
end;

destructor TAlias.Destroy;
begin
  FValueAsTStrings.Free;
  inherited Destroy;
end;

function TAlias.GetValueAsTStrings: TStrings;
begin
  if not Assigned(FValueAsTStrings) then
    FValueAsTStrings := TStringList.Create;

  StrToStrings(Value, ',', FValueAsTStrings, false);
  Result := FValueAsTStrings;
end;

{ TAliasList }

constructor TAliasList.Create(Node: TJvSimpleXmlElem);
var
  i : integer;
begin
  inherited Create(True);
  if Assigned(Node) then
    for i := 0 to Node.Items.Count - 1 do
    begin
      Add(TAlias.Create(Node.Items[i]));
    end;
end;

function TAliasList.GetItems(index: integer): TAlias;
begin
  Result := TAlias(inherited Items[index]);
end;

function TAliasList.GetItemsByName(name: string): TAlias;
var
  i : integer;
begin
  Result := nil;
  for i := 0 to Count - 1 do
    if SameText(TAlias(Items[i]).Name, name) then
    begin
      Result := TAlias(Items[i]);
      Break;
    end;
end;

procedure TAliasList.SetItems(index: integer; const Value: TAlias);
begin
  inherited Items[index] := Value;
end;

{ TDefine }

constructor TDefine.Create(const Name : string; IfDefs : TStringList);
begin
  inherited Create;

  FName := Name;
  FIfDefs := TStringList.Create;
  FIfDefs.Assign(IfDefs);
end;

destructor TDefine.Destroy;
begin
  FIfDefs.Free;
  
  inherited Destroy;
end;

{ TDefinesList }

constructor TDefinesList.Create(incfile: TStringList);
const
  IfDefMarker  : string = '{$IFDEF';
  IfNDefMarker : string = '{$IFNDEF';
  EndIfMarker  : string = '{$ENDIF';
  ElseMarker   : string = '{$ELSE';
  DefineMarker : string = '{$DEFINE';
var
  i: Integer;
  curLine: string;
  IfDefs : TStringList;
begin
  inherited Create(True);

  IfDefs := TStringList.Create;
  try
    if Assigned(incfile) then
      for i := 0 to incfile.Count - 1 do
      begin
        curLine := Trim(incfile[i]);

        if StrHasPrefix(curLine, [IfDefMarker]) then
          IfDefs.AddObject(Copy(curLine, Length(IfDefMarker)+2, Length(curLine)-Length(IfDefMarker)-2), TObject(True))
        else if StrHasPrefix(curLine, [IfNDefMarker]) then
          IfDefs.AddObject(Copy(curLine, Length(IfNDefMarker)+2, Length(curLine)-Length(IfNDefMarker)-2), TObject(False))
        else if StrHasPrefix(curLine, [ElseMarker]) then
          IfDefs.Objects[IfDefs.Count-1] := TObject(not Boolean(IfDefs.Objects[IfDefs.Count-1]))
        else if StrHasPrefix(curLine, [EndIfMarker]) then
          IfDefs.Delete(IfDefs.Count-1)
        else if StrHasPrefix(curLine, [DefineMarker]) then
          Add(TDefine.Create(Copy(curLine, Length(DefineMarker)+2, Length(curLine)-Length(DefineMarker)-2), IfDefs));
      end;
  finally
    IfDefs.Free;
  end;
end;

function TDefinesList.GetItems(index: integer): TDefine;
begin
  Result := TDefine(inherited Items[index]);
end;

function TDefinesList.IsDefined(const Condition, Target : string;
  DefineLimit : Integer = -1): Boolean;
var
  I : Integer;
  Define : TDefine;
begin
  if DefineLimit = -1 then
    DefineLimit := Count
  else
  if DefineLimit > Count then
    DefineLimit := Count;

  Result := False;
  Define := nil;
  for i := 0 to DefineLimit - 1 do
  begin
    if SameText(Items[I].Name, Condition) then
    begin
      Result := True;
      Define := Items[I];
      Break;
    end;
  end;

  // If the condition is not defined by its name, maybe it
  // is as a consequence of the target we use
  if not Result then
    Result := TargetList[GetNonPersoTarget(Target)].Defines.IndexOf(Condition) > -1;

  // If the condition is defined, then all the IfDefs in which
  // it is enclosed must also be defined but only before the
  // current define
  if Result and Assigned(Define) then
    for I := 0 to Define.IfDefs.Count - 1 do
    begin
      if Boolean(Define.IfDefs.Objects[I]) then
        Result := Result and IsDefined(Define.IfDefs[I], Target, IndexOf(Define))
      else
        Result := Result and not IsDefined(Define.IfDefs[I], Target, IndexOf(Define));
    end
end;

procedure TDefinesList.SetItems(index: integer; const Value: TDefine);
begin
  inherited Items[index] := Value;
end;

{ TClxReplacement }

constructor TClxReplacement.Create(Node: TJvSimpleXmlElem);
begin
  inherited Create;
  FOriginal := Node.Properties.ItemNamed['original'].Value;
  FReplacement := Node.Properties.ItemNamed['replacement'].Value;
end;

function TClxReplacement.DoReplacement(const Filename: string): string;
begin
  Result := Filename;
  StrReplace(Result, Original, Replacement, [rfIgnoreCase]);
end;

{ TClxReplacementList }

constructor TClxReplacementList.Create(Node: TJvSimpleXmlElem);
var
  i : integer;
begin
  inherited Create(True);
  IgnoredFiles := TStringList.Create;
  IgnoredFiles.Sorted := True;
  IgnoredFiles.Duplicates := dupIgnore;

  if Assigned(Node) then
    for i := 0 to Node.Items.Count - 1 do
    begin
      if Node.Items[i].Name = 'replacement' then
        Add(TClxReplacement.Create(Node.Items[i]))
      else if Node.Items[i].Name = 'ignoredFile' then
        IgnoredFiles.Add(ExtractFileName(Node.Items[i].Properties.Value('filename')));
    end;
end;

destructor TClxReplacementList.Destroy;
begin
  IgnoredFiles.Free;

  inherited Destroy;
end;

function TClxReplacementList.DoReplacement(
  const Filename: string): string;
var
  i : Integer;
begin
  Result := Filename;

  // Only do the replacement if the file is not to be ignored
  if not IgnoredFiles.Find(ExtractFileName(Filename), i) then
  begin
    for i := 0 to Count -1 do
      Result := Items[i].DoReplacement(Result);
  end;
end;

function TClxReplacementList.GetItems(
  index: integer): TClxReplacement;
begin
  Result := TClxReplacement(inherited Items[index]);
end;

procedure TClxReplacementList.SetItems(index: integer;
  const Value: TClxReplacement);
begin
  inherited Items[index] := Value;
end;

initialization
  StartupDir := GetCurrentDir;

  IsBinaryCache := TStringList.Create;
  IsBinaryCache.Sorted := True;
  IsBinaryCache.Duplicates := dupIgnore;

// ensure the lists are not assigned
  TargetList := nil;
  AliasList := nil;
  DefinesList := nil;
  ClxReplacementList := nil;

  ExpandPackageTargets := ExpandTargets;

finalization
  TargetList.Free;
  AliasList.Free;
  DefinesList.Free;
  IsBinaryCache.Free;
  ClxReplacementList.Free;

end.