mirror of
https://github.com/rkd77/elinks.git
synced 2024-06-30 01:55:30 +00:00
107 lines
3.2 KiB
Perl
Executable File
107 lines
3.2 KiB
Perl
Executable File
#! /usr/bin/perl
|
|
use strict;
|
|
use warnings;
|
|
use Locale::PO qw();
|
|
|
|
{
|
|
package Contextline;
|
|
use fields qw(lineno contexts);
|
|
sub new {
|
|
my($self, $lineno, $contexts) = @_;
|
|
$self = fields::new($self) unless ref $self;
|
|
$self->{lineno} = $lineno;
|
|
$self->{contexts} = $contexts;
|
|
return $self;
|
|
}
|
|
}
|
|
|
|
# Each key is a file name.
|
|
# Each value is a reference to an array of references to Contextline
|
|
# pseudo-hashes. The array is in ascending order by {lineno}.
|
|
my %Srcfiles;
|
|
|
|
# Scan the $srcfile for gettext_accelerator_context directives,
|
|
# cache the result in %Srcfiles, and return it in that format.
|
|
sub contextlines ($$)
|
|
{
|
|
my($top_srcdir, $srcfile) = @_;
|
|
return $Srcfiles{$srcfile} if exists($Srcfiles{$srcfile});
|
|
|
|
local $_;
|
|
my @contextlines = ();
|
|
my @prevctxs;
|
|
open my $srcfd, "<", "$top_srcdir/$srcfile" or die "$top_srcdir/$srcfile: $!";
|
|
while (<$srcfd>) {
|
|
chomp;
|
|
if (/^\}/ && @prevctxs) {
|
|
push @contextlines, Contextline->new($., [@prevctxs = ()]);
|
|
}
|
|
if (my($contexts) = /\[gettext_accelerator_context\(([^()]*)\)\]/) {
|
|
my @contexts = grep { $_ ne "" } split(/\s*,\s*/, $contexts);
|
|
foreach (@contexts) { s/^\./${srcfile}:/ }
|
|
warn "$srcfile:$.: Previous context not closed\n"
|
|
if @prevctxs && @contexts;
|
|
warn "$srcfile:$.: Context already closed\n"
|
|
if !@prevctxs && !@contexts;
|
|
push @contextlines, Contextline->new($., [@prevctxs = @contexts]);
|
|
} elsif (/gettext_accelerator_context/) {
|
|
warn "$srcfile:$.: Suspicious non-directive: $_\n";
|
|
}
|
|
}
|
|
warn "$srcfile:$.: Last context not closed\n" if @prevctxs;
|
|
|
|
return $Srcfiles{$srcfile} = \@contextlines;
|
|
}
|
|
|
|
sub contexts ($$$)
|
|
{
|
|
my($top_srcdir, $srcfile, $lineno) = @_;
|
|
# Could use a binary search here.
|
|
my $contextlines = contextlines($top_srcdir, $srcfile);
|
|
my @contexts = ();
|
|
foreach my Contextline $contextline (@{$contextlines}) {
|
|
return @contexts if $contextline->{lineno} > $lineno;
|
|
@contexts = @{$contextline->{contexts}};
|
|
}
|
|
return ();
|
|
}
|
|
|
|
sub format_contexts (@)
|
|
{
|
|
if (@_) {
|
|
return "#. accelerator_context(" . join(", ", @_) . ")\n";
|
|
} else {
|
|
return "";
|
|
}
|
|
}
|
|
|
|
my($top_srcdir, $pofile) = @ARGV;
|
|
my $pos = Locale::PO->load_file_asarray($pofile) or die "$pofile: $!";
|
|
foreach my $po (@$pos) {
|
|
my $automatic = $po->automatic();
|
|
$automatic =~ s/^\[gettext_accelerator_context\(.*(?:\n|\z)//mg
|
|
if defined($automatic);
|
|
|
|
if ($po->msgid() =~ /\~/) {
|
|
my @po_contexts = ();
|
|
foreach my $ref (split(' ', $po->reference())) {
|
|
my @parts = split(/\:/, $ref);
|
|
warn "weird reference: $ref\n", next unless @parts == 2;
|
|
my @ref_contexts = contexts($top_srcdir, $parts[0], $parts[1]);
|
|
if (@ref_contexts) {
|
|
push @po_contexts, grep { $_ ne "IGNORE" } @ref_contexts;
|
|
} else {
|
|
warn "$ref: No accelerator context for msgid " . $po->msgid() . "\n";
|
|
}
|
|
}
|
|
if (@po_contexts) {
|
|
# 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: $!";
|