File Coverage

blib/lib/Circle/FE/Term/Tab.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             # You may distribute under the terms of the GNU General Public License
2             #
3             # (C) Paul Evans, 2012-2015 -- leonerd@leonerd.org.uk
4              
5             package Circle::FE::Term::Tab;
6              
7 1     1   901 use strict;
  1         2  
  1         24  
8 1     1   4 use warnings;
  1         1  
  1         23  
9              
10 1     1   337 use Tickit::Widget::Tabbed;
  0            
  0            
11             use base qw( Tickit::Widget::Tabbed::Tab );
12             Tickit::Widget::Tabbed->VERSION( '0.019' );
13              
14             use Tickit::Term 0.27; # setctl_str
15              
16             use Circle::FE::Term;
17              
18             use Module::Pluggable search_path => "Circle::FE::Term::Widget",
19             sub_name => "widgets",
20             require => 1,
21             inner => 0;
22              
23             use Tickit::Widget::Static;
24              
25             sub new
26             {
27             my $class = shift;
28             my ( $tabbed, %args ) = @_;
29              
30             my $object = delete $args{object};
31             my $self;
32              
33             my $watch_tag;
34             if( $object->proxy_isa( "Circle.RootObj" ) ) {
35             $args{label} = "Global";
36             }
37             else {
38             $args{label} = $object->prop( "tag" );
39             $watch_tag++;
40             }
41              
42             $self = $class->SUPER::new( $tabbed, %args );
43             $self->{object} = $object;
44             $self->{term} = $tabbed->window->term;
45              
46             $self->adopt_future(
47             $object->call_method(
48             get_widget => (),
49             )->on_done( sub {
50             $self->widget->add( $self->build_widget( $_[0] ), expand => 1 );
51             })
52             );
53              
54             $self->adopt_future(
55             $object->watch_property_with_initial(
56             "level",
57             on_set => sub {
58             my ( $level ) = @_;
59             $self->set_level( $level );
60             },
61             )
62             );
63              
64             $self->adopt_future(
65             $object->subscribe_event(
66             "raise",
67             on_fire => sub {
68             $self->activate;
69             },
70             )
71             );
72              
73             if( $watch_tag ) {
74             $self->adopt_future(
75             $object->watch_property(
76             "tag",
77             on_set => sub {
78             my ( $newtag ) = @_;
79             $self->set_label_text( $newtag );
80             },
81             )
82             );
83             }
84              
85             $self->set_on_activated( 'activated' );
86              
87             return $self;
88             }
89              
90             sub adopt_future
91             {
92             my $self = shift;
93             my ( $f ) = @_;
94              
95             my $futures = $self->{futures} //= {};
96              
97             $futures->{"$f"} = $f;
98              
99             $f->on_ready( sub {
100             delete $futures->{shift()};
101             });
102             }
103              
104             sub build_widget
105             {
106             my $self = shift;
107             my ( $obj ) = @_;
108              
109             foreach my $type ( widgets ) {
110             next unless $obj->proxy_isa( "Circle.Widget." . $type->type );
111             return $type->build( $obj, $self );
112             }
113              
114             die "Cannot build widget for $obj as I don't recognise its type - " . join( ", ", map { $_->name } $obj->proxy_isa ) . "\n";
115             }
116              
117             sub level
118             {
119             my $self = shift;
120             return $self->{object}->prop( "level" );
121             }
122              
123             sub set_level
124             {
125             my $self = shift;
126             my ( $level ) = @_;
127              
128             $self->set_pen( Circle::FE::Term->get_theme_pen( "level$level" ) );
129             }
130              
131             sub set_label_text
132             {
133             my $self = shift;
134             my ( $text ) = @_;
135              
136             $self->{label} = $text;
137              
138             return unless my $tab = $self->{tab};
139             $tab->set_label( $text );
140             }
141              
142             sub label
143             {
144             my $self = shift;
145             return $self->{label};
146             }
147              
148             sub label_short
149             {
150             my $self = shift;
151             my $label = $self->label;
152             $label =~ s/([a-z0-9])([a-z0-9]+)/$1/gi;
153             return $label;
154             }
155              
156             sub activated
157             {
158             my $self = shift;
159              
160             my $object = $self->{object};
161              
162             if( $object->prop("level") > 0 ) {
163             $self->adopt_future(
164             $object->call_method(
165             reset_level => (),
166             )
167             );
168             }
169              
170             my $tag = $object->prop("tag") // "Global";
171             my $title = sprintf "%s - %s", $tag, "Circle";
172              
173             $self->{term}->setctl_str( icontitle_text => $title );
174             }
175              
176             0x55AA;