From 5c6d14bca8de104b0495c0c15d12f37fac6c933d Mon Sep 17 00:00:00 2001 From: Tom Willemse Date: Mon, 12 Aug 2013 01:00:33 +0200 Subject: [PATCH] Initial commit --- README.org | 9 ++ modeline | 408 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 417 insertions(+) create mode 100644 README.org create mode 100755 modeline diff --git a/README.org b/README.org new file mode 100644 index 0000000..586b811 --- /dev/null +++ b/README.org @@ -0,0 +1,9 @@ +A modeline for URxvt. + +* Usage + + Download and put it in your ~perl-lib~ (or change your ~perl-lib~ to + contain it), add ~modeline~ to your ~perl-ext-common~, and set the + ~URxvt.modeline.command~ setting to a shell-executable which produces + a single line of output which will be shown in the last line of the + terminal. diff --git a/modeline b/modeline new file mode 100755 index 0000000..ea28848 --- /dev/null +++ b/modeline @@ -0,0 +1,408 @@ +#! perl + +#:META:X_RESOURCE:modeline-fg:colour:tab bar foreground colour +#:META:X_RESOURCE:modeline-bg:colour:tab bar background colour +#:META:X_RESOURCE:tab-fg:colour:tab foreground colour +#:META:X_RESOURCE:tab-bg:colour:tab background colour +#:META:X_RESOURCE:command:string:command + +=head1 NAME + +modeline - modeline interface to urxvt + +=head1 DESCRIPTION + +This transforms the terminal into a tabbar with additional terminals, that +is, it implements what is commonly referred to as "modeline terminal". The topmost line +displays a "[NEW]" button, which, when clicked, will add a new tab, followed by one +button per tab. + +Clicking a button will activate that tab. Pressing B and +B will switch to the tab left or right of the current one, +while B creates a new tab. Pressing B and +B will renumber the current tab by moving it to the left or +to the right. + +The tabbar itself can be configured similarly to a normal terminal, but +with a resource class of C. In addition, it supports the +following four resources (shown with defaults): + + URxvt.modeline.tabbar-fg: + URxvt.modeline.tabbar-bg: + URxvt.modeline.tab-fg: + URxvt.modeline.tab-bg: + +See I in the @@RXVT_NAME@@(1) manpage for valid +indices. + +=cut + +sub refresh { + my ($self) = @_; + + my $ncol = $self->ncol; + + my $text = " " x $ncol; + my $rend = [($self->{rs_tabbar}) x $ncol]; + + my $output = `$self->{command}`; + substr $text, 0, length $output, $output; + + my $idx = 0; + + $self->ROW_t ($self->nrow - 1, $text, 0, 0, $ncol); + $self->ROW_r ($self->nrow - 1, $rend, 0, 0, $ncol); + + $self->want_refresh; +} + +sub new_tab { + my ($self, @argv) = @_; + + # save a backlink to us, make sure modeline 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") . ",-modeline"); + }; + + push @urxvt::TERM_EXT, urxvt::ext::modeline::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, 0, + $self->width, $self->height - $self->{tabheight} + ); + $tab->XMoveResizeWindow ( + $tab->parent, 0, 0, + $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; + $self->refresh; + + () +} + +sub on_focus_out { + my ($self, $event) = @_; + + $self->{cur}->focus_out; + $self->refresh; + + () +} + +sub on_tt_write { + my ($self, $octets) = @_; + + $self->{cur}->tt_write ($octets); + + 1 +} + +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.modeline"); + $self->resource (pty_fd => -1); + + $self->option ($urxvt::OPTION{scrollBar}, 0); + + my $fg = $self->x_resource ("fg"); + my $bg = $self->x_resource ("bg"); + my $tabfg = $self->x_resource ("tab-fg"); + my $tabbg = $self->x_resource ("tab-bg"); + $self->{command} = $self->x_resource ("command"); + + defined $fg or $fg = 3; + defined $bg or $bg = 0; + defined $tabfg or $tabfg = 0; + defined $tabbg or $tabbg = 1; + + $self->{rs_tabbar} = urxvt::SET_COLOR (urxvt::DEFAULT_RSTYLE, $fg + 2, $bg + 2); + $self->{rs_tab} = urxvt::SET_COLOR (urxvt::DEFAULT_RSTYLE, $tabfg + 2, $tabbg + 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->{overlay} = $self->overlay (-1, 0, 8, 1, urxvt::OVERLAY_RSTYLE, 0); + $self->{timer} = urxvt::timer + ->new + ->start (1 + int urxvt::NOW) # make sure we update "on" the second + ->interval (60) + ->cb (sub { + $self->refresh; + }); + + $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_start { + my ($self, $tab) = @_; + + $tab->XChangeInput ($tab->parent, urxvt::PropertyChangeMask); + + push @{ $self->{tabs} }, $tab; + +# $tab->{name} ||= scalar @{ $self->{tabs} }; + $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, $keysym, $str) = @_; + + if ($event->{state} & urxvt::ShiftMask) { + if ($keysym == 0xff51 || $keysym == 0xff53) { + my ($idx) = grep $self->{tabs}[$_] == $tab, 0 .. $#{ $self->{tabs} }; + + --$idx if $keysym == 0xff51; + ++$idx if $keysym == 0xff53; + + $self->make_current ($self->{tabs}[$idx % @{ $self->{tabs}}]); + + return 1; + } elsif ($keysym == 0xff54) { + $self->new_tab; + + return 1; + } + } + elsif ($event->{state} & urxvt::ControlMask) { + if ($keysym == 0xff51 || $keysym == 0xff53) { + my ($idx1) = grep $self->{tabs}[$_] == $tab, 0 .. $#{ $self->{tabs} }; + my $idx2 = ($idx1 + ($keysym == 0xff51 ? -1 : +1)) % @{ $self->{tabs} }; + + ($self->{tabs}[$idx1], $self->{tabs}[$idx2]) = + ($self->{tabs}[$idx2], $self->{tabs}[$idx1]); + + $self->make_current ($self->{tabs}[$idx2]); + + 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::modeline::tab; + +# helper extension implementing the subwindows of a modeline terminal. +# simply proxies all interesting calls back to the modeline 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]); + () +}