1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
# You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
# (C) Paul Evans, 2020-2023 -- leonerd@leonerd.org.uk
use v5.20;
use warnings;
use Object::Pad 0.800;
package Tickit::WidgetRole::SingleChildContainer 0.42;
role Tickit::WidgetRole::SingleChildContainer;
use Carp;
=head1 NAME
C<Tickit::WidgetRole::SingleChildContainer> - role for widgets that contain a
single other widget
=head1 SYNOPSIS
class Some::Widget::Class
:isa(Tickit::Widget)
:does(Tickit::WidgetRole::SingleChildContainer);
...
=head1 DESCRIPTION
Applying this role to a L<Tickit::Widget> subclass adds behaviour for it to
act as a container widget holding a single child widget.
=cut
field $_child :reader;
=head1 METHODS
=cut
=head2 child
$child = $widget->child;
Returns the contained child widget.
=cut
# generated accessor
method children
{
return $_child ? ( $_child ) : () if wantarray;
return $_child ? 1 : 0;
}
=head2 set_child
$widget->set_child( $child );
Sets the child widget, or C<undef> to remove.
This method returns the container widget instance itself making it suitable to
use as a chaining mutator; e.g.
my $container = Tickit::SingleChildWidget->new( ... )
->set_child( Tickit::Widget::Static->new( ... ) );
=cut
method set_child
{
my ( $child ) = @_;
if( my $old_child = $_child ) {
$self->remove( $old_child );
}
if( $child ) {
$self->add( $child );
}
return $self;
}
method add
{
croak "Already have a child; cannot add another" if $_child;
( $_child ) = @_;
$self->next::method( @_ );
}
method remove
{
my ( $child ) = @_;
croak "Cannot remove this child" if !$_child or $_child != $child;
undef $_child;
$self->next::method( $child );
}
=head1 AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
=cut
0x55AA;
|
