source: trunk/Compiler/Producer.pas

unit Producer;

interface

uses
  SourceCodePascal, Classes, SysUtils, StrUtils, Generics.Collections, Process,
  FileUtil, Forms;

type

  TWriteTargetEvent = function (Name: string; const Code: string): Boolean of object;
  TStringEvent = procedure (Value: string) of object;

  { TProducer }

  TProducer = class
  private
    FOnProcessOutput: TStringEvent;
    FOnWriteTarget: TWriteTargetEvent;
  public
    Process: TProcess;
    TextSource: TStringList;
    IndentationLength: Integer;
    Indentation: Integer;
    CompilerPath: string;
    CompilerParameters: string;
    procedure Emit(AText: string);
    procedure EmitLn(AText: string = '');
    procedure AssignToStringList(Target: TStringList); virtual; abstract;
    procedure Produce(Module: TSourceModule); virtual; abstract;
    procedure ExternalExecute(CommandLine: string);
    constructor Create;
    destructor Destroy; override;
    property OnWriteTarget: TWriteTargetEvent read FOnWriteTarget write FOnWriteTarget;
    property OnProcessOutput: TStringEvent read FOnProcessOutput write FOnProcessOutput;
  end;

implementation

{ TProducer }

procedure TProducer.EmitLn(AText: string = '');
begin
  Emit(AText);
  TextSource.Add('');
end;

procedure TProducer.ExternalExecute(CommandLine: string);
var
  Buffer: string;
  Count: Integer;
  Text: string;
  Line: string;
begin
  if not FileExists(CompilerPath) then Exit;
  Text := '';
  try
    Process := TProcess.Create(nil);
    //if Path <> '' then
    //  Process.CurrentDirectory := Path;
    //Path := '';
    //if Environment <> '' then
    //  Process.Environment.Text := Environment;
    //Environment := '';
    Process.CommandLine := CommandLine;
    Process.Options := [poUsePipes, poNoConsole];
    Process.Execute;
    Application.ProcessMessages;
    while Process.Running or (Process.Output.NumBytesAvailable > 0) or
    (Process.Stderr.NumBytesAvailable > 0) do
    begin
      if Process.Output.NumBytesAvailable > 0 then begin
        SetLength(Buffer, 1000);
        Count := Process.Output.Read(Buffer[1], Length(Buffer));
        SetLength(Buffer, Count);
        Text := Text + Buffer;
        while Pos(LineEnding, Text) > 0 do begin
          Line := Copy(Text, 1, Pos(LineEnding, Text) - 1);
          Delete(Text, 1, Length(Line) + Length(LineEnding));
          if Assigned(FOnProcessOutput) then
            FOnProcessOutput(Line);
        end;
      end;

      if Process.Stderr.NumBytesAvailable > 0 then begin
        SetLength(Buffer, 1000);
        Count := Process.Stderr.Read(Buffer[1], Length(Buffer));
        SetLength(Buffer, Count);
        Text := Text + Buffer;
        while Pos(LineEnding, Text) > 0 do begin
          Line := Copy(Text, 1, Pos(LineEnding, Text) - 1);
          Delete(Text, 1, Length(Line) + Length(LineEnding));
          if Assigned(FOnProcessOutput) then
            FOnProcessOutput(Line);
        end;
      end;
      Sleep(10);
      Application.ProcessMessages;
    end;
  finally
    if Assigned(FOnProcessOutput) then
      FOnProcessOutput(Text);
    FreeAndNil(Process);
  end;
end;

constructor TProducer.Create;
begin
  TextSource := TStringList.Create;
  IndentationLength := 2;
  CompilerParameters := '%0:s';
end;

destructor TProducer.Destroy;
begin
  TextSource.Free;
  inherited Destroy;
end;

procedure TProducer.Emit(AText: string);
begin
  with TextSource do begin
    if Count = 0 then Add('');
    if Strings[Count - 1] = '' then
      Strings[Count - 1] := Strings[Count - 1] + DupeString(' ', IndentationLength * Indentation);
    Strings[Count - 1] := Strings[Count - 1] + AText;
  end;
end;

end.