line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Wx::Perl::IconDepot; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
Wx::Perl::IconDepot - Use icon libraries quick & easy |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=cut |
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
48987
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
24
|
|
10
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
25
|
|
11
|
|
|
|
|
|
|
|
12
|
1
|
|
|
1
|
|
4
|
use vars qw($VERSION); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
50
|
|
13
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
14
|
|
|
|
|
|
|
|
15
|
1
|
|
|
1
|
|
193
|
use Wx qw( :image ); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
use File::Basename; |
17
|
|
|
|
|
|
|
use Module::Load::Conditional qw( check_install ); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my %imgext = ( |
20
|
|
|
|
|
|
|
'.jpg' => wxBITMAP_TYPE_JPEG, |
21
|
|
|
|
|
|
|
'.jpeg' => wxBITMAP_TYPE_JPEG, |
22
|
|
|
|
|
|
|
'.png' => wxBITMAP_TYPE_PNG, |
23
|
|
|
|
|
|
|
'.gif' => wxBITMAP_TYPE_GIF, |
24
|
|
|
|
|
|
|
'.bmp' => wxBITMAP_TYPE_BMP, |
25
|
|
|
|
|
|
|
'.xpm' => wxBITMAP_TYPE_XPM, |
26
|
|
|
|
|
|
|
); |
27
|
|
|
|
|
|
|
my @extensions = (keys %imgext); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
if (check_install( module => 'Image::LibRSVG' )) { |
30
|
|
|
|
|
|
|
push @extensions, '.svg'; |
31
|
|
|
|
|
|
|
use Image::LibRSVG; |
32
|
|
|
|
|
|
|
use IO::Scalar; |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
my @iconpath = (); |
37
|
|
|
|
|
|
|
if ($^O eq 'MSWin32') { |
38
|
|
|
|
|
|
|
push @iconpath, $ENV{ALLUSERSPROFILE} . '\Icons' |
39
|
|
|
|
|
|
|
} else { |
40
|
|
|
|
|
|
|
push @iconpath, $ENV{HOME} . '/.local/share/icons', |
41
|
|
|
|
|
|
|
push @iconpath, '/usr/share/icons', |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
############################################################################### |
45
|
|
|
|
|
|
|
=head1 SYNOPSIS |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=over 4 |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
my $depot = new Wx::Perl::IconDepot(@pathnames); |
50
|
|
|
|
|
|
|
$depot->SetThemes($theme1, $theme2, $theme3); |
51
|
|
|
|
|
|
|
my $wxbitmap = $depot->GetBitmap($name, $size, $context) |
52
|
|
|
|
|
|
|
my $wxicon = $depot->GetIcon($name, $size, $context) |
53
|
|
|
|
|
|
|
my $wximage = $depot->GetImage($name, $size, $context) |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=back |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=head1 DESCRIPTION |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
This module allows B easy access to icon libraries used in desktops |
60
|
|
|
|
|
|
|
like KDE and GNOME. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
It supports libraries containing scalable vector graphics like Breeze if |
63
|
|
|
|
|
|
|
B is installed. If not you are confined to bitmapped libraries |
64
|
|
|
|
|
|
|
like Oxygen or Adwaita. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
On Windows you have to install icon libraries yourself in C:\ProgramData\Icons. |
67
|
|
|
|
|
|
|
You will find plenty of them on Github. Extract an icon set and copy the main |
68
|
|
|
|
|
|
|
folder of the theme (the one that contains the file 'index.theme') to |
69
|
|
|
|
|
|
|
C:\ProgramData\Icons. On Linux you will probably find some icon themes |
70
|
|
|
|
|
|
|
in /usr/share/icons. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
The constructor takes a reference to a list of folders where it finds the icons |
73
|
|
|
|
|
|
|
libraries. If you specify nothing, it will assign default values for: |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
Windows: $ENV{ALLUSERSPROFILE} . '\Icons'. IconDepot will not create |
76
|
|
|
|
|
|
|
the folder if it does not exist. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
Others: $ENV{HOME} . '/.local/share/icons', '/usr/share/icons' |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=cut |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub new { |
83
|
|
|
|
|
|
|
my $proto = shift; |
84
|
|
|
|
|
|
|
my $class = ref($proto) || $proto; |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
my $self = {}; |
87
|
|
|
|
|
|
|
bless ($self, $class); |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
my $pathlist = shift; |
90
|
|
|
|
|
|
|
unless (defined $pathlist) { $pathlist = \@iconpath }; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
$self->{ACTIVE} = []; |
93
|
|
|
|
|
|
|
$self->{ACTIVENAMES} = []; |
94
|
|
|
|
|
|
|
$self->{DEFAULTSIZE} = 22; |
95
|
|
|
|
|
|
|
$self->{FORCEIMAGE} = 1; |
96
|
|
|
|
|
|
|
$self->{INDEX} = undef; |
97
|
|
|
|
|
|
|
$self->{ICONPATH} = $pathlist; |
98
|
|
|
|
|
|
|
$self->{MISSINGIMAGE} = $self->FindINC('Wx/Perl/IconDepot/image_missing.png'); |
99
|
|
|
|
|
|
|
$self->{THEMEPOOL} = {}; |
100
|
|
|
|
|
|
|
$self->{THEMES} = $self->CollectThemes; |
101
|
|
|
|
|
|
|
Wx::InitAllImageHandlers(); |
102
|
|
|
|
|
|
|
return $self; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=head1 PUBLIC METHODS |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=over 4 |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=cut |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
############################################################################### |
112
|
|
|
|
|
|
|
=item BI<($theme, $name, $size); |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=over 4 |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
Returns a list of available contexts. If you set $name to undef if will return |
117
|
|
|
|
|
|
|
all contexts of size $size. If you set $size to undef it will return all |
118
|
|
|
|
|
|
|
contexts associated with icon $name. If you set $name and $size to undef it |
119
|
|
|
|
|
|
|
will return all known contexts in the theme. out $size it returns a list |
120
|
|
|
|
|
|
|
of all contexts found in $theme. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=back |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=cut |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub AvailableContexts { |
127
|
|
|
|
|
|
|
my ($self, $theme, $name, $size) = @_; |
128
|
|
|
|
|
|
|
my $t = $self->GetTheme($theme); |
129
|
|
|
|
|
|
|
my %found = (); |
130
|
|
|
|
|
|
|
if ((not defined $name) and (not defined $size)) { |
131
|
|
|
|
|
|
|
my @names = keys %$t; |
132
|
|
|
|
|
|
|
for (@names) { |
133
|
|
|
|
|
|
|
my $si = $t->{$_}; |
134
|
|
|
|
|
|
|
my @sizes = keys %$si; |
135
|
|
|
|
|
|
|
for (@sizes) { |
136
|
|
|
|
|
|
|
my $ci = $si->{$_}; |
137
|
|
|
|
|
|
|
for (keys %$ci) { |
138
|
|
|
|
|
|
|
$found{$_} = 1; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
} elsif ((defined $name) and (not defined $size)) { |
143
|
|
|
|
|
|
|
if (exists $t->{$name}) { |
144
|
|
|
|
|
|
|
my $si = $t->{$name}; |
145
|
|
|
|
|
|
|
my @sizes = keys %$si; |
146
|
|
|
|
|
|
|
for (@sizes) { |
147
|
|
|
|
|
|
|
my $ci = $si->{$_}; |
148
|
|
|
|
|
|
|
for (keys %$ci) { |
149
|
|
|
|
|
|
|
$found{$_} = 1; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
} elsif ((not defined $name) and (defined $size)) { |
154
|
|
|
|
|
|
|
my @names = keys %$t; |
155
|
|
|
|
|
|
|
for (@names) { |
156
|
|
|
|
|
|
|
if (exists $t->{$_}->{$size}) { |
157
|
|
|
|
|
|
|
my $ci = $t->{$_}->{$size}; |
158
|
|
|
|
|
|
|
for (keys %$ci) { |
159
|
|
|
|
|
|
|
$found{$_} = 1; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
} else { |
164
|
|
|
|
|
|
|
if (exists $t->{$name}) { |
165
|
|
|
|
|
|
|
my $si = $t->{$name}; |
166
|
|
|
|
|
|
|
if (exists $si->{$size}) { |
167
|
|
|
|
|
|
|
my $ci = $si->{$size}; |
168
|
|
|
|
|
|
|
%found = %$ci |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
return sort keys %found |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
############################################################################### |
176
|
|
|
|
|
|
|
=item BI<($theme, $size, $context); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=over 4 |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
Returns a list of available icons. If you set $size to undef the list will |
181
|
|
|
|
|
|
|
contain names it found in all sizes. If you set $context to undef it will return |
182
|
|
|
|
|
|
|
names it found in all contexts. If you leave out both then |
183
|
|
|
|
|
|
|
you get a list of all available icons. Watch out, it might be pretty long. |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=back |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=cut |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub AvailableIcons { |
190
|
|
|
|
|
|
|
my ($self, $theme, $size, $context) = @_; |
191
|
|
|
|
|
|
|
my $t = $self->GetTheme($theme); |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
my @names = keys %$t; |
194
|
|
|
|
|
|
|
my @matches = (); |
195
|
|
|
|
|
|
|
if ((not defined $size) and (not defined $context)) { |
196
|
|
|
|
|
|
|
@matches = @names |
197
|
|
|
|
|
|
|
} elsif ((defined $size) and (not defined $context)) { |
198
|
|
|
|
|
|
|
for (@names) { |
199
|
|
|
|
|
|
|
if (exists $t->{$_}->{$size}) { push @matches, $_ } |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
} elsif ((not defined $size) and (defined $context)) { |
202
|
|
|
|
|
|
|
for (@names) { |
203
|
|
|
|
|
|
|
my $name = $_; |
204
|
|
|
|
|
|
|
my $si = $t->{$name}; |
205
|
|
|
|
|
|
|
my @sizes = keys %$si; |
206
|
|
|
|
|
|
|
for (@sizes) { |
207
|
|
|
|
|
|
|
if (exists $t->{$name}->{$_}->{$context}) { push @matches, $name } |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
} else { |
211
|
|
|
|
|
|
|
for (@names) { |
212
|
|
|
|
|
|
|
if (exists $t->{$_}->{$size}) { |
213
|
|
|
|
|
|
|
my $c = $t->{$_}->{$size}; |
214
|
|
|
|
|
|
|
if (exists $c->{$context}) { |
215
|
|
|
|
|
|
|
push @matches, $_ |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
return sort @matches |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
############################################################################### |
224
|
|
|
|
|
|
|
=item BI<($theme, $name, $context); |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=over 4 |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Returns a list of available contexts. If you leave out $size it returns a list |
229
|
|
|
|
|
|
|
of all contexts found in $theme. |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=back |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=cut |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
sub AvailableSizes { |
236
|
|
|
|
|
|
|
my ($self, $theme, $name, $context) = @_; |
237
|
|
|
|
|
|
|
my $t = $self->GetTheme($theme); |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
my %found = (); |
240
|
|
|
|
|
|
|
if ((not defined $name) and (not defined $context)) { |
241
|
|
|
|
|
|
|
my @names = keys %$t; |
242
|
|
|
|
|
|
|
for (@names) { |
243
|
|
|
|
|
|
|
my $si = $t->{$_}; |
244
|
|
|
|
|
|
|
my @sizes = keys %$si; |
245
|
|
|
|
|
|
|
for (@sizes) { |
246
|
|
|
|
|
|
|
$found{$_} = 1 |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
} elsif ((defined $name) and (not defined $context)) { |
250
|
|
|
|
|
|
|
if (exists $t->{$name}) { |
251
|
|
|
|
|
|
|
my $si = $t->{$name}; |
252
|
|
|
|
|
|
|
%found = %$si; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
} elsif ((not defined $name) and (defined $context)) { |
255
|
|
|
|
|
|
|
my @names = keys %$t; |
256
|
|
|
|
|
|
|
for (@names) { |
257
|
|
|
|
|
|
|
my $n = $_; |
258
|
|
|
|
|
|
|
my $si = $t->{$n}; |
259
|
|
|
|
|
|
|
my @sizes = keys %$si; |
260
|
|
|
|
|
|
|
for (@sizes) { |
261
|
|
|
|
|
|
|
if (exists $t->{$n}->{$_}->{$context}) { |
262
|
|
|
|
|
|
|
$found{$_} = 1 |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
} else { |
267
|
|
|
|
|
|
|
if (exists $t->{$name}) { |
268
|
|
|
|
|
|
|
my $si = $t->{$name}; |
269
|
|
|
|
|
|
|
my @sizes = keys %$si; |
270
|
|
|
|
|
|
|
for (@sizes) { |
271
|
|
|
|
|
|
|
if (exists $t->{$name}->{$_}->{$context}) { |
272
|
|
|
|
|
|
|
$found{$_} = 1 |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
return sort {$a <=> $b} keys %found |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
############################################################################### |
281
|
|
|
|
|
|
|
=item B |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=over 4 |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
Returns a list of available themes it found while initiating the module. |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=back |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
=cut |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
sub AvailableThemes { |
292
|
|
|
|
|
|
|
my $self = shift; |
293
|
|
|
|
|
|
|
my $k = $self->{THEMES}; |
294
|
|
|
|
|
|
|
return sort keys %$k |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
############################################################################### |
298
|
|
|
|
|
|
|
=item BI<($name, $size, $context, \$resize)> |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=over 4 |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
Returns the filename of an image in the library. Finds the best suitable |
303
|
|
|
|
|
|
|
version of the image in the library according to $size and $context. If it |
304
|
|
|
|
|
|
|
eventually returns an image of another size, it sets $resize to 1. This gives |
305
|
|
|
|
|
|
|
the opportunity to scale the image to the requested icon size. All parameters |
306
|
|
|
|
|
|
|
except $name are optional. |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=back |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
=cut |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
sub FindImage { |
313
|
|
|
|
|
|
|
my ($self, $name, $size, $context, $resize) = @_; |
314
|
|
|
|
|
|
|
unless (defined $size) { $size = 'unknown' } |
315
|
|
|
|
|
|
|
unless (defined $context) { $context = 'unknown' } |
316
|
|
|
|
|
|
|
my $active = $self->{ACTIVE}; |
317
|
|
|
|
|
|
|
for (@$active) { |
318
|
|
|
|
|
|
|
my $index = $_; |
319
|
|
|
|
|
|
|
if (exists $index->{$name}) { |
320
|
|
|
|
|
|
|
return $self->FindImageS($index->{$name}, $size, $context, $resize); |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
return undef; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
############################################################################### |
327
|
|
|
|
|
|
|
=item B |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=over 4 |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
Returns a list of active themes. Primary theme first then the fallback themes. |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
=back |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
=cut |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
sub GetActiveThemes { |
338
|
|
|
|
|
|
|
my $self = shift; |
339
|
|
|
|
|
|
|
my $a = $self->{ACTIVENAMES}; |
340
|
|
|
|
|
|
|
return @$a |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
############################################################################### |
344
|
|
|
|
|
|
|
=item BI<($name>, [ I<$size, $context, $force> ] I<)> |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
=over 4 |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
Returns a Wx::Bitmap object. If you do not specify I<$size> or the icon does |
349
|
|
|
|
|
|
|
not exist in the specified size, it will return the largest possible icon. |
350
|
|
|
|
|
|
|
I<$force> can be 0 or 1. It is 0 by default. If you set it to 1 a missing icon |
351
|
|
|
|
|
|
|
image is returned instead of undef when the icon cannot be found. |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
=back |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=cut |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
sub GetBitmap { |
358
|
|
|
|
|
|
|
my $self = shift; |
359
|
|
|
|
|
|
|
return Wx::Bitmap->new($self->GetImage(@_)) |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
############################################################################### |
363
|
|
|
|
|
|
|
=item BI<($name>, [ I<$size, $context, $force> ] I<)> |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
=over 4 |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
Returns a Wx::Icon object. If you do not specify I<$size> or the icon does not |
368
|
|
|
|
|
|
|
exist in the specified size, it will return the largest possible icon. |
369
|
|
|
|
|
|
|
I<$force> can be 0 or 1. It is 0 by default. If you set it to 1 a missing icon |
370
|
|
|
|
|
|
|
image is returned instead of undef when the icon cannot be found. |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
=back |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
=cut |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
sub GetIcon { |
377
|
|
|
|
|
|
|
my $self = shift; |
378
|
|
|
|
|
|
|
my $bmp = $self->GetBitmap(@_); |
379
|
|
|
|
|
|
|
my $icon = Wx::Icon->new(); |
380
|
|
|
|
|
|
|
$icon->CopyFromBitmap($bmp); |
381
|
|
|
|
|
|
|
return $icon |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
############################################################################### |
385
|
|
|
|
|
|
|
=item BI<($name>, [ I<$size, $context, $force> ] I<)> |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
=over 4 |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
Returns a Wx::Image object. If you do not specify I<$size> or the icon does |
390
|
|
|
|
|
|
|
not exist in the specified size, it will find the largest possible icon and |
391
|
|
|
|
|
|
|
scale it to the requested size. I<$force> can be 0 or 1. It is 0 by default. |
392
|
|
|
|
|
|
|
If you set it to 1 a missing icon image is returned instead of undef when the |
393
|
|
|
|
|
|
|
icon cannot be found. |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=back |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
=cut |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
sub GetImage { |
400
|
|
|
|
|
|
|
my ($self, $name, $size, $context, $force) = @_; |
401
|
|
|
|
|
|
|
unless (defined $force) { $force = 0 } |
402
|
|
|
|
|
|
|
my $resize = 0; |
403
|
|
|
|
|
|
|
my $file = $self->FindImage($name, $size, $context, \$resize); |
404
|
|
|
|
|
|
|
if (defined $file) { |
405
|
|
|
|
|
|
|
my $img = $self->LoadImage($file, $size); |
406
|
|
|
|
|
|
|
if ($img->IsOk) { |
407
|
|
|
|
|
|
|
if ($resize) { |
408
|
|
|
|
|
|
|
return $img->Scale($size, $size); |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
return $img |
411
|
|
|
|
|
|
|
} else { |
412
|
|
|
|
|
|
|
return undef |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
} elsif ($force and (defined $size) and ($size =~ /^\d+$/)) { #size must be defined and numeric |
415
|
|
|
|
|
|
|
return $self->GetMissingImage($size) |
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
return undef |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
############################################################################### |
421
|
|
|
|
|
|
|
=item BI<($theme)> |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=over 4 |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
Returns the full path to the folder containing I<$theme> |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=back |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
=cut |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
sub GetThemePath { |
432
|
|
|
|
|
|
|
my ($self, $theme) = @_; |
433
|
|
|
|
|
|
|
my $t = $self->{THEMES}; |
434
|
|
|
|
|
|
|
if (exists $t->{$theme}) { |
435
|
|
|
|
|
|
|
return $t->{$theme}->{path} |
436
|
|
|
|
|
|
|
} else { |
437
|
|
|
|
|
|
|
warn "Icon theme $theme not found" |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
############################################################################### |
442
|
|
|
|
|
|
|
=item BI<($file)> |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=over 4 |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
Returns true if I<$file> is an image. Otherwise returns false. |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
=back |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
=cut |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
sub IsImageFile { |
453
|
|
|
|
|
|
|
my ($self, $file) = @_; |
454
|
|
|
|
|
|
|
unless (-f $file) { return 0 } #It must be a file |
455
|
|
|
|
|
|
|
my ($d, $f, $e) = fileparse(lc($file), @extensions); |
456
|
|
|
|
|
|
|
if ($e ne '') { return 1 } |
457
|
|
|
|
|
|
|
return 0 |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
############################################################################### |
461
|
|
|
|
|
|
|
=item BI<($file)> |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
=over 4 |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
Loads image I<$file> and returns it as a Wx::Image object. |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
=back |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
=cut |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
sub LoadImage { |
472
|
|
|
|
|
|
|
my ($self, $file, $size) = @_; |
473
|
|
|
|
|
|
|
if (-e $file) { |
474
|
|
|
|
|
|
|
my ($name,$path,$suffix) = fileparse(lc($file), @extensions); |
475
|
|
|
|
|
|
|
if (exists $imgext{$suffix}) { |
476
|
|
|
|
|
|
|
my $type = $imgext{$suffix}; |
477
|
|
|
|
|
|
|
my $img = Wx::Image->new($file, $type); |
478
|
|
|
|
|
|
|
if ($img->IsOk) { |
479
|
|
|
|
|
|
|
return $img |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
} elsif ($suffix eq '.svg') { |
482
|
|
|
|
|
|
|
my $renderer = Image::LibRSVG->new; |
483
|
|
|
|
|
|
|
$renderer->loadFromFileAtSize($file, $size, $size); |
484
|
|
|
|
|
|
|
my $png = $renderer->getImageBitmap("png", 100); |
485
|
|
|
|
|
|
|
my $img = Wx::Image->newStreamType(IO::Scalar->new(\$png), wxBITMAP_TYPE_PNG); |
486
|
|
|
|
|
|
|
if ($img->IsOk) { |
487
|
|
|
|
|
|
|
return $img |
488
|
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
} else { |
490
|
|
|
|
|
|
|
warn "could not define image type for file $file" |
491
|
|
|
|
|
|
|
} |
492
|
|
|
|
|
|
|
} else { |
493
|
|
|
|
|
|
|
warn "image file $file not found \n"; |
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
return undef |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
############################################################################### |
499
|
|
|
|
|
|
|
=item BI<($theme1, $theme2, $theme3)> |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
=over 4 |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
Initializes themes. I<$theme1> is the primary theme. The rest are subsequent |
504
|
|
|
|
|
|
|
fallback themes. I suggest to use your favourite theme as the first one and |
505
|
|
|
|
|
|
|
the theme that has the most icons as the last one. |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
=back |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=cut |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
sub SetThemes { |
512
|
|
|
|
|
|
|
my $self = shift; |
513
|
|
|
|
|
|
|
my @activenames = (); |
514
|
|
|
|
|
|
|
my @active = (); |
515
|
|
|
|
|
|
|
for (@_) { |
516
|
|
|
|
|
|
|
push @activenames, $_; |
517
|
|
|
|
|
|
|
push @active, $self->GetTheme($_); |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
$self->{ACTIVENAMES} = \@activenames; |
520
|
|
|
|
|
|
|
$self->{ACTIVE} = \@active; |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
############################################################################### |
524
|
|
|
|
|
|
|
=back |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
=head1 PRIVATE METHODS |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
=over 4 |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
=cut |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
############################################################################### |
533
|
|
|
|
|
|
|
=item B |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
Called during initialization. It scans the folders the constructor receives for |
536
|
|
|
|
|
|
|
icon libraries. It loads their index files and stores the info. |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
=over 4 |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
=back |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
=cut |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
sub CollectThemes { |
545
|
|
|
|
|
|
|
my $self = shift; |
546
|
|
|
|
|
|
|
my %themes = (); |
547
|
|
|
|
|
|
|
my $iconpath = $self->{ICONPATH}; |
548
|
|
|
|
|
|
|
for (@$iconpath) { |
549
|
|
|
|
|
|
|
my $dir = $_; |
550
|
|
|
|
|
|
|
if (opendir DIR, $dir) { |
551
|
|
|
|
|
|
|
while (my $entry = readdir(DIR)) { |
552
|
|
|
|
|
|
|
my $fullname = "$dir/$entry"; |
553
|
|
|
|
|
|
|
if (-d $fullname) { |
554
|
|
|
|
|
|
|
if (-e "$fullname/index.theme") { |
555
|
|
|
|
|
|
|
my $index = $self->LoadThemeFile($fullname); |
556
|
|
|
|
|
|
|
my $main = delete $index->{general}; |
557
|
|
|
|
|
|
|
if (%$index) { |
558
|
|
|
|
|
|
|
my $name = $entry; |
559
|
|
|
|
|
|
|
if (exists $main->{Name}) { |
560
|
|
|
|
|
|
|
$name = $main->{Name} |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
$themes{$name} = { |
563
|
|
|
|
|
|
|
path => $fullname, |
564
|
|
|
|
|
|
|
general => $main, |
565
|
|
|
|
|
|
|
folders => $index, |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
} |
569
|
|
|
|
|
|
|
} |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
closedir DIR; |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
return \%themes |
575
|
|
|
|
|
|
|
} |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
############################################################################### |
578
|
|
|
|
|
|
|
=item BI<($themeindex)> |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
=over 4 |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
Creates a searchable index from a loaded theme index file. Returns a reference |
583
|
|
|
|
|
|
|
to a hash. |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
=back |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
=cut |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
sub CreateIndex { |
590
|
|
|
|
|
|
|
my ($self, $tindex) = @_; |
591
|
|
|
|
|
|
|
my %index = (); |
592
|
|
|
|
|
|
|
my $base = $tindex->{path}; |
593
|
|
|
|
|
|
|
my $folders = $tindex->{folders}; |
594
|
|
|
|
|
|
|
foreach my $dir (keys %$folders) { |
595
|
|
|
|
|
|
|
my @raw = <"$base/$dir/*">; |
596
|
|
|
|
|
|
|
foreach my $file (@raw) { |
597
|
|
|
|
|
|
|
if ($self->IsImageFile($file)) { |
598
|
|
|
|
|
|
|
my ($name, $d, $e) = fileparse($file, @extensions); |
599
|
|
|
|
|
|
|
unless (exists $index{$name}) { |
600
|
|
|
|
|
|
|
$index{$name} = {} |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
my $size = $folders->{$dir}->{Size}; |
603
|
|
|
|
|
|
|
unless (defined $size) { |
604
|
|
|
|
|
|
|
$size = 'unknown'; |
605
|
|
|
|
|
|
|
} |
606
|
|
|
|
|
|
|
unless (exists $index{$name}->{$size}) { |
607
|
|
|
|
|
|
|
$index{$name}->{$size} = {} |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
my $context = $folders->{$dir}->{Context}; |
610
|
|
|
|
|
|
|
unless (defined $context) { |
611
|
|
|
|
|
|
|
$context = 'unknown'; |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
$index{$name}->{$size}->{$context} = $file; |
614
|
|
|
|
|
|
|
} |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
} |
617
|
|
|
|
|
|
|
return \%index; |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
############################################################################### |
621
|
|
|
|
|
|
|
=item BI<($sizeindex, $context)> |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
=over 4 |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
Looks for an icon in $context for a given size index (a portion of a searchable |
626
|
|
|
|
|
|
|
index). If it can not find it, it looks for another version in all other |
627
|
|
|
|
|
|
|
contexts. Returns the first one it finds. |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
=back |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
=cut |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
sub FindImageC { |
634
|
|
|
|
|
|
|
my ($self, $si, $context) = @_; |
635
|
|
|
|
|
|
|
if (exists $si->{$context}) { |
636
|
|
|
|
|
|
|
return $si->{$context} |
637
|
|
|
|
|
|
|
} else { |
638
|
|
|
|
|
|
|
my @contexts = sort keys %$si; |
639
|
|
|
|
|
|
|
if (@contexts) { |
640
|
|
|
|
|
|
|
return $si->{$contexts[0]}; |
641
|
|
|
|
|
|
|
} |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
return undef |
644
|
|
|
|
|
|
|
} |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
############################################################################### |
647
|
|
|
|
|
|
|
=item BI<($nameindex, $size, $context, \$resize)> |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
=over 4 |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
Looks for an icon of $size for a given name index (a portion of a searchable |
652
|
|
|
|
|
|
|
index). If it can not find it it looks for another version in all other sizes. |
653
|
|
|
|
|
|
|
In this case it returns the biggest one it finds and sets $resize to 1. |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
=back |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
=cut |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
sub FindImageS { |
660
|
|
|
|
|
|
|
my ($self, $nindex, $size, $context, $resize) = @_; |
661
|
|
|
|
|
|
|
if (exists $nindex->{$size}) { |
662
|
|
|
|
|
|
|
my $file = $self->FindImageC($nindex->{$size}, $context); |
663
|
|
|
|
|
|
|
if (defined $file) { return $file } |
664
|
|
|
|
|
|
|
} else { |
665
|
|
|
|
|
|
|
if (defined $resize) { $$resize = 1 } |
666
|
|
|
|
|
|
|
my @sizes = reverse sort keys %$nindex; |
667
|
|
|
|
|
|
|
for (@sizes) { |
668
|
|
|
|
|
|
|
my $si = $nindex->{$_}; |
669
|
|
|
|
|
|
|
my $file = $self->FindImageC($si, $context); |
670
|
|
|
|
|
|
|
if (defined $file) { return $file } |
671
|
|
|
|
|
|
|
} |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
return undef |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
############################################################################### |
677
|
|
|
|
|
|
|
=item BI<($file)> |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
=over 4 |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
Looks for a file in @INC. if found returns the full pathname. |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
=back |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
=cut |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
sub FindINC { |
688
|
|
|
|
|
|
|
my ($self, $file) = @_; |
689
|
|
|
|
|
|
|
for (@INC) { |
690
|
|
|
|
|
|
|
my $f = $_ . "/$file"; |
691
|
|
|
|
|
|
|
if (-e $f) { |
692
|
|
|
|
|
|
|
return $f; |
693
|
|
|
|
|
|
|
} |
694
|
|
|
|
|
|
|
} |
695
|
|
|
|
|
|
|
return undef; |
696
|
|
|
|
|
|
|
} |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
############################################################################### |
699
|
|
|
|
|
|
|
=item BI<($size)> |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
=over 4 |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
Returns a Wx::Image object of the missing image symbal on the requested size. |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
=back |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
=cut |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
sub GetMissingImage { |
710
|
|
|
|
|
|
|
my ($self, $size) = @_; |
711
|
|
|
|
|
|
|
my $tmp = Wx::Image->new($self->{MISSINGIMAGE}, wxBITMAP_TYPE_PNG, ); |
712
|
|
|
|
|
|
|
return $tmp->Scale($size, $size, wxIMAGE_QUALITY_HIGH) |
713
|
|
|
|
|
|
|
} |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
############################################################################### |
716
|
|
|
|
|
|
|
=item BI<($themename)> |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=over 4 |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
Looks for a searchable index of the theme. If it is not yet created it will |
721
|
|
|
|
|
|
|
be created first and stored in the index pool. |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
=back |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
=cut |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
sub GetTheme { |
728
|
|
|
|
|
|
|
my ($self, $theme) = @_; |
729
|
|
|
|
|
|
|
my $pool = $self->{THEMEPOOL}; |
730
|
|
|
|
|
|
|
if (exists $pool->{$theme}) { |
731
|
|
|
|
|
|
|
return $pool->{$theme} |
732
|
|
|
|
|
|
|
} else { |
733
|
|
|
|
|
|
|
my $themindex = $self->{THEMES}->{$theme}; |
734
|
|
|
|
|
|
|
if (defined $themindex) { |
735
|
|
|
|
|
|
|
my $index = $self->CreateIndex($themindex); |
736
|
|
|
|
|
|
|
$pool->{$theme} = $index; |
737
|
|
|
|
|
|
|
return $index |
738
|
|
|
|
|
|
|
} else { |
739
|
|
|
|
|
|
|
warn "Setting theme '$theme' failed" |
740
|
|
|
|
|
|
|
} |
741
|
|
|
|
|
|
|
} |
742
|
|
|
|
|
|
|
} |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
############################################################################### |
745
|
|
|
|
|
|
|
=item BI<($file)> |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
=over 4 |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
Loads a theme index file and returns the information in it in a hash. |
750
|
|
|
|
|
|
|
It returns a reference to this hash. |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=back |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=cut |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
sub LoadThemeFile { |
757
|
|
|
|
|
|
|
my ($self, $file) = @_; |
758
|
|
|
|
|
|
|
if (defined $file) { |
759
|
|
|
|
|
|
|
$file = "$file/index.theme"; |
760
|
|
|
|
|
|
|
if (open(OFILE, "<", $file)) { |
761
|
|
|
|
|
|
|
my %index = (); |
762
|
|
|
|
|
|
|
my $section; |
763
|
|
|
|
|
|
|
my %inf = (); |
764
|
|
|
|
|
|
|
my $firstline = ; |
765
|
|
|
|
|
|
|
unless ($firstline =~ /^\[.+\]$/) { |
766
|
|
|
|
|
|
|
warn "Illegal file format $file"; |
767
|
|
|
|
|
|
|
} else { |
768
|
|
|
|
|
|
|
while () { |
769
|
|
|
|
|
|
|
my $line = $_; |
770
|
|
|
|
|
|
|
chomp $line; |
771
|
|
|
|
|
|
|
if ($line =~ /^\[([^\]]+)\]/) { #new section |
772
|
|
|
|
|
|
|
if (defined $section) { |
773
|
|
|
|
|
|
|
$index{$section} = { %inf } |
774
|
|
|
|
|
|
|
} else { |
775
|
|
|
|
|
|
|
$index{general} = { %inf } |
776
|
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
|
$section = $1; |
778
|
|
|
|
|
|
|
%inf = (); |
779
|
|
|
|
|
|
|
} elsif ($line =~ s/^([^=]+)=//) { #new key |
780
|
|
|
|
|
|
|
$inf{$1} = $line; |
781
|
|
|
|
|
|
|
} |
782
|
|
|
|
|
|
|
} |
783
|
|
|
|
|
|
|
if (defined $section) { |
784
|
|
|
|
|
|
|
$index{$section} = { %inf } |
785
|
|
|
|
|
|
|
} |
786
|
|
|
|
|
|
|
close OFILE; |
787
|
|
|
|
|
|
|
} |
788
|
|
|
|
|
|
|
return \%index; |
789
|
|
|
|
|
|
|
} else { |
790
|
|
|
|
|
|
|
warn "Cannot open theme index file: $file" |
791
|
|
|
|
|
|
|
} |
792
|
|
|
|
|
|
|
} |
793
|
|
|
|
|
|
|
} |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
############################################################################### |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
=back |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
=head1 AUTHOR |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
Hans Jeuken (hansjeuken at xs4all dot nl) |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
=head1 BUGS |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
If you find any, please contact the author. |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
Icon libararies that depend on .svg images show up in the list of |
808
|
|
|
|
|
|
|
B when no support for scalable vector graphics is available. |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
=head1 TODO |
811
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
=cut |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
1; |
815
|
|
|
|
|
|
|
__END__ |