no_comment

1 files changed, 77 insertions, 2 deletions

diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index 7eefa8685..f0f92807b 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -6,7 +6,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $border @grabbed);
 
 @ISA = qw(Exporter);
 %EXPORT_TAGS = (
-    helpers => [ qw(create_okcancel createScrolledWindow create_menu create_notebook create_packtable create_hbox create_vbox create_adjustment create_box_with_title) ],
+    helpers => [ qw(create_okcancel createScrolledWindow create_menu create_notebook create_packtable create_hbox create_vbox create_adjustment create_box_with_title create_treeitem) ],
     wrappers => [ qw(gtksignal_connect gtkpack gtkpack_ gtkpack__ gtkappend gtkadd gtktext_insert gtkset_usize gtkset_justify gtkset_active gtkshow gtkdestroy gtkset_mousecursor gtkset_background gtkset_default_fontset) ],
     ask => [ qw(ask_warn ask_okcancel ask_yesorno ask_from_entry ask_from_list ask_file) ],
 );
@@ -212,7 +212,7 @@ sub create_box_with_title($@) {
 
 sub createScrolledWindow($) {
     my ($W) = @_;
-    if (ref $W eq "Gtk::Text") {
+    if (member(ref $W, qw(Gtk::Text)) {
 	gtkpack_(new Gtk::HBox(0,0), 
 		 1, $W, 
 		 0, new Gtk::VScrollbar($W->vadj));
@@ -334,6 +334,81 @@ sub _create_window($$) {
     $o->{rwindow} = $w;
 }
 
+my ($next_child, $left, $right, $up, $down);
+{
+    my $next_child = sub {
+	my ($c, $dir) = @_;
+
+	my @childs = $c->parent->children;
+   
+	my $i; for ($i = 0; $i < @childs; $i++) {
+	    last if $childs[$i] == $c || $childs[$i]->subtree == $c;
+	}
+	$i += $dir;
+	0 <= $i && $i < @childs ? $childs[$i] : undef;
+    };
+    $left = sub { &$next_child($_[0]->parent, 0); };
+    $right = sub {
+	my ($c) = @_;
+	if ($c->subtree) {
+	    $c->expand;
+	    ($c->subtree->children)[0];
+	} else {
+	    $c;
+	}
+    };
+    $down = sub {
+	my ($c) = @_;
+	return &$right($c) if ref $c eq "Gtk::TreeItem" && $c->subtree && $c->expanded;
+
+	if (my $n = &$next_child($c, 1)) {
+	    $n;
+	} else {
+	    return if ref $c->parent ne 'Gtk::Tree';	
+	    &$down($c->parent);
+	}
+    };
+    $up = sub {
+	my ($c) = @_;
+	if (my $n = &$next_child($c, -1)) {
+	    $n = ($n->subtree->children)[-1] while ref $n eq "Gtk::TreeItem" && $n->subtree && $n->expanded;
+	    $n;
+	} else {
+	    return if ref $c->parent ne 'Gtk::Tree';	
+	    &$left($c);
+	}
+    };
+}
+
+sub create_treeitem($$) {
+    my ($name) = @_;
+    
+    my $w = new Gtk::TreeItem($name);
+    $w->signal_connect(key_press_event => sub {
+        my (undef, $e) = @_;
+        local $_ = chr ($e->{keyval} & 0xff);
+
+	if ($e->{keyval} > 0x100) {
+	    my $n;
+	    $n = &$left($w)  if /[Q´\x96]/;
+	    $n = &$right($w) if /[S¶\x98]/;
+	    $n = &$up($w)    if /[R¸\x97]/;
+	    $n = &$down($w)  if /[T²\x99]/;
+	    if ($n) {
+		$n->focus('up');
+		$w->signal_emit_stop("key_press_event"); 
+	    }
+	    $w->expand if /[+«]/;
+	    $w->collapse if /[-\xad]/;
+	    do { 
+		$w->expanded ? $w->collapse : $w->expand; 
+		$w->signal_emit_stop("key_press_event"); 
+	    } if /[\r\x8d]/;
+	}
+        1;
+    });
+    $w;
+}