unit chain;

{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}

interface

implementation
uses
      SysUtils, Forms, Process, UTF8Process,
      listcoll,base,base0,variabl,struct,express,
      helpctex,texthand,control,sconsts,statemen;


function ShellExec(s1,s2:string; opWaitFor:boolean):boolean;
var
   AProcess: TProcessUTF8;
begin
   result:=false;
   AProcess := TProcessUTF8.Create(nil);
   AProcess.CommandLine :=s1 + ' ' +s2;
   if opWaitFor then
     AProcess.Options := AProcess.Options + [poWaitOnExit];
   try
   try
      AProcess.Execute;
      result:=true;
   finally
      AProcess.Free;
   end;
   except
   end;
end;

type
  TEXECUTE=class(TStatement)
     exp1:TPrincipal;
     params:TListCollection;
     ChainSt:TStatement;
     opWaitFor:boolean;
     NoQuotes:boolean;
    constructor create(prev,eld:TStatement; opWaitFor0:boolean);
    //procedure exec;override;
    destructor destroy;override;
    function Code:ansistring;override;
  end;


constructor TEXECUTE.create(prev,eld:TStatement; opWaitFor0:boolean);
begin
    inherited create(prev,eld);
    opWaitFor:=opWaitFor0;
    if token='NOWAIT' then
                      begin opWaitFor:=false; gettoken end;
    exp1:=SExpression;
    params:=TListCollection.create;
    if token='WITH' then
       begin
          gettoken;
          check('(',IDH_CHAIN);
          repeat
             params.insert(article);
          until test(',')=false;
          check(')',IDH_CHAIN);

           if token=',' then   //Ver 7.6.1
             begin
               GetToken;
               if token='NOQUOTES' then
                  begin
                     gettoken;
                     NoQuotes:=true;
                  end;
             end;

       end;
end;

destructor TEXECUTE.destroy;
begin
   exp1.free;
   params.free;
   inherited destroy;
end;

function EXECUTEst(prev,eld:TStatement):TStatement;
begin
    EXECUTEst:=TEXECUTE.CREATE(prev,eld, true);
end;

type
    TCHAIN=class(TEXECUTE)
      constructor create(prev,eld:TStatement);
      //procedure exec;override;
    end;

function CHAINst(prev,eld:TStatement):TStatement;
begin
    CHAINst:=TCHAIN.CREATE(prev,eld);
end;

constructor TCHAIN.create(prev,eld:TStatement);
begin
   inherited create(prev,eld,false);
   Chainst:=STOPst(nil,nil);
end;
(*
procedure TCHAIN.exec;
begin
   inherited exec ;
   raise EParStop.create;
end;
*)
function TExecute.Code:ansistring;
var
  i:integer;
  s2:string;
  s:string;
begin
  s2:='';
  with  params do
  for i:=0 to Count-1 do
    begin
       if i>0 then s2:=s2+',';
       if NoQuotes or (TPrincipal(items[i]).kind='n') then
         s2:=s2+TPrincipal(items[i]).code
       else
         //s2:=s2+'''"''+'+TPrincipal(items[i]).code+'+''"''';
         begin
           s:=TPrincipal(items[i]).code;
           if pos(' ', s)>0 then
             s:='''"''+'+s+'+''"''';
           s2:=s2+s;
         end;

    end;
  result:='ShellExec('+exp1.code+',['+s2+']'+','+TruthLiteral(opWaitfor) +');';
  if chainst<>nil  then
    result:=result+EOL+Chainst.code;
end;

type
  TPlay=Class(TExecute)
    function code:ansistring;override;
  end;

  function TPlay.code:ansistring;
  begin
     result:='Play(' + exp1.code + ',' +  TruthLiteral(opWaitfor) +');';
  end;

function PLAYst(prev,eld:TStatement):TStatement;
begin
    PLAYst:=TPlay.CREATE(prev,eld,true);
end;


{*********}
{PLAYSOUND}
{*********}
{$IFDEF WINDOWS}
type
  TPlaySound=class(TStatement)
     exp1:TPrincipal;
     Async:boolean;
    constructor create(prev,eld:TStatement);
    destructor destroy;override;
    function Code:ansistring;override;
  end;

constructor TPlaySound.create(prev,eld:TStatement);
begin
  inherited create(prev, eld);
  exp1:=SExpression;
  if test(',') then
     begin
        CheckToken('ASYNC',IDH_EXTENSION_MS);
        Async:=true
     end;
end;

destructor TPlaySound.destroy;
begin
   exp1.Free;
   inherited destroy;
end;


function TPlaySound.Code:ansistring;
begin
   result:='PlaySound('+ exp1.code +',' +TruthLiteral(async) +');'
end;

function PLAYSOUNDst(prev,eld:TStatement):TStatement;
begin
    PLAYSoundst:=TPLAYSOUND.CREATE(prev,eld);
end;
{$ENDIF}

{*************}
{registeration}
{*************}

procedure statementTableinit;
begin
   StatementTableInitImperative('CHAIN',CHAINst);
   StatementTableInitImperative('EXECUTE',EXECUTEst);
{$IFDEF WINDOWS}
   StatementTableInitImperative('PLAY',PLAYst);
   StatementTableInitImperative('PLAYSOUND',PLAYSOUNDst);
   //StatementTableInitImperative('ASSOC',ASSOCPRINTst);
{$ENDIF}
end;

procedure functiontableInit;
begin
end;


begin
   tableInitProcs.accept(statementTableinit);
   tableInitProcs.accept(FunctionTableInit);
end.
