File Coverage

blib/lib/Tk/TextHighlight/Bash.pm
Criterion Covered Total %
statement 12 112 10.7
branch 0 48 0.0
condition 0 3 0.0
subroutine 4 15 26.6
pod 0 11 0.0
total 16 189 8.4


line stmt bran cond sub pod time code
1             package Tk::TextHighlight::Bash;
2              
3 1     1   25442 use vars qw($VERSION);
  1         2  
  1         68  
4             $VERSION = '0.1'; # Initial release;
5              
6 1     1   5 use strict;
  1         1  
  1         60  
7 1     1   5 use warnings;
  1         3  
  1         43  
8 1     1   6 use base('Tk::TextHighlight::Template');
  1         2  
  1         566  
9              
10             my $separators = '\||&|;|(|)|<|>|\s|\'|"|`|#|$';
11              
12             sub new {
13 0     0 0   my ($proto, $rules) = @_;
14 0   0       my $class = ref($proto) || $proto;
15 0 0         if (not defined($rules)) {
16 0           $rules = [
17             ['Text'],
18             ['Comment', -foreground => 'gray'],
19             ['Reserved', -foreground => 'brown'],
20             ['Keyword', -foreground => 'orange'],
21             ['String', -foreground => 'red'],
22             ['Backticked', -foreground => 'purple'],
23             ['String intrapolated', -foreground => 'red'],
24             ['Escaped character', -foreground => 'magenta'],
25             ['Operator', -foreground => 'darkblue'],
26             ['Variable', -foreground => 'blue'],
27             ];
28             };
29 0           my $self = $class->SUPER::new($rules);
30 0           $self->lists({
31             'Reserved' => [
32             '!', 'case', 'do', 'done', 'elif', 'else', 'esac', 'fi', 'for',
33             'function', 'if', 'in', 'select', 'then', 'until', 'while', '{',
34             '}', 'time', '[[', ']]',
35             ],
36             'Keyword' => [
37             'alias', 'bind', 'bg','builtin', 'break', 'cd', 'command', 'compgen',
38             'complete', 'continue', 'cp', 'declare', 'disown', 'dirs', 'echo',
39             'enable', 'eval', 'exec', 'exit', 'export', 'false', 'fc', 'fg',
40             'function', 'getopts', 'hash', 'help', 'history', 'jobs', 'kill',
41             'let', 'local', 'logout', 'mv', 'popd', 'printf', 'pushd','pwd', 'read',
42             'readonly', 'return', 'rm', 'select', 'set', 'shift', 'shopt', 'source',
43             'suspend', 'test', 'trap', 'true', 'type', 'typeset', 'ulimit',
44             'umask', 'unalias', 'unset', 'variables', 'wait',
45             ],
46             });
47 0           bless ($self, $class);
48 0           $self->callbacks({
49             'Backticked' => \&parseBackticked,
50             'Comment' => \&parseComment,
51             'Escaped character' => \&parseEscaped,
52             'Keyword' => \&parseKeyword,
53             'Operator' => \&parseOperator,
54             'Reserved' => \&parseReserved,
55             'String' => \&parseString,
56             'String intrapolated' => \&parseIString,
57             'Text' => \&parseText,
58             'Variable' => \&parseVariable,
59             });
60 0           $self->stackPush('Text');
61 0           return $self;
62             }
63              
64             sub parseBackticked {
65 0     0 0   my ($self, $text) = @_;
66 0 0         if ($text =~ s/^(`)//) { #backtick stop
67 0           $self->snippetParse($1);
68 0           $self->stackPull;
69 0           return $text;
70             }
71 0           return $self->parseText($text);
72             }
73              
74             sub parseComment {
75 0     0 0   my ($self, $text) = @_;
76 0           return $self->parserError($text);
77             }
78              
79             sub parseEscaped {
80 0     0 0   my ($self, $text) = @_;
81 0           return $self->parserError($text);
82             }
83              
84             sub parseIString {
85 0     0 0   my ($self, $text) = @_;
86 0 0         if ($text =~ s/^(\\.)//) { #escaped character
87 0           $self->snippetParse($1, 'Escaped character');
88 0           return $text;
89             }
90 0 0         if ($text =~ s/^(\$[^$separators]*)//) { #variable
91 0           $self->snippetParse($1, 'Variable');
92 0           return $text;
93             }
94 0 0         if ($text =~ s/^(`)//) { #backticked
95 0           $self->stackPush('Backticked');
96 0           $self->snippetParse($1);
97 0           return $text;
98             }
99 0 0         if ($text =~ s/^(")//) { #string stop
100 0           $self->snippetParse($1);
101 0           $self->stackPull;
102 0           return $text;
103             }
104 0 0         if ($text =~ s/^([^"|\$|`]+)//) { #string content
105 0           $self->snippetParse($1);
106 0           return $text;
107             }
108 0           return $self->parserError($text);
109             }
110              
111             sub parseKeyword {
112 0     0 0   my ($self, $text) = @_;
113 0           return $self->parserError($text);
114             }
115              
116             sub parseOperator {
117 0     0 0   my ($self, $text) = @_;
118 0           return $self->parserError($text);
119             }
120              
121             sub parseReserved {
122 0     0 0   my ($self, $text) = @_;
123 0           return $self->parserError($text);
124             }
125              
126             sub parseString {
127 0     0 0   my ($self, $text) = @_;
128 0 0         if ($text =~ s/^([^']+)//) { #string content
129 0           $self->snippetParse($1);
130 0           return $text;
131             }
132 0 0         if ($text =~ s/^(')//) { #string stop
133 0           $self->snippetParse($1);
134 0           $self->stackPull;
135 0           return $text;
136             }
137 0           return $self->parserError($text);
138             }
139              
140             sub parseText {
141 0     0 0   my ($self, $text) = @_;
142 0 0         if ($text =~ s/^(^#!\/.*)//) { #launch line
143 0           $self->snippetParse($1, 'Reserved');
144 0           return $text;
145             }
146 0 0         if ($text =~ s/^(#.*)//) { #comment
147 0           $self->snippetParse($1, 'Comment');
148 0           return $text;
149             }
150 0 0         if ($text =~ s/^(\s+)//) { #spaces
151 0           $self->snippetParse($1);
152 0           return $text;
153             }
154 0 0         if ($text =~ s/^(`)//) { #backticked
155 0           $self->stackPush('Backticked');
156 0           $self->snippetParse($1);
157 0           return $text;
158             }
159 0 0         if ($text =~ s/^(")//) { #string intrapolated
160 0           $self->stackPush('String intrapolated');
161 0           $self->snippetParse($1);
162 0           return $text;
163             }
164 0 0         if ($text =~ s/^('[^']*)//) { #string start
165 0           $self->snippet($1);
166 0 0         if ($text) { #if there is still text to be parsed, string ends at same line
167 0 0         if ($text =~ s/(^')//) {
168 0           $self->snippetParse($1)
169             }
170             } else {
171 0           $self->stackPush('String');
172             }
173 0           return $text;
174             }
175 0 0         if ($text =~ s/^(\$[^$separators]*)//) { #variable
176 0           $self->snippetParse($1, 'Variable');
177 0           return $text;
178             }
179 0 0         if ($text =~ s/^([\|\||\||&&|&|;;|;|(|)])//) { #operator
180 0           $self->snippetParse($1, 'Operator');
181 0           return $text
182             }
183 0 0         if ($text =~ s/^([<|>])//) { #remaining separators
184 0           $self->snippetParse($1);
185 0           return $text
186             }
187 0 0         if ($text =~ s/^(\\.)//) { #escaped character
188 0           $self->snippet($1, 'Escaped character');
189 0           return $text;
190             }
191 0 0         if ($text =~ s/^([^$separators]+)//) { #fetching a bare part
192 0 0         if ($self->tokenTest($1, 'Reserved')) {
    0          
193 0           $self->snippetParse($1, 'Reserved');
194             } elsif ($self->tokenTest($1, 'Keyword')) {
195 0           $self->snippetParse($1, 'Keyword');
196             } else { #unrecognized text
197 0           $self->snippetParse($1);
198             }
199 0           return $text
200             }
201             #It shouldn't have come this far, but it has.
202 0           return $self->parserError($text);
203             }
204              
205             sub parseVariable {
206 0     0 0   my ($self, $text) = @_;
207 0           return $self->parserError($text);
208             }
209              
210              
211              
212             1;
213              
214             __END__