File Coverage

blib/lib/Circle/Widget/Entry.pm
Criterion Covered Total %
statement 12 49 24.4
branch 0 6 0.0
condition 0 6 0.0
subroutine 4 10 40.0
pod 0 2 0.0
total 16 73 21.9


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   13 use strict;
  4         5  
  4         86  
8 4     4   12 use warnings;
  4         4  
  4         81  
9              
10 4     4   14 use base qw( Circle::Widget );
  4         4  
  4         1161  
11              
12             sub new
13             {
14 0     0 0   my $class = shift;
15 0           my %args = @_;
16              
17 0           my $self = $class->SUPER::new( @_ );
18              
19 0           $self->{on_enter} = $args{on_enter};
20 0           $self->{history} = $args{history};
21              
22 0           $self->set_prop_text( "" );
23 0           $self->set_prop_autoclear( $args{autoclear} );
24              
25 0           return $self;
26             }
27              
28             sub method_enter
29             {
30 0     0 0   my $self = shift;
31 0           my ( $ctx, $text ) = @_;
32 0           $self->{on_enter}->( $text, $ctx );
33              
34 0 0         if( defined( my $history = $self->{history} ) ) {
35 0           my $histqueue = $self->get_prop_history;
36              
37 0           my $overcount = @$histqueue + 1 - $history;
38              
39 0 0         $self->shift_prop_history( $overcount ) if $overcount > 0;
40              
41 0           $self->push_prop_history( $text );
42             }
43             }
44              
45             package Circle::Widget::Entry::CompleteGroup;
46              
47 4     4   18 use base qw( Tangence::Object );
  4         4  
  4         933  
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;