Hi all,
I am trying to create a MegaWidget that is a ReadOnly version of
Tk::ComboEntry by Damian Wilson (part of the Tk-DKW package).  Because
Tk::ComboEntry sorts list entries when they are inserted into the popup
window, it makes selecting the proper entry difficult since you don't know
at which index it would be.  One way to overcome, is to maintain a global
hash that stores your sorted lists, with lookups for their index value.
But, that means re-sorting the lists, another global laying around, etc.

I believe I almost have it working.  Just one problem, for some reason the
widget displays an empty ComboEntry, and then the ComboEntry I want is
inside the Entry widget of the first.  A strange effect.  If you run this
code, you'll see.  Does anyone know what is wrong here?


$Tk::ROComboEntry::VERSION = '1.0';

package Tk::ROComboEntry;

use base qw/Tk::Derived Tk::ComboEntry/;

Construct Tk::Widget 'ROComboBox';

use strict;
use warnings;

# ClassInit is called once per MainWindow, and serves to
# perform tasks for the class as a whole.
sub ClassInit {
    my ($class, $mw) = @_;

    $class-> SUPER::ClassInit($mw);

} # end ClassInit

sub Populate {
    my ($self, $args) = @_;

    $self-> SUPER::Populate($args);

    my $ce = $self-> Component
       (
        'ComboEntry' =>  'ComboEntry'
       );

    $ce-> grid(); # remove this line and an empty ComboEntry shows

    $self-> Advertise( 'ce' => $ce );

    $self-> ConfigSpecs
       (
        '-select' =>  ['PASSIVE', 'select', 'Select', undef],
        '-vals' =>  ['PASSIVE', 'vals', 'Vals', undef],
        -listheight =>  [ $ce, qw/listheight ListHeight 180/ ],
        -popupwidth =>  [ $ce, qw/popupwidth PopupWidth 100/ ],
        -SelectValue =>  [ qw/METHOD selectvalue SelectValue/],
        'DEFAULT' =>  [$ce],
       );

    $self-> Delegates( 'DEFAULT' => $ce );

    # Create a hash that tells us the sort order, hence index, of
    #   the elements in our combo box.
    # Assumption: elements in the combo box do not change, are
    #    initialzed once and always remain the same.  If not
    #    events should be trapped to update -vals.
    # Note: sorted elements is a hard coded function of ComboEntry.pm
    my $o = 0;
    foreach my $vals ( sort @{$args-> {'-vals'}} ) {
        $self-> {'-vals'}{$vals} = $o;
        $o++;
    } # end foreach
    $self-> {'-select'} = $args->{'-select'};

    $ce-> SelectionList( keys %{$self->{'-vals'}} );
    $ce-> SelectionState( 'disabled' );

    my $e = $ce-> Subwidget('Entry');
    $e-> configure( -cursor => undef );

    if( defined $self-> {'-select'} ) {
        $self-> SelectValue( $self->{'-select'} );
    }

} # end sub

sub SelectValue {
    my $self = shift;
    my $val = shift;

    my $ce = $self-> Subwidget ('ComboEntry');
    $ce-> {m_ListBox}->selectionSet( $self->{'-vals'}{$val} );
    $ce-> Select();

} # end sub

package main;

our $top = MainWindow-> new();
$top-> title("TopDialog");
my @vals = qw/abc def ghi jkl mno pqr stu vwx yz abcdef ghijkl mnopqr stuvwx
yzd fds fg wey gfjh dfg ytuye/;
$top-> ROComboBox( -vals => \@vals, -select => $vals[2]  )->grid();
$top-> gridRowconfigure(0, -weight => 0, -minsize => 80, -pad => 0);

Tk::MainLoop();

1; # Ancient Druid Custom

-++**==--++**==--++**==--++**==--++**==--++**==--++**==
This message was posted through the Stanford campus mailing list
server.  If you wish to unsubscribe from this mailing list, send the
message body of "unsubscribe ptk" to majordomo@lists.stanford.edu