dpp_macros.pas

East make Tray Icon in delphi

  The modified files are saved a .i.pas or .iX.* files (for more information
  see Utils.GetPreProcessedFilename() ). }
function TMacros.ParseFile(Filename: string; ParseType: TParseType;
  TestFileExistence: Boolean): string;
var
  S: string;
  Modified: Boolean;
  Index, IncludeIndex: Integer;
begin
  Result := '';

  Inc(FFileRecursion);
  try
    if FFileRecursion > MaxFileRecursion then // too many open files
      Error(SToManyRecursions, Filename, 1);

   // find the file
    if TestFileExistence then
    begin
      if not FFileSys.FileExists(Filename) then
      begin
        Filename := FFileSys.FindFile(Filename, ParseType = ptInclude); // try to get the file name
        if Length(Filename) = 0 then Exit;
      end;
    end;

    Modified := False;
    Result := Filename;
    if ParseType <> ptInterfaceMacros then
      FFileSys.BeforeFile(Filename, ParseType = ptInclude);
    try
      FFileSys.LoadFile(Filename, S, ParseType = ptInclude);  // load file into a string

      if S <> '' then
      begin
       // parse file and replace macros
        Modified := ParseString(S, Filename, {StartLinenum:=}1, ParseType);

        if ParseType = ptInterfaceMacros then
          Modified := False; // only read these files, do not write these files

        if (Modified) then
        begin
          if ParseType = ptInclude then
          begin
           // change file extension to .i1.*, .i2.* and so on for include files
            Index := IndexOfFilename(FIncludeFiles, Filename);
            if Index = -1 then
            begin
              FIncludeFiles.AddObject(Filename, Pointer(1));
              IncludeIndex := 1;
            end
            else
            begin
              IncludeIndex := Integer(FIncludeFiles.Objects[Index]) + 1;
              FIncludeFiles.Objects[Index] := Pointer(IncludeIndex);
            end;
          end
          else
            IncludeIndex := 0; // -> .i.pas

          Result := GetPreProcessedFilename(Filename, IncludeIndex);
          FFileSys.SaveFile(Filename, Result, S, ParseType = ptInclude); // save string to file
        end;
      end;

    finally
      if ParseType <> ptInterfaceMacros then
        FFileSys.AfterFile(Filename, Result, ParseType = ptInclude, Modified);
    end;
  finally
    Dec(FFileRecursion);
  end;
end;


{ ParseString() is the main parsing method. It is called by ParseComment() and
  ParseFile(). There is no interesting stuff in this function. }
function TMacros.ParseString(var Text: string; const Filename: string;
  StartLineNum: Integer; ParseType: TParseType): Boolean;
var
  Parser: TPascalParserEx;
  Token: PTokenInfo;
begin
  Parser := TPascalParserEx.Create(Filename, Text, StartLineNum);
  try
    Parser.NoReplaceMacros := ParseType = ptInterfaceMacros;
    while NextToken(Parser, Token) do // NextToken() replaces macros
    begin
      if Token.Kind = tkComment then
      begin
       // test for macro related comments
        ParseComment(Token); // FConditionalParseCode is tested in ParseComment()
      end
      else if Token.Kind = tkIdent then
      begin
        if FConditionalParse and not FConditionalParseCode.Last then // still in a "false condition"
          Continue;

        if (ParseType = ptInterfaceMacros) then
        begin
          if (SameText(Token.Value, 'implementation')) then
            Break; // do not parse any implementation macros
        end
        else
        begin
          if (SameText(Token.Value, 'uses')) or (SameText(Token.Value, 'contains')) then
            ParseUsesIdent(Parser); // parse USES statement
        end;
      end;
    end;
  finally
    Result := Parser.Modified;
    if Result then Text := Parser.Text; // replace Text
    Parser.Free;
  end;
end;


{ NextToken() returns the next token. If there is no further token the result
  value is FALSE else TRUE and the Token argument is NIL.
  For every token which is a macro name the ReplaceMacros() method is called. }
function TMacros.NextToken(Parser: TPascalParserEx; out Token: PTokenInfo): Boolean;
var
  Item: TMacroItem;
  Replacement: string;
begin
  if (Parser.NoReplaceMacros) or (FConditionalParse and not FConditionalParseCode.Last) then
  begin
   // just collect macros
    Result := Parser.GetToken(Token);
    Exit;
  end;
 // replace macros
  repeat
    Result := Parser.GetToken(Token);
    if (Result) and (Token.Kind = tkIdent) then
    begin
      if (Token.Value[1] = SBuiltInStartChars[1]) and
         (Token.Value[2] = SBuiltInStartChars[2]) and // may be point to #0 but this is no problem
         (BuiltInMacro(Token, Replacement)) then
      begin
       // built in simple macros
        Parser.ReplaceParseNext(Token, Token, Replacement);
      end
      else
      begin
        Item := FindMacro(Token.Value);
        if (Item <> nil) then
          ReplaceMacro(Parser, Item)
        else
          Break; // no macro -> return token
      end;
    end
    else
      Break; // no macro -> return token
  until False;
end;


{ NextToken(): no comment }
function TMacros.NextToken(Parser: TPascalParserEx): PTokenInfo;
begin
  NextToken(Parser, Result);
end;


{ ParseConditionals() parses all {$... compiler directives. It also interprets
  the $IFDEF, $IFNDEF, $ELSE, $ENDIF and $APPTYPE directives.

  $DEFINE und $UNDEF are directly handled by ParseComment().
}
function TMacros.ParseConditionals(var Line: string; const Filename: string;
  StartLineNum: Integer): Boolean;
type
  TConditionalWordType = (cwNone,
    cwIfdef, cwIfndef, {cwIfopt,} cwElse,
    cwEndif, {cwIf, cwElseif, cwIfend,} cwAppType
  );
const
  ConditionalWords: array[TConditionalWordType] of string = (
    '',
    'ifdef', 'ifndef', {'ifopt',}
    'else', 'endif',
    {'if', 'elseif', 'ifend'}
    'apptype'
  );
  procedure SyntaxError;
  begin
    Error(SConditionalSyntaxError, Filename, StartLineNum);
  end;

var
  Parser: TPascalParserEx;
  Token: PTokenInfo;
  ConditionalWord, Found: TConditionalWordType;
  Item: TMacroItem;
begin
  System.Delete(Line, 1, 1); // remove '$'
  if (Length(Line) = 0) or (Line[1] <= ' ') then SyntaxError;

  Parser := TPascalParserEx.Create(Filename, Line, StartLineNum);
  try
    if (not Parser.GetToken(Token)) or (Token.Kind <> tkIdent) then
      Token.Value := '';

    ConditionalWord := cwNone;
    for Found := Low(TConditionalWordType) to High(TConditionalWordType) do
      if SameText(Token.Value, ConditionalWords[Found]) then
      begin
        ConditionalWord := Found;
        Break;
      end;

    case ConditionalWord of
      cwIfdef, cwIfndef:
        begin
          if not FConditionalParse or FConditionalParseCode.Last then // can parse these line
          begin
            Token := Parser.GetToken;
            if Token = nil then SyntaxError;

            Item := FindMacro(Token.Value);
            case ConditionalWord of
              cwIfdef:
                begin
                  if (Item <> nil) and (Item.InterfaceMacro) then
                  begin
                   // replace the token by 'PREPROCESSOR'
                    FConditionalParseCode.Add(True);
                    Parser.ReplaceParseNext(Token, Token, 'PREPROCESSOR');
                  end
                  else
                    FConditionalParseCode.Add(IsDefined(Token.Value));
                end;

              cwIfndef:
                begin
                  if (Item <> nil) and (Item.InterfaceMacro) then
                  begin
                   // replace the token by 'NEVER_DEFINED'
                    FConditionalParseCode.Add(False);
                    Parser.ReplaceParseNext(Token, Token, 'NEVER_DEFINED');
                  end
                  else
                    FConditionalParseCode.Add(not IsDefined(Token.Value));
                end;
            end;
          end;
        end; // cwDefine, cwUndefine, cwIfdef, cwIfndef
      cwElse: FConditionalParseCode.ToggleLast;
      cwEndif: FConditionalParseCode.DeleteLast;
      cwAppType:
        begin
          if not FConditionalParse or FConditionalParseCode.Last then // can parse these line
          begin
            if (NextToken(Parser, Token)) and (Token.Kind = tkIdent) then
            begin
              FAppType := Token.Value;
              if SameText(FAppType, 'CONSOLE') then Define('CONSOLE')
                                               else Undefine('CONSOLE');
            end;
          end;
        end; // cwAppType

      else
        if not FConditionalParse or FConditionalParseCode.Last then // can parse these line
         // parse and replace macros
          while NextToken(Parser, Token) do ; // replace macros
    end; // case
  finally
    Result := Parser.Modified;
    if Result then Line := '$' + Parser.Text;
    Parser.Free;
  end;
end;


{ ParseComment() parses all comment tokens. Single line comments (//) are
  ignored. It registers all found MACRO statments. For include files $I and
  $INCLUDE the ParseFile() method is called. After parsing the include file
  the $I/$INCLUDE statment is replaced by the new filename returned by
  ParseFile().

  For compiler directives and conditional compilation macros are replaced. }
function TMacros.ParseComment(Token: PTokenInfo): Boolean;
var
  ps, BracketCount, ri, Len: Integer;
  Item: TMacroItem;
  s, Filename: string;
  IsCompilerDirective: Boolean;
begin
  Result := True;
  s := Token.Value;
  if s[1] = '/' then Exit; // single line comment are not parsed

 // remove comment brackets
  if s[1] = '(' then BracketCount := 2 else BracketCount := 1;
  System.Delete(s, 1, BracketCount);
  System.Delete(s, Length(s) - BracketCount + 1, BracketCount);
  if Pointer(s) = nil then Exit; // <==> if Length(s) = 0 then Exit;

  IsCompilerDirective := (s[1] = '$');

  if (IsCompilerDirective) and (not FConditionalParse or FConditionalParseCode.Last) and
     (StartsText(SMacroStartString, s)) then
  begin
   // register new macro
    System.Delete(s, 1, Length(SMacroStartString));
    Item := RegisterMacroByToken(s, Token);
    if Item <> nil then Define(Item.Name); // define also as conditional
  end

  else if (IsCompilerDirective) and
          (not FConditionalParse or FConditionalParseCode.Last) and
          (StartsText(SUnmacroStartString, s)) then
  begin
   // unregister macro
    System.Delete(s, 1, Length(SUnmacroStartString));
    s := Trim(s);
    UnregisterMacro(s);
    Undefine(s); // undefine conditional
  end

  else if (not IsCompilerDirective) and
          (not FConditionalParse or FConditionalParseCode.Last) and
          (s[1] in ['M', 'm']) and
          (StartsText(SMacroIncludeString, s)) then
  begin
   // parse macro include file

    System.Delete(s, 1, PosChar(' ', s));
    s := Trim(s);
    if s <> '' then
    begin
      if s[1] = '''' then
      begin
        System.Delete(s, 1, 1);
        System.Delete(s, Length(s), 1);
      end;

      FileName := ParseFile(s, ptInterfaceMacros, {TestFileExistence:=}True);
      if Filename = '' then
        Error(Format(SFindFile, [s]), Token);
    end;
  end

  else if (IsCompilerDirective) and
          (not FConditionalParse or FConditionalParseCode.Last) and
          ((StartsText('$I ', s)) or (StartsText('$INCLUDE ', s))) then
  begin
   // parse include file

    System.Delete(s, 1, PosChar(' ', s));
    s := Trim(s);
    if s <> '' then
    begin
      if s[1] = '''' then
      begin
        System.Delete(s, 1, 1);
        System.Delete(s, Length(s), 1);
      end;
     // parse include file