doc/rxvt-tabbed

   1 #!/usr/bin/perl
   2
   3 # I tried to write this with Tk, as it uses less memory and is
   4 # more widely available. Alas, Tk is rather broken with respect to embedding.
   5
   6 # on debian, do:
   7 # apt-get install libgtk2-perl
   8
   9 # Also see the Gtk2::URxvt module family, which does this much cleaner
  10 # and provides a real tabbed-terminal.
  11
  12 my $RXVT_BASENAME = "rxvt";
  13
  14 use Gtk2;
  15 use Encode;
  16
  17 $SIG{CHLD} = 'IGNORE';
  18
  19 my $event_cb; # $wid => $cb
  20
  21 init Gtk2;
  22
  23 my $window = new Gtk2::Window 'toplevel';
  24
  25 my $vbox = new Gtk2::VBox;
  26 $window->add ($vbox);
  27
  28 my $notebook = new Gtk2::Notebook;
  29 $vbox->pack_start ($notebook, 1, 1, 0);
  30
  31 $notebook->can_focus (0);
  32 $notebook->set (scrollable => 1);
  33
  34 sub new_terminal {
  35    my ($title, @args) = @_;
  36
  37    my $label = new Gtk2::Label $title;
  38
  39    my $rxvt = new Gtk2::Socket;
  40    $rxvt->can_focus (1);
  41
  42    my $wm_normal_hints = sub {
  43       my ($window) = @_;
  44       my ($type, $format, @data)
  45          = $window->property_get (
  46               Gtk2::Gdk::Atom->intern ("WM_NORMAL_HINTS", 0),
  47               Gtk2::Gdk::Atom->intern ("WM_SIZE_HINTS", 0),
  48               0, 70*4, 0
  49            );
  50       my ($width_inc, $height_inc, $base_width, $base_height) = @data[9,10,15,16];
  51
  52       my $hints = new Gtk2::Gdk::Geometry;
  53       $hints->base_width  ($base_width); $hints->base_height ($base_height);
  54       $hints->width_inc   ($width_inc);  $hints->height_inc  ($height_inc);
  55
  56       $rxvt->get_toplevel->set_geometry_hints ($rxvt, $hints, [qw(base-size resize-inc)]);
  57    };
  58
  59    $rxvt->signal_connect_after (realize => sub {
  60       my $win = $_[0]->window;
  61
  62       if (fork == 0) {
  63          exec $RXVT_BASENAME,
  64                  -embed => $win->get_xid, @args;
  65          exit (255);
  66       }
  67
  68       0
  69    });
  70
  71    $rxvt->signal_connect_after (plug_added => sub {
  72       my ($socket) = @_;
  73       my $plugged = ($socket->window->get_children)[0];
  74
  75       $plugged->set_events ($plugged->get_events + ["property-change-mask"]);
  76
  77       $wm_normal_hints->($plugged);
  78
  79       $event_cb{$plugged} = sub {
  80          my ($event) = @_;
  81          my $window = $event->window;
  82
  83          if (Gtk2::Gdk::Event::Configure:: eq ref $event) {
  84             $wm_normal_hints->($window);
  85          } elsif (Gtk2::Gdk::Event::Property:: eq ref $event) {
  86             my $atom = $event->atom;
  87             my $name = $atom->name;
  88
  89             return if $event->state; # GDK_PROPERTY_NEW_VALUE == 0
  90
  91
  92             if ($name eq "_NET_WM_NAME") {
  93                my ($type, $format, $data)
  94                   = $window->property_get (
  95                        $atom,
  96                        Gtk2::Gdk::Atom->intern ("UTF8_STRING", 0),
  97                        0, 128, 0
  98                     );
  99
 100                $label->set_text (Encode::decode_utf8 $data);
 101             }
 102          }
 103
 104          0;
 105       };
 106
 107       0;
 108    });
 109
 110    $rxvt->signal_connect_after (map_event => sub {
 111       $_[0]->grab_focus;
 112       0
 113    });
 114
 115    $notebook->append_page ($rxvt, $label);
 116
 117    $rxvt->show_all;
 118
 119    $notebook->set_current_page ($notebook->page_num ($rxvt));
 120
 121    $rxvt;
 122 }
 123
 124 my $new = new Gtk2::Frame;
 125 $notebook->prepend_page ($new, "New");
 126
 127 $notebook->signal_connect_after (switch_page => sub {
 128    if ($_[2] == 0) {
 129       new_terminal $RXVT_BASENAME;
 130    }
 131 });
 132
 133 $window->set_default_size (700, 400);
 134 $window->show_all;
 135
 136 # ugly, but gdk_window_filters are ot available in perl
 137
 138 Gtk2::Gdk::Event->handler_set (sub {
 139    my ($event) = @_;
 140    my $window = $event->window;
 141
 142    ($event_cb{$window} && $event_cb{$window}->($event))
 143       or Gtk2->main_do_event ($event);
 144 });
 145
 146 main Gtk2;
 147