File Coverage

blib/lib/Circle/FE/Term.pm
Criterion Covered Total %
statement 9 28 32.1
branch 0 8 0.0
condition 0 3 0.0
subroutine 3 7 42.8
pod 0 4 0.0
total 12 50 24.0


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-2010 -- leonerd@leonerd.org.uk
4              
5             package Circle::FE::Term;
6              
7 1     1   747 use strict;
  1         2  
  1         28  
8 1     1   4 use warnings;
  1         1  
  1         49  
9              
10             our $VERSION = '0.170850';
11              
12 1     1   439 use File::ShareDir qw( dist_file );
  1         4693  
  1         410  
13              
14             =head1 NAME
15              
16             C - Terminal frontend for the C application host
17              
18             =cut
19              
20             my %theme_vars;
21              
22             {
23             my $theme_filename;
24              
25             foreach ( $ENV{CIRCLE_FE_TERM_THEME},
26             "$ENV{HOME}/.circle-fe-term.theme",
27             dist_file( "circle-fe-term", "circle-fe-term.theme" ) ) {
28             defined $_ or next;
29             -e $_ or next;
30              
31             $theme_filename = $_;
32             last;
33             }
34              
35             defined $theme_filename or die "Cannot find a circle-fe-term.theme";
36              
37             open( my $themefh, "<", $theme_filename ) or die "Cannot read $theme_filename - $!";
38              
39             while( <$themefh> ) {
40             m/^\s*#/ and next; # skip comments
41             m/^\s*$/ and next; # skip blanks
42              
43             m/^(\S*)=(.*)$/ and $theme_vars{$1} = $2, next;
44             print STDERR "Unrecognised theme line: $_";
45             }
46             }
47              
48             sub get_theme_var
49             {
50 0     0 0   my $class = shift;
51 0           my ( $varname ) = @_;
52 0 0         return $theme_vars{$varname} if exists $theme_vars{$varname};
53 0           print STDERR "No such theme variable $varname\n";
54 0           return undef;
55             }
56              
57             sub translate_theme_colour
58             {
59 0     0 0   my $class = shift;
60 0           my ( $colourname ) = @_;
61              
62 0 0         return $colourname if $colourname =~ m/^#/; # Literal #rrggbb
63 0 0         return $theme_vars{$colourname} if exists $theme_vars{$colourname}; # hope
64 0           print STDERR "No such theme colour $colourname\n";
65 0           return undef;
66             }
67              
68             sub get_theme_colour
69             {
70 0     0 0   my $class = shift;
71 0           my ( $varname ) = @_;
72 0 0         return $theme_vars{$varname} if exists $theme_vars{$varname};
73 0           print STDERR "No such theme variable $varname for a colour\n";
74 0           return undef;
75             }
76              
77             my %theme_pens;
78              
79             sub get_theme_pen
80             {
81 0     0 0   my $class = shift;
82 0           my ( $varname ) = @_;
83 0   0       return $theme_pens{$varname} ||= Tickit::Pen->new( fg => $class->get_theme_colour( $varname ) );
84             }
85              
86             =head1 AUTHOR
87              
88             Paul Evans
89              
90             =cut
91              
92             0x55AA;