unit Browser;

(*
modified
  [ap-list:0665] by KUMAGAI Hidetake
*)

interface

uses
  Windows, Messages, ShellAPI,
  SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
  ExtCtrls, ComCtrls, Menus, FileCtrl;

const
  APM_BASE      = $8500;
  APM_QUICK_RUN = APM_BASE + 1;

type
  TFormBrowser = class(TForm)
    StatusBar: TStatusBar;
    Memo1: TMemo;
    OpenDialog: TOpenDialog;
    Panel1: TPanel;
    EditPath: TEdit;
    btnExec: TButton;
    btnOpen: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnExecClick(Sender: TObject);
    procedure btnOpenClick(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure Memo1Click(Sender: TObject);
  private
    FReadError: Boolean;
    FScriptDir: string;
    FQuickMode: Boolean;
    procedure SetEditPath(Path: string);
    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DropFiles;
    procedure doExec(Sender: TObject);
    procedure ApmQuickRun(var Msg: TMessage); message APM_QUICK_RUN;
    function GetScriptPath: string;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    procedure JumpError;
    procedure LoadScript;
    procedure ThreadDone(Sender: TObject);
  end;

var
  FormBrowser: TFormBrowser;
  InExecCustom: Boolean = False;

implementation

uses
  Rubies,
{$IFDEF PHIEMBED}
  PhiMainUnit, uHandle, uError,
{$ELSE}
  Pythia,
{$ENDIF}
  uStrUtils, uAppInit,
  Console, Resource;

{$R *.dfm}

var
  age: Integer;

procedure ShowInfoFmt(const Msg: string; Params: array of const);
begin
  if not InExecCustom then
    ShowMessageFmt(Msg, Params);
end;

procedure init;
begin
//  PhiExport('Apollo');
end;

procedure TFormBrowser.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.ExStyle := Params.EXStyle or WS_EX_ACCEPTFILES;
end;

procedure TFormBrowser.SetEditPath(Path: string);
begin
  if Pos(' ', Path) <> 0 then
    EditPath.Text := AnsiQuotedStr(Path, '"')
  else
    EditPath.Text := Path;
end;

procedure TFormBrowser.WMDropFiles(var msg: TWMDropFiles);
var
  Path: array[0..MAX_PATH] of Char;
begin
  DragQueryFile(msg.Drop, 0, Path, SizeOf(Path));
  SetEditPath(Path);
  DragFinish(msg.Drop);
  LoadScript;
end;

procedure TFormBrowser.FormCreate(Sender: TObject);
begin
  PhiAppInit;
  PhiSetStdoutProc(Stdout);
  PhiSetGetsFunc(gets);
  PhiSetGetcFunc(getc);
  PhiSetInitProc(init);
end;

procedure TFormBrowser.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  PhiTerminate;
  ruby_finalize; // [ap-dev:0724]
end;

procedure TFormBrowser.ThreadDone(Sender: TObject);
begin
  if Application.Terminated then exit;
  StatusBar.SimpleText := sReady;
  btnExec.Caption := sExecute;
end;
(*
procedure ProcessOptions(Line: string);
var
  argc, i: Integer;
  args: array of string;
  argv: array of PChar;
begin
  argc := ParamCount1(PChar(Line));
  SetLength(args, argc);
  SetLength(argv, argc);
  for i := 0 to argc-1 do
  begin
    args[i] := ParamStr1(PChar(Line), i+1);
    argv[i] := PChar(args[i]);
  end;
//  ruby_prog_init;
//  ruby_process_options(argc, argv);
//  ruby_options(argc, argv);
end;
*)
procedure ProcessOptions(Line: string);
var
  argc, i: Integer;
  S: string;
begin
  argc := ParamCount1(PChar(Line));
  for i := 0 to argc-1 do
  begin
    S := ParamStr1(PChar(Line), i+1);
    if S[1] = '-' then
    begin
      if Length(S) = 1 then Continue;
      case S[2] of
      'K': if Length(S) >= 3 then rb_set_kcode(@S[3]);
      end;
    end;
  end;
end;

procedure CommentOptions(Lines: TStrings);
const
  EXC = '#!';
  PROGNAME = 'ruby';
var
  S: string;
  n: Integer;
begin
  if Lines.Count = 0 then Exit;
  S := Lines[0];
  if Pos(EXC, S) = 0 then Exit;
  n := Pos(PROGNAME, S);
  if n = 0 then Exit;
  S := Copy(S, n, Length(S));
  if Length(S) = Length(PROGNAME) then Exit;
  case S[Length(PROGNAME)+1] of
  #9, ' ':
    ProcessOptions(S);
  end;
end;

//	return full path, not quoted path
//	do not add data
function TFormBrowser.GetScriptPath: string;
var
  FScriptPath : string;
  FOldEditText: string;
begin
  result := FScriptPath;
  if FOldEditText = EditPath.text then exit;
  if FScriptDir <> '' then ChDir(FScriptDir);
  result := StringReplace(EditPath.Text, '\', '/', [rfReplaceAll]);
  result := ParamStr1(PChar(result),0);
  result := ExpandFileName(result);
  FOldEditText := EditPath.text;
  FScriptPath  := result;
end;

procedure TFormBrowser.LoadScript;
var
  str: string;
begin
  try
    str := GetScriptPath;
    FReadError := False;
    try
      Memo1.Lines.LoadFromFile(str);
      CommentOptions(Memo1.Lines);

      age := FileAge(str);

      SetEditPath(ExtractFileName(str));
      FScriptDir := ExtractFileDir(ExpandFileName(str));
      ChDir(FScriptDir);
    except
      FReadError := True;
      ShowInfoFmt(fmt_cannot_read, [str]);
    end;

    if PhiAlive then
      btnExec.Caption := sTerminate
    else
      btnExec.Caption := sExecute;
  except
    on E: Exception do
      StatusBar.SimpleText := Format('%s(code %d)', [E.Message, E.HelpContext]);
  end;
end;

procedure TFormBrowser.btnOpenClick(Sender: TObject);
begin
  OpenDialog.FileName := GetScriptPath;
  if OpenDialog.Execute then
  begin
    SetEditPath(OpenDialog.FileName);
    LoadScript;
    if FReadError then btnExec.Caption := sSave;
  end;
  PhiGetHandle.NotifyOnClick(Sender);
end;

procedure TFormBrowser.JumpError;
begin
  try
    SetEditPath(PhiErrorFile);
    LoadScript;
    Memo1.SelStart := Memo1.Perform(EM_LINEINDEX, PhiErrorLine-1, 0);
    Memo1.SelLength := 0;
    Show;
    FocusControl(Memo1);
  except
    on E: Exception do;
  end;
end;

procedure TFormBrowser.ApmQuickRun(var Msg: TMessage);
begin
  FQuickMode := True;
  doExec(nil);
end;

procedure TFormBrowser.doExec(Sender: TObject);
var
  script: string;
  argc, i: Integer;
  str: string;
  args: array of string;
  argv: array of PChar;
  OldCount: Integer;
begin
  argv := nil;

  chdir(FScriptDir);
  script := StringReplace(EditPath.Text, '\', '/', [rfReplaceAll]);

  argc := ParamCount1(PChar(script));
  SetLength(args, argc);
  SetLength(argv, argc);
  for i := 0 to argc-1 do
  begin
    args[i] := ParamStr1(PChar(script), i+1);
    argv[i] := PChar(args[i]);
  end;
  ruby_set_argv(argc, argv);

  str := GetScriptPath;
  btnExec.Caption := sTerminate;
  StatusBar.SimpleText := sRunning;
  OldCount := FormConsole.Memo1.Lines.Count;
  PhiLoadProtect(PChar(ExpandFileName(str)), ThreadDone);
  if PhiErrorLine = -1 then
  begin
    if FormConsole.ShowOnOutput 
    and (OldCount <> FormConsole.Memo1.Lines.Count)
    then
      FormConsole.Show
    else if FQuickMode
    then
      Application.MainForm.Close
    else
      FormConsole.Show
  end
  else
  begin
    if FQuickMode then
    begin
      FQuickMode := False;
      FormConsole.Show;
      FormBrowser.Show;
    end;
    JumpError;
  end;
end;

procedure TFormBrowser.btnExecClick(Sender: TObject);
var
  str: string;
begin
  if Memo1.Modified then
  begin
    str := GetScriptPath;
    try
      Memo1.Lines.SaveToFile(str);
      CommentOptions(Memo1.Lines);
    except
      ShowInfoFmt(fmt_cannot_save, [str]);
    end;
    Memo1.Modified := False;
    age := FileAge(str);
    if PhiAlive then
      btnExec.Caption := sTerminate
    else
      btnExec.Caption := sExecute;
  end
  else
  if PhiAlive then
  begin
    PhiTerminate;
    rb_interrupt;
  end
  else
  begin
    doExec(Sender);
  end;
end;

procedure TFormBrowser.Memo1Change(Sender: TObject);
begin
  btnExec.Caption := sSave;
end;

procedure TFormBrowser.Memo1Click(Sender: TObject);
var
  str: string;
  cur: Integer;
begin
  if InExecCustom then Exit;
  str := GetScriptPath;
  cur := FileAge(str);
  if age < cur then
    if MessageDlg(Format(fmt_modified, [str]),
      mtConfirmation, [mbYes, mbNo], 0) = mrYes then
      LoadScript
    else
    begin
      Memo1.Modified := True;
      btnExec.Caption := sSave;
    end;
  Abort;
end;

end.
