Tk::Action - action abstraction for tk

Tk-Action documentation

Contained in the Tk-Action distribution.

Index

NAME
VERSION
SYNOPSIS
DESCRIPTION
ATTRIBUTES
- callback
- window
METHODS
SEE ALSO
AUTHOR
COPYRIGHT AND LICENSE

Code Index:

package Tk::Action
- add_widget
- add_binding
- enable
- disable
__END__
EOF

NAME

Tk::Action - action abstraction for tk

VERSION

version 1.093390

SYNOPSIS

    my $action = Tk::Action->new(
        window   => $mw,
        callback => \&jfdi,
    );
    $action->add_widget( $menu_entry );
    $action->add_widget( $button );
    $action->add_binding( '<Control-F>' );
    $action->enable;
    ...
    $action->disable;

DESCRIPTION

Menu entries are often also available in toolbars or other widgets. And sometimes, we want to enable or disable a given action, and this means having to update everywhere this action is allowed.

This module helps managing actions in a Tk GUI: just create a new object, associate some widgets and bindings with add_widget() and then de/activate the whole action at once with enable() or disable().

ATTRIBUTES

callback

The callback associated to the action. It is needed to create the shortcut bindings. Required, no default.

window

The window holding the widgets being part of the action object. It is needed to create the shortcut bindings. Required, no default.

METHODS

$action->add_widget( $widget );

Associate $widget with $action. Enable or disable it depending on current action status.

$action->rm_widget( $widget );

De-associate $widget from C$<action>.

$action->add_binding( $binding );

Associate $binding with $action. Enable or disable it depending on current action status. $binding is a regular binding, as defined by Tk::bind.

It is not possible to remove a binding from an action.

$action->enable;

Activate all associated widgets and shortcuts.

$action->disable;

De-activate all associated widgets and shortcuts.

SEE ALSO

You can look for information on this module at:

* Search CPAN: http://search.cpan.org/dist/Tk-Action
* See open / report bugs: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Tk-Action
* Git repository: http://github.com/jquelin/tk-action
* AnnoCPAN: Annotated CPAN documentation: http://annocpan.org/dist/Tk-Action
* CPAN Ratings: http://cpanratings.perl.org/d/Tk-Action

AUTHOR

  Jerome Quelin

COPYRIGHT AND LICENSE

This software is copyright (c) 2009 by Jerome Quelin.

This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.

Tk-Action documentation

Contained in the Tk-Action distribution.

# 
# This file is part of Tk-Action
# 
# This software is copyright (c) 2009 by Jerome Quelin.
# 
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# 
use 5.010;
use strict;
use warnings;

package Tk::Action;
our $VERSION = '1.093390';


# ABSTRACT: action abstraction for tk

use Moose 0.92; # attribute helpers
use MooseX::Has::Sugar;
use MooseX::SemiAffordanceAccessor;
use Tk::Sugar;


# -- attributes & accessors

# a hash with action widgets.
has _widgets => (
    ro,
    traits  => ['Hash'],
    isa     => 'HashRef',
    default => sub { {} },
    handles => {
        rm_widget    => 'delete',
        _set_widget  => 'set',      # $action->_set_widget($widget, $widget);
        _all_widgets => 'values',   # my @widgets = $action->_all_widgets;
    },
);

# a list of bindings.
has _bindings => (
    ro,
    traits  => ['Array'],
    isa     => 'ArrayRef',
    default => sub { [] },
    handles => {
        _add_binding  => 'push',      # $action->_add_binding($binding);
        _all_bindings => 'elements',  # my @bindings = $action->_all_bindings;
    },
);

# whether the action is currently available
has is_enabled => (
    ro,
    traits  => ['Bool'],
    isa     => 'Bool',
    default => 1,
    handles => {
        _enable  => 'set',
        _disable => 'unset',
    },
);


has callback => ( ro, required, isa => 'CodeRef'    );
has window   => ( ro, required, isa => 'Tk::Widget' );



# -- public methods


sub add_widget {
    my ($self, $widget) = @_;
    $self->_set_widget($widget, $widget);
    $widget->configure( $self->is_enabled ? enabled : disabled );
}



# rm_widget() implemented in _widget attribute declaration



sub add_binding {
    my ($self, $binding) = @_;
    $self->_add_binding($binding);
    $self->window->bind( $binding, $self->is_enabled ? $self->callback : '' );
}



sub enable {
    my $self = shift;
    $_->configure(enabled) for $self->_all_widgets;
    $self->window->bind( $_, $self->callback ) for $self->_all_bindings;
    $self->_enable;
}



sub disable {
    my $self = shift;
    $_->configure(disabled) for $self->_all_widgets;
    $self->window->bind( $_, '' ) for $self->_all_bindings;
    $self->_disable;
}


no Moose;
__PACKAGE__->meta->make_immutable;

1;


__END__