aniani/elinks
1
0
Fork 0
mirror of https://github.com/rkd77/elinks.git synced 2024-12-04 14:46:47 -05:00
Code

gather-accelerator-contexts.pl parses options, and the top_srcdir must

Browse Source 
now be specified as --srcdir=top_srcdir (or --source-directory=top_srcdir
or -S top_srcdir).  Changed po/Makefile to match.
This option can even be repeated; that resolves a BUGS item.
Changed po/Makefile to ignore exit codes from check-accelerator-contexts.pl.
Enabled bundling of options in Getopt::Long so that -Stop_srcdir works too.
This commit is contained in:
Kalle Olavi Niemitalo 2006-01-14 12:24:32 +02:00 committed by Kalle Olavi Niemitalo
parent 78ea4c8425
commit 71bf9716c8
3 changed files with 134 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
po/Makefile
View File

@ -59,7 +59,7 @@ $(srcdir)$(PACKAGE).pot: $(srcdir)$(POTFILES_ABS_LIST) $(srcdir)perl/gather-acce
--add-comments --language=C \ --add-comments --language=C \
--keyword=_ --keyword=N_ --keyword=n_:1,2 --keyword=N__ -f $(srcdir)$(POTFILES_ABS_LIST) \ --keyword=_ --keyword=N_ --keyword=n_:1,2 --keyword=N__ -f $(srcdir)$(POTFILES_ABS_LIST) \
&& test -f $(PACKAGE).po \ && test -f $(PACKAGE).po \
&& $(PERL) -I"$(srcdir)perl" $(srcdir)perl/gather-accelerator-contexts.pl $(top_srcdir) $(PACKAGE).po \ && $(PERL) -I"$(srcdir)perl" $(srcdir)perl/gather-accelerator-contexts.pl -S"$(top_srcdir)" $(PACKAGE).po \
&& mv -f $(PACKAGE).po $(srcdir)$(PACKAGE).pot && mv -f $(PACKAGE).po $(srcdir)$(PACKAGE).pot
@ -91,7 +91,7 @@ update-gmo: Makefile $(GMOFILES)
# #
check-po: check-po:
@$(foreach lang,$(basename $(if $(strip $(PO)),$(PO),$(GMOFILES))), \ @-$(foreach lang,$(basename $(if $(strip $(PO)),$(PO),$(GMOFILES))), \
echo -n "$(lang): "; \ echo -n "$(lang): "; \
$(GMSGFMT) --check --check-accelerators="~" --verbose --statistics -o /dev/null $(srcdir)$(lang).po; \ $(GMSGFMT) --check --check-accelerators="~" --verbose --statistics -o /dev/null $(srcdir)$(lang).po; \
$(PERL) -I"$(srcdir)perl" $(srcdir)perl/check-accelerator-contexts.pl $(srcdir)$(lang).po; \ $(PERL) -I"$(srcdir)perl" $(srcdir)perl/check-accelerator-contexts.pl $(srcdir)$(lang).po; \

16
po/perl/check-accelerator-contexts.pl
View File

@ -4,11 +4,18 @@
use strict; use strict;
use warnings; use warnings;
use Locale::PO qw(); use Locale::PO qw();
use Getopt::Long qw(GetOptions); use Getopt::Long qw(GetOptions :config bundling gnu_compat);
use autouse 'Pod::Usage' => qw(pod2usage); use autouse 'Pod::Usage' => qw(pod2usage);
my $VERSION = "1.0"; my $VERSION = "1.0";
sub show_version
{
print "check-accelerator-contexts.pl $VERSION\n";
pod2usage({-verbose => 99, -sections => "COPYRIGHT AND LICENSE",
-exitval => 0});
}
sub check_po_file sub check_po_file
{ {
my($po_file_name) = @_; my($po_file_name) = @_;
@ -49,13 +56,6 @@ sub check_po_file
return $warnings ? 1 : 0; return $warnings ? 1 : 0;
} }
sub show_version
{
print "check-accelerator-contexts.pl $VERSION\n";
pod2usage({-verbose => 99, -sections => "COPYRIGHT AND LICENSE",
-exitval => 0});
}
GetOptions("help" => sub { pod2usage({-verbose => 1, -exitval => 0}) }, GetOptions("help" => sub { pod2usage({-verbose => 1, -exitval => 0}) },
"version" => \&show_version) "version" => \&show_version)
or exit 2; or exit 2;

193
po/perl/gather-accelerator-contexts.pl
View File

@ -1,7 +1,21 @@
#! /usr/bin/perl #! /usr/bin/perl
# The copyright notice and license are in the POD at the bottom.
use strict; use strict;
use warnings; use warnings;
use Locale::PO qw(); use Locale::PO qw();
use Getopt::Long qw(GetOptions :config bundling gnu_compat);
use autouse 'Pod::Usage' => qw(pod2usage);
use autouse 'File::Spec::Functions' => qw(catfile);
my $VERSION = "1.0";
sub show_version
{
print "gather-accelerator-contexts.pl $VERSION\n";
pod2usage({-verbose => 99, -sections => "COPYRIGHT AND LICENSE",
-exitval => 0});
}
{ {
package Contextline; package Contextline;
@ -15,49 +29,80 @@ use Locale::PO qw();
} }
} }
my @Srcpath;
# Each key is a file name. # Each key is a file name.
# Each value is a reference to an array of references to Contextline # Each value is a reference to an array of references to Contextline
# pseudo-hashes. The array is in ascending order by {lineno}. # pseudo-hashes. The array is in ascending order by {lineno}.
my %Srcfiles; my %Srcfiles;
# Scan the $srcfile for gettext_accelerator_context directives, sub open_file_on_path ($@)
# cache the result in %Srcfiles, and return it in that format.
sub contextlines ($$)
{ {
my($top_srcdir, $srcfile) = @_; my($fname, @path) = @_;
return $Srcfiles{$srcfile} if exists($Srcfiles{$srcfile}); if (@path) {
my @warnings;
local $_; foreach my $dir (@path) {
my @contextlines = (); my $full_fname = catfile($dir, $fname);
my @prevctxs; if (open my $fh, "<", $full_fname) {
open my $srcfd, "<", "$top_srcdir/$srcfile" or die "$top_srcdir/$srcfile: $!"; return($fh, $full_fname);
while (<$srcfd>) { } else {
chomp; push @warnings, "$full_fname: $!\n";
if (/^\}/ && @prevctxs) { }
push @contextlines, Contextline->new($., [@prevctxs = ()]);
} }
if (my($contexts) = /\[gettext_accelerator_context\(([^()]*)\)\]/) { # Didn't find $name anywhere on @path.
my @contexts = grep { $_ ne "" } split(/\s*,\s*/, $contexts); warn $_ foreach @warnings;
foreach (@contexts) { s/^\./${srcfile}:/ } return;
warn "$srcfile:$.: Previous context not closed\n" } else { # no path
if @prevctxs && @contexts; if (open my $fh, "<", $fname) {
warn "$srcfile:$.: Context already closed\n" return($fh, $fname);
if !@prevctxs && !@contexts; } else {
push @contextlines, Contextline->new($., [@prevctxs = @contexts]); warn "$fname: $!\n";
} elsif (/gettext_accelerator_context/) { return;
warn "$srcfile:$.: Suspicious non-directive: $_\n";
} }
} }
warn "$srcfile:$.: Last context not closed\n" if @prevctxs; # not reached
return $Srcfiles{$srcfile} = \@contextlines;
} }
sub contexts ($$$) # Scan the file $src_fname for gettext_accelerator_context directives,
# cache the result in %Srcfiles, and return it in that format.
# Cache and return [] if the file cannot be read on @Srcpath.
sub contextlines ($)
{ {
my($top_srcdir, $srcfile, $lineno) = @_; my($src_fname) = @_;
return $Srcfiles{$src_fname} if exists($Srcfiles{$src_fname});
my @contextlines = ();
if (my($src_fh, $src_full_fname) = open_file_on_path($src_fname, @Srcpath)) {
my @prevctxs;
local $_;
while (<$src_fh>) {
chomp;
if (/^\}/ && @prevctxs) {
push @contextlines, Contextline->new($., [@prevctxs = ()]);
}
if (my($contexts) = /\[gettext_accelerator_context\(([^()]*)\)\]/) {
my @contexts = grep { $_ ne "" } split(/\s*,\s*/, $contexts);
s/^\./${src_fname}:/ foreach @contexts;
warn "$src_full_fname:$.: Previous context not closed\n"
if @prevctxs && @contexts;
warn "$src_full_fname:$.: Context already closed\n"
if !@prevctxs && !@contexts;
push @contextlines, Contextline->new($., [@prevctxs = @contexts]);
} elsif (/gettext_accelerator_context/) {
warn "$src_full_fname:$.: Suspicious non-directive: $_\n";
}
}
warn "$src_full_fname:$.: Last context not closed\n" if @prevctxs;
} # if opened ok
return $Srcfiles{$src_fname} = \@contextlines;
}
sub contexts ($$)
{
my($srcfile, $lineno) = @_;
# Could use a binary search here. # Could use a binary search here.
my $contextlines = contextlines($top_srcdir, $srcfile); my $contextlines = contextlines($srcfile);
my @contexts = (); my @contexts = ();
foreach my Contextline $contextline (@{$contextlines}) { foreach my Contextline $contextline (@{$contextlines}) {
return @contexts if $contextline->{lineno} > $lineno; return @contexts if $contextline->{lineno} > $lineno;
@ -66,44 +111,48 @@ sub contexts ($$$)
return (); return ();
} }
sub format_contexts (@) sub gather_accelerator_contexts ($$)
{ {
if (@_) { my($pos, $po_fname) = @_;
return "#. accelerator_context(" . join(", ", @_) . ")\n"; foreach my $po (@$pos) {
} else { my $automatic = $po->automatic();
return ""; $automatic =~ s/^\[gettext_accelerator_context\(.*(?:\n|\z)//mg
} if defined($automatic);
}
my($top_srcdir, $pofile) = @ARGV; if ($po->msgid() =~ /\~/) {
my $pos = Locale::PO->load_file_asarray($pofile) or die "$pofile: $!"; my @po_contexts = ();
foreach my $po (@$pos) { foreach my $ref (split(' ', $po->reference())) {
my $automatic = $po->automatic(); my @parts = split(/\:/, $ref);
$automatic =~ s/^\[gettext_accelerator_context\(.*(?:\n|\z)//mg warn "weird reference: $ref\n", next unless @parts == 2;
if defined($automatic); my @ref_contexts = contexts($parts[0], $parts[1]);
if (@ref_contexts) {
if ($po->msgid() =~ /\~/) { push @po_contexts, grep { $_ ne "IGNORE" } @ref_contexts;
my @po_contexts = (); } else {
foreach my $ref (split(' ', $po->reference())) { warn "$ref: No accelerator context for msgid " . $po->msgid() . "\n";
my @parts = split(/\:/, $ref); }
warn "weird reference: $ref\n", next unless @parts == 2; }
my @ref_contexts = contexts($top_srcdir, $parts[0], $parts[1]); if (@po_contexts) {
if (@ref_contexts) { # sort and uniquify
push @po_contexts, grep { $_ ne "IGNORE" } @ref_contexts; @po_contexts = sort keys %{{map { $_ => 1 } @po_contexts}};
} else { $automatic .= "\n" if defined($automatic) and $automatic ne "";
warn "$ref: No accelerator context for msgid " . $po->msgid() . "\n"; $automatic .= "accelerator_context(" . join(", ", @po_contexts) . ")";
} }
} }
if (@po_contexts) { $po->automatic($automatic);
# sort and uniquify
@po_contexts = sort keys %{{map { $_ => 1 } @po_contexts}};
$automatic .= "\n" if defined($automatic) and $automatic ne "";
$automatic .= "accelerator_context(" . join(", ", @po_contexts) . ")";
}
} }
$po->automatic($automatic);
} }
Locale::PO->save_file_fromarray($pofile, $pos) or die "$pofile: $!";
GetOptions("srcdir|source-directory|S=s" => \@Srcpath,
"help" => sub { pod2usage({-verbose => 1, -exitval => 0}) },
"version" => \&show_version)
or exit 2;
print(STDERR "$0: missing file operand\n"), exit 2 unless @ARGV;
print(STDERR "$0: too many operands\n"), exit 2 if @ARGV > 1;
my($po_fname) = @ARGV;
my $pos = Locale::PO->load_file_asarray($po_fname) or die "$po_fname: $!";
gather_accelerator_contexts($pos, $po_fname);
Locale::PO->save_file_fromarray($po_fname, $pos) or die "$po_fname: $!";
__END__ __END__
@ -114,7 +163,7 @@ for detecting accelerator conflicts.
=head1 SYNOPSIS =head1 SYNOPSIS
B<gather-accelerator-contexts.pl> I<top_srcdir> F<I<program>.pot> B<gather-accelerator-contexts.pl> [B<-S>F<I<srcdir>>]... F<I<program>.pot>
=head1 DESCRIPTION =head1 DESCRIPTION
@ -195,14 +244,23 @@ an accelerator (e.g. in "~/.bashrc"), the warning can be silenced by
specifying the special context "IGNORE", which specifying the special context "IGNORE", which
B<gather-accelerator-contexts.pl> otherwise ignores. B<gather-accelerator-contexts.pl> otherwise ignores.
=head1 ARGUMENTS =head1 OPTIONS
=over =over
=item I<top_srcdir> =item B<-S>F<I<srcdir>>
The directory to which the source references in "#:" lines are The directory to which the source references in "#:" lines are
relative. relative. Each use of this option adds one directory to the search
path. If you do not specify this option,
B<gather-accelerator-contexts.pl> implicitly searches the current
directory.
=back
=head1 ARGUMENTS
=over
=item F<I<program>.pot> =item F<I<program>.pot>
@ -230,9 +288,6 @@ the beginning of a line marks the end of a function.
B<gather-accelerator-contexts.pl> doesn't check whether the B<gather-accelerator-contexts.pl> doesn't check whether the
"gettext_accelerator_context" comments actually are comments. "gettext_accelerator_context" comments actually are comments.
There should be a way to specify a source path, rather than just a
single I<top_srcdir> directory.
=head1 AUTHOR =head1 AUTHOR
Kalle Olavi Niemitalo <kon@iki.fi> Kalle Olavi Niemitalo <kon@iki.fi>