tabbed_new

#! perl

sub refresh {
    my ($self) = @_;

    my $ncol = $self->ncol;

    my $text = ' ' x $ncol;
    my $rend = [($self->{rs_tabbar}) x $ncol];

    my @ofs;
    my $ofs = 0;
    my $idx = 0;

    for my $tab (@{ $self->{tabs} }) {
        my $is_rename = defined $self->{tab_rename_started} && $self->{tab_rename_started} && $tab == $self->{cur};

        my $txt = '  '.($tab->{manual_name} || $tab->{name}).'  ';
        if ($is_rename) {
            $txt  = '  '.$tab->{tab_new_name}.'  ';
            $txt .= ' ' if $tab->{tab_new_pos} == length($tab->{tab_new_name});
        }
        my $len = length($txt);

        unless ($idx++) {
            # first tab
            substr $text, $ofs, $len, $txt;
            if ($is_rename) {
                @$rend[$ofs .. $ofs + $len - 1] = ($self->{rs_tab}) x $len;
                @$rend[$ofs + $tab->{tab_new_pos} + 2] = $self->{rs_rename};
            } elsif ($tab == $self->{cur}) {
                @$rend[$ofs .. $ofs + $len - 1] = ($self->{rs_tab}) x $len;
            } elsif ($tab->{activity} && $tab != $self->{cur}) {
                @$rend[$ofs .. $ofs + $len - 1] = ($self->{rs_tabsel}) x $len;
            }
            push @ofs, [ $ofs, $ofs + $len, sub { $_[0]->make_current($tab) } ];
            $ofs += $len;
        } else {
            # other tabs
            substr $text, $ofs, $len + 1, '|'.$txt;
            @$rend[$ofs] = $self->{rs_tabdiv};
            if ($tab == $self->{cur}) {
                @$rend[$ofs + 1 .. $ofs + $len] = ($self->{rs_tab}) x $len;
            } elsif ($tab->{activity} && $tab != $self->{cur}) {
                @$rend[$ofs + 1 .. $ofs + $len] = ($self->{rs_tabsel}) x $len;
            }
            push @ofs, [ $ofs + 1, $ofs + $len + 1, sub { $_[0]->make_current($tab) } ];
            $ofs += $len + 1;
        }
    }

    $self->{tabofs} = \@ofs;
    $self->ROW_t(0, $text, 0, 0, $ncol);
    $self->ROW_r(0, $rend, 0, 0, $ncol);
    $self->want_refresh;
}

sub new_tab {
    my ($self, @argv) = @_;

    my $offset = $self->fheight;

    # save a backlink to us, make sure tabbed is inactive
    push @urxvt::TERM_INIT, sub {
        my ($term) = @_;
        $term->{parent} = $self;
        for (0 .. urxvt::NUM_RESOURCES - 1) {
            my $value = $self->{resource}[$_];
            $term->resource("+$_" => $value) if defined $value;
        }
        $term->resource(perl_ext_2 => $term->resource("perl_ext_2") . ",-tabbed_new");
    };

    push @urxvt::TERM_EXT, urxvt::ext::tabbed_new::tab::;

    my $term = new urxvt::term $self->env, $urxvt::RXVTNAME, -embed => $self->parent, @argv,;
}

sub configure {
    my ($self) = @_;

    my $tab = $self->{cur};

    # this is an extremely dirty way to force a configurenotify, but who cares
    $tab->XMoveResizeWindow($tab->parent, 0, $self->{tabheight} + 1, $self->width, $self->height - $self->{tabheight});
    $tab->XMoveResizeWindow($tab->parent, 0, $self->{tabheight},     $self->width, $self->height - $self->{tabheight});
}

sub on_resize_all_windows {
    my ($self, $width, $height) = @_;
    1;
}

sub copy_properties {
    my ($self) = @_;
    my $tab = $self->{cur};

    my $wm_normal_hints = $self->XInternAtom("WM_NORMAL_HINTS");

    my $current = delete $self->{current_properties};

    # pass 1: copy over properties different or nonexisting
    for my $atom ($tab->XListProperties($tab->parent)) {
        my ($type, $format, $items) = $self->XGetWindowProperty($tab->parent, $atom);

        # fix up size hints
        if ($atom == $wm_normal_hints) {
            my (@hints) = unpack "l!*", $items;

            $hints[$_] += $self->{tabheight} for (4, 6, 16);

            $items = pack "l!*", @hints;
        }

        my $cur = delete $current->{$atom};

        # update if changed, we assume empty items and zero type and format will not happen
        $self->XChangeProperty($self->parent, $atom, $type, $format, $items)
        if $cur->[0] != $type or $cur->[1] != $format or $cur->[2] ne $items;

        $self->{current_properties}{$atom} = [$type, $format, $items];
    }

    # pass 2, delete all extraneous properties
    $self->XDeleteProperty($self->parent, $_) for keys %$current;
}

sub make_current {
    my ($self, $tab) = @_;

    if (my $cur = $self->{cur}) {
        delete $cur->{activity};
        $cur->XUnmapWindow($cur->parent) if $cur->mapped;
        $cur->focus_out;
    }

    $self->{cur} = $tab;
    $self->configure;
    $self->copy_properties;
    $tab->focus_out; # just in case, should be a nop
    $tab->focus_in if $self->focus;
    $tab->XMapWindow($tab->parent);
    delete $tab->{activity};
    $self->refresh;
    ();
}

sub on_focus_in {
    my ($self, $event) = @_;
    $self->{cur}->focus_in;
    ();
}

sub on_focus_out {
    my ($self, $event) = @_;
    $self->{cur}->focus_out;
    ();
}

sub on_key_press {
    my ($self, $event) = @_;
    $self->{cur}->key_press($event->{state}, $event->{keycode}, $event->{time});
    1;
}

sub on_key_release {
    my ($self, $event) = @_;
    $self->{cur}->key_release($event->{state}, $event->{keycode}, $event->{time});
    1;
}

sub on_button_press {
    1;
}

sub on_button_release {
    my ($self, $event) = @_;
    if ($event->{row} == 0) {
        for my $button (@{ $self->{tabofs} }) {
            $button->[2]->($self, $event) if $event->{col} >= $button->[0] && $event->{col} < $button->[1];
        }
    }
    1;
}

sub on_motion_notify {
    1;
}

sub on_init {
    my ($self) = @_;

    $self->{resource} = [map $self->resource("+$_"), 0 .. urxvt::NUM_RESOURCES - 1];

    $self->resource(int_bwidth => 0);
    $self->resource(name => "URxvt.tabbed_new");
    $self->resource(pty_fd => -1);

    $self->option($urxvt::OPTION{scrollBar}, 0);

    my $renamebg = $self->x_resource("tabren-bg");
    my $divfg    = $self->x_resource("tabdiv-fg");
    my $fg       = $self->x_resource("tabbar-fg");
    my $bg       = $self->x_resource("tabbar-bg");
    my $selfg    = $self->x_resource("tabsel-fg");
    my $selbg    = $self->x_resource("tabsel-bg");
    my $tabfg    = $self->x_resource("tab-fg");
    my $tabbg    = $self->x_resource("tab-bg");

    defined $renamebg or $renamebg = 11;
    defined $divfg    or $divfg = 8;
    defined $fg       or $fg    = 0;
    defined $bg       or $bg    = 15;
    defined $tabfg    or $tabfg = 1;
    defined $tabbg    or $tabbg = 15;
    defined $selfg    or $selfg = 0;
    defined $selbg    or $selbg = 7;

    $self->{rs_tabbar} = urxvt::SET_COLOR(urxvt::DEFAULT_RSTYLE, $fg    + 2, $bg    + 2);
    $self->{rs_tabdiv} = urxvt::SET_COLOR(urxvt::DEFAULT_RSTYLE, $divfg + 2, $bg    + 2);
    $self->{rs_tabsel} = urxvt::SET_COLOR(urxvt::DEFAULT_RSTYLE, $selfg + 2, $selbg + 2);
    $self->{rs_tab}    = urxvt::SET_COLOR(urxvt::DEFAULT_RSTYLE, $tabfg + 2, $tabbg + 2);
    
    $self->{rs_rename} = urxvt::SET_COLOR(urxvt::DEFAULT_RSTYLE, $selfg + 2, $renamebg + 2);

    ();
}

sub on_start {
    my ($self) = @_;

    $self->{tabheight} = $self->int_bwidth + $self->fheight + $self->lineSpace;
    $self->cmd_parse("\033[?25l");
    my @argv = $self->argv;

    do { shift @argv; } while @argv && $argv[0] ne "-e";
    $self->new_tab(@argv);
    ();
}

sub on_configure_notify {
    my ($self, $event) = @_;
    $self->configure;
    $self->refresh;
    ();
}

sub on_wm_delete_window {
    my ($self) = @_;
    $_->destroy for @{ $self->{tabs} };
    1;
}

sub tab_name {
    my ($self, $name) = @_;

    return unless $name =~ /\@/;
    my $tab = $self->{cur};
    $tab->{name} = $name;
    $self->refresh;
    1;
}

sub tab_start {
    my ($self, $tab) = @_;
    $tab->XChangeInput($tab->parent, urxvt::PropertyChangeMask);
    push @{ $self->{tabs} }, $tab;
    $tab->{name} ||= 'tab '.scalar @{ $self->{tabs} };
    $tab->{manual_name} = undef;
    $self->make_current($tab);
    ();
}

sub tab_destroy {
    my ($self, $tab) = @_;
    $self->{tabs} = [ grep $_ != $tab, @{ $self->{tabs} } ];
    if (@{ $self->{tabs} }) {
        if ($self->{cur} == $tab) {
            delete $self->{cur};
            $self->make_current($self->{tabs}[-1]);
        } else {
            $self->refresh;
        }
    } else {
        # delay destruction a tiny bit
        $self->{destroy} = urxvt::iw->new->start->cb(sub { $self->destroy });
    }
    ();
}

sub tab_key_press {
    my ($self, $tab, $event, $keysum, $str) = @_;
    my $action;

    if ($event->{state} & urxvt::Mod4Mask) {
        if ($event->{state} & urxvt::ControlMask) {
            $action = 'move-left'    if $keysum == 0xff51;  # Mod4+Ctrl+Left
            $action = 'move-right'   if $keysum == 0xff53;  # Mod4+Ctrl+Right
        } else {
            $action = 'prev-tab'     if $keysum == 0xff51;  # Mod4+Left
            $action = 'next-tab'     if $keysum == 0xff53;  # Mod4+Right
            $action = 'new-tab'      if $keysum == 0x74;    # Mod4+T
            $action = 'rename-start' if $keysum == 0x6e;    # Mod4+N
        }
    } elsif ($event->{state} & urxvt::ControlMask) {
        $action = 'next-tab'         if $keysum == 0xff09;  # Ctrl+Tab
    } elsif (defined $self->{tab_rename_started} && $self->{tab_rename_started}) {
        if ($keysum == 0xff1b) {                            # Esc
            $action = 'cancel-rename';
        } elsif ($keysum == 0xff0d || $keysum == 0xff8d) {  # Enter
            $action = 'confirm-rename';
        } elsif ($keysum == 0xff51) {                       # Left
            if ($tab->{tab_new_pos} > 0) {
                $tab->{tab_new_pos}--;
                $self->refresh;
            }
            return 1;
        } elsif ($keysum == 0xff53) {                       # Right
            if ($tab->{tab_new_pos} < length($tab->{tab_new_name})) {
                $tab->{tab_new_pos}++;
                $self->refresh;
            }
            return 1;
        } elsif ($keysum == 0xff50) {                       # Home
            if ($tab->{tab_new_pos} > 0) {
                $tab->{tab_new_pos} = 0;
                $self->refresh;
            }
            return 1;
        } elsif ($keysum == 0xff57) {                       # End
            if ($tab->{tab_new_pos} < length($tab->{tab_new_name})) {
                $tab->{tab_new_pos} = length($tab->{tab_new_name});
                $self->refresh;
            }
            return 1;
        } elsif ($keysum == 0xff08) {                       # Backspace
            if ($tab->{tab_new_pos} > 0) {
                my $name = '';
                $name   .= substr($tab->{tab_new_name}, 0,                   $tab->{tab_new_pos} - 1)      if $tab->{tab_new_pos} > 1;
                $name   .= substr($tab->{tab_new_name}, $tab->{tab_new_pos}, length($tab->{tab_new_name})) if $tab->{tab_new_pos} < length($tab->{tab_new_name});
                $tab->{tab_new_name} = $name;
                $tab->{tab_new_pos}--;
            }
            $self->refresh;
            return 1;
        } elsif ($keysum == 0xffff) {                       # Delete
            if ($tab->{tab_new_pos} < length($tab->{tab_new_name})) {
                my $name = '';
                $name   .= substr($tab->{tab_new_name}, 0,                       $tab->{tab_new_pos})          if $tab->{tab_new_pos} > 0;
                $name   .= substr($tab->{tab_new_name}, $tab->{tab_new_pos} + 1, length($tab->{tab_new_name})) if $tab->{tab_new_pos} < length($tab->{tab_new_name}) - 1;
                $tab->{tab_new_name} = $name;
            }
            $self->refresh;
            return 1;
        } else {
            if ($str =~ /^[\x20-\x7f]$/) {       # printable symbols
                my $name = '';
                $name   .= substr($tab->{tab_new_name}, 0,                   $tab->{tab_new_pos})          if $tab->{tab_new_pos} > 0;
                $name   .= $str;
                $name   .= substr($tab->{tab_new_name}, $tab->{tab_new_pos}, length($tab->{tab_new_name})) if $tab->{tab_new_pos} < length($tab->{tab_new_name});
                $tab->{tab_new_name} = $name;
                $tab->{tab_new_pos}++;
            }
            $self->refresh;
            return 1;
        }
    }

    if (defined $action) {
        if ($action eq 'next-tab' || $action eq 'prev-tab') {
            my ($idx) = grep $self->{tabs}[$_] == $tab, 0 .. $#{ $self->{tabs} };
            --$idx if $action eq 'prev-tab';
            ++$idx if $action eq 'next-tab';
            $self->make_current($self->{tabs}[$idx % @{ $self->{tabs}}]);
            return 1;
        } elsif ($action eq 'move-left' || $action eq 'move-right') {
            my ($idx1) = grep $self->{tabs}[$_] == $tab, 0 .. $#{ $self->{tabs} };
            if (($action eq 'move-left' && $idx1 > 0) || ($action eq 'move-right' && $idx1 < $#{ $self->{tabs} })) {
                my $idx2  = ($idx1 + ($action eq 'move-left' ? -1 : +1)) % @{ $self->{tabs} };
                ($self->{tabs}[$idx1], $self->{tabs}[$idx2]) = ($self->{tabs}[$idx2], $self->{tabs}[$idx1]);
                $self->make_current($self->{tabs}[$idx2]);
            }
            return 1;
        } elsif ($action eq 'new-tab') {
            $self->new_tab;
            return 1;
        } elsif ($action eq 'rename-start') {
            $self->{tab_rename_started} = 1;
            $tab->{tab_new_name} = $tab->{manual_name} || '';
            $tab->{tab_new_pos} = length($tab->{tab_new_name});
            $self->refresh;
            return 1;
        } elsif ($action eq 'cancel-rename') {
            undef $self->{tab_rename_started};
            undef $tab->{tab_new_name};
            undef $tab->{tab_new_pos};
            $self->refresh;
            return 1;
        } elsif ($action eq 'confirm-rename') {
            $tab->{manual_name} = $tab->{tab_new_name} || undef;
            undef $self->{tab_rename_started};
            undef $tab->{tab_new_name};
            undef $tab->{tab_new_pos};
            $self->refresh;
            return 1;
        }
    }

    ();
}

sub tab_property_notify {
    my ($self, $tab, $event) = @_;
    $self->copy_properties if $event->{window} == $tab->parent;
    ();
}

sub tab_activity {
    my ($self, $tab) = @_;
    $self->refresh;
}

package urxvt::ext::tabbed_new::tab;

# helper extension implementing the subwindows of a tabbed terminal.
# simply proxies all interesting calls back to the tabbed class.

{
    for my $hook qw(start destroy key_press property_notify) {
        eval qq{
            sub on_$hook \{
                my \$parent = \$_[0]\{term\}\{parent\} or return;
                \$parent->tab_$hook(\@_);
            \}
        };
        die if $@;
    }
}

sub on_add_lines {
    $_[0]->{activity}++ or $_[0]{term}{parent}->tab_activity($_[0]);
    ();
}

sub on_osc_seq {
    my ($self, $seq, $cmd, $resp) = @_;
    return unless $seq == 0;

    my $parent = $self->{term}->{parent};
    return unless $parent;

    my ($name, undef) = split /:\s/, $cmd, 2;
    return unless $name;

    $parent->tab_name($name);
    
    ();
}