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; |