dpp_preprocess.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_PreProcess.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_PreProcess;
interface
uses
  SysUtils, Classes, dpp_Macros, dpp_FileInfos, dpp_Utils;
const
  PreProcessorVersion = '1.1';
type
  TErrorWarningEvent = procedure(Sender: TObject; const Message: string) of object;
  TErrorWarningExEvent = procedure(Sender: TObject; Error: Boolean;
    const Filename, Msg: string; Line: Integer) of object;

  { IPreProcessorFileSys: all file names are full qualified file names. }
  IDppVirtualFileSys = interface
    { InitPreProcessorFileSys is called for every BeginPreProcessing. }
    procedure InitPreProcessorFileSys;

    { IsVirtualFile should return True if the file is in an edit buffer. }
    function IsVirtualFile(const Filename: string): Boolean;
    { GetVirtualFileContent is called to obtain the edit buffer's content. }
    procedure GetVirtualFileContent(const Filename: string; out Content: string);
    { SetVirtualFileContent is called to replace the edit buffer's content. }
    procedure SetVirtualFileContent(const Filename: string; const Content: string);
    { RestoreVirtualFileContent is called after the compiler has done its work.
      So the edit buffer's content can be restored. }
    procedure RestoreVirtualFileContent(const Filename: string; const BackupedContent: string);

    { AdjustLines is called for content changes breaking line numbers.
      LineNum: line where the changes occure
      Count: number of inserted lines (always >0) }
    procedure AdjustLines(const Filename: string; LineNum, Count: Integer);
  end;

  TPreProcessor = class(TObject)
  private
    FPasFiles: TStrings; // .pas files
    FIncFiles: TStrings; // .i1, .i2, ... files which have to be deleted on termination
    FFileInfos: TFileInfoList;
    FVirtualFileList: TStrings; // contains every virtual file name
    FFilenameMapper: TFilenameMapper;

    FMacros: TMacros;
    FFileSys: IDppVirtualFileSys;

    FUnitPaths: string;
    FIncludePaths: string;
    FCompilePrepare: Boolean;
    FParseOnlyOneFile: Boolean;
    FConditionals: TStrings;
    FConditionalParse: Boolean;
    FCaseSensitive: Boolean;

    FOnError: TErrorWarningEvent;
    FOnWarning: TErrorWarningEvent;
    FOnErrorWarningEx: TErrorWarningExEvent;
  protected
    FProjectPath: string; // has no trailing path delimiter
  private
   // TMacros events
    procedure EvError(Sender: TObject; const Filename, Msg: string; LineNum: Integer);
    procedure EvWarning(Sender: TObject; const Filename, Msg: string; LineNum: Integer);
    procedure EvPredefineMacros(Sender: TObject);
    procedure EvDefaultConditionals(Sender: TObject);
  public
    constructor Create(FileSys: IDppVirtualFileSys);
    destructor Destroy; override;

    function BeginPreProcessing(const Filename: string): Boolean; // parses all files
    procedure EndPreProcessing; // restores the original files

    property CompilePrepare: Boolean read FCompilePrepare write FCompilePrepare;
    property ParseOnlyOneFile: Boolean read FParseOnlyOneFile write FParseOnlyOneFile;
    property IncludePaths: string read FIncludePaths write FIncludePaths; // WIN: path;path LINUX: path:path
    property UnitPaths: string read FUnitPaths write FUnitPaths;          // WIN: path;path LINUX: path:path
    property Conditionals: TStrings read FConditionals;

    property ConditionalParse: Boolean read FConditionalParse write FConditionalParse;
    property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive;


    property PasFiles: TStrings read FPasFiles;
    property IncFiles: TStrings read FIncFiles;

   // events - if not assigned: output to stdout
    property OnError: TErrorWarningEvent read FOnError write FOnError;
    property OnWarning: TErrorWarningEvent read FOnWarning write FOnWarning;
    property OnErrorWarningEx: TErrorWarningExEvent read FOnErrorWarningEx write FOnErrorWarningEx;
  end;

  TMacroFileSys = class(TInterfacedObject, IMacroFileSys)
  private
    FPreProcessor: TPreProcessor;
    function ExTestFilename(const Filename: string): Boolean;
  public
    constructor Create(PreProcessor: TPreProcessor);
   // IMacroFileSys
    procedure BeforeFile(const Filename: string; IsIncludeFile: Boolean);
    procedure AfterFile(const Filename, NewFilename: string; IsIncludeFile,
      Modified: Boolean);
    procedure LoadFile(const Filename: string; out Content: string;
      IsIncludeFile: Boolean);
    procedure SaveFile(const Filename: string; var NewFilename: string;
      const Content: string; IsIncludeFile: Boolean);
    function FindFile(const Filename: string; IsIncludeFile: Boolean): string;
    function FileExists(const Filename: string): Boolean;
    procedure LinesMoved(const Filename: string; LineNum, AddedLines: Integer);
  end;

  TNoVirtualFileSys = class(TInterfacedObject, IDppVirtualFileSys)
   // IDppVirtualFileSys
    procedure InitPreProcessorFileSys; virtual;
    function IsVirtualFile(const Filename: string): Boolean; virtual;
    procedure GetVirtualFileContent(const Filename: string; out Content: string); virtual;
    procedure SetVirtualFileContent(const Filename: string; const Content: string); virtual;
    procedure RestoreVirtualFileContent(const Filename: string; const BackupedContent: string); virtual;
    procedure AdjustLines(const Filename: string; LineNum, Count: Integer); virtual;
  end;

implementation
resourcestring
  SErrorMovingFile = 'Error moving file "%s" to "%s"';

{ TPreProcessor }

constructor TPreProcessor.Create(FileSys: IDppVirtualFileSys);
begin
  inherited Create;
  FPasFiles := TStringList.Create;
  FIncFiles := TStringList.Create;
  FFileInfos := TFileInfoList.Create;
  FVirtualFileList := TStringList.Create;
  FFilenameMapper := TFilenameMapper.Create;
  FFileSys := FileSys;

  FMacros := TMacros.Create(TMacroFileSys.Create(Self));
  FMacros.OnWarning := EvWarning;
  FMacros.OnError := EvError;
  FMacros.OnPredefineMacros := EvPredefineMacros;
  FMacros.OnDefaultConditionals := EvDefaultConditionals;

  FCompilePrepare := True;
  FParseOnlyOneFile := False;
  FConditionals := TStringList.Create;
  FConditionalParse := False;
  FCaseSensitive := True;
end;

destructor TPreProcessor.Destroy;
begin
  FConditionals.Free;
  FPasFiles.Free;
  FIncFiles.Free;
  FVirtualFileList.Free;
  FFileInfos.Free;
  FMacros.Free;
  FFilenameMapper.Free;
  FFileSys := nil;
  inherited Destroy;
end;

function TPreProcessor.BeginPreProcessing(const Filename: string): Boolean;
begin
  FProjectPath := ExtractFileDir(Filename);

  FPasFiles.Clear;
  FIncFiles.Clear;
  FFileInfos.Clear;
  FVirtualFileList.Clear;
  FFilenameMapper.Clear;

  FUnitPaths := FProjectPath + PathSep + FUnitPaths;
  FIncludePaths := FProjectPath + PathSep + FIncludePaths;

  FFileSys.InitPreProcessorFileSys;

  FMacros.ConditionalParse := FConditionalParse;
  FMacros.CaseSensitive := FCaseSensitive;

  Result := False;
  try
    Result := FMacros.Parse(Filename, FParseOnlyOneFile);
  finally
    if not Result then
      EndPreProcessing;
  end;
end;

procedure TPreProcessor.EndPreProcessing;
var
  i: Integer;
  dpp, BackupedContent: string;
begin
  try
    if FCompilePrepare then
    begin
      for i := 0 to FVirtualFileList.Count - 1 do
      begin
        try
          dpp := ChangeFileExt(FVirtualFileList.Strings[i], '.dpp');
          FileToString(dpp, BackupedContent);
          FFileSys.RestoreVirtualFileContent(FVirtualFileList.Strings[i], BackupedContent);
          DeleteFile(dpp);
        except
         // proceed on errors
        end;
      end;

     // restore .pas files (.dpp -> .pas)
      for i := 0 to FPasFiles.Count - 1 do
        MoveFile(ChangeFileExt(FPasFiles.Strings[i], '.dpp'), FPasFiles.Strings[i]);

     // delete .i1, .i2, ... files