Tk-Bounded

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

When a bounding is created with the B<bound> command, it is associated either
with a particular window such as I<$widget>, a class name such as B<Tk::Button>,
the keyword B<all>, or any other string. All of these forms are called
I<bounding tags>. Each window has a list of bounding tags and levels that
determine how events are processed for the window.  When an event occurs in a
window, it is applied to each of the window's tags in order:  for each tag, the
most specific bounding that matches the given tag and event is executed. See the
L<Tk::bound> documentation for more information on the matching process.

In addition, Tk::Bounded is used with Perl's multiple inheritance to override
some methods normally inherited from Tk::Derived and Tk::Widget. It also
specifies level 1 bound tags for caller class.

=head1 AUTHOR

Copyright (c) 2000-2007 Meccanomania

=cut

lib/Tk/Bounded.pm  view on Meta::CPAN

package Tk::Bounded;

# Import bound and boundtags for caller.
use Tkbound;
use Tkboundtags;

$VERSION = '$Revision: 58 $' =~ /\D(\d+)\s*\$$/;

use attributes;
use Carp;
use base qw/Tk::Derived/;
use Tk qw/Ev lsearch/;

# Deriving from Tk::Derived class is not well documented.

# We need a Populate function in order to add some config specs, but derived
# base class (as not derived from the widget class) cannot handle it. Workaround
# it by calling the Populate function in the package that use it. To do so, add
# a _super wrapper function into user's class namespace, that, in turn calls the
# bounded class Populate function.
# [Delegate ?]
#
# On the other hand, ConfigSpec function is defined in derived class, and we can
# call it a as regular Tk derived class does.

lib/Tk/Bounded.pod  view on Meta::CPAN

	print "$m\n";

	my $w = $Tk::bwidget;
	print "$w\n";
  }


=head1 DESCRIPTION

Tk::Bounded is used with Perl's multiple inheritance to override some methods
normally inherited from Tk::Derived and Tk::Widget. It also specifies level 1
bound tags for caller class.

Tk::Bounded should precede any Tk widgets in the class's base class definition.

Tk::Bounded's main purpose is to apply wrappers to C<configure> and C<cget>
methods of widgets to allow the derived widget to add to or modify behaviour
of the configure options supported by the base widget.

The bounded class should normally override the C<Populate> method provided by
Tk::Bounded and call C<ConfigSpecs> to declare configure options.

lib/Tk/Bounded.pod  view on Meta::CPAN

=over 4

=item -E<gt>ConfigSpecs(-I<key> =E<gt> [I<kind>, I<name>, I<Class>, I<default>],
...) 

=back

=head1 SEE ALSO

L<Tk::Derived|Tk::Derived>
L<Tk::ConfigSpecs|Tk::ConfigSpecs>
L<Tk::mega|Tk::mega>
L<Tk::composite|Tk::composite>
L<Tk::bound|Tk::bound>
L<Tk::boundtags|Tk::boundtags>


=cut

t/bound.t  view on Meta::CPAN

# Associate boundings
#-------------------------------------------------------------------------------

$title = 'Associate boundings - previous callback called.';

$here = 0;

{
  package Tk::bEntry_1;

  use base qw/Tk::Derived Tk::Entry/;
  use Tkbound qw/:bound_mask/;

  Construct Tk::Widget 'bEntry_1';

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

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

    $mw -> bound( $class, '<Left>',  nP );

t/bound.t  view on Meta::CPAN

#-------------------------------------------------------------------------------

$title = 'Associate boundings - user defined - without arguments - sub { }';

$here = 0;

{
  package Tk::bEntry_2;

  use base qw/Tk::Derived Tk::Entry/;
  use Tkbound qw/:bound_mask/;

  Construct Tk::Widget 'bEntry_2';

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

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

    $mw -> bound( $class, '<Left>',  nP, sub { $here = 1 } );

t/bound.t  view on Meta::CPAN

#-------------------------------------------------------------------------------

$title = 'Associate boundings - user defined - without arguments - \'methodname\'.';

$here = 0;

{
  package Tk::bEntry_2b;

  use base qw/Tk::Derived Tk::Entry/;
  use Tkbound qw/:bound_mask/;

  Construct Tk::Widget 'bEntry_2b';

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

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

    $mw -> bound( $class, '<Left>', nP, 'here' );

t/bound.t  view on Meta::CPAN

#-------------------------------------------------------------------------------
# Callback and substitutions.
#-------------------------------------------------------------------------------

$title = 'Callback and substitution - use &Tk::bEv.';

{
  package Tk::bEntry_3;

  use base qw/Tk::Derived Tk::Entry/;
  use Tkbound qw/:bound_mask/;
  use Tk qw/bEv/;

  Construct Tk::Widget 'bEntry_3';

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

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

t/bound.t  view on Meta::CPAN

    $title );


#-------------------------------------------------------------------------------

$title = 'Callback and substitution - use $self -> bXevent.';

{
  package Tk::bEntry_4;

  use base qw/Tk::Derived Tk::Entry/;
  use Tkbound qw/:bound_mask/;

  Construct Tk::Widget 'bEntry_4';

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

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

    $mw -> bound( $class, '<Left>',  nP, sub {

t/bound.t  view on Meta::CPAN

		'SetCursor' ] ),
    $title );

#-------------------------------------------------------------------------------

$title = 'Callback and substitution - use $Tk::bwidget and $Tk::bevent.';

{
  package Tk::bEntry_5;

  use base qw/Tk::Derived Tk::Entry/;
  use Tkbound qw/:bound_mask/;

  Construct Tk::Widget 'bEntry_5';

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

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

    $mw -> bound( $class, '<Left>',  nP, 'NoOp' );

t/bound.t  view on Meta::CPAN

#-------------------------------------------------------------------------------
# Out of bound level
#-------------------------------------------------------------------------------

$title = 'Out of bound level.';

$here = 0;
{
  package Tk::bEntry_6;

  use base qw/Tk::Derived Tk::Entry/;
  use Tkbound qw/:bound_mask/;

  Construct Tk::Widget 'bEntry_6';

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

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

    $mw -> bound( $class, '<Left>', nP, sub { $here++ } );

t/boundtags.t  view on Meta::CPAN

#-------------------------------------------------------------------------------
# Associate bound tags.
#-------------------------------------------------------------------------------

$title = 'Associate bound tags.';

$here = 0;
{
  package Tk::bEntry_1;

  use base qw/Tk::Derived Tk::Entry/;
  use Tkbound qw/:bound_mask/;
  use Tkboundtags;

  Construct Tk::Widget 'bEntry_1';

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

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

t/boundtags.t  view on Meta::CPAN

#-------------------------------------------------------------------------------
# Out of bound level
#-------------------------------------------------------------------------------

$title = 'Out of bound level.';

$here = 0;
{
  package Tk::bEntry_2;

  use base qw/Tk::Derived Tk::Entry/;
  use Tkbound qw/:bound_mask/;

  Construct Tk::Widget 'bEntry_2';

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

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

    $mw -> bound( $class, '<Left>', nP, sub { $here++ } );

t/boundtags.t  view on Meta::CPAN

#-------------------------------------------------------------------------------
# Retreive bound tags
#-------------------------------------------------------------------------------

$title = 'Retreive bound tags.';

$here = 0;
{
  package Tk::bEntry_3;

  use base qw/Tk::Derived Tk::Entry/;
  use Tkbound qw/:bound_mask/;

  Construct Tk::Widget 'bEntry_3';

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

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

    $mw -> bound( $class, '<Left>', nP, sub { $here++ } );