The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

#  You may distribute under the terms of the GNU General Public License
#
#  (C) Paul Evans, 2010-2012 -- leonerd@leonerd.org.uk

use strict;
use warnings;

use Tickit::Async;
use Tickit::Term qw( BIND_FIRST );
use Tickit::Widget::Tabbed 0.005;
use Tickit::Widget::VBox;
use Tickit::Window 0.57;  # ->bind_event

use Net::Async::Tangence::Client 0.13; # ->connect_url returns Future

use Circle::FE::Term::Tab;
use Circle::FE::Term::Ribbon;

use IO::Async::Loop;

use Text::Balanced qw( extract_bracketed );
use Getopt::Long;

my $loop = IO::Async::Loop->new();

my $IDENTITY;

GetOptions(
   'identity|i=s' => \$IDENTITY,
   'help' => sub { usage(0) },
) or usage(1);

sub usage
{
   my ( $exitcode ) = @_;

   print { $exitcode ? \*STDERR : \*STDOUT } <<'EOF';
circle-fe-term [options...] [URL]

Options:

   --identity, -i IDENTITY   Use the given session identity for reconnection

URL should be one of:

   sshunix://host/path/to/socket
   sshexec://host/path/to/command?with+arguments
   exec:///path/to/command?with+arguments
   tcp://host:port/
   unix:///path/to/socket

EOF

   exit $exitcode;
}

my $URL = shift @ARGV or usage(1);

if( !defined $IDENTITY ) {
   my $hostname = `hostname -f`; chomp $hostname;
   $IDENTITY = $ENV{USER} . "@" . $hostname . "/Term";
}

my $client = Net::Async::Tangence::Client->new(
   identity => $IDENTITY,

   on_closed => sub {
      warn "Connection closed\n";
      exit(0);
   },

   on_error => sub { warn "Received MSG_ERROR: $_[0]\n"; },
);

$loop->add( $client );

my $rootobj = $client->connect_url( $URL )->get;

my $t = Tickit::Async->new;

$loop->add( $t );

# TODO: think about whether this can be extracted into some kind of Tickit::App::Plugin or somesuch?
my $esc_held;
my $esc_indicator_window =$t->rootwin->make_float( 0, 0, 1, 4 );
$esc_indicator_window->hide;
$esc_indicator_window->pen->chattr( rv => 1 );
$esc_indicator_window->bind_event( expose => sub {
   my ( $win, undef, $info ) = @_;
   $info->rb->text_at( 0, 0, "ESC-" );
} );
my $esc_timer = IO::Async::Timer::Countdown->new(
   delay => 3,
   on_expire => sub {
      $esc_held = 0;
      $esc_indicator_window->hide;
   },
);
$t->add_child( $esc_timer );

$t->term->bind_event( key => BIND_FIRST, sub {
   my ( $term, $ev, $info ) = @_;

   if( $esc_held ) {
      $esc_held = 0;
      $esc_indicator_window->hide;
      $esc_timer->stop;

      $term->emit_key(
         type => "key",
         str  => "M-" . $info->str,
         mod  => $info->mod | 2,  # TODO: ALT?
      );

      return 1;
   }

   if( $info->type eq "key" and $info->str eq "Escape" ) {
      $esc_held = 1;
      $esc_indicator_window->reposition( $t->rootwin->lines - 1, 0 );
      $esc_indicator_window->show;
      $esc_timer->start;

      return 1;
   }

   return 0;
} );
# End TODO

my $top_vbox = Tickit::Widget::VBox->new;

# TODO: Consider a menubar

my $tabbed = Tickit::Widget::Tabbed->new(
   tab_position => "bottom",
   pen_active   => Tickit::Pen->new( b => 1, u => 1 ),
   tab_class    => "Circle::FE::Term::Tab",
   ribbon_class => "Circle::FE::Term::Ribbon",
);

$t->bind_key( "C-n" => sub { $tabbed->next_tab } );
$t->bind_key( "C-p" => sub { $tabbed->prev_tab } );

$top_vbox->add( $tabbed, expand => 1 );

$t->set_root_widget( $top_vbox );

my $f = $rootobj->call_method(
   "get_session" => [ 'tabs' ],
)->then( sub {
   my ( $session ) = @_;

   $session->watch_property_with_initial( "tabs",
      on_set => sub {
         my ( $objarray ) = @_;

         foreach my $obj ( @$objarray ) {
            $tabbed->add_tab( Tickit::Widget::VBox->new, object => $obj );
         }
      },
      on_push => sub {
         my @new = @_;
         foreach my $obj ( @new ) {
            $tabbed->add_tab( Tickit::Widget::VBox->new, object => $obj );
         }
      },
      on_shift => sub {
         my ( $count ) = @_;
         $tabbed->remove_tab( 0 ) for 1 .. $count;
      },
      on_splice => sub {
         my ( $index, $count, @objs ) = @_;

         # $count times, remove the one at $index, as they'll shuffle down
         $tabbed->remove_tab( $index ) for 1 .. $count;

         # TODO: I have no idea wtf is going on here
         foreach my $i ( 0 .. $#objs ) {
            my $obj = $objs[$i];
            die "TODO: insert tab\n";
         }
      },
      on_move => sub {
         my ( $index, $delta ) = @_;

         $tabbed->move_tab( $index, $delta );
      },
   );
});
$t->adopt_future( $f );

$t->run;