Yeah, I see your problem. It seems that it's a bug in the module, where he tries to calculate the height of the listbox. His calculation is a bit off on font heights. You should file a bug report... it's a pretty easy fix. In the meantime, you have 2 choices to keep your core MatchEntry.pm unchanged. You can sub-class the MatchEntry.pm to your own custom fixed module; OR you can do a simple redefine of the bad sub and fix it. The only drawback with redefining, is it emits a warning (which you can suppress).
#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::MatchEntry;
no warnings 'redefine';
#redefine the bad sub
# Display the listbox
sub Tk::MatchEntry::show_listbox {
my $self = shift;
my $current_word = shift; # optional
# Don't do that stuff if we're already popped up
unless ($self->{'popped'}) {
# Allow the programmer to change his choices
$self->Callback(-listcmd => $self);
# Display only listbox entries which could match
my $number_of_visible_elements = $self->listbox_filter($curren
+t_word);
# abort if listbox would be empty or contain less entries
# than required for auto-completion (usually 1)
return unless (defined $number_of_visible_elements &&
($number_of_visible_elements > $self->cget(-complete)));
# Fetch our subwidgets
my $entry = $self->Subwidget('entry');
my $choices = $self->Subwidget('choices');
my $scrolled_listbox = $self->Subwidget('slistbox');
# Calculate height and width for the popup listbox
my $y1 = $entry->rooty + $entry->height + 3;
my $bd = $choices->cget(-bd) + $choices->cget(-highlightthickn
+ess);
#my $ht = ($scrolled_listbox->reqheight / 2) + 2 * $bd + 2;
# Calculate height for listbox. Default reqheight = 10 element
+s.
my $maxheight = $self->cget(-maxheight);
my $elements_per_page =
$number_of_visible_elements < $maxheight ?
$number_of_visible_elements : $maxheight;
my $ht = (($scrolled_listbox->reqheight *
$elements_per_page) / 10) + 2 * $bd + 2;
my $x1 = $entry->rootx + $bd + 3;
# change both to 'e'as a simple fix, but a better fix would be
# to add a fudge factor to the height calculation above
# Check whether the scrollbar should be hidden
if ($number_of_visible_elements <= $maxheight) { # hide it
$scrolled_listbox->configure(-scrollbars => 'e'); #''
}
else { # show the scrollbar
$scrolled_listbox->configure(-scrollbars => 'e'); #'oe'
}
my ($width, $x2);
# Check whether programmer has specified a width
$width = $self->cget(-listwidth);
if (defined $width) {
$x2 = $x1 + $width;
} # else take the entry widget's width
else {
$x2 = $entry->rootx + $entry->width;
$width = $x2 - $x1;
}
# check requested and maximum width unless programmer forbid
my $rw = $choices->reqwidth;
unless ($self->cget(-fixedwidth)) {
if ($rw < $width) {
$rw = $width;
}
else {
if ($rw > $width * 3) {
$rw = $width * 3;
}
if ($rw > $self->vrootwidth) {
$rw = $self->vrootwidth;
}
}
$width = $rw;
}
else { # force fixed width
$rw = $width;
}
# check whether listbox is too far right
if ($x2 > $self->vrootwidth) {
$x1 = $self->vrootwidth - $width;
}
# check whetherlistbox is too far left
if ($x1 < 0) {
$x1 = 0;
}
# check whether listbox is below bottom of screen
my $y2 = $y1 + $ht;
if ($y2 > $self->vrootheight) {
$y1 = $y1 - $ht - ($entry->height - 5);
}
# Set the listbox's geometry and show it
$choices->geometry(sprintf('%dx%d+%d+%d', $rw, $ht, $x1, $y1))
+;
$choices->deiconify;
$choices->raise;
$entry->focus;
$self->{'popped'} = 1;
$choices->configure(-cursor => 'arrow');
$self->grabGlobal;
}
}
my %data = (
a => [qw/Abberley Abberton Abbotsley Aberaeron Abergele Abingdon A
+ccrington Achany Acton Adderley Airth/],
b => [qw/Babraham Bacton Barrow Barry Barton Baslow Bath Battle Ba
+xenden Bexhill Bradfield/]
);
my $place;
my $mw = MainWindow->new (-title => "i wish this would work",);
my $me = $mw->MatchEntry (
-textvariable => \$place,
-choices => [keys %data],
-ignorecase => 1,
-maxheight => 10,
-onecmd => \&repopulate,
# -entercmd => \&calc,
)->pack (-side => 'left');
my $me_subwidget = $me->Subwidget('entry');
$me_subwidget->configure(-width => '41',
-label => 'Starting at ',
);
my $c = $mw->Button(
-text => "Exit",
-command => sub {
$mw->destroy;
exit;
},
);
$c->pack(-anchor => 'se',
-padx =>10,
-pady =>30,
-expand => 1
);
Tk::MainLoop ();
sub repopulate {
return unless exists $data{lc $place};
$me->configure (-choices => $data{lc $place});
}
|