File Coverage

blib/lib/Circle/Widget/Entry.pm
Criterion Covered Total %
statement 28 49 57.1
branch 2 6 33.3
condition 0 6 0.0
subroutine 6 10 60.0
pod 0 2 0.0
total 36 73 49.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, 2008-2013 -- leonerd@leonerd.org.uk
4              
5             package Circle::Widget::Entry;
6              
7 4     4   24 use strict;
  4         8  
  4         138  
8 4     4   20 use warnings;
  4         8  
  4         120  
9              
10 4     4   28 use base qw( Circle::Widget );
  4         7  
  4         2799  
11              
12             sub new
13             {
14 2     2 0 88 my $class = shift;
15 2         29 my %args = @_;
16              
17 2         22 my $self = $class->SUPER::new( @_ );
18              
19 2         11 $self->{on_enter} = $args{on_enter};
20 2         8 $self->{history} = $args{history};
21              
22 2         12 $self->set_prop_text( "" );
23 2         29 $self->set_prop_autoclear( $args{autoclear} );
24              
25 2         23 return $self;
26             }
27              
28             sub method_enter
29             {
30 2     2 0 13363 my $self = shift;
31 2         5 my ( $ctx, $text ) = @_;
32 2         32 $self->{on_enter}->( $text, $ctx );
33              
34 2 50       48 if( defined( my $history = $self->{history} ) ) {
35 2         17 my $histqueue = $self->get_prop_history;
36              
37 2         29 my $overcount = @$histqueue + 1 - $history;
38              
39 2 50       9 $self->shift_prop_history( $overcount ) if $overcount > 0;
40              
41 2         11 $self->push_prop_history( $text );
42             }
43             }
44              
45             package Circle::Widget::Entry::CompleteGroup;
46              
47 4     4   30 use base qw( Tangence::Object );
  4         7  
  4         1560  
48              
49             sub new
50             {
51 0     0     my $class = shift;
52 0           my %args = @_;
53              
54 0           my $self = $class->SUPER::new( @_ );
55              
56 0   0       $self->set_prop_only_at_sol( $args{only_at_sol} || 0 );
57 0   0       $self->set_prop_prefix_sol( $args{prefix_sol} || '' );
58 0   0       $self->set_prop_suffix_sol( $args{suffix_sol} || '' );
59              
60 0           return $self;
61             }
62              
63             sub set
64             {
65 0     0     my $self = shift;
66 0           my ( @strings ) = @_;
67              
68 0           $self->set_prop_items( \@strings );
69             }
70              
71             sub add
72             {
73 0     0     my $self = shift;
74 0           my ( $str ) = @_;
75              
76 0 0         grep { $_ eq $str } @{ $self->get_prop_items } or
  0            
  0            
77             $self->push_prop_items( $str );
78             }
79              
80             sub remove
81             {
82 0     0     my $self = shift;
83 0           my ( $str ) = @_;
84              
85 0           my $items = $self->get_prop_items;
86 0           my @indices = grep { $items->[$_] eq $str } 0 .. $#$items;
  0            
87              
88 0           $self->splice_prop_items( $_, 1, () ) for reverse @indices;
89             }
90              
91             0x55AA;