unit U_ScriptHost;

////////////////////////////////////////////////////////////////////////////////
interface
uses
  U_LogEmitter, RegExpr,
  U_ZBarPoller, U_ScriptManager;

type
  TPropertyEvent = procedure(Sender: TObject; PropertyName: string;
                              Values: array of const) of object;

  TScriptHost = class(TLogEmitter)
    private
      FPoller: TZBarPoller;
      FManager: TScriptManager;
      FCommandRE: TRegExpr;
      FBuiltInCmdRE: TRegExpr;

      FOnPropertyChanged: TPropertyEvent;

      procedure RaisePropertyChanged(Sender: TObject; PropertyName: string; Values: array of const);

      procedure SetEnabled(Value: boolean);
      function  GetEnabled: boolean;
      function  GetPoller: TZBarPoller;
      function  GetScriptManager: TScriptManager;

      procedure ProcessPamphlet(Sender: TObject);
    public
      constructor Create(Path: string);
      destructor  Destroy; override;

      procedure WriteToLog(Text: string; LogLevel: TLogLevel = llInfo;
                            IndentLevel: integer = 0); override;

      property Enabled: boolean                   read GetEnabled         write SetEnabled;
      property Poller: TZBarPoller                read GetPoller;
      property ScriptManager: TScriptManager      read GetScriptManager;

      property OnPropertyChanged: TPropertyEvent  read FOnPropertyChanged write FOnPropertyChanged;
      property OnLog;
  end;

var
  ScriptHost: TScriptHost;

////////////////////////////////////////////////////////////////////////////////
implementation

uses
  SysUtils, ComObj, Variants, Windows,
  L_StringUtils, L_ScriptingUtils,
  U_Globals, U_Script;


{ ============================================================================ }
{ TScriptHost }

{ ---------------------------------------------------------------------------- }
constructor TScriptHost.Create(Path: string);
begin
  ScriptHost := Self;

  CoInitializeEx(nil, 0);
  U_Globals.FSO := CreateOleObject('Scripting.FileSystemObject');

  FPoller := TZBarPoller.Create;
  FPoller.OnLog := TransferLog;
  FPoller.OnPamphlet := ProcessPamphlet;

  U_Globals.ZBar := FPoller.Zbar;


  FManager := TScriptManager.Create(Path, FPoller.ZBar);
  FManager.OnLog := TransferLog;
end;
{ ---------------------------------------------------------------------------- }
destructor TScriptHost.Destroy;
begin
  if Assigned(FPoller) then begin
    FPoller.Enabled := False;
    FreeAndNil(FManager);
    FreeAndNil(FPoller);
  end;

  inherited;
end;

{ ---------------------------------------------------------------------------- }
procedure TScriptHost.SetEnabled(Value: boolean);
begin
  if Value and (FManager.Count = 0) then begin
    FManager.Refresh;
  end;
  FPoller.Enabled := Value;
end;
{ ---------------------------------------------------------------------------- }
function TScriptHost.GetEnabled: boolean;
begin
  Result := FPoller.Enabled;
end;

{ ---------------------------------------------------------------------------- }
function TScriptHost.GetPoller: TZBarPoller;
begin
  Result := FPoller;
end;

{ ---------------------------------------------------------------------------- }
function TScriptHost.GetScriptManager: TScriptManager;
begin
  Result := FManager;
end;

{ ---------------------------------------------------------------------------- }
procedure TScriptHost.ProcessPamphlet(Sender: TObject);
var
  ZBar: OleVariant;
  Skip: boolean;
  Command, Language: string;
  BuiltinCmd: integer;
  Engine, ReturnValue: OleVariant;
  Script: TScript;
  i: Integer;
  Msg: string;
begin
  ZBar := TZBarPoller(Sender).ZBar;

  RaisePropertyChanged(Self, 'ZBar.SequenceNumber', [ZBar]);

  Skip := False;

  if U_Globals.FSO.FolderExists(ZBar.NewFilename) then begin
    U_Globals.ThisFile := FSO.GetFolder(ZBar.NewFilename);
  end else if FSO.FileExists(ZBar.NewFilename) then begin
    U_Globals.ThisFile := FSO.GetFile(ZBar.NewFilename);
  end else begin
    U_Globals.ThisFile := Null;
  end;
  if U_Globals.FSO.FolderExists(ZBar.OtherFilename) then begin
    U_Globals.OtherFile := FSO.GetFolder(ZBar.OtherFilename);
  end else if FSO.FileExists(ZBar.OtherFilename) then begin
    U_Globals.OtherFile := FSO.GetFile(ZBar.OtherFilename);
  end else begin
    U_Globals.OtherFile := Null;
  end;

  // Check for Assist commands starting with 's'
  if (ZBar.ZTreeCommand = Ord('Y')) and (Copy(ZBar.AssistCommand, 1, 1) = 's') then begin
    // Check for one of the Assist commands (starting with 'eval', 'exec', or 'echo').
    Command := Copy(ZBar.AssistCommand, 2);
    WriteToLog(Format('Processing command line "%s"...', [Command]));
    if not Assigned(FCommandRE) then begin
      FCommandRE := TRegExpr.Create;
      FCommandRE.Expression := '^(\w+)';
      FCommandRE.Compile;
    end;
    if FCommandRE.Exec(Command) then begin
      BuiltinCmd := IndexOfString(FCommandRE.Match[1], ['tag', 'untag', 'eval', 'exec']);
      WriteToLog(Format('Command "%s" (built-in: %d)', [Command, BuiltInCmd]), llInfo, 1);
      if BuiltinCmd > -1 then begin
        if not Assigned(FBuiltInCmdRE) then begin
          FBuiltInCmdRE := TRegExpr.Create;
          FBuiltInCmdRE.Expression := '^\w+(\s*\.\w*|\s+\w)\s+(.*)$';
          FBuiltInCmdRE.Compile;
        end;
        // parse command, language, and code
        if FBuiltInCmdRE.Exec(Command) then begin
          Language := TrimLeft(FBuiltInCmdRE.Match[1]);
          if Language = '.' then begin
            Language := 'JScript'; // TODO: retrieve default language from settings
          end else if Copy(Language, 1, 1) = '.' then begin
            Language := ScriptLanguageFromExtension(Language);
          end;
          WriteToLog(Format('Language "%s", Code "%s"', [Language, FBuiltInCmdRE.Match[2]]), llInfo, 1);

          // Prepare a script host for the given language
          Engine := FManager.GetEngine(Language, False);
          try
            Engine.AddObject('zbar', U_Globals.ZBar, False);
            Engine.AddObject('File', U_Globals.ThisFile, False);
            Engine.AddObject('OtherFile', U_Globals.OtherFile, False);
            case BuiltinCmd of
              0..1: begin // tag, untag
                ReturnValue := Engine.Eval(FBuiltInCmdRE.Match[2]);
                WriteToLog(Format('%s >>> [%s] %s',
                                  [Command, VarTypeAsText(VarType(ReturnValue)), VarToStrDef(ReturnValue, '')]));
                FPoller.InterpretScriptResult(ReturnValue, True, BuiltinCmd = 1);
              end;
              2: begin // eval
                ReturnValue := Engine.Eval(FBuiltInCmdRE.Match[2]);
                ZBar.WriteZBarError(Ord('s'), Copy(VarToStr(ReturnValue), 1, 72));
                WriteToLog(Format('%s >>> [%s] %s',
                                  [Command, VarTypeAsText(VarType(ReturnValue)), VarToStrDef(ReturnValue, '')]));
              end;
              3: begin // exec
                Engine.ExecuteStatement(FBuiltInCmdRE.Match[2]);
              end;
            end;
          except
            on E: Exception do begin
              if Engine.Error.Number <> 0 then begin
                Msg := Format('(%d,%d) %s - %s (%d)', [Engine.Error.Line, Engine.Error.Column, Engine.Error.Description, Engine.Error.Source, Engine.Error.Number]);
                WriteToLog(Msg);
                ZBar.WriteZBarError(Ord('e'), Copy(Msg, 1, 72));
              end else begin
                WriteToLog(Format('%s: %s', [E.ClassName, E.Message]));
                ZBar.WriteZBarError(Ord('e'), Copy(E.Message, 1, 72));
              end;
            end;
          end{try..except};
        end else begin
          Msg := Format('Expected: %s <lang> <code> (syntax error)', [FCommandRE.Match[1]]);
          ZBar.WriteZBarError(Ord('s'), Msg);
        end{if match regex};
        Skip := True;

      end else begin

        // Get the script that handles this command
        Script := FManager.GetScriptForCommand(FCommandRE.Match[1]);
        if Assigned(Script) then begin
          if Script.Enabled = False then begin
            WriteToLog(Format('Script %s is disabled.', [Script.Name]), llWarning, 2);
            ZBar.WriteZBar(Ord('k'));
          end else begin
            // Have the script execute this command
            try
              ReturnValue := Script.DoCommand(Command);
              WriteToLog(Format('%s: %s (%s) >>> [%s] %s',
                                [Script.Name, Command, ZBar.NewFilename,
                                 VarTypeAsText(VarType(ReturnValue)), VarToStrDef(ReturnValue, '')]));
              FPoller.InterpretScriptResult(ReturnValue, True);
            except
              on E: Exception do begin
                if Script.Engine.Error.Number <> 0 then begin
                  Msg := Format('(%d,%d) %s - %s (%d)',
                                [integer(Script.Engine.Error.Line),
                                integer(Script.Engine.Error.Column),
                                Script.Engine.Error.Description,
                                Script.Engine.Error.Source,
                                integer(Script.Engine.Error.Number)]);
                  WriteToLog(Msg);
                  ZBar.WriteZBarError(Ord('e'), Copy(Msg, 1, 72));
                end else begin
                  WriteToLog(Format('%s: %s', [E.ClassName, E.Message]));
                  ZBar.WriteZBarError(Ord('e'), Copy(E.Message, 1, 72));
                end;
              end;
            end;
          end;
        end else begin
          ZBar.WriteZBar(Ord('k'));
        end{if Assigned(Script)};
        Skip := True;

      end;
    end else begin

      MessageBeep(MB_ICONERROR);
      WriteToLog(Format('Command not recognized: "%s"', [Command]));

    end{if command matches /^(\w+)/};
  end{if Y or Ctrl-Y};

  // Check for keypresses, and pass them to any script that's registered for them
  if (not Skip) and ((ZBar.ZTreeCommand = Ord('^')) or (ZBar.ZTreeCommand = Ord('~'))) then begin
    for i := 0 to FManager.Count - 1 do begin
      Script := FManager.Script[i];
      if Script.Enabled and Script.HandlesKeyPress(ZBar.ZtreeCommandChar, ZBar.ZTreeCommand = Ord('~')) then begin
        try
          FManager.Script[i].DoKeyPress(ZBar.ZtreeCommandChar, ZBar.ZTreeCommand = Ord('~'));
        except
          on E: Exception do begin
            MessageBeep(MB_ICONWARNING);
            WriteToLog(Format('%s: %s', [E.ClassName, E.Message]));
          end;
        end;
      end;
    end;
  end;

  // Send updates to all scripts handling them
  if (not Skip) then begin
    for i := 0 to FManager.Count - 1 do begin
      Script := FManager.Script[i];
      if Script.Enabled and Script.HandlesUpdate then begin
        try
          FManager.Script[i].DoUpdate(ZBar);
        except
          on E: Exception do begin
            MessageBeep(MB_ICONWARNING);
            WriteToLog(Format('%s: %s', [E.ClassName, E.Message]));
          end;
        end;
      end;
    end;
  end;
end;

{ ---------------------------------------------------------------------------- }
procedure TScriptHost.RaisePropertyChanged(Sender: TObject;
  PropertyName: string; Values: array of const);
begin
  if Assigned(FOnPropertyChanged) then begin
    FOnPropertyChanged(Sender, PropertyName, Values);
  end;
end;

{ ---------------------------------------------------------------------------- }
procedure TScriptHost.WriteToLog(Text: string; LogLevel: TLogLevel;
  IndentLevel: integer);
begin
  inherited;
end;


////////////////////////////////////////////////////////////////////////////////
initialization

////////////////////////////////////////////////////////////////////////////////
finalization
  if Assigned(ScriptHost) then begin
    FreeAndNil(ScriptHost);
  end;

end.
