dpp_macros.pas

East make Tray Icon in delphi

{**************************************************************************************************}
{                                                                                                  }
{ Delphi language Preprocessor (dpp32)                                                             }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is dpp_Macros.pas                                                              }
{                                                                                                  }
{ The Initial Developer of the Original Code is Andreas Hausladen                                  }
{ Portions created by these individuals are Copyright (C) of these individuals.                    }
{                                                                                                  }
{ You may retrieve the latest version of this file at the Projects home page, located at           }
{ http://www.sourceforge.net/projects/dpp32                                                        }
{                                                                                                  }
{**************************************************************************************************}
unit dpp_Macros;
(*******************************************************************************
* Preprocessor for Delphi and Kylix compiler (dcc32, dcc)
* =======================================================
*
* This preprocessor make it possible for Delphi developers to use the power of
* macros in Object Pascal code. The macros acts like the C/C++ preprocessor
* macros with the exception of conditional compilation.
*
*
* Macro Syntax:
* {$define macroname}          // registers a macro
* {$undef macroname}           // unregisters a the macro
* {MACROINCLUDE mymacros.mac}  // does only include the macros from the file
*
* Examples:
* {$define macroname1   replacement text }
* {$define macroname2(arg1, arg2) WriteLn(#arg1); ReadLn(arg2 ## _Var) }
* {$undef macroname2}
*
*
*
* The macros in the interface sections of the USES units are not imported. For
* macro imports use MACROINCLUDE.
*
* For every unit in the uses-statement a MACROINCLUDE is automatically generated
* e.g. uses MyUnit; -> MyUnit.macros is included if it exists. For the current
* unit also the corresponding .macros file is also included. The .macros file
* must exist in the same directory as the unit itself and it cannot contain any
* source code. Only macro declarations ($define, $undef, MACROINCLUDE) are
* allowed. Other code is ignored.
*
* The preprocessor follows the compiler directive {$I filename} and
* {$INCLUDE filename}. For every included file a copy of the preprocessed files
* is generated to support differences in macro defined before the include
* directive.
*
*
* ISSUES:
*   - The compiler has a line limit of 1024 chars. For larger macros a unique
*     include file can be necessary. Splitting the macro in more lines will
*     break the error message lines. Prehaps the preprocessor can modify the
*     original file by inserting "{MACROPLACE}" comment lines after the long
*     line.
*
*   - No conditional expressions (Delphi 6+) are supported by the preprocessor.
*     All macros in such an expression are parsed and replaced. In order to
*     support this feature an expression parser is necessary. Furthermore
*     we must collect all *const* expressions. But how can we get the consts
*     from a compiled unit (.dcu).
*
*******************************************************************************)
{.$define HASHTABLE}
interface

uses
  Types, SysUtils, Classes, Contnrs, dpp_PascalParser, dpp_Utils;

const
  MaxFileRecursion = 30; // files can be opened at once

type
  TWarningEvent = procedure(Sender: TObject; const Filename, Msg: string;
    LineNum: Integer) of object;
  TErrorEvent = procedure(Sender: TObject; const Filename, Msg: string;
    LineNum: Integer) of object;
  TPredefineMacrosEvent = procedure(Sender: TObject) of object;
  TDefaultConditionalsEvent = procedure(Sender: TObject) of object;
  TBuiltInMacroEvent = function(Sender: TObject; Token: PTokenInfo;
    var Replacement: string; var IsBuiltIn: Boolean): string of object;

  TMacroCompare = function(const S1, S2: string): Integer;

  TParseType = (
    ptUnit,            // collect and replace macros in the whole file
    ptInclude,         // collect and replace macros in the whole file but use some special file handling
    ptInterfaceMacros  // collect macros from the interface-section of the file (only for MACROINCLUDE)
  );

 { TPascalParserEx make it easier to pass NoReplaceMacros across the
   TMacro.methods. }
  TPascalParserEx = class(TPascalParser)
  public
    NoReplaceMacros: Boolean;
  end;

  TMacros = class;
  TMacroList = class;

  IMacroFileSys = interface
  ['{F3CD3F56-F849-4C9E-BD57-3D76DE6E0C64}']
    { Called before the file is read. The file exists. }
    procedure BeforeFile(const FileName: string; IsIncludeFile: Boolean);
    { Called after the file was stored depending on Modified. Filename is a
      full qualified file name. The file and the new file exist. }
    procedure AfterFile(const FileName, NewFileName: string; IsIncludeFile,
      Modified: Boolean);
    { LoadFile must return the file content in *Content*. Filename is a
      full qualified file name. The file exists. }
    procedure LoadFile(const Filename: string; out Content: string;
      IsIncludeFile: Boolean);
    { SaveFile is called for saving the file's content. Filename is the original
      filename and NewFilename is the preprocessor's new file name. All file
      names are full qualified file names. The file exists but the new file
      doesn't. }
    procedure SaveFile(const Filename: string; var NewFilename: string;
      const Content: string; IsIncludeFile: Boolean);
    { FindFile is called if the file name is not a full qualified file
      name. Return the full qualified file name or '' if the file does not
      exist. }
    function FindFile(const Filename: string; IsIncludeFile: Boolean): string;
    { FileExists must return True if the given File exists. Filename is a
      full qualified file name. }
    function FileExists(const Filename: string): Boolean;

    { LinesMoved is called for macro replacements using more than one line.
      LineNum   : line where the macro is.
      AddedLines: number of inserted lines }
    procedure LinesMoved(const Filename: string; LineNum, AddedLines: Integer);
  end;

  TMacroItem = class(TObject)
  private
    FMacroList: TMacroList;
    FName: string;
    FReplacement: string;
    FHasBrackets: Boolean;
    FArguments: TStringDynArray;
    FInterfaceMacro: Boolean; // if TRUE the $ifdef/$ifndef must be modified
  public
    constructor Create(AMacroList: TMacroList);
    function Parse(const MacroNameArgReplacement: string; out ErrorMsg: string;
      AInterfaceMacro: Boolean): Boolean;
    function IsEqual(Item: TMacroItem): Boolean;
    procedure Assign(Item: TMacroItem);
    function IndexOfArg(const ArgName: string): Integer;

    property Name: string read FName;
    property Replacement: string read FReplacement;
    property HasBrackets: Boolean read FHasBrackets write FHasBrackets;
    property Arguments: TStringDynArray read FArguments;
    property MacroList: TMacroList read FMacroList;
    property InterfaceMacro: Boolean read FInterfaceMacro write FInterfaceMacro;
  end;

  TMacroList = class(TObjectList)
  private
    FMacros: TMacros;
    FHashTable: TRedirectTable;
    function GetItems(Index: Integer): TMacroItem;
  protected
    function IndexOfMacro(const Name: string): Integer;
  public
    constructor Create(Macros: TMacros);
    procedure Assign(MacroList: TMacroList);
    procedure Clear; override;

    function RegisterMacro(const Macro: string; AInterfaceMacro: Boolean): TMacroItem;  // in: 'test(x) x*x' // DEVINFO: Macro must be TrimLeft()
    procedure UnregisterMacro(const Name: string);            // in: 'test'        // DEVINFO: Macro must be Trim()
    function IsMacroRegistered(const Name: string): Boolean;                       // DEVINFO: Macro must be Trim()

    function FindMacro(const Name: string): TMacroItem;

    property Items[Index: Integer]: TMacroItem read GetItems;
  end;

  TMacros = class(TMacroList)
  private
    FCaseSensitive: Boolean;
    FConditionalParse: Boolean;
    FErrorMsg: string;

    FUnits: TStrings;        // contains all units (interface and implementation <uses>); "MacroFileExists:=Boolean(Objects[])"
    FIncludeFiles: TStrings; // contains all include files. Integer(Objects[]): how often the file is used

    FMacroMacroRecursion: TList; // used for in macro replacement see TMacros.ReplaceMacro()
    FFileRecursion: Integer;  // number of open include files

    FConditionals: TStrings; // $define, $ifdef, $ifndef - conditional compilation
    FCompilerOptions: TStrings; // $ifopt - conditional compilation
    FConditionalParseCode: TBooleanList; // .LastItem=True: parse code; .LastItem=False: ignore code and macros

    FAppType: string;
    FFileSys: IMacroFileSys;

    FCompare: TMacroCompare;
    FOnError: TErrorEvent;
    FOnWarning: TWarningEvent;
    FOnPredefineMacros: TPredefineMacrosEvent;
    FOnBuiltInMacro: TBuiltInMacroEvent;
    FOnDefaultConditionals: TDefaultConditionalsEvent;

    procedure SetCaseSensitive(const Value: Boolean);
  protected
    procedure Warning(const Msg, FileName: string; LineNum: Integer); overload;
    procedure Warning(const Msg: string; Token: PTokenInfo); overload;
    procedure Error(const Msg, FileName: string; LineNum: Integer); overload;
    procedure Error(const Msg: string; Token: PTokenInfo); overload;
    procedure PredefineMacros;
    function BuiltInMacro(Token: PTokenInfo; var Replacement: string): Boolean;
    procedure DefaultConditionals;

    function ParseUnitMacroFile(UnitIndex: Integer): Integer;
    function ParseFile(Filename: string; ParseType: TParseType;
      TestFileExistence: Boolean): string; // returns new filename (.i.pas, .i1.*, .i2.*, ...)
    function ParseString(var Text: string; const Filename: string;
      StartLineNum: Integer; ParseType: TParseType): Boolean;

    function NextToken(Parser: TPascalParserEx; out Token: PTokenInfo): Boolean; overload;
    function NextToken(Parser: TPascalParserEx): PTokenInfo; overload;
    function ParseConditionals(var Line: string; const Filename: string;
      StartLineNum: Integer): Boolean;
    function ParseComment(Token: PTokenInfo): Boolean;
    procedure ParseUsesIdent(Parser: TPascalParserEx);

    function GetReplacement(Item: TMacroItem; const Args: TStringDynArray;
      const Filename: string; StartLineNum: Integer): string;
    procedure ReplaceMacro(Parser: TPascalParserEx; Item: TMacroItem);

    function RegisterMacroByToken(const Macro: string; Token: PTokenInfo): TMacroItem;
  public
    constructor Create(AFileSys: IMacroFileSys);
    destructor Destroy; override;

    procedure Define(const Condition: string); // defines a condition (FConditionals)
    procedure Undefine(const Condition: string); // undefines a condition (FConditionals)
    procedure SetOption(const Option: string; Value: Boolean);
    function IsDefined(const Condition: string): Boolean; // return TRUE if the condition is defined (FConditionals)

    function Parse(const FileName: string; OnlyThisFile: Boolean): Boolean;

    property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive default True;
    property ConditionalParse: Boolean read FConditionalParse write FConditionalParse default False;
    property ErrorMsg: string read FErrorMsg;

    property OnWarning: TWarningEvent read FOnWarning write FOnWarning;
    property OnError: TErrorEvent read FOnError write FOnError;
    property OnPredefineMacros: TPredefineMacrosEvent read FOnPredefineMacros write FOnPredefineMacros;
    property OnDefaultConditionals: TDefaultConditionalsEvent read FOnDefaultConditionals write FOnDefaultConditionals;
    property OnBuiltInMacro: TBuiltInMacroEvent read FOnBuiltInMacro write FOnBuiltInMacro;
  end;

implementation

resourcestring
 // error messages
  SMacroArgumentsSyntaxError = 'No valid macro name/argument: %s';
  SMacroNotEnoughArguments = 'Not enough arguments for %s';
  SMacroSytaxError = 'Syntax error: %s';
  SEmptyMacroArgument = 'Macro argument is empty.';
  SNoFurtherToken = 'Unexpected file/macro end.';
  SCanOnlyMakeStringFromArguments = 'Can only use # on macro arguments.';
  SCombineError = 'Wrong usage for ##.';
  SNoArgumentSpecified = 'No argument specified for macro.';
  SMacroRedefinitionNotIdentical = 'Redeclaration of "%s" is not identical.';
  SToManyRecursions = 'To many file recursions.';
  SFindFile = 'File "%s" not found.';
  SConditionalSyntaxError = 'Syntax error in conditional directive.';

const
  SMacroStartString = '$DEFINE ';
  SUnmacroStartString = '$UNDEF ';
  SMacroIncludeString = 'MACROINCLUDE ';
  SMacroIncludeFileExt = '.macros';

  SBuiltInStartChars = '__'; // do not modify or localize 
  SBuiltIn_Line = '__LINE__';
  SBuiltIn_File = '__FILE__';
  SBuiltIn_Date = '__DATE__';
  SBuiltIn_Time = '__TIME__';

{ TMacroItem }

constructor TMacroItem.Create(AMacroList: TMacroList);
begin
  inherited Create;
  FMacroList := AMacroList;
end;

procedure TMacroItem.Assign(Item: TMacroItem);
var i: Integer;
begin
  FHasBrackets := Item.FHasBrackets;
  SetLength(FArguments, Length(Item.FArguments));
  FReplacement := Item.FReplacement;
  for i := 0 to High(FArguments) do
    FArguments[i] := Item.FArguments[i];
end;

{ IndexOfArg() returns the index of the macro argument with the name ArgName. }
function TMacroItem.IndexOfArg(const ArgName: string): Integer;
var cmp: TMacroCompare;
begin
  cmp := FMacroList.FMacros.FCompare;
  for Result := 0 to High(Arguments) do
    if cmp(ArgName, Arguments[Result]) = 0 then Exit;
  Result := -1;
end;

function TMacroItem.IsEqual(Item: TMacroItem): Boolean;
var
  i: Integer;
  cmp: TMacroCompare;
begin
  Result := False;
  if FHasBrackets <> Item.FHasBrackets then Exit;
  if Length(FArguments) <> Length(Item.FArguments) then Exit;
  if FReplacement <> Item.FReplacement then Exit;

  cmp := FMacroList.FMacros.FCompare;
  for i := 0 to High(FArguments) do
    if cmp(FArguments[i], Item.FArguments[i]) <> 0 then Exit;

  Result := True;
end;

procedure SetTrimString(out S: string; P: PChar; Count: Integer);
var
  F: PChar;
begin
  while {(P[0] <> #0) and }(P[0] <= #32) and (Count > 0) do
  begin
    Inc(P);
    Dec(Count);
  end;
  if Count > 0 then
  begin
    F := P;
    Inc(P, Count);
    while (P > F) and (P[0] <= #32) do Dec(P);
    SetString(S, F, P - F);
  end
  else
    S := '';
end;

{ Parse() parses the macro declaration and split it to its name, arguments and
  replacement. }
function TMacroItem.Parse(const MacroNameArgReplacement: string; out ErrorMsg: string;
  AInterfaceMacro: Boolean): Boolean;
var
  F, P: PChar;