view release on metacpan or  search on metacpan

alpha/Tk/MenuEntry.pm  view on Meta::CPAN

package Tk::MenuEntry;

use Tk qw(Ev);
use strict;
use vars qw(@ISA $VERSION);

@ISA = qw(Tk::Derived Tk::Frame);
$VERSION = "0.02";

Construct Tk::Widget 'MenuEntry';

my $BITMAP;

sub ClassInit {
    my($class,$mw) = @_;

    unless(defined($BITMAP)) {
	$BITMAP = __PACKAGE__ . "::downarrow";

	my $bits = pack("b12"x5,".1111111111.",
				"..11111111..",
				"...111111...",
				"....1111....",
				".....11.....");

	$mw->DefineBitmap($BITMAP => 12,5, $bits);
    }
}

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

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

    my $sf = $me->Frame;

    my $b = $sf->Button(
	-bitmap => $BITMAP,
	-anchor => 'center',
	-highlightthickness => 0,
    )->pack(-fill => 'both', -expand => 1);

    $me->Advertise(Button => $b);

    $sf->packPropagate(0);
    $sf->GeometryRequest($b->ReqWidth + 2,1);
    $sf->pack(-side => 'right', -fill => 'y');

    my $e = $me->Entry(
	-borderwidth => 0,
	-highlightthickness => 0,
    )->pack(
	-side => 'left',
	-fill => 'both',
	-expand => 1
    );

    # popup shell for listbox with values.
    my $c = $me->Toplevel(-bd => 2,-relief => "raised");
    $c->overrideredirect(1);
    $c->withdraw;
    my $sl = $c->ScrlListbox(
	-scrollbars => 'oe',
	-selectmode => "browse",
	-exportselection => 0,
	-bd => 0,
	-width => 0,