Commit 26bfe5d4 authored by Christian Fibich's avatar Christian Fibich Committed by Stefan Tauner
Browse files

Scroll workaround: Build a list of scrolled widgets in mainwindow

parent ebe96b5d
......@@ -97,7 +97,7 @@ sub _populate_widget ($) {
if (defined $self->{'scrolled'} && $self->{'scrolled'} =~ /^1|yes$/) {
$sp = $p->Scrolled('Pane', -scrollbars => "oe", -sticky => 'nwse');
Tk::FIJIUtils::bind_mousewheel($self->toplevel,$sp);
Tk::FIJIUtils::bind_mousewheel($p->toplevel,$sp);
} else {
$sp = $p->Pane(-sticky => 'nwse');
}
......
......@@ -515,7 +515,7 @@ sub _populate_widget {
-expand => 1,
);
Tk::FIJIUtils::bind_mousewheel($self->{'mw'},$text_scrolled);
#Tk::FIJIUtils::bind_mousewheel($self->{'mw'},$text_scrolled);
#---
# Configure logging window
......@@ -812,8 +812,8 @@ sub _populate_widget {
# extra widgets and settings for the test modes
if ($mode eq "auto") {
my $fr = $page->Frame(-relief => "ridge", -borderwidth => 2);
$self->_add_test_panel($fr);
$fr->grid(-row => $row, -column => 0, -columnspan => 3, -padx => 10, -pady => 10, -ipadx => 10, -ipady => 10, -sticky => "nsew");
$self->_add_test_panel($fr);
} elsif ($mode eq "random") {
# no extra widgets
} elsif ($mode eq "manual") {
......@@ -937,7 +937,7 @@ sub _add_test_panel {
'-sticky' => 'nwse',
);
Tk::FIJIUtils::bind_mousewheel($self->{'mw'},$fr_tests_scroll);
Tk::FIJIUtils::bind_mousewheel($self->MainWindow,$fr_tests_scroll);
$fr_tests_scroll->pack(
'-expand' => 1,
......
......@@ -160,32 +160,55 @@ sub bind_mousewheel {
$logger->error("Could not bind mouse wheel to wrong widget (".$widget->class().")\n($@)");
}
# add to the list of scrollable widgets in the main window
if (!defined $mw->{'scrollable_widgets'}) {
$mw->{'scrollable_widgets'} = [$widget];
} else {
my $in_list = 0;
for my $scrollable_widget (@{$mw->{'scrollable_widgets'}}) {
if ($scrollable_widget == $widget) {
$in_list = 1;
last;
}
}
push @{$mw->{'scrollable_widgets'}}, $widget unless $in_list;
}
# bind the mouse wheel
if ($^O eq "MSWin32") {
# Windows passes the 'delta' itself
$mw->bind('<MouseWheel>' => [\&_wheel_handler, $widget]);
$mw->bind('<MouseWheel>' => [\&_wheel_handler, $mw]);
} else {
$mw->bind('<Button-4>' => [\&_wheel_handler, -1, $widget]);
$mw->bind('<Button-5>' => [\&_wheel_handler, 1, $widget]);
$mw->bind('<4>' => [\&_wheel_handler, -1, $mw]);
$mw->bind('<5>' => [\&_wheel_handler, 1, $mw]);
}
}
sub _wheel_handler {
my ($event_widget, $val, $widget_to_scroll) = @_;
# only scroll if visible
return if (!$widget_to_scroll->ismapped());
my $scrolled = $widget_to_scroll->Subwidget('scrolled');
my $container;
for ($container = $event_widget;
defined $container && $container != $widget_to_scroll;
$container = $container->parent) {}
return if (!defined $container);
if ($^O eq "MSWin32") {
$scrolled->yview(scroll=>(-$val/120)*SCROLL,'units');
} else {
$scrolled->yview(scroll=>$val*SCROLL,'units');
my ($event_widget, $val, $mw) = @_;
for (my $index = 0; $index < @{$mw->{'scrollable_widgets'}}; $index++) {
my $widget_to_scroll = @{$mw->{'scrollable_widgets'}}[$index];
# remove already deleted widgets from list
unless (Tk::Exists($widget_to_scroll)) {
delete @{$mw->{'scrollable_widgets'}}[$index];
next;
}
# only scroll if visible
next if (!$widget_to_scroll->ismapped());
my $scrolled = $widget_to_scroll->Subwidget('scrolled');
my $container;
for ($container = $event_widget;
defined $container && $container != $widget_to_scroll;
$container = $container->parent) {}
next if (!defined $container);
if ($^O eq "MSWin32") {
$scrolled->yview(scroll=>(-$val/120)*SCROLL,'units');
} else {
$scrolled->yview(scroll=>$val*SCROLL,'units');
}
}
}
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment