summaryrefslogtreecommitdiff
path: root/intltool-extract.in
diff options
context:
space:
mode:
Diffstat (limited to 'intltool-extract.in')
-rwxr-xr-xintltool-extract.in406
1 files changed, 0 insertions, 406 deletions
diff --git a/intltool-extract.in b/intltool-extract.in
deleted file mode 100755
index 00e894aaa..000000000
--- a/intltool-extract.in
+++ /dev/null
@@ -1,406 +0,0 @@
-#!@INTLTOOL_PERL@ -w
-# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4 -*-
-
-#
-# The Intltool Message Extractor
-#
-# Copyright (C) 2000-2001, 2003 Free Software Foundation.
-#
-# Intltool is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License as
-# published by the Free Software Foundation; either version 2 of the
-# License, or (at your option) any later version.
-#
-# Intltool is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-#
-# As a special exception to the GNU General Public License, if you
-# distribute this file as part of a program that contains a
-# configuration script generated by Autoconf, you may include it under
-# the same distribution terms that you use for the rest of that program.
-#
-# Authors: Kenneth Christiansen <kenneth@gnu.org>
-# Darin Adler <darin@bentspoon.com>
-#
-
-## Release information
-my $PROGRAM = "intltool-extract";
-my $PACKAGE = "intltool";
-my $VERSION = "0.27.2";
-
-## Loaded modules
-use strict;
-use File::Basename;
-use Getopt::Long;
-
-## Scalars used by the option stuff
-my $TYPE_ARG = "0";
-my $LOCAL_ARG = "0";
-my $HELP_ARG = "0";
-my $VERSION_ARG = "0";
-my $UPDATE_ARG = "0";
-my $QUIET_ARG = "0";
-
-my $FILE;
-my $OUTFILE;
-
-my $gettext_type = "";
-my $input;
-my %messages = ();
-
-## Use this instead of \w for XML files to handle more possible characters.
-my $w = "[-A-Za-z0-9._:]";
-
-## Always print first
-$| = 1;
-
-## Handle options
-GetOptions (
- "type=s" => \$TYPE_ARG,
- "local|l" => \$LOCAL_ARG,
- "help|h" => \$HELP_ARG,
- "version|v" => \$VERSION_ARG,
- "update" => \$UPDATE_ARG,
- "quiet|q" => \$QUIET_ARG,
- ) or &error;
-
-&split_on_argument;
-
-
-## Check for options.
-## This section will check for the different options.
-
-sub split_on_argument {
-
- if ($VERSION_ARG) {
- &version;
-
- } elsif ($HELP_ARG) {
- &help;
-
- } elsif ($LOCAL_ARG) {
- &place_local;
- &extract;
-
- } elsif ($UPDATE_ARG) {
- &place_normal;
- &extract;
-
- } elsif (@ARGV > 0) {
- &place_normal;
- &message;
- &extract;
-
- } else {
- &help;
-
- }
-}
-
-sub place_normal {
- $FILE = $ARGV[0];
- $OUTFILE = "$FILE.h";
-}
-
-sub place_local {
- $OUTFILE = fileparse($FILE, ());
- if (!-e "tmp/") {
- system("mkdir tmp/");
- }
- $OUTFILE = "./tmp/$OUTFILE.h"
-}
-
-sub determine_type {
- if ($TYPE_ARG =~ /^gettext\/(.*)/) {
- $gettext_type=$1
- }
-}
-
-## Sub for printing release information
-sub version{
- print <<_EOF_;
-${PROGRAM} (${PACKAGE}) $VERSION
-Copyright (C) 2000, 2003 Free Software Foundation, Inc.
-Written by Kenneth Christiansen, 2000.
-
-This is free software; see the source for copying conditions. There is NO
-warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-_EOF_
- exit;
-}
-
-## Sub for printing usage information
-sub help {
- print <<_EOF_;
-Usage: ${PROGRAM} [OPTION]... [FILENAME]
-Generates a header file from an XML source file.
-
-It grabs all strings between <_translatable_node> and its end tag in
-XML files. Read manpage (man ${PROGRAM}) for more info.
-
- --type=TYPE Specify the file type of FILENAME. Currently supports:
- "gettext/glade", "gettext/ini", "gettext/keys"
- "gettext/rfc822deb", "gettext/schemas",
- "gettext/scheme", "gettext/xml"
- -l, --local Writes output into current working directory
- (conflicts with --update)
- --update Writes output into the same directory the source file
- reside (conflicts with --local)
- -v, --version Output version information and exit
- -h, --help Display this help and exit
- -q, --quiet Quiet mode
-
-Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE")
-or send email to <xml-i18n-tools\@gnome.org>.
-_EOF_
- exit;
-}
-
-## Sub for printing error messages
-sub error{
- print STDERR "Try `${PROGRAM} --help' for more information.\n";
- exit;
-}
-
-sub message {
- print "Generating C format header file for translation.\n" unless $QUIET_ARG;
-}
-
-sub extract {
- &determine_type;
-
- &convert ($FILE);
-
- open OUT, ">$OUTFILE";
- &msg_write;
- close OUT;
-
- print "Wrote $OUTFILE\n" unless $QUIET_ARG;
-}
-
-sub convert($) {
-
- ## Reading the file
- {
- local (*IN);
- local $/; #slurp mode
- open (IN, "<$FILE") || die "can't open $FILE: $!";
- $input = <IN>;
- }
-
- &type_ini if $gettext_type eq "ini";
- &type_keys if $gettext_type eq "keys";
- &type_xml if $gettext_type eq "xml";
- &type_glade if $gettext_type eq "glade";
- &type_scheme if $gettext_type eq "scheme";
- &type_schemas if $gettext_type eq "schemas";
- &type_rfc822deb if $gettext_type eq "rfc822deb";
-}
-
-sub entity_decode_minimal
-{
- local ($_) = @_;
-
- s/&apos;/'/g; # '
- s/&quot;/"/g; # "
- s/&amp;/&/g;
-
- return $_;
-}
-
-sub entity_decode
-{
- local ($_) = @_;
-
- s/&apos;/'/g; # '
- s/&quot;/"/g; # "
- s/&amp;/&/g;
- s/&lt;/</g;
- s/&gt;/>/g;
-
- return $_;
-}
-
-sub escape_char
-{
- return '\"' if $_ eq '"';
- return '\n' if $_ eq "\n";
- return '\\' if $_ eq '\\';
-
- return $_;
-}
-
-sub escape
-{
- my ($string) = @_;
- return join "", map &escape_char, split //, $string;
-}
-
-sub type_ini {
- ### For generic translatable desktop files ###
- while ($input =~ /^_.*=(.*)$/mg) {
- $messages{$1} = [];
- }
-}
-
-sub type_keys {
- ### For generic translatable mime/keys files ###
- while ($input =~ /^\s*_\w+=(.*)$/mg) {
- $messages{$1} = [];
- }
-}
-
-sub type_xml {
- ### For generic translatable XML files ###
-
- while ($input =~ /\s_$w+\s*=\s*\"([^"]+)\"/sg) { # "
- $messages{entity_decode_minimal($1)} = [];
- }
-
- while ($input =~ /<_($w+)(?: xml:space="($w+)")?>(.+?)<\/_\1>/sg) {
- $_ = $3;
- if (!defined($2) || $2 ne "preserve") {
- s/\s+/ /g;
- s/^ //;
- s/ $//;
- }
- $messages{entity_decode_minimal($_)} = [];
- }
-}
-
-sub type_schemas {
- ### For schemas XML files ###
-
- # FIXME: We should handle escaped < (less than)
- while ($input =~ /
- <locale\ name="C">\s*
- (<default>\s*(.*?)\s*<\/default>\s*)?
- (<short>\s*(.*?)\s*<\/short>\s*)?
- (<long>\s*(.*?)\s*<\/long>\s*)?
- <\/locale>
- /sgx) {
- my @totranslate = ($2,$4,$6);
- foreach (@totranslate) {
- next if !$_;
- s/\s+/ /g;
- $messages{entity_decode_minimal($_)} = [];
- }
- }
-}
-
-sub type_rfc822deb {
- ### For rfc822-style Debian configuration files ###
-
- while ($input =~ /(?:^|\n)_[^:]+:\s*(.*?)(?=\n\S|$)/sg) {
- my @str_list = rfc822deb_split($1);
- for my $str (@str_list) {
- # As rfc822deb is for configuration files, duplicates
- # should never happen. Developers must use the
- # [] construct to make msgid unique, see also intltool-merge
- print STDERR "Warning: msgid multiply defined:\n $str\n"
- if defined($messages{$str});
- $messages{$str} = [];
- }
- }
-}
-
-sub rfc822deb_split {
- # Debian defines a special way to deal with rfc822-style files:
- # when a value contain newlines, it consists of
- # 1. a short form (first line)
- # 2. a long description, all lines begin with a space,
- # and paragraphs are separated by a single dot on a line
- # This routine returns an array of all paragraphs, and reformat
- # them.
- my $text = shift;
- $text =~ s/^ //mg;
- return ($text) if $text !~ /\n/;
-
- $text =~ s/([^\n]*)\n//;
- my @list = ($1);
- my $str = '';
- for my $line (split (/\n/, $text)) {
- chomp $line;
- $line =~ /\s+$/;
- if ($line =~ /^\.$/) {
- # New paragraph
- $str =~ s/\s*$//;
- push(@list, $str);
- $str = '';
- } elsif ($line =~ /^\s/) {
- # Line which must not be reformatted
- $str .= "\n" if length ($str) && $str !~ /\n$/;
- $str .= $line."\n";
- } else {
- # Continuation line, remove newline
- $str .= " " if length ($str) && $str !~ /[\n ]$/;
- $str .= $line;
- }
- }
- $str =~ s/\s*$//;
- push(@list, $str) if length ($str);
- return @list;
-}
-
-sub type_glade {
- ### For translatable Glade XML files ###
-
- my $tags = "label|title|text|format|copyright|comments|preview_text|tooltip|message";
-
- while ($input =~ /<($tags)>([^<]+)<\/($tags)>/sg) {
- # Glade sometimes uses tags that normally mark translatable things for
- # little bits of non-translatable content. We work around this by not
- # translating strings that only includes something like label4 or window1.
- $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label)[0-9]+$/;
- }
-
- while ($input =~ /<items>(..[^<]*)<\/items>/sg) {
- for my $item (split (/\n/, $1)) {
- $messages{entity_decode($item)} = [];
- }
- }
-
- ## handle new glade files
- while ($input =~ /<(property|atkproperty)\s+[^>]*translatable\s*=\s*"yes"[^>]*>([^<]+)<\/\1>/sg) {
- $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label)[0-9]+$/;
- }
- while ($input =~ /<atkaction\s+action_name="([^>]*)"\s+description="([^>]+)"\/>/sg) {
- $messages{entity_decode_minimal($2)} = [];
- }
-}
-
-sub type_scheme {
- while ($input =~ /_\w*\(?"((?:[^"\\]+|\\.)*)"\)?/sg) {
- $messages{$1} = [];
- }
-}
-
-sub msg_write {
- for my $message (sort keys %messages) {
- print OUT "/* xgettext:no-c-format */\n" if $message =~ /%/;
-
- my @lines = split (/\n/, $message, -1);
- for (my $n = 0; $n < @lines; $n++) {
- if ($n == 0) {
- print OUT "char *s = N_(\"";
- } else {
- print OUT " \"";
- }
-
- print OUT escape($lines[$n]);
-
- if ($n < @lines - 1) {
- print OUT "\\n\"\n";
- } else {
- print OUT "\");\n";
- }
- }
- }
-}
-
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-25 07:09:26 +0000