File Coverage

blib/lib/Tk/Menustrip.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

package Tk::Menustrip;

use Tk;
use Tk::Label;
use Tk::Button;
use Tk::Toplevel;

use base qw (Tk::Frame);
use vars qw ($VERSION);
use strict;
use Carp;

$VERSION = '0.01';

Tk::Widget->Construct ('Menustrip');

sub Populate
   {
    my ($this, %p_Options) = (shift, @_);

    my $l_DefaultFont = delete $p_Options {'-font'} || '-*-Times-Medium-R-Normal--*-140-*-*-*-*-*-*';

    my $l_SubRef = sub
       {
        $this->configure ('-automenu' => 'false');
        $this->Hide();
       };

    $this->SUPER::Populate (@_);
    $this->toplevel()->bind ('' => $l_SubRef);
    $this->bind ('' => $l_SubRef);

    $this->ConfigSpecs
       (
        '-background' => [['SELF', 'CHILDREN', 'DESCENDANTS'], 'background', 'Background', $this->parent()->cget ('-background')],
        '-foreground' => [['SELF', 'PASSIVE', 'CHILDREN', 'DESCENDANTS'], 'foreground', 'Foreground', 'black'],
        '-borderwidth' => ['SELF', 'borderwidth', 'BorderWidth', 1],
        '-automenu' => ['METHOD', 'automenu', 'AutoMenu', 'false'],
        '-font' => ['PASSIVE', 'font', 'Font', $l_DefaultFont],
        '-relief' => ['SELF', 'relief', 'Relief', 'raised'],
       );

    $this->configure ('-font' => $l_DefaultFont);

    return $this;
   }

sub automenu
   {
    $_[0]->{'m_AutoMenu'} =
       (
        defined ($_[1]) ?
        ($_[1] eq 'true' || $_[1] > 0 || $_[1] eq 'on') :
        $_[0]->{'m_AutoMenu'}
       );
   }

sub MenuLabel
   {
    my ($this, $p_Caption, $p_Flag) = (shift, @_);

    my $l_Frame = $this->Component
       (
        'Frame' => $this->FixName ($p_Caption),
        '-borderwidth' => 2,
        '-relief' => 'flat',
       );

    my $l_Label = $l_Frame->Component
       (
        'Button' => 'Label',
        '-font' => $this->cget ('-font'),
        '-text' => $p_Caption,
        '-relief' => 'flat',
        '-borderwidth' => 0,
        '-padx' => 0,
        '-pady' => 0,
       );

    my $l_Popup = $l_Frame->Component
       (
        'Toplevel' => 'Popup',
        '-relief' => 'raised',
        '-borderwidth' => 1,
       );

    $l_Label->configure
       (
        '-activebackground' => $l_Label->cget ('-background'),
        '-highlightthickness' => 1,
       );

    $l_Label->pack
       (
        '-expand' => 'true',
        '-side' => 'left',
        '-ipadx' => 0,
        '-ipady' => 0,
        '-padx' => 0,
        '-pady' => 0,
       );

    $l_Frame->pack
       (
        '-side' => ($p_Flag eq '-right' ? 'right' : 'left'),
        '-anchor' => ($p_Flag eq '-right' ? 'ne' : 'nw'),
        '-fill' => 'y',
        '-padx' => 1,
        '-pady' => 1,
       );

    $l_Label->bind
       (
        '' => sub
           {
            $this->configure ('-automenu' => 'true');
            $this->Show ($l_Label);
            Tk->break;
           }
       );

    $l_Label->bind
       (
        '' => sub
           {
            $this->Show ($l_Label) if ($this->cget ('-automenu'));
            Tk->break;
           }
       );

    $l_Label->bind
       (
        '' => sub
           {
            $this->configure ('-automenu' => 'true');
            $this->Show ($l_Label);
           }
       );

    $l_Label->bind
       (
        '' => sub
           {
            $this->configure ('-automenu' => 'true');
            $this->Show ($l_Label);
           }
       );

    $l_Label->bind
       (
        '' => sub
           {
            $l_Label->focusNext();
           }
       );

    $l_Label->bind
       (
        '' => sub
           {
            $l_Label->focusPrev();
           }
       );

    $l_Popup->bind
       (
        '' => sub
           {
            $this->automenu ('false');
            $this->Hide();
           }
       );

    push (@{$this->{m_MenuList}}, $l_Label);
    $l_Popup->overrideredirect (1);
    $this->Hide ($l_Label);
   }

sub MenuEntry
   {
    my ($this, $p_Caption, $p_EntryCaption, $p_Action) = (shift, @_);

    unless (defined ($p_EntryCaption))
       {
        $this->MenuSeparator ($p_Caption);
        return;
       }

    unless (Exists ($this->Subwidget ($this->FixName ($p_Caption))))
       {
        $this->MenuLabel ($p_Caption);
        return unless Exists ($this->Subwidget ($this->FixName ($p_Caption)));
       }

    my $l_Popup = $this->Subwidget ($this->FixName ($p_Caption))->Subwidget ('Popup');

    my $l_Label = $l_Popup->Component
       (
        'Button' => $this->FixName ($p_EntryCaption),
        '-font' => $this->cget ('-font'),
        '-highlightthickness' => 1,
        '-text' => $p_EntryCaption,
        '-justify' => 'left',
        '-relief' => 'flat',
        '-borderwidth' => 1,
        '-anchor' => 'w',
        '-padx' => 5,
        '-pady' => 0,
       );

    $l_Popup->{'m_Focus'} = $l_Label unless (defined ($l_Popup->{'m_Focus'}));

    unless (ref ($p_Action) eq 'CODE')
       {
        $p_Action = sub {printf ("[%s]\n", $p_EntryCaption);};
       }

    $l_Label->configure
       (
        '-command' => sub
           {
            if ($l_Label->{m_Enabled} eq 'true')
               {
                $this->automenu ('false');
                $this->Hide();
                $this->afterIdle ($p_Action);
               }
           }
       );

    $l_Label->pack
       (
        '-expand' => 'true',
        '-anchor' => 'nw',
        '-side' => 'top',
        '-fill' => 'x',
        '-ipadx' => 0,
        '-ipady' => 0,
        '-padx' => 0,
        '-pady' => 0,
       );

    $l_Label->bind
       (
        '' => sub
           {
            $l_Label->focusPrev();
           }
       );

    $l_Label->bind
       (
        '' => sub
           {
            $l_Label->focusNext();
           }
       );

    $l_Label->bind
       (
        '' => sub
           {
            my $l_Header = $l_Popup->parent()->Subwidget ('Label');

            $this->Hide ($l_Header);
            $l_Header->focusPrev();

            my $l_Next = $this->toplevel()->focusCurrent();
            my $l_Found = 0;

            foreach my $l_Widget (@{$this->{m_MenuList}})
               {
                $l_Found = 1 if ($l_Next eq $l_Widget);
               }

            $this->Show ($l_Next) if ($l_Found);
           }
       );

    $l_Label->bind
       (
        '' => sub
           {
            my $l_Header = $l_Popup->parent()->Subwidget ('Label');
            $this->Hide ($l_Header);
            $l_Header->focusNext();

            my $l_Next = $this->toplevel()->focusCurrent();
            my $l_Found = 0;

            foreach my $l_Widget (@{$this->{m_MenuList}})
               {
                $l_Found = 1 if ($l_Next eq $l_Widget);
               }

            $this->Show ($l_Next) if ($l_Found);
           }
       );

    $l_Label->bind
       (
        '' => sub
           {
            $l_Label->invoke();
           }
       );

    $this->EnableEntry
       (
        $p_Caption,
        $p_EntryCaption
       );
   }

sub MenuSeparator
   {
    my ($this, $p_Caption) = (shift, @_);

    unless (Exists ($this->Subwidget ($this->FixName ($p_Caption))))
       {
        $this->MenuLabel ($p_Caption);
        return unless Exists ($this->Subwidget ($this->FixName ($p_Caption)));
       }

    my $l_Popup = $this->Subwidget ($this->FixName ($p_Caption))->Subwidget ('Popup');

    my $l_Frame = $l_Popup->Frame
       (
        '-borderwidth' => 1,
        '-relief' => 'flat',
       );

    my $l_Separator = $l_Frame->Frame
       (
        '-borderwidth' => 1,
        '-relief' => 'sunken',
        '-height' => 2,
       );

    $l_Separator->pack
       (
        '-anchor' => 'w',
        '-side' => 'left',
        '-fill' => 'x',
        '-expand' => 'true',
       );

    $l_Frame->pack
       (
        '-anchor' => 'nw',
        '-expand' => 'true',
        '-side' => 'top',
        '-fill' => 'x',
       );
   }

sub Show
   {
    my ($this, $p_Label) = (shift, @_);
    my $l_Popup = $p_Label->parent()->Subwidget ('Popup');
    my $l_Label = $p_Label;

    $this->Hide();

    $p_Label->parent()->configure
       (
        '-relief' => 'groove',
       );

    my $l_CodeRef = sub
       {
        $l_Popup->raise(); # Tk::
        $l_Popup->MapWindow();

        $l_Popup->geometry
           (
            '+'.
            ($l_Label->rootx() - 1).
            '+'.
            ($l_Label->parent()->rooty() + $l_Label->parent()->height() + $l_Label->cget ('-borderwidth'))
           );
       };

    $this->toplevel()->bind
       (
        '' => $l_CodeRef
       );

    &{$l_CodeRef}();

    $l_Popup->{'m_FocusRestore'} = $this->toplevel()->focusSave();
    $l_Popup->transient();
    $l_Popup->deiconify();
#    $l_Popup->focus();
#    $l_Popup->{'m_Focus'}->focus() if (Exists ($l_Popup->{'m_Focus'}));
   }

sub Hide
   {
    my ($this, $p_Label) = (shift, @_);

    if (defined ($p_Label))
       {
        my $l_Popup = $p_Label->parent()->Subwidget ('Popup');

        $this->toplevel()->bind
           (
            '' => ''
           );

        $p_Label->parent()->configure
           (
            '-relief' => 'flat',
           );

        &{$l_Popup->{'m_FocusRestore'}} if (ref ($l_Popup->{'m_FocusRestore'}) eq 'CODE');
        delete $l_Popup->{'m_FocusRestore'};
        $l_Popup->withdraw();
       }
    else
       {
        foreach my $l_Label (@{$this->{m_MenuList}})
           {
            $this->Hide ($l_Label);
           }
       }
   }

sub EnableEntry
   {
    my ($this, $p_MenuCaption, $p_EntryCaption) = (shift, @_);
    my $l_Popup = $this->Subwidget ($this->FixName ($p_MenuCaption))->Subwidget ('Popup');
    my $l_Label = $l_Popup->Subwidget ($this->FixName ($p_EntryCaption));

    $l_Label->{m_Enabled} = 'true';

    $l_Label->configure
       (
        '-activeforeground' => $this->cget ('-background'),
        '-activebackground' => $this->cget ('-foreground'),
        '-foreground' => $this->cget ('-foreground'),
        '-background' => $this->cget ('-background'),
        '-relief' => 'flat',
       );
   }

sub DisableEntry
   {
    my ($this, $p_MenuCaption, $p_EntryCaption) = (shift, @_);
    my $l_Popup = $this->Subwidget ($this->FixName ($p_MenuCaption))->Subwidget ('Popup');
    my $l_Label = $l_Popup->Subwidget ($this->FixName ($p_EntryCaption));

    $l_Label->{m_Enabled} = 'false';

    $l_Label->configure
       (
        '-activeforeground' => $l_Label->Darken ($this->cget ('-background'), 80),
        '-activebackground' => $this->cget ('-background'),
        '-foreground' => $l_Label->Darken ($this->cget ('-background'), 80),
        '-background' => $this->cget ('-background'),
        '-relief' => 'flat',
       );
   }

sub FixName
   {
    return (join ('_', split ('\.', $_[1])));
   }

1;

__END__