elinks/po/perl/gather-accelerator-contexts.pl

#! /usr/bin/perl
# The copyright notice and license are in the POD at the bottom.

use strict;
use warnings;
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.1";

sub show_version
{
    print "gather-accelerator-contexts.pl $VERSION\n";
    pod2usage({-verbose => 99, -sections => "COPYRIGHT AND LICENSE",
	       -exitval => 0});
}

{
    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;
    }
}

my @Srcpath;
my $Accelerator_tag;

# 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;

sub open_file_on_path ($@)
{
    my($fname, @path) = @_;
    if (@path) {
	my @warnings;
	foreach my $dir (@path) {
	    my $full_fname = catfile($dir, $fname);
	    if (open my $fh, "<", $full_fname) {
		return($fh, $full_fname);
	    } else {
		push @warnings, "$full_fname: $!\n";
	    }
	}
	# Didn't find $name anywhere on @path.
	warn $_ foreach @warnings;
	return;
    } else {			# no path
	if (open my $fh, "<", $fname) {
	    return($fh, $fname);
	} else {
	    warn "$fname: $!\n";
	    return;
	}
    }
    # not reached
}

# 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($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.
    my $contextlines = contextlines($srcfile);
    my @contexts = ();
    foreach my Contextline $contextline (@{$contextlines}) {
	return @contexts if $contextline->{lineno} > $lineno;
	@contexts = @{$contextline->{contexts}};
    }
    return ();
}

sub gather_accelerator_contexts ($$)
{
    my($pos, $po_fname) = @_;
    foreach my $po (@$pos) {
	my $automatic = $po->automatic();
	$automatic =~ s/^\[gettext_accelerator_context\(.*(?:\n|\z)//mg
	    if defined($automatic);

	if ($po->msgid() =~ /\Q$Accelerator_tag/s) {
	    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($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);
    }
}

GetOptions("srcdir|source-directory|S=s" => \@Srcpath,
	   "accelerator-tag=s" => sub {
	       my($option, $value) = @_;
	       die "Cannot use multiple --accelerator-tag options\n"
		   if defined($Accelerator_tag);
	       die "--accelerator-tag requires a single-character argument\n"
		   if length($value) != 1;
	       $Accelerator_tag = $value;
	   },
	   "help" => sub { pod2usage({-verbose => 1, -exitval => 0}) },
	   "version" => \&show_version)
    or exit 2;
$Accelerator_tag = "~" unless defined $Accelerator_tag;
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__

=head1 NAME

gather-accelerator-contexts.pl - Augment a PO file with information
for detecting accelerator conflicts.

=head1 SYNOPSIS

B<gather-accelerator-contexts.pl> [I<option> ...] F<I<program>.pot>

=head1 DESCRIPTION

B<gather-accelerator-contexts.pl> is part of a framework that detects
conflicting accelerator keys in Gettext PO files.  A conflict is when
two items in the same menu or two buttons in the same dialog box use
the same accelerator key.

The PO file format does not normally include any information on which
strings will be used in the same menu or dialog box.
B<gather-accelerator-contexts.pl> adds this information in the form of
"accelerator_context" comments, which B<check-accelerator-conflicts.pl>
then parses in order to detect the conflicts.

The PO file format also does not directly support definitions of
accelerator keys.  Typically, the keys are encoded in C<msgstr>
strings, by placing a tilde in front of the character that should be
used as the accelerator key.  That is also the syntax supported by
this framework and by B<msgfmt --check-accelerators> of GNU Gettext.

B<gather-accelerator-contexts.pl> first reads the F<I<program>.pot>
file named on the command line.  This file must include "#:" comments
that point to the source files from which B<xgettext> extracted each
C<msgid>.  B<gather-accelerator-contexts.pl> then scans those source
files for context information and rewrites F<I<program>.pot> to
include the "accelerator_context" comments.  Finally, the standard
tool B<msgmerge> can be used to copy the added comments to all the
F<I<language>.po> files.

It is best to run B<gather-accelerator-contexts.pl> immediately after
B<xgettext> so that the source references will be up to date.

=head2 Contexts

Whenever a source file refers to an C<msgid> that includes an
accelerator key, it must assign one or more named B<contexts> to it.
The C<msgstr>s in the PO files inherit these contexts.  If multiple
C<msgstr>s use the same accelerator (case insensitive) in the same
context, that's a conflict and can be detected automatically.

If the same C<msgid> is used in multiple places in the source code,
and those places assign different contexts to it, then all of those
contexts will apply.

The names of contexts consist of C identifiers delimited with periods.
The identifier is typically the name of a function that sets up a
dialog, or the name of an array where the items of a menu are listed.
There is a special feature for file-local identifiers (C<static> in C):
if the name begins with a period, then the period will be replaced
with the name of the source file and a colon.  The name "IGNORE" is
reserved.

If a menu is programmatically generated from multiple parts, of which
some are never used together, so that it is safe to use the same
accelerators in them, then it is necessary to define multiple contexts
for the same menu.

=head2 How to define contexts in source files

The contexts are defined with "gettext_accelerator_context" comments
in source files.  These comments delimit regions where all C<msgid>s
that seem to contain accelerators are given the same contexts.  There
must be one special comment at the top of the region; it lists the
contexts assigned to that region.  The region automatically ends at
the end of the function (found with regexp C</^\}/>), but it can also
be closed explicitly with another special comment.  The comments are
formatted like this:

  /* [gettext_accelerator_context(foo, bar, baz)]
       begins a region that uses the contexts "foo", "bar", and "baz".
       The comma is the delimiter; whitespace is optional.

     [gettext_accelerator_context()]
       ends the region.  */

B<gather-accelerator-contexts.pl> removes from F<I<program>.pot> any
"gettext_accelerator_context" comments that B<xgettext --add-comments>
may have copied there.  

B<gather-accelerator-contexts.pl> warns if it does not find any
contexts for some use of an C<msgid> that contains the character
specified with the B<--accelerator-tag> option.  If the character does
not actually indicate an accelerator in that C<msgid> (e.g. "~" in
"~/.bashrc"), the warning can be silenced by specifying the special
context "IGNORE", which B<gather-accelerator-contexts.pl> otherwise
ignores.

=head1 OPTIONS

=over

=item B<-S>F<I<srcdir>>, B<--srcdir=>F<I<srcdir>>,
B<--source-directory=>F<I<srcdir>>

The directory to which the source references in "#:" lines are
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.

=item B<--accelerator-tag=>I<character>

Specify the character that marks accelerators in C<msgid> strings.
B<gather-accelerator-contexts.pl> looks up accelerator contexts for
any C<msgid> that contains this character.

Omitting the B<--accelerator-tag> option implies
B<--accelerator-tag="~">.  The option must be given to each program
separately because there is no standard way to save this information
in the PO file.

=back

=head1 ARGUMENTS

=over

=item F<I<program>.pot>

The file to augment with context information.
B<gather-accelerator-contexts.pl> first reads this file and then
overwrites it.

Although this documentation keeps referring to F<I<program>.pot>,
you can also use B<gather-accelerator-contexts.pl> on an already
translated F<I<language>.po>.  However, that will only work correctly
if the source references in the "#:" lines are still up to date.

=back

=head1 BUGS

B<gather-accelerator-contexts.pl> assumes that source files are in
the C programming language: specifically, that a closing brace at
the beginning of a line marks the end of a function.

B<gather-accelerator-contexts.pl> doesn't check whether the
"gettext_accelerator_context" comments actually are comments.

=head1 AUTHOR

Kalle Olavi Niemitalo <kon@iki.fi>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2006 Kalle Olavi Niemitalo.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.  In addition:

=over

Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
THE COPYRIGHT HOLDER(S) BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
DEALINGS IN THE SOFTWARE.

=back

=head1 SEE ALSO

L<check-accelerator-conflicts.pl>, C<xgettext(1)>, C<msgmerge(1)>