dpp_macros.pas

East make Tray Icon in delphi

      if TPascalParserEx(Token.Parser).NoReplaceMacros then
        Filename := ParseFile(s, ptInterfaceMacros, {TestFileExistence:=}True)
      else
        Filename := ParseFile(s, ptInclude, {TestFileExistence:=}True);
      if Filename = '' then
        Error(Format(SFindFile, [s]), Token);
      if ExtractFileName(Filename) = ExtractFileName(s) then Exit; // file was not modified so no file name change

      if TPascalParserEx(Token.Parser).NoReplaceMacros then Exit;

     // replace old filename by new one
      ps := Pos(s, Token.Value); // find file name start position
      s := Token.Value;
      ri := ps - 1;
      while (ri > 1) and (not (s[ri] in ['''', ' '])) do Dec(ri);
      Len := Length(s);
      while (ps < Len) and (not (s[ps] in [s[ri], '}', '*'])) do Inc(ps);
      if s[ps] <> '''' then Dec(ps);
      if s[ri] = ' ' then Inc(ri);
      System.Delete(s, ri, ps - ri + 1);
      System.Insert('''' + Filename + '''', s, ri);

      Token.Parser.ReplaceParseNext(Token, Token, s); // replace token
      Token.Parser.ClearCache; // clear cache
    end;

  end else if (IsCompilerDirective) then
  begin
    // compiler directive / conditional compilation

    if ParseConditionals(s, Token.pFilename^, Token.StartLine) then
    begin
      if BracketCount = 1 then s := '{' + s + '}'
                          else s := '(*' + s + '*)';
      Token.Parser.ReplaceParseNext(Token, Token, s); // replace token
      Token.Parser.ClearCache; // clear cache
    end;
  end;
end;


{ ParseUsesIdent() parses the USES statement and add all found units who's
  file exists to the FUnits-List. No duplicate files are added. }
procedure TMacros.ParseUsesIdent(Parser: TPascalParserEx);
var
  Token: PTokenInfo;
  s: string;
  UnitIndex: Integer;
begin
  while NextToken(Parser, Token) do // NextToken() replaces macros
  begin
    if Token.Kind = tkSymbol then
    begin
      if Token.Value = ';' then Break
      else if Token.Value = ',' then Continue;
    end

    else if Token.Kind = tkIdent then
    begin
      if SameText(Token.Value, 'in') then
      begin
        Token := NextToken(Parser); // NextToken() replaces macros
        s := RemoveQuotes(Token.Value);
      end else s := Token.Value + '.pas';

      s := FFileSys.FindFile(s, {IsInclude:=}False);
      if s <> '' then
      begin
        UnitIndex := IndexOfFilename(FUnits, s);
       // add this unit to the unit-parse-list.
        if UnitIndex = -1 then
          UnitIndex := FUnits.AddObject(s, Pointer(-1));

       // Include the macros from the interface section of the the new unit.
        ParseUnitMacroFile(UnitIndex);

       // Include the macro include file for the new unit.
        ParseUnitMacroFile(UnitIndex);
      end;
    end;
  end;
end;


{ GetReplacement() is called for "Function Macros" only. It replaces the
  arguments of the macro item with Args[] which is created in ReplaceMacros().
  All macros in Args[] are replaced when entering this method. }
function TMacros.GetReplacement(Item: TMacroItem; const Args: TStringDynArray;
  const Filename: string; StartLineNum: Integer): string;

  function GetArg(Token: PTokenInfo; var Arg: string): Boolean;
  var ArgIndex: Integer;
  begin
   // do not set Args to '' here
    Result := False;
    if (Token = nil) or (Token.Kind <> tkIdent) then Exit;

    ArgIndex := Item.IndexOfArg(Token.Value);
    if ArgIndex >= 0 then
    begin
      Arg := Args[ArgIndex];
      Result := True;
    end;
  end;

var
  Parser: TPascalParserEx;
  StartToken, Token: PTokenInfo;
begin
 // parsing "Macro Replacement" text
  Parser := TPascalParserEx.Create(Filename, Item.Replacement, StartLineNum);
  try
    while Parser.GetToken(Token) do
    begin

      if (Token.Kind = tkIdent) then
      begin
        if GetArg(Token, Token.Value) then
        begin
          StartToken := Token;
         // parse the new content but do not clear cache so it is possilbe
         // for '##' to get the string as identifier
          Parser.ReplaceParseNext(StartToken, Token, Token.Value);
        end;
      end


      else if (Token.Kind = tkSymbol) then
      begin
       // make string
        if Token.Value = '#' then
        begin
          StartToken := Token;
          if (not Parser.GetToken(Token)) then
            Error(Format(SMacroSytaxError, [SNoFurtherToken]), StartToken); // Abort
          if (not GetArg(Token, Token.Value)) then
            Error(Format(SMacroSytaxError, [SCanOnlyMakeStringFromArguments]), StartToken); // Abort

          Token.Value := '''' + Token.Value + '''';
          Parser.ReplaceParseNext(StartToken, Token, Token.Value);
         // parse the new content but do not clear cache so it is possilbe for
         // '##' to get the string as identifier
          Token.StartIndex := StartToken.StartIndex; // adjust tkIdent-token StartIndex becoming PreToken
        end


        else if (Token.Value = '##') then
        begin
          StartToken := Parser.PreToken;
          if (StartToken = nil) or
             (StartToken.Kind <> tkIdent) or
             (not Parser.GetToken(Token)) or
             (Token.Kind <> tkIdent) then  // changes <Token>
            Error(Format(SMacroSytaxError, [SCombineError]), Token); // Abort

          GetArg(Token, Token.Value); // get argument replacement if available

         // parse the new content but do not clear cache so it is possilbe for
         // '##' to get the string as identifier
          Parser.ReplaceParseNext(StartToken, Token, TrimRight(StartToken.Value) + TrimLeft(Token.Value));
          Token.StartIndex := StartToken.StartIndex; // adjust tkIdent-token StartIndex becoming PreToken
        end;
      end; // if Token.Kind = tkSymbol

    end; // while

    Result := Parser.Text;
  finally
    Parser.Free;
  end;
end;


{ ReplaceMacro() creates the argument array and replaces all array items by
  its macro(-function). For macro functions GetReplacement() is called. }
procedure TMacros.ReplaceMacro(Parser: TPascalParserEx; Item: TMacroItem);
var
  Token: PTokenInfo;
  ReplStartIndex, ReplEndIndex, LastCommaIndex: Integer;
  Replacement: string;
  BracketNum: Integer;
  Args: TStringDynArray;
  ArgIndex: Integer;
  AddedLines: Integer;
  EndLineNum: Integer;
begin
  if FMacroMacroRecursion.IndexOf(Item) >= 0 then Exit; // do not replace the macro with itself
  FMacroMacroRecursion.Add(Item);
  try
    Token := Parser.CurToken;
    ReplStartIndex := Token.StartIndex;
    ReplEndIndex := Token.EndIndex;
    EndLineNum := Token.EndLine;
    if Item.HasBrackets then
    begin
     // macro with arguments

     // is '(' the next token
      if (not Parser.GetToken(Token)) or (Token.Value <> '(') then
        Error(Format(SMacroSytaxError, [SNoArgumentSpecified]), Parser.PreToken); // Abort


     // Here we use NextToken(), because the arguments can also be macros and
     // NextToken() replaces them.

     // get macro arguments
      SetLength(Args, Length(Item.Arguments));
      ArgIndex := 0;
      LastCommaIndex := Token.StartIndex;
      BracketNum := 1;
      while NextToken(Parser, Token) do // NextToken() replaces macros
      begin
        EndLineNum := Token.EndLine;
        if Token.Value = '(' then Inc(BracketNum)
        else if Token.Value = ')' then
        begin
          Dec(BracketNum);
          if BracketNum = 0 then
          begin
            if Length(Args) > 0 then
            begin
              Args[ArgIndex] := Trim(Parser.GetPlainText(LastCommaIndex + 1, Token.StartIndex - 1)); // save last argument
              if Length(Args[ArgIndex]) = 0 then
                Error(Format(SMacroSytaxError, [SEmptyMacroArgument]), Token);
            end;
            Break; // last bracket
          end;
        end
        else if (BracketNum = 1) and (Token.Value = ',') then
        begin
          Args[ArgIndex] := Parser.GetPlainText(LastCommaIndex + 1, Token.StartIndex - 1);
          if IsStrEmpty(Args[ArgIndex]) then
            Error(Format(SMacroSytaxError, [SEmptyMacroArgument]), Token);

          LastCommaIndex := Token.StartIndex;
         // new argument
          Inc(ArgIndex);
          if ArgIndex >= Length(Args) then
            Error(SMacroSytaxError, Token);
        end;
      end;
      SetLength(Args, ArgIndex + 1); // set to correct length
      ReplEndIndex := Token.EndIndex; // new end index

     // check arguments
      if Length(Args) <> Length(Item.Arguments) then
        Error(Format(SMacroNotEnoughArguments, [Item.Name]), Token);

      Replacement := GetReplacement(Item, Args, Parser.Filename, Token.StartLine);
    end
    else
      Replacement := Item.Replacement; // just a simple replacement

   // parse replacement
    ParseString(Replacement, Parser.Filename, Parser.LineNum, ptInclude);
   // replace text
    Parser.ReplaceParseNext(ReplStartIndex, ReplEndIndex - ReplStartIndex + 1, Replacement);
    Parser.ClearCache; // new parse start and clear token cache

   // lines moved
    AddedLines := CountChars(#10, Replacement);
    if AddedLines > 0 then
      FFileSys.LinesMoved(Token^.Parser.Filename, EndLineNum, AddedLines);
  finally
    FMacroMacroRecursion.Remove(Item);
  end;
end;


function TMacros.BuiltInMacro(Token: PTokenInfo; var Replacement: string): Boolean;
begin
 // __LINE__
  if FCompare(Token.Value, SBuiltIn_Line) = 0 then
  begin
    Result := True;
    Replacement := IntToStr(Token.StartLine);
  end

 // __FILE__
  else if FCompare(Token.Value, SBuiltIn_File) = 0 then
  begin
    Result := True;
    Replacement := '''' + Token.pFilename^ + ''''
  end

 // __DATE__
  else if FCompare(Token.Value, SBuiltIn_Date) = 0 then
  begin
    Result := True;
    Replacement := '''' + DateToStr(Date) + ''''
  end

 // __TIME__
  else if FCompare(Token.Value, SBuiltIn_Time) = 0 then
  begin
    Result := True;
    Replacement := '''' + TimeToStr(Time) + ''''
  end

  else
  begin
    Result := False;
    if Assigned(FOnBuiltInMacro) then
    begin
      Replacement := '';
      FOnBuiltInMacro(Self, Token, Replacement, Result);
    end;
  end;
end;

procedure TMacros.DefaultConditionals;
begin
  Define('PREPROCESSOR'); // always defined
 //  Define('CONDITIONALEXPRESSIONS');  not supported

{$ifdef VER130}         Define('VER130'); {Delphi 5} {$endif}
{$ifdef VER140}         Define('VER140'); {Delphi 6} {$endif}
{$ifdef VER150}         Define('VER150'); {Delphi 7} {$endif}
{$ifdef VER160}         Define('VER160'); {Delphi 8} {$endif}

{$ifdef MSWINDOWS}      Define('MSWINDOWS'); {$endif}
{$ifdef WIN32}          Define('WIN32'); {$endif}
{$ifdef LINUX}          Define('LINUX'); {$endif}
{$ifdef CPU386}         Define('CPU386'); {$endif}

  if SameText(FAppType, 'CONSOLE') then
    Define('CONSOLE');

 // user defined
  if Assigned(FOnDefaultConditionals) then
    FOnDefaultConditionals(Self);

  Undefine('CONDITIONALEXPRESSIONS'); // not supported
end;

procedure TMacros.Define(const Condition: string);
begin
  if (Condition <> '') and (FConditionals.IndexOf(Condition) = -1) then
    FConditionals.Add(Condition);
end;

procedure TMacros.Undefine(const Condition: string);
var Index: Integer;
begin
  Index := FConditionals.IndexOf(Condition);
  if Index >= 0 then FConditionals.Delete(Index);
end;

function TMacros.IsDefined(const Condition: string): Boolean;
begin
  Result := (Condition <> '') and (FConditionals.IndexOf(Condition) >= 0);
end;

procedure TMacros.SetOption(const Option: string; Value: Boolean);
begin
{TODO set options for $ifopt, be carefull with $R+/- and $RANGECHECKS ON/OFF and so on}
end;

end.