1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
#!/usr/bin/perl
use strict;
use warnings;
use ExtUtils::PkgConfig;
use Gtk2;
# depending on the locale, we may be writing wide characters (translations
# of strings from gtk+). according to perldiag, we need to set an encoding
# on our filehandles to avoid the "Wide character in %s" warnings. since
# we're printing stuff directly from gtk+, which is in utf8...
binmode STDOUT, ':utf8';
my @path = map { s/^-I//; $_ } grep /-I/, split /\s+/,
{ExtUtils::PkgConfig->find ('gtk+-2.0')}->{cflags};
print "\n";
while ($_ = shift (@path))
{
last if (-e "$_/gtk/gtkstock.h");
}
my @ids;
open HDR, "<$_/gtk/gtkstock.h" or die "unable to open ($_) for input";
while (<HDR>)
{
push @ids, $1 if (/#define\s+\w+\s+"(.*)"/);
}
close HDR;
@ids = sort @ids;
my @widths = (0, 0, 0);
my @data;
foreach (@ids)
{
my $info = Gtk2::Stock->lookup ($_);
next unless ($info);
my $mask = undef;
if ($info->{modifier})
{
$mask = join (',', @{$info->{modifier}});
$mask =~ s/-mask//g;
$mask =~ s/(\w+)/<$1>-/g;
$mask .= uc(chr($info->{keyval}));
}
push @data, [ $_, $info->{label} || '', $mask || '' ];
$widths[0] = length($data[$#data][0])
if (length($data[$#data][0]) > $widths[0]);
$widths[1] = length($data[$#data][1])
if (length($data[$#data][1]) > $widths[1]);
$widths[2] = length($data[$#data][2])
if (length($data[$#data][2]) > $widths[2]);
}
my $end = ' +-'.'-'x$widths[0].'-+-'.'-'x$widths[1].'-+-'
.'-'x$widths[2]."-+\n";
my $fmt = " | %-$widths[0]s | %-$widths[1]s | %-$widths[2]s |\n";
print "=head1 Stock Items\n\n";
print $end;
printf $fmt, 'Stock-Id', 'Label', 'Mod-Key';
print $end;
foreach (@data)
{
printf $fmt, @$_;
}
print $end."\n=cut\n\n";
|
