CompleteEntry.pm

#-----------------------------------------------------------------------
# Fault InJection Instrumenter (FIJI)
# https://embsys.technikum-wien.at/projects/vecs/fiji
#
# The creation of this file has been supported by the publicly funded
# R&D project Josef Ressel Center for Verification of Embedded Computing
# Systems (VECS) managed by the Christian Doppler Gesellschaft (CDG).
#
# Authors:
# Christian Fibich <fibich@technikum-wien.at>
# Stefan Tauner <tauner@technikum-wien.at>
#
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# See the LICENSE file for more details.
#-----------------------------------------------------------------------
#
# Based on MatchEntry.pm which is Copyright (c) 2003 - 2005 Wolfgang Hommel
# Bugs introduced in changes between MatchEntry and CompleteEntry by Stefan Tauner
#

# Set package name
package Tk::CompleteEntry;

# Set version information
use vars qw($VERSION);
$VERSION = '0.0';

# Define dependencies
use strict;
use warnings;

use Tk qw(Ev);
use Carp;
require Tk::Frame;
require Tk::Entry;

# Construct widget
use base qw(Tk::Frame);
Construct Tk::Widget 'CompleteEntry';

# Compositing the widget
sub Populate {
    my ($self, $args) = @_;

    $self->SUPER::Populate($args);    # let ancestors populate first

    # Create the entry subwidget
    my $content;
    my $entry = $self->Entry(-textvariable => \$content,);
    $self->Advertise('entry' => $entry);    # make it available to outside
    $entry->pack(
        -side   => 'right',
        -fill   => 'x',
        -expand => 1
    );                                      # place the entry widget in our frame

    # Create the popup-listbox
    my $popup_frame = $self->Toplevel(-bd => 2, -relief => 'raised');
    $popup_frame->overrideredirect(1);      # turn off window decorations
    $popup_frame->withdraw;                 # start hidden
                                            # set exportselection to 0 in the listbox widget so we can have
                                            # selections in both the entry and the listbox widget at the same time
    my $scrolled_listbox = $popup_frame->Scrolled(qw/Listbox -selectmode browse -scrollbars oe -exportselection 0/);
    $self->Advertise('choices'  => $popup_frame);
    $self->Advertise('slistbox' => $scrolled_listbox);
    $scrolled_listbox->pack(-expand => 1, -fill => 'both');    # place it

    # Other initializations
    $self->set_bindings;                                       # Set up keyboard and mouse bindings
    $self->{'popped'} = 0;                                     # Start with hidden listbox
    $self->Delegates(
        'insert' => $scrolled_listbox,
        'delete' => $scrolled_listbox,
        'get'    => $scrolled_listbox,
        DEFAULT  => $entry
    );

    $self->ConfigSpecs(
        -bottomcmd  => [qw/CALLBACK bottomCmd   BottomCmd/,  undef],
        -browsecmd  => [qw/CALLBACK browseCmd   BrowseCmd/,  undef],
        -entercmd   => [qw/CALLBACK enterCmd    EnterCmd/,   undef],
        -listcmd    => [qw/CALLBACK listCmd     ListCmd/,    undef],
        -mm_onecmd  => [qw/CALLBACK mm_oneCmd   mm_OneCmd/,  undef],
        -mm_zerocmd => [qw/CALLBACK mm_zeroCmd  mm_ZeroCmd/, undef],
        -onecmd     => [qw/CALLBACK oneCmd      OneCmd/,     undef],
        -sortcmd    => [qw/CALLBACK sortCmd     SortCmd/,    undef],
        -tabcmd     => [qw/CALLBACK tabCmd      TabCmd/,     undef],
        -topcmd     => [qw/CALLBACK topCmd      TopCmd/,     undef],
        -zerocmd    => [qw/CALLBACK zeroCmd     ZeroCmd/,    undef],

        -command    => '-browsecmd',
        -ignorecase => '-case',
        -options    => '-choices',

        # -variable    => '-textvariable',

        -choices => [qw/METHOD   choices     Choices/, undef],
        -state   => [qw/METHOD   state       State        normal/],

        -autopopup   => [qw/PASSIVE  autoPopup   AutoPopup    1/],
        -autoshrink  => [qw/PASSIVE  autoShrink  AutoShrink   1/],
        -autosort    => [qw/PASSIVE  autoSort    AutoSort     1/],
        -case        => [qw/PASSIVE  case        Case         0/],
        -colorstate  => [qw/PASSIVE  colorState  ColorState/, undef],
        -complete    => [qw/PASSIVE  complete    Complete     1/],
        -fixedwidth  => [qw/PASSIVE  fixedWidth  FixedWidth   1/],
        -listwidth   => [qw/PASSIVE  listWidth   ListWidth/, undef],
        -matchprefix => [qw/PASSIVE  matchPrefix MatchPrefix/, undef],
        -maxheight   => [qw/PASSIVE  maxHeight   MaxHeight    5/],
        -multimatch  => [qw/PASSIVE  multiMatch  MultiMatch   0/],
        -sorttrigger => [qw/PASSIVE  sortTrigger SortTrigger/, undef],
        -wraparound  => [qw/PASSIVE  wrapAround  WrapAround   0/],

        DEFAULT => [[$entry, $scrolled_listbox]]
    );
}

# Set up the keyboard and mouse event bindings
sub set_bindings {
    my ($self) = @_;
    my $entry = $self->Subwidget('entry');

    # Set the bind tags
    $self->bindtags([$self, 'Tk::CompleteEntry', $self->toplevel, 'all']);

    #    $entry->bindtags([$entry, $entry->toplevel, 'all']); # original and kaputt
    #    $entry->bindtags([$entry, 'Tk::Entry', $entry->toplevel, 'all']); # correct but not what we want!?

    # Bindings for the entry widget
    #$entry->bind('<Down>', [$self, 'open_and_focus_listbox']);
    $entry->bind('<Down>',     [$self, 'entry_cursor_down']);
    $entry->bind('<Up>',       [$self, 'entry_cursor_up']);
    $entry->bind('<Escape>',   [$self, 'entry_escape']);
    $entry->bind('<Tab>',      [$self, 'entry_tabulator']);
    $entry->bind('<Return>',   [$self, 'entry_return']);
    $entry->bind('<FocusOut>', [$self, 'entry_leave']);
    $entry->bind(
        '<Any-KeyPress>',
        sub {
            my $event = $_[0]->XEvent;
            $self->entry_anykey($event->K, $event->s);    # Key, State
        }
    );

    # Bindings for the listbox
    my $scrolled_list = $self->Subwidget('slistbox');
    my $listbox       = $scrolled_list->Subwidget('listbox');
    $listbox->bind('<ButtonRelease-1>', [$self, 'release_listbox', Ev('x'), Ev('y')]);
    $listbox->bind('<Escape>' => [$self, 'close_listbox',  $listbox]);
    $listbox->bind('<Return>' => [$self, 'return_listbox', $listbox]);
    $listbox->bind('<Tab>'    => [$self, 'listbox_tab',    $listbox]);

    # Close listbox if clicked outside
    $self->bind('<1>', 'open_listbox');
}

# Called when the entry widget loses focus to make sure any text is deselected
sub entry_leave {
    my $self = shift;

    $self->entry_prepare_leave;
}

# Called when the user hits <Return> within the entry widget
sub entry_return {
    my $self = shift;

    # Execute given callback
    $self->Callback(-entercmd => $self);

    # Hide the listbox, if popped up, deselect all entry text, place cursor
    # at end of entry widget
    $self->entry_prepare_leave;
}

# Called when the user hits <Tab> within the entry widget
sub entry_tabulator {
    my $self = shift;

    # Execute given callback
    $self->Callback(-tabcmd => $self);

    # Hide the listbox, if popped up, deselect all entry text, place cursor
    # at end of entry widget
    $self->entry_prepare_leave;
}

# Hide the listbox, if popped up, deselect all entry text, place cursor
# at end of entry widget
sub entry_prepare_leave {
    my $self  = shift;
    my $entry = $self->Subwidget('entry');

    # close the listbox if popped up
    if ($self->{'popped'}) {
        $self->hide_listbox;
    }

    # clear the selection
    $entry->selection('clear');

    # place the input cursor at end of entry widget
    $entry->icursor($entry->index('end'));

    # finalize the auto-completion
    $self->check_choice_case;
}

# If we have case-insensitive auto-completion, check whether the text in the
# entry widget matches one of the choices (case-insensitively). If so, replace
# it with the choice. This allows the user to enter "john doe", but makes sure
# the result is "John Doe" when the MatchEntry widget is left.
sub check_choice_case {
    my $self  = shift;
    my $entry = $self->Subwidget('entry');

    return unless ($self->cget(-case));    # abort if case sensitive matching

    my $text = $entry->get;                # text in entry widget

    my $all_choices_r = $self->{Configure}{all_choices_r};
    my @all_choices   = @$all_choices_r;

    foreach my $choice (@all_choices) {    # loop over all choices
                                           # check whether choice matches text case-insensitively but not
                                           # case-sensitively
        if ($text =~ m/^\Q$choice\E$/i && ($text ne $choice)) {

            # if so, replace the text in the entry widget with the choice
            $entry->delete(0, 'end');
            $entry->insert(0, $choice);
            $entry->icursor($entry->index('end'));
        }
    }
}

# called when the user presses <Escape> in the entry widget
sub entry_escape {
    my $self  = shift;
    my $entry = $self->Subwidget('entry');

    # Close listbox if popped up
    if ($self->{'popped'}) {
        $self->hide_listbox;
        $entry->selectionRange($entry->index('insert'), $entry->index('end'));

        # assume that another <Escape> follows
        $self->{Configure}{double_escape_possible} = 1;
    } else {

        # undo auto-completion otherwise
        if ($entry->selectionPresent()) {
            $entry->delete($entry->index("sel.first"), $entry->index("sel.last"));
        } elsif ($self->{Configure}{double_escape_possible}) {

            # no text selected -> cut from current insert position to end
            $entry->delete($entry->index("insert"), $entry->index("end"));

            # turn off double-<Escape> assumption
            $self->{Configure}{double_escape_possible} = 0;
        }
    }
}

# Called whenever the user presses any key within the entry widget
sub entry_anykey {
    my ($self, $key, $state) = @_;
    my $entry = $self->Subwidget('entry');

    # turn off double-escape mode for turning off auto-completion
    $self->{Configure}{double_escape_possible} = 0;

    # Check entry length, call appropriate callbacks
    my $entry_length = length $entry->get;
    if ($entry_length == 0) {
        $self->Callback(-zerocmd => $self);
    } elsif ($entry_length == 1) {
        $self->Callback(-onecmd => $self);
    }

    if ($self->cget(-multimatch)) {
        if ($key =~ m/^Left|^Right|^Home|^End/) {
            $self->hide_listbox;
        }
    }

    # print ">>>$key<<<\n";
    my $trigger = $self->cget(-sorttrigger);
    if (defined $trigger) {
        $self->resort if ($key =~ m/$trigger/);
    }

    $self->{Configure}{was_real_input} = 0;

    return if ($key =~ m/^Super|^Shift|^Alt|^Control|^Left|^Right|^Home|^End/);
    return if ($state =~ m/^Control-/);

    $self->{Configure}{was_real_input} = 1;

    # check whether we are in multimatch mode
    if ($self->cget(-multimatch)) {
        return $self->entry_anykey_multimatch($key, $state, $entry);
    }

    # automatically pop the listbox up if requested by programmer
    # and the user has already entered at least 1 character
    if ($self->cget(-autopopup) && length $entry->get) {
        if ($self->{popped}) {    # already popped up, just filter entries
            my $last_num    = $self->{Configure}{last_number_of_entries};
            my $num_entries = $self->listbox_filter;

            $num_entries = 0 unless (defined $num_entries);

            # number of choices has changed, redraw the listbox
            unless ($last_num == $num_entries) {
                $self->hide_listbox;
                $self->show_listbox;
            }
        } else {                  # pop the listbox up, automatically calls the filter
            $self->show_listbox;
        }
    } else {    # check length of input, close listbox if too short
        unless (length $entry->get) {
            $self->hide_listbox;
        }
    }

    # Skip the rest if user pressed Backspace or Delete
    return if ($key eq "BackSpace" or $key eq "Delete");

    $self->entry_autocomplete;
}

# Handle any keypress in multimatch mode
sub entry_anykey_multimatch {
    my ($self, $key, $state, $entry) = @_;

    # automatically pop the listbox up if requested by programmer
    # and the user has already entered at least 1 character in the
    # current word

    my $text   = $entry->get;
    my $cursor = $entry->index('insert');
    (my $typed_text = $text) =~ s/^(.{$cursor})(.*)/$1/;
    my $text_after_cursor = $2;

    (my $current_word = $typed_text) =~ s/.*\s(.*)/$1/;

    my $word_length = length $current_word;
    if ($word_length == 0) {
        $self->Callback(-mm_zerocmd => $self);
    } elsif ($word_length == 1) {
        $self->Callback(-mm_onecmd => $self);
    }

    # print "current word: $current_word\n";

    if ($self->cget(-autopopup) && length $current_word) {
        if ($self->{popped}) {    # already popped up, just filter entries
            my $last_num    = $self->{Configure}{last_number_of_entries};
            my $num_entries = $self->listbox_filter($current_word);

            $num_entries = 0 unless (defined $num_entries);

            # number of choices has changed, redraw the listbox
            unless ($last_num == $num_entries) {
                $self->hide_listbox;
                $self->show_listbox($current_word);
            }
        } else {                  # pop the listbox up, automatically calls the filter
            $self->show_listbox($current_word);
        }
    } else {    # check length of input, close listbox if too short
        unless (length $current_word) {
            $self->hide_listbox;
        }
    }

    # Skip the rest if user pressed Backspace or Delete
    return if ($key eq "BackSpace" or $key eq "Delete");

    $self->entry_autocomplete_multimatch;
}

# attempt to auto-complete the entry
sub entry_autocomplete {
    my $self  = shift;
    my $entry = $self->Subwidget('entry');

    # check whether we are in multimatch mode
    if ($self->cget(-multimatch)) {
        return $self->entry_autocomplete_multimatch;
    }

    if ($self->cget(-complete)) {    # do we want auto-completion at all?
        my $text   = $entry->get;
        my $cursor = $entry->index('insert');
        (my $typed_text = $text) =~ s/^(.{$cursor})(.*)/$1/;
        my $text_after_cursor = $2;

        # check whether any text after insert cursor is from auto-completion
        my $non_auto_text;
        $non_auto_text = 1 if ($text_after_cursor ne "");
        if ($non_auto_text && $entry->selectionPresent) {
            $non_auto_text = 0
              if ( ($entry->index('end') == $entry->index('sel.last'))
                && ($entry->index('insert') == $entry->index('sel.first')));
        }

        # skip if position = 0 or there's text after the insert cursor
        unless ($cursor == 0 || $text eq "" || $non_auto_text) {

            # search for the first matching entry
            my $ignore_case   = ($self->cget(-case) ? "(?i)" : "");
            my $all_choices_r = $self->{Configure}{all_choices_r};
            my @all_choices   = @$all_choices_r;

            my $prefix = $self->cget(-matchprefix) || "";

            my $index = 0;
            foreach my $choice (@all_choices) {    # @all_choices is sorted
                if ($choice =~ m/^${ignore_case}$prefix\Q$typed_text\E(.*)/) {
                    my $choice_tail = $1;          # auto-completed part of entry

                    #print "..$choice_tail..\n";

                    $entry->selection('clear');
                    $entry->delete($cursor, 'end');
                    $entry->insert($cursor, $choice_tail);
                    $entry->selection('range', $cursor, 'end');
                    $entry->icursor($cursor);

                    last;                          # break out of foreach $choice
                }
            }
        }
    }
}

# attempt to auto-complete the current word in multimatch mode
sub entry_autocomplete_multimatch {
    my $self  = shift;
    my $entry = $self->Subwidget('entry');

    if ($self->cget(-complete)) {                  # do we want auto-completion at all?
        my $text   = $entry->get;
        my $cursor = $entry->index('insert');
        (my $typed_text = $text) =~ s/^(.{$cursor})(.*)/$1/;
        my $text_after_cursor = $2;

        my $rest_of_line = '';

        # check whether the user is editing a word which is not the
        # last on the line
        if ($text_after_cursor =~ m/\s/) {
            ($rest_of_line = $text_after_cursor) =~ s/(.*?)\s(.*)/$2/;
            $text_after_cursor = $1;
        }

        # extract last word on line
        if ($typed_text =~ m/\s/) {
            $typed_text =~ s/.*\s(.*)/$1/;
        }

        # check whether any text after insert cursor is from auto-completion
        my $non_auto_text;
        $non_auto_text = 1 if ($text_after_cursor ne "");
        if ($non_auto_text && $entry->selectionPresent) {
            $non_auto_text = 0
              if ( ($entry->index('end') == $entry->index('sel.last'))
                && ($entry->index('insert') == $entry->index('sel.first')));
        }

        # skip if position = 0 or there's text after the insert cursor
        unless ($typed_text eq "" || $non_auto_text) {

            # search for the first matching entry
            my $ignore_case   = ($self->cget(-case) ? "(?i)" : "");
            my $all_choices_r = $self->{Configure}{all_choices_r};
            my @all_choices   = @$all_choices_r;

            my $prefix = $self->cget(-matchprefix) || "";

            my $index = 0;
            foreach my $choice (@all_choices) {    # @all_choices is sorted
                if ($choice =~ m/^${ignore_case}$prefix\Q$typed_text\E(.*)/) {
                    my $choice_tail = $1;          # auto-completed part of entry
                    $entry->selection('clear');
                    $entry->delete($cursor, 'end');
                    $entry->insert($cursor, $choice_tail);
                    $entry->selection('range', $cursor, 'end');
                    if (length $rest_of_line) {
                        $entry->insert('end', " " . $rest_of_line);
                    }
                    $entry->icursor($cursor);

                    last;                          # break out of foreach $choice
                }
            }
        }
    }
}

# called when the <Down> key is pressed within the entry
sub entry_cursor_down {
    my $self    = shift;
    my $listbox = $self->Subwidget('slistbox')->Subwidget('listbox');
    my $entry   = $self->Subwidget('entry');

    $self->{Configure}{was_real_input} = 0;

    # print "entry_cursor_down\n";

    my $index;

    # unless it's already there, open the listbox and focus first entry
    unless ($self->{popped}) {
        if ($self->cget(-multimatch)) {
            my $text   = $entry->get;
            my $cursor = $entry->index('insert');
            (my $typed_text   = $text) =~ s/^(.{$cursor})(.*)/$1/;
            (my $current_word = $typed_text) =~ s/.*\s(.*)/$1/;
            $self->open_listbox($current_word);
        } else {
            $self->open_listbox;
        }

        $listbox->selection('clear', 0, 'end');
        $listbox->selectionSet(0);
        $listbox->activate(0);
        $index = 0;
    } else {    # otherwise move selection one down, unless already at bottom
                # print "one down\n";
        if ($self->cget(-multimatch)) {
            my $text   = $entry->get;
            my $cursor = $entry->index('insert');
            (my $typed_text   = $text) =~ s/^(.{$cursor})(.*)/$1/;
            (my $current_word = $typed_text) =~ s/.*\s(.*)/$1/;
            $self->listbox_filter($current_word);
        } else {
            $self->listbox_filter;
        }

        $index = $self->listbox_index;
        if ($index < $self->{Configure}{last_number_of_entries} - 1) {
            $index++;

            # check whether no element was selected before
            $index = 0 if ($index == 1 && !$listbox->selectionIncludes(0));

            $listbox->selection('clear', 0, 'end');
            $listbox->selectionSet($index);
            $listbox->activate($index);
        } else {
            $self->Callback(-bottomcmd => $self);
            if ($self->cget(-wraparound)) {
                $index = 0;
                $listbox->selection('clear', 0, 'end');
                $listbox->selectionSet($index);
                $listbox->activate($index);
            }
        }
    }

    $listbox->see($index);
    $self->listbox_copy_to_entry;
    $self->entry_select_from_cursor_to_end;
}

sub entry_cursor_up {
    my $self    = shift;
    my $listbox = $self->Subwidget('slistbox')->Subwidget('listbox');
    my $entry   = $self->Subwidget('entry');

    my $index;

    $self->{Configure}{was_real_input} = 0;

    # unless it's already there, open the listbox and focus first entry
    unless ($self->{popped}) {

        if ($self->cget(-multimatch)) {
            my $text   = $entry->get;
            my $cursor = $entry->index('insert');
            (my $typed_text   = $text) =~ s/^(.{$cursor})(.*)/$1/;
            (my $current_word = $typed_text) =~ s/.*\s(.*)/$1/;
            $self->open_listbox($current_word);
        } else {
            $self->open_listbox;
        }

        $listbox->selection('clear', 0, 'end');
        $listbox->selectionSet(0);
        $listbox->activate(0);
        $index = 0;
    } else {    # otherwise move selection one up, unless already at top
        if ($self->cget(-multimatch)) {
            my $text   = $entry->get;
            my $cursor = $entry->index('insert');
            (my $typed_text   = $text) =~ s/^(.{$cursor})(.*)/$1/;
            (my $current_word = $typed_text) =~ s/.*\s(.*)/$1/;
            $self->listbox_filter($current_word);
        } else {
            $self->listbox_filter;
        }
        $index = $self->listbox_index;
        if ($index > 0) {
            $index--;
        } else {
            $self->Callback(-topcmd => $self);
            if ($self->cget(-wraparound)) {
                $index = $self->{Configure}{last_number_of_entries} - 1;
                $listbox->selection('clear', 0, 'end');
                $listbox->selectionSet($index);
                $listbox->activate($index);
            }
        }

        $listbox->selection('clear', 0, 'end');
        $listbox->selectionSet($index);
        $listbox->activate($index);
    }

    $listbox->see($index);
    $self->listbox_copy_to_entry;
    $self->entry_select_from_cursor_to_end;
}

# Select text in the entry widget, from current cursor position to end
sub entry_select_from_cursor_to_end {
    my $self  = shift;
    my $entry = $self->Subwidget('entry');

    # set insertion cursor to begin of line if the last listbox
    # filtering process was successful only because of -matchprefix
    # (beginning of current word in multi-match mode)

    if ($self->{Configure}{last_filter_matched_by_prefix_only}) {
        if ($self->cget(-multimatch)) {
            my $pos = $entry->index('insert');
            (my $text = $entry->get) =~ s/^(.{$pos})/$1/;
            $text =~ s/(.*)\s.*/$1/;

            # print $text."\n";
            # print "..." . length $text , "\n(of $pos)\n";
            if (length $text > $pos) {
                if ($text =~ m/(.{$pos})/) {
                    my $t = $1;
                    $t =~ s/(.*)\s.*/$1/;

                    # print "...$t\n";
                    $entry->icursor(1 + length $t);
                } else {
                    $entry->icursor($pos);
                }
            } else {
                $entry->icursor(1 + length $text);
            }
        } else {
            $entry->icursor(0);
        }
    }

    if ($self->cget(-multimatch)) {
        my $pos = $entry->index('insert');
        (my $text = $entry->get) =~ s/^.{$pos}(.*)/$1/;
        if ($text =~ m/\s/g) {
            $pos += pos($text) - 1;

            # print "spacematch: $text\n";
        } else {
            $pos = $entry->index('end');
        }

        # print "pps: $pos\n";
        $entry->selectionRange($entry->index('insert'), $pos);
    } else {
        $entry->selectionRange($entry->index('insert'), $entry->index('end'));
    }
}

# called when mouse button 1 is released within the listbox
sub release_listbox {
    my ($self, $x, $y) = @_;
    $self->choose_listbox($x, $y);
}

# allows the programmer to popup the listbox if auto-popup is disabled
sub popup {
    my $self         = shift;
    my $current_word = shift;    # optional, introduced with multi-matching
    $self->open_listbox($current_word);
}

# hide/unhide the popup listbox
sub open_listbox {
    my $self         = shift;
    my $current_word = shift;    # optional, introduced with multi-matching

    # check whether we are in state "disabled"
    return if ($self->cget('-state') eq 'disabled');

    if ($self->{'popped'}) {
        $self->close_listbox;
    } else {
        $self->show_listbox($current_word);
    }
}

# Remove all entries from the choices listbox which can't match the user's
# input anymore.
sub listbox_filter {
    my $self          = shift;
    my $text_to_match = shift;    # optional, introduced with multimatching

    my $listbox = $self->Subwidget('slistbox')->Subwidget('listbox');
    my $entry   = $self->Subwidget('entry');

    $entry->update;
    my $cursor_pos = $entry->index('insert');

    my $old_index = $self->listbox_index;
    my ($old_value, $new_index);
    if (defined $old_index) {
        $old_value = $listbox->get($old_index);
    }
    $listbox->delete(0, 'end');
    my $ignore_case   = ($self->cget(-case) ? "(?i)" : "");
    my $all_choices_r = $self->{Configure}{all_choices_r};
    my @all_choices   = @$all_choices_r;

    my $text = $entry->get;
    (my $typed_text = $text) =~ s/^(.{$cursor_pos})(.*)/$1/;
    my $rest_of_line = $2;

    my $prefix = $self->cget(-matchprefix) || "";

    my $force_match = '';
    if (length $self->{Configure}{last_user_input}) {
        $force_match = $self->{Configure}{last_user_input};
    }

    unless (defined $text_to_match) {
        if ($rest_of_line ne "") {    # text after cursor
                                      # only use matching if whole text matches one of the choices
            my $text_is_choice = 0;

            foreach my $choice (@all_choices) {
                if ($text =~ m/^${ignore_case}\Q$choice\E$/) {
                    $text_is_choice++;
                }
            }

            # give it a try for sure if we have a match-prefix
            $self->{Configure}{last_filter_matched_by_prefix_only} = 0;
            if ($text_is_choice == 0) {
                if (length $prefix) {
                    $self->{Configure}{last_filter_matched_by_prefix_only} = 1;
                    $text_is_choice++;
                }
            }

            return unless ($text_is_choice);
        }
    } else {    # multimatch mode or $text_to_match otherwise specified
                # print "text to match: $text_to_match\n";
        $typed_text = $text_to_match;

        if (length $typed_text) {

            # check whether the text typed by the user can match
            # any of the choices,
            # a) as it is
            # b) at least with the match-prefix
            my $text_is_choice = 0;
            foreach my $choice (@all_choices) {
                if ($choice =~ m/^${ignore_case}\Q$typed_text\E/) {
                    $text_is_choice++;
                }
            }

            # give it a try for sure if we have a match-prefix
            $self->{Configure}{last_filter_matched_by_prefix_only} = 0;
            if ($text_is_choice == 0) {
                if (length $prefix) {
                    $self->{Configure}{last_filter_matched_by_prefix_only} = 1;
                    $text_is_choice++;
                }
            }
        }
    }

    if ($self->{Configure}{last_filter_matched_by_prefix_only}) {
        $self->{Configure}{last_user_input} = $typed_text;
    } else {
        $self->{Configure}{last_user_input} = '';
    }

    # print "real input: . " . $self->{Configure}{was_real_input} . "\n";

    if (length $force_match) {
        $typed_text = $force_match
          unless ($self->{Configure}{was_real_input});
        $self->{Configure}{last_user_input} = $typed_text
          unless ($self->{Configure}{was_real_input});
    }

    my $index = 0;
    foreach my $choice (@all_choices) {    # @all_choices is sorted
        if ($choice =~ m/^${ignore_case}$prefix\Q$typed_text\E/) {
            $listbox->insert('end', $choice);
            if (defined $old_value && ($old_value eq $choice)) {
                $new_index = $index;
            }
            $index++;
        }
    }

    if (defined $new_index) {

        # $listbox->see($new_index);
        $listbox->selectionSet($new_index);
        $listbox->activate($new_index);
    }

    $self->{Configure}{last_number_of_entries} = $index;
    return $index;    # equals number of visible elements
}

# Display the listbox
sub 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($current_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(-highlightthickness);

        #my $ht = ($scrolled_listbox->reqheight / 2) + 2 * $bd + 2;

        # Calculate height for listbox. Default reqheight = 10 elements.
        my $maxheight = $self