← Back to branch summary

~ubuntu-branches/ubuntu/trusty/fluxbox/trusty-proposed

« back to all changes in this revision

Viewing changes to nls/nlsinfo

  • Committer: Bazaar Package Importer
  • Author(s): Dmitry E. Oboukhov
  • Date: 2008-07-01 10:38:14 UTC
  • mfrom: (2.1.12 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080701103814-khx2b6il152x9p93
Tags: 1.0.0+deb1-8
* x-dev has been removed from build-depends (out-of-date package).
* Standards-Version bumped to 3.8.0.

Show diffs side-by-side

added added

removed removed

Lines of Context:
nls/nlsinfo
1
 
#!/usr/bin/perl -w
2
 
 
3
 
# This perl script is intended to go through the fluxbox source
4
 
# code searching for the special NLS strings. It then dumps
5
 
# the requested details.
6
 
# 
7
 
# I started trying to write it fairly generic, but it was difficult :-)
8
 
# Should be fairly adaptable though
9
 
#
10
 
# It doesn't currently handle more than one NLS define per line
11
 
#    => If you get an "undefined" error, its probably 2 on one line
12
 
 
13
 
$VERSION = "0.1";
14
 
 
15
 
use strict;
16
 
use Getopt::Std;
17
 
 
18
 
$Getopt::Std::STANDARD_HELP_VERSION = 1;
19
 
 
20
 
# the boolitem and focusitem is pretty dodgy, but it'll do for now
21
 
my $match_re = "(?:_FB(?:TK)?TEXT|_BOOLITEM|_FOCUSITEM)";
22
 
# regular expression for not a unquoted quote
23
 
my $noquote = q'(?:[^\"]|\\")';
24
 
 
25
 
my $fielddelim = "\0";
26
 
my $recorddelim = "\0";
27
 
 
28
 
#############################
29
 
# Parse and validate arguments
30
 
my %opts;
31
 
 
32
 
my $command = $0;
33
 
$command =~ s,^.*/,,;
34
 
 
35
 
my $fullcommand = "$command " . join(" ", @ARGV);
36
 
 
37
 
if (!getopts("d:fhn:pr:vFHN:R", \%opts)) {
38
 
    HELP_MESSAGE("error");
39
 
    exit(1);
40
 
}
41
 
 
42
 
sub HELP_MESSAGE {
43
 
    my $arg = shift;
44
 
    my $FD = *STDOUT;
45
 
    if (defined($arg) && $arg eq "error") {
46
 
        $FD = *STDERR;
47
 
    }
48
 
 
49
 
    print $FD "Usage: $command [options] directory\n";
50
 
    print $FD " Where options can be:\n";
51
 
    print $FD "    -R\tDon't recurse into subdirectories.\n";
52
 
    print $FD "    -f\tThe argument is a file, not a directory\n";
53
 
    print $FD "    -F\tPrint full NLS names, not shorthand ones\n";
54
 
    print $FD "    -d delim\tUse delim as the default delimiter\n";
55
 
    print $FD "    -r delim\tUse delim as the record delimiter\n";
56
 
    print $FD "    -n\tHeader name, default FLUXBOX_NLS_HH\n";
57
 
    print $FD "    -N\tNamespace for header\n";
58
 
    print $FD "    -v\tverbose output\n";
59
 
    print $FD "    -h\tPrint this help message\n";
60
 
    print $FD "\nPlus one of the following options that direct how to operate:\n";
61
 
    print $FD "    -H\tGenerate a header file for the strings encountered (-n implied).\n";
62
 
    print $FD "    -p\tPrint out a null-separated tuple of Set,String,Default,Description\n";
63
 
    print $FD "    \t\n";
64
 
    print $FD "\n";
65
 
 
66
 
}
67
 
 
68
 
if (defined($opts{"h"})) {
69
 
    HELP_MESSAGE();
70
 
    exit(0);
71
 
}
72
 
 
73
 
my $num_modes = 0;
74
 
my $mode;
75
 
 
76
 
sub mode_opt {
77
 
    my $opt = shift;
78
 
    my $modename = shift;
79
 
    return if (!defined($opts{$opt}));
80
 
    $num_modes++;
81
 
    $mode = $modename;
82
 
}
83
 
 
84
 
mode_opt("H", "header");
85
 
mode_opt("p", "print");
86
 
 
87
 
if ($num_modes == 0) {
88
 
    print STDERR "Must give one mode of operation!\n";
89
 
    HELP_MESSAGE("error");
90
 
    exit(1);
91
 
} elsif ($num_modes > 1) {
92
 
    print STDERR "Too many modes of operation - must give exactly one!\n";
93
 
    HELP_MESSAGE("error");
94
 
    exit(1);
95
 
}
96
 
 
97
 
my $recurse = 1;
98
 
$recurse = 0 if (defined($opts{"R"}));
99
 
 
100
 
my $fullnames = 0;
101
 
$fullnames = 1 if (defined($opts{"f"}) || $mode eq "header");
102
 
 
103
 
my $headername = "FLUXBOX_NLS_HH";
104
 
$headername = $opts{"n"} if (defined($opts{"n"}));
105
 
 
106
 
my $namespace;
107
 
$namespace = $opts{"N"} if (defined($opts{"N"}));
108
 
 
109
 
my $verbose = 0;
110
 
$verbose = 1 if (defined($opts{"v"}));
111
 
 
112
 
if (defined($opts{"d"})) {
113
 
    $fielddelim = $opts{"d"};
114
 
    $recorddelim = $opts{"d"};
115
 
}
116
 
 
117
 
if (defined($opts{"r"})) {
118
 
    $recorddelim = $opts{"r"};
119
 
}
120
 
 
121
 
 
122
 
if (scalar(@ARGV) == 0) {
123
 
    print STDERR "Must give at least one more argument - the directory to scan\n";
124
 
    exit(1);
125
 
}
126
 
 
127
 
 
128
 
my @args = @ARGV;
129
 
if (!defined($opts{"f"})) {
130
 
    foreach my $dir (@args) {
131
 
        if (! -d $dir) {
132
 
            print STDERR "$dir is not a directory, aborting\n";
133
 
            exit(2);
134
 
        }
135
 
    }
136
 
} elsif (defined($opts{"f"})) {
137
 
    $recurse = 0;
138
 
 
139
 
    foreach my $file (@args) {
140
 
        if (! -r $file) {
141
 
            print STDERR "$file is not a readable file, aborting\n";
142
 
            exit(2);
143
 
        }
144
 
    }
145
 
}
146
 
 
147
 
 
148
 
#############################
149
 
# Actually do stuff! (finally...)
150
 
 
151
 
my %sets;
152
 
 
153
 
if (defined($opts{"f"})) {
154
 
    foreach my $file (@args) {
155
 
        process_file($file);
156
 
    }
157
 
} else {
158
 
    foreach my $dir (@args) {
159
 
        process_dir($dir);
160
 
    }
161
 
}
162
 
 
163
 
# Now we have the data, we need to print it out
164
 
eval "mode_$mode()";
165
 
exit(0);
166
 
 
167
 
# this function is given the fbtext arguments
168
 
# But the first argument is the macro name...
169
 
sub store {
170
 
    my ($type, $set, $str, $default, $desc) = @_;
171
 
 
172
 
    if ($type eq "_FBTKTEXT") {
173
 
        $set = "FbTk$set";
174
 
    }
175
 
 
176
 
    if ($fullnames == 1) {
177
 
        $str = $set . $str;
178
 
        $set = $set . "Set";
179
 
    }
180
 
 
181
 
    $sets{$set}->{$str}{"default"} = $default;
182
 
    $sets{$set}->{$str}{"desc"} = $desc;
183
 
 
184
 
}
185
 
 
186
 
# C strings can just be a bunch of quoted strings adjacent to 
187
 
# each other. This just puts them all together, removes the quotes
188
 
# and unquotes anything we want to.
189
 
# there may be newlines embedded... compare everything /s
190
 
sub squish {
191
 
    my $str = shift;
192
 
 
193
 
    # remove first and last quote
194
 
    $str =~ s/^\s*\"//s;
195
 
    $str =~ s/\"\s*$//s;
196
 
    
197
 
    # now remove any inner quotes and intervening spaces
198
 
    $str =~ s/([^\\])\"\s*\"/$1/sg;
199
 
 
200
 
    # finally, unescape any remaining quotes
201
 
    $str =~ s/\\\"/\"/g;
202
 
 
203
 
    return $str;
204
 
}
205
 
 
206
 
sub process_dir {
207
 
    my $dir = shift;
208
 
    print STDERR "Processing directory '$dir'\n" if ($verbose == 1);
209
 
    opendir(DIR, $dir) || die "can't opendir $dir: $!";
210
 
    my @files = grep { ( /\.(cc|hh)$/ && -f "$dir/$_" ) || 
211
 
                           ( -d "$dir/$_" && $_ !~ /^\.\.?$/ )
212
 
                         } readdir(DIR);
213
 
    closedir DIR;
214
 
 
215
 
    foreach my $file (@files) {
216
 
        if (-d "$dir/$file") {
217
 
            process_dir("$dir/$file") if ($recurse == 1);
218
 
        } else {
219
 
            process_file("$dir/$file");
220
 
        }
221
 
    }
222
 
}
223
 
 
224
 
# assumptions for now:
225
 
# - no more than one NLS thing on any single line
226
 
# - internal parenthesis are balanced
227
 
# - one nls thing can span several lines
228
 
sub process_file {
229
 
    my $file = shift;
230
 
 
231
 
    print STDERR "Processing file '$file'\n" if ($verbose == 1);
232
 
    open(FILE, "<$file") || die "Can't open file $file: $!";
233
 
 
234
 
    while (<FILE>) {
235
 
        chomp;
236
 
        if (/$match_re/ && $_ !~ /^\#(define|undef)/) {
237
 
            my $tail = $_;
238
 
            # strip away leading stuff
239
 
            # note that this doesn't work with more than one match on a line
240
 
            $tail =~ s/^.*($match_re)/$1/;
241
 
            # now we just need to find the end, looking out for any
242
 
            # quotes
243
 
            my $end = 0;
244
 
            my $full  = $tail;
245
 
            while ($end == 0) {
246
 
                # match the defined macro, plus the first 4 arguments 
247
 
                # (ignore any more), then handle them
248
 
                if ($full =~ /^($match_re)\(([^,]+),\s*([^,]+),((?:\s*\"$noquote*\")+),((?:\s*"$noquote*")+)\s*(?:,.*)?\)/s ) {
249
 
                    store($1, $2, $3, squish($4), squish($5));
250
 
                    $end++;
251
 
                } else {
252
 
                    my $extra = <FILE>;
253
 
                    last if (!defined($extra));
254
 
                    $full .= $extra;
255
 
                }
256
 
            }
257
 
        }
258
 
    }
259
 
    close(FILE);
260
 
}
261
 
 
262
 
 
263
 
sub mode_print {
264
 
    foreach my $set (sort keys %sets) {
265
 
        foreach my $str (sort keys %{$sets{$set}}) {
266
 
            print $set . $fielddelim . $str . $fielddelim . $sets{$set}->{$str}{"default"} . $fielddelim . $sets{$set}->{$str}{"desc"} . $recorddelim;
267
 
        }
268
 
    }
269
 
}
270
 
 
271
 
sub mode_header {
272
 
    print "// This file generated by $fullcommand, on " . localtime() . "\n\n";
273
 
    print "#ifndef $headername\n";
274
 
    print "#define $headername\n\n";
275
 
    print "namespace $namespace {\n\n" if (defined($namespace));
276
 
    print "enum {\n";
277
 
 
278
 
    my $setnum = 0;
279
 
    foreach my $set (sort keys %sets) {
280
 
        $setnum++;
281
 
        printf "\t%s = %d,\n", $set, $setnum; 
282
 
 
283
 
        my $strnum = 0;
284
 
        foreach my $str (sort keys %{$sets{$set}}) {
285
 
            $strnum++;
286
 
            printf "\t%s = %d,\n", $str, $strnum; 
287
 
        }
288
 
        print "\n";
289
 
    }
290
 
    print "\tdummy_not_used = 0 // just for the end\n\n";
291
 
    print "}; // end enum\n\n";
292
 
    print "}; // end namespace $namespace\n\n" if (defined($namespace));
293
 
    print "#endif // $headername\n";
294
 
}
295