1#!@INTLTOOL_PERL@ -w 2# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4 -*- 3 4# 5# The Intltool Message Extractor 6# 7# Copyright (C) 2000-2001, 2003 Free Software Foundation. 8# 9# Intltool is free software; you can redistribute it and/or 10# modify it under the terms of the GNU General Public License as 11# published by the Free Software Foundation; either version 2 of the 12# License, or (at your option) any later version. 13# 14# Intltool is distributed in the hope that it will be useful, 15# but WITHOUT ANY WARRANTY; without even the implied warranty of 16# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17# General Public License for more details. 18# 19# You should have received a copy of the GNU General Public License 20# along with this program; if not, write to the Free Software 21# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 22# 23# As a special exception to the GNU General Public License, if you 24# distribute this file as part of a program that contains a 25# configuration script generated by Autoconf, you may include it under 26# the same distribution terms that you use for the rest of that program. 27# 28# Authors: Kenneth Christiansen <kenneth@gnu.org> 29# Darin Adler <darin@bentspoon.com> 30# 31 32## Release information 33my $PROGRAM = "intltool-extract"; 34my $PACKAGE = "intltool"; 35my $VERSION = "0.35.0"; 36 37## Loaded modules 38use strict; 39use File::Basename; 40use Getopt::Long; 41 42## Scalars used by the option stuff 43my $TYPE_ARG = "0"; 44my $LOCAL_ARG = "0"; 45my $HELP_ARG = "0"; 46my $VERSION_ARG = "0"; 47my $UPDATE_ARG = "0"; 48my $QUIET_ARG = "0"; 49my $SRCDIR_ARG = "."; 50 51my $FILE; 52my $OUTFILE; 53 54my $gettext_type = ""; 55my $input; 56my %messages = (); 57my %loc = (); 58my %count = (); 59my %comments = (); 60my $strcount = 0; 61 62my $XMLCOMMENT = ""; 63 64## Use this instead of \w for XML files to handle more possible characters. 65my $w = "[-A-Za-z0-9._:]"; 66 67## Always print first 68$| = 1; 69 70## Handle options 71GetOptions ( 72 "type=s" => \$TYPE_ARG, 73 "local|l" => \$LOCAL_ARG, 74 "help|h" => \$HELP_ARG, 75 "version|v" => \$VERSION_ARG, 76 "update" => \$UPDATE_ARG, 77 "quiet|q" => \$QUIET_ARG, 78 "srcdir=s" => \$SRCDIR_ARG, 79 ) or &error; 80 81&split_on_argument; 82 83 84## Check for options. 85## This section will check for the different options. 86 87sub split_on_argument { 88 89 if ($VERSION_ARG) { 90 &version; 91 92 } elsif ($HELP_ARG) { 93 &help; 94 95 } elsif ($LOCAL_ARG) { 96 &place_local; 97 &extract; 98 99 } elsif ($UPDATE_ARG) { 100 &place_normal; 101 &extract; 102 103 } elsif (@ARGV > 0) { 104 &place_normal; 105 &message; 106 &extract; 107 108 } else { 109 &help; 110 111 } 112} 113 114sub place_normal { 115 $FILE = $ARGV[0]; 116 $OUTFILE = "$FILE.h"; 117} 118 119sub place_local { 120 $FILE = $ARGV[0]; 121 $OUTFILE = fileparse($FILE, ()); 122 if (!-e "tmp/") { 123 system("mkdir tmp/"); 124 } 125 $OUTFILE = "./tmp/$OUTFILE.h" 126} 127 128sub determine_type { 129 if ($TYPE_ARG =~ /^gettext\/(.*)/) { 130 $gettext_type=$1 131 } 132} 133 134## Sub for printing release information 135sub version{ 136 print <<_EOF_; 137${PROGRAM} (${PACKAGE}) $VERSION 138Copyright (C) 2000, 2003 Free Software Foundation, Inc. 139Written by Kenneth Christiansen, 2000. 140 141This is free software; see the source for copying conditions. There is NO 142warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 143_EOF_ 144 exit; 145} 146 147## Sub for printing usage information 148sub help { 149 print <<_EOF_; 150Usage: ${PROGRAM} [OPTION]... [FILENAME] 151Generates a header file from an XML source file. 152 153It grabs all strings between <_translatable_node> and its end tag in 154XML files. Read manpage (man ${PROGRAM}) for more info. 155 156 --type=TYPE Specify the file type of FILENAME. Currently supports: 157 "gettext/glade", "gettext/ini", "gettext/keys" 158 "gettext/rfc822deb", "gettext/schemas", 159 "gettext/scheme", "gettext/xml" 160 -l, --local Writes output into current working directory 161 (conflicts with --update) 162 --update Writes output into the same directory the source file 163 reside (conflicts with --local) 164 --srcdir Root of the source tree 165 -v, --version Output version information and exit 166 -h, --help Display this help and exit 167 -q, --quiet Quiet mode 168 169Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE") 170or send email to <xml-i18n-tools\@gnome.org>. 171_EOF_ 172 exit; 173} 174 175## Sub for printing error messages 176sub error{ 177 print STDERR "Try `${PROGRAM} --help' for more information.\n"; 178 exit; 179} 180 181sub message { 182 print "Generating C format header file for translation.\n" unless $QUIET_ARG; 183} 184 185sub extract { 186 &determine_type; 187 188 &convert; 189 190 open OUT, ">$OUTFILE"; 191 binmode (OUT) if $^O eq 'MSWin32'; 192 &msg_write; 193 close OUT; 194 195 print "Wrote $OUTFILE\n" unless $QUIET_ARG; 196} 197 198sub convert { 199 200 ## Reading the file 201 { 202 local (*IN); 203 local $/; #slurp mode 204 open (IN, "<$SRCDIR_ARG/$FILE") || die "can't open $SRCDIR_ARG/$FILE: $!"; 205 $input = <IN>; 206 } 207 208 &type_ini if $gettext_type eq "ini"; 209 &type_keys if $gettext_type eq "keys"; 210 &type_xml if $gettext_type eq "xml"; 211 &type_glade if $gettext_type eq "glade"; 212 &type_scheme if $gettext_type eq "scheme"; 213 &type_schemas if $gettext_type eq "schemas"; 214 &type_rfc822deb if $gettext_type eq "rfc822deb"; 215} 216 217sub entity_decode_minimal 218{ 219 local ($_) = @_; 220 221 s/'/'/g; # ' 222 s/"/"/g; # " 223 s/&/&/g; 224 225 return $_; 226} 227 228sub entity_decode 229{ 230 local ($_) = @_; 231 232 s/'/'/g; # ' 233 s/"/"/g; # " 234 s/&/&/g; 235 s/</</g; 236 s/>/>/g; 237 238 return $_; 239} 240 241sub escape_char 242{ 243 return '\"' if $_ eq '"'; 244 return '\n' if $_ eq "\n"; 245 return '\\' if $_ eq '\\'; 246 247 return $_; 248} 249 250sub escape 251{ 252 my ($string) = @_; 253 return join "", map &escape_char, split //, $string; 254} 255 256sub type_ini { 257 ### For generic translatable desktop files ### 258 while ($input =~ /^_.*=(.*)$/mg) { 259 $messages{$1} = []; 260 } 261} 262 263sub type_keys { 264 ### For generic translatable mime/keys files ### 265 while ($input =~ /^\s*_\w+=(.*)$/mg) { 266 $messages{$1} = []; 267 } 268} 269 270sub type_xml { 271 ### For generic translatable XML files ### 272 my $tree = readXml($input); 273 parseTree(0, $tree); 274} 275 276sub print_var { 277 my $var = shift; 278 my $vartype = ref $var; 279 280 if ($vartype =~ /ARRAY/) { 281 my @arr = @{$var}; 282 print "[ "; 283 foreach my $el (@arr) { 284 print_var($el); 285 print ", "; 286 } 287 print "] "; 288 } elsif ($vartype =~ /HASH/) { 289 my %hash = %{$var}; 290 print "{ "; 291 foreach my $key (keys %hash) { 292 print "$key => "; 293 print_var($hash{$key}); 294 print ", "; 295 } 296 print "} "; 297 } else { 298 print $var; 299 } 300} 301 302# Same syntax as getAttributeString in intltool-merge.in.in, similar logic (look for ## differences comment) 303sub getAttributeString 304{ 305 my $sub = shift; 306 my $do_translate = shift || 1; 307 my $language = shift || ""; 308 my $translate = shift; 309 my $result = ""; 310 foreach my $e (reverse(sort(keys %{ $sub }))) { 311 my $key = $e; 312 my $string = $sub->{$e}; 313 my $quote = '"'; 314 315 $string =~ s/^[\s]+//; 316 $string =~ s/[\s]+$//; 317 318 if ($string =~ /^'.*'$/) 319 { 320 $quote = "'"; 321 } 322 $string =~ s/^['"]//g; 323 $string =~ s/['"]$//g; 324 325 ## differences from intltool-merge.in.in 326 if ($key =~ /^_/) { 327 $comments{entity_decode($string)} = $XMLCOMMENT if $XMLCOMMENT; 328 $messages{entity_decode($string)} = []; 329 $$translate = 2; 330 } 331 ## differences end here from intltool-merge.in.in 332 $result .= " $key=$quote$string$quote"; 333 } 334 return $result; 335} 336 337# Verbatim copy from intltool-merge.in.in 338sub getXMLstring 339{ 340 my $ref = shift; 341 my $spacepreserve = shift || 0; 342 my @list = @{ $ref }; 343 my $result = ""; 344 345 my $count = scalar(@list); 346 my $attrs = $list[0]; 347 my $index = 1; 348 349 $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)); 350 $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/)); 351 352 while ($index < $count) { 353 my $type = $list[$index]; 354 my $content = $list[$index+1]; 355 if (! $type ) { 356 # We've got CDATA 357 if ($content) { 358 # lets strip the whitespace here, and *ONLY* here 359 $content =~ s/\s+/ /gs if (!$spacepreserve); 360 $result .= $content; 361 } 362 } elsif ( "$type" ne "1" ) { 363 # We've got another element 364 $result .= "<$type"; 365 $result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements 366 if ($content) { 367 my $subresult = getXMLstring($content, $spacepreserve); 368 if ($subresult) { 369 $result .= ">".$subresult . "</$type>"; 370 } else { 371 $result .= "/>"; 372 } 373 } else { 374 $result .= "/>"; 375 } 376 } 377 $index += 2; 378 } 379 return $result; 380} 381 382# Verbatim copy from intltool-merge.in.in, except for MULTIPLE_OUTPUT handling removed 383# Translate list of nodes if necessary 384sub translate_subnodes 385{ 386 my $fh = shift; 387 my $content = shift; 388 my $language = shift || ""; 389 my $singlelang = shift || 0; 390 my $spacepreserve = shift || 0; 391 392 my @nodes = @{ $content }; 393 394 my $count = scalar(@nodes); 395 my $index = 0; 396 while ($index < $count) { 397 my $type = $nodes[$index]; 398 my $rest = $nodes[$index+1]; 399 traverse($fh, $type, $rest, $language, $spacepreserve); 400 $index += 2; 401 } 402} 403 404# Based on traverse() in intltool-merge.in.in 405sub traverse 406{ 407 my $fh = shift; # unused, to allow us to sync code between -merge and -extract 408 my $nodename = shift; 409 my $content = shift; 410 my $language = shift || ""; 411 my $spacepreserve = shift || 0; 412 413 if ($nodename && "$nodename" eq "1") { 414 $XMLCOMMENT = $content; 415 } elsif ($nodename) { 416 # element 417 my @all = @{ $content }; 418 my $attrs = shift @all; 419 my $translate = 0; 420 my $outattr = getAttributeString($attrs, 1, $language, \$translate); 421 422 if ($nodename =~ /^_/) { 423 $translate = 1; 424 $nodename =~ s/^_//; 425 } 426 my $lookup = ''; 427 428 $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/)); 429 $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)); 430 431 if ($translate) { 432 $lookup = getXMLstring($content, $spacepreserve); 433 if (!$spacepreserve) { 434 $lookup =~ s/^\s+//s; 435 $lookup =~ s/\s+$//s; 436 } 437 438 if ($lookup && $translate != 2) { 439 $comments{$lookup} = $XMLCOMMENT if $XMLCOMMENT; 440 $messages{$lookup} = []; 441 } elsif ($translate == 2) { 442 translate_subnodes($fh, \@all, $language, 1, $spacepreserve); 443 } 444 } else { 445 $XMLCOMMENT = ""; 446 my $count = scalar(@all); 447 if ($count > 0) { 448 my $index = 0; 449 while ($index < $count) { 450 my $type = $all[$index]; 451 my $rest = $all[$index+1]; 452 traverse($fh, $type, $rest, $language, $spacepreserve); 453 $index += 2; 454 } 455 } 456 } 457 $XMLCOMMENT = ""; 458 } 459} 460 461 462# Verbatim copy from intltool-merge.in.in, $fh for compatibility 463sub parseTree 464{ 465 my $fh = shift; 466 my $ref = shift; 467 my $language = shift || ""; 468 469 my $name = shift @{ $ref }; 470 my $cont = shift @{ $ref }; 471 472 while (!$name || "$name" eq "1") { 473 $name = shift @{ $ref }; 474 $cont = shift @{ $ref }; 475 } 476 477 my $spacepreserve = 0; 478 my $attrs = @{$cont}[0]; 479 $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)); 480 481 traverse($fh, $name, $cont, $language, $spacepreserve); 482} 483 484# Verbatim copy from intltool-merge.in.in 485sub intltool_tree_comment 486{ 487 my $expat = shift; 488 my $data = $expat->original_string(); 489 my $clist = $expat->{Curlist}; 490 my $pos = $#$clist; 491 492 $data =~ s/^<!--//s; 493 $data =~ s/-->$//s; 494 push @$clist, 1 => $data; 495} 496 497# Verbatim copy from intltool-merge.in.in 498sub intltool_tree_cdatastart 499{ 500 my $expat = shift; 501 my $clist = $expat->{Curlist}; 502 my $pos = $#$clist; 503 504 push @$clist, 0 => $expat->original_string(); 505} 506 507# Verbatim copy from intltool-merge.in.in 508sub intltool_tree_cdataend 509{ 510 my $expat = shift; 511 my $clist = $expat->{Curlist}; 512 my $pos = $#$clist; 513 514 $clist->[$pos] .= $expat->original_string(); 515} 516 517# Verbatim copy from intltool-merge.in.in 518sub intltool_tree_char 519{ 520 my $expat = shift; 521 my $text = shift; 522 my $clist = $expat->{Curlist}; 523 my $pos = $#$clist; 524 525 # Use original_string so that we retain escaped entities 526 # in CDATA sections. 527 # 528 if ($pos > 0 and $clist->[$pos - 1] eq '0') { 529 $clist->[$pos] .= $expat->original_string(); 530 } else { 531 push @$clist, 0 => $expat->original_string(); 532 } 533} 534 535# Verbatim copy from intltool-merge.in.in 536sub intltool_tree_start 537{ 538 my $expat = shift; 539 my $tag = shift; 540 my @origlist = (); 541 542 # Use original_string so that we retain escaped entities 543 # in attribute values. We must convert the string to an 544 # @origlist array to conform to the structure of the Tree 545 # Style. 546 # 547 my @original_array = split /\x/, $expat->original_string(); 548 my $source = $expat->original_string(); 549 550 # Remove leading tag. 551 # 552 $source =~ s|^\s*<\s*(\S+)||s; 553 554 # Grab attribute key/value pairs and push onto @origlist array. 555 # 556 while ($source) 557 { 558 if ($source =~ /^\s*([\w:-]+)\s*[=]\s*["]/) 559 { 560 $source =~ s|^\s*([\w:-]+)\s*[=]\s*["]([^"]*)["]||s; 561 push @origlist, $1; 562 push @origlist, '"' . $2 . '"'; 563 } 564 elsif ($source =~ /^\s*([\w:-]+)\s*[=]\s*[']/) 565 { 566 $source =~ s|^\s*([\w:-]+)\s*[=]\s*[']([^']*)[']||s; 567 push @origlist, $1; 568 push @origlist, "'" . $2 . "'"; 569 } 570 else 571 { 572 last; 573 } 574 } 575 576 my $ol = [ { @origlist } ]; 577 578 push @{ $expat->{Lists} }, $expat->{Curlist}; 579 push @{ $expat->{Curlist} }, $tag => $ol; 580 $expat->{Curlist} = $ol; 581} 582 583# Copied from intltool-merge.in.in and added comment handler. 584sub readXml 585{ 586 my $xmldoc = shift || return; 587 my $ret = eval 'require XML::Parser'; 588 if(!$ret) { 589 die "You must have XML::Parser installed to run $0\n\n"; 590 } 591 my $xp = new XML::Parser(Style => 'Tree'); 592 $xp->setHandlers(Char => \&intltool_tree_char); 593 $xp->setHandlers(Start => \&intltool_tree_start); 594 $xp->setHandlers(CdataStart => \&intltool_tree_cdatastart); 595 $xp->setHandlers(CdataEnd => \&intltool_tree_cdataend); 596 597 ## differences from intltool-merge.in.in 598 $xp->setHandlers(Comment => \&intltool_tree_comment); 599 ## differences end here from intltool-merge.in.in 600 601 my $tree = $xp->parse($xmldoc); 602 #print_var($tree); 603 604# <foo><!-- comment --><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo> 605# would be: 606# [foo, [{}, 1, "comment", head, [{id => "a"}, 0, "Hello ", em, [{}, 0, "there"]], bar, 607# [{}, 0, "Howdy", ref, [{}]], 0, "do" ] ] 608 609 return $tree; 610} 611 612sub type_schemas { 613 ### For schemas XML files ### 614 615 # FIXME: We should handle escaped < (less than) 616 while ($input =~ / 617 <locale\ name="C">\s* 618 (<default>\s*(?:<!--([^>]*?)-->\s*)?(.*?)\s*<\/default>\s*)? 619 (<short>\s*(?:<!--([^>]*?)-->\s*)?(.*?)\s*<\/short>\s*)? 620 (<long>\s*(?:<!--([^>]*?)-->\s*)?(.*?)\s*<\/long>\s*)? 621 <\/locale> 622 /sgx) { 623 my @totranslate = ($3,$6,$9); 624 my @eachcomment = ($2,$5,$8); 625 foreach (@totranslate) { 626 my $currentcomment = shift @eachcomment; 627 next if !$_; 628 s/\s+/ /g; 629 $messages{entity_decode_minimal($_)} = []; 630 $comments{entity_decode_minimal($_)} = $currentcomment if (defined($currentcomment)); 631 } 632 } 633} 634 635sub type_rfc822deb { 636 ### For rfc822-style Debian configuration files ### 637 638 my $lineno = 1; 639 my $type = ''; 640 while ($input =~ /\G(.*?)(^|\n)(_+)([^:]+):[ \t]*(.*?)(?=\n\S|$)/sg) 641 { 642 my ($pre, $newline, $underscore, $tag, $text) = ($1, $2, $3, $4, $5); 643 while ($pre =~ m/\n/g) 644 { 645 $lineno ++; 646 } 647 $lineno += length($newline); 648 my @str_list = rfc822deb_split(length($underscore), $text); 649 for my $str (@str_list) 650 { 651 $strcount++; 652 $messages{$str} = []; 653 $loc{$str} = $lineno; 654 $count{$str} = $strcount; 655 my $usercomment = ''; 656 while($pre =~ s/(^|\n)#([^\n]*)$//s) 657 { 658 $usercomment = "\n" . $2 . $usercomment; 659 } 660 $comments{$str} = $tag . $usercomment; 661 } 662 $lineno += ($text =~ s/\n//g); 663 } 664} 665 666sub rfc822deb_split { 667 # Debian defines a special way to deal with rfc822-style files: 668 # when a value contain newlines, it consists of 669 # 1. a short form (first line) 670 # 2. a long description, all lines begin with a space, 671 # and paragraphs are separated by a single dot on a line 672 # This routine returns an array of all paragraphs, and reformat 673 # them. 674 # When first argument is 2, the string is a comma separated list of 675 # values. 676 my $type = shift; 677 my $text = shift; 678 $text =~ s/^[ \t]//mg; 679 return (split(/, */, $text, 0)) if $type ne 1; 680 return ($text) if $text !~ /\n/; 681 682 $text =~ s/([^\n]*)\n//; 683 my @list = ($1); 684 my $str = ''; 685 for my $line (split (/\n/, $text)) 686 { 687 chomp $line; 688 if ($line =~ /^\.\s*$/) 689 { 690 # New paragraph 691 $str =~ s/\s*$//; 692 push(@list, $str); 693 $str = ''; 694 } 695 elsif ($line =~ /^\s/) 696 { 697 # Line which must not be reformatted 698 $str .= "\n" if length ($str) && $str !~ /\n$/; 699 $line =~ s/\s+$//; 700 $str .= $line."\n"; 701 } 702 else 703 { 704 # Continuation line, remove newline 705 $str .= " " if length ($str) && $str !~ /\n$/; 706 $str .= $line; 707 } 708 } 709 $str =~ s/\s*$//; 710 push(@list, $str) if length ($str); 711 return @list; 712} 713 714sub type_glade { 715 ### For translatable Glade XML files ### 716 717 my $tags = "label|title|text|format|copyright|comments|preview_text|tooltip|message"; 718 719 while ($input =~ /<($tags)>([^<]+)<\/($tags)>/sg) { 720 # Glade sometimes uses tags that normally mark translatable things for 721 # little bits of non-translatable content. We work around this by not 722 # translating strings that only includes something like label4 or window1. 723 $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label|dialog)[0-9]+$/; 724 } 725 726 while ($input =~ /<items>(..[^<]*)<\/items>/sg) { 727 for my $item (split (/\n/, $1)) { 728 $messages{entity_decode($item)} = []; 729 } 730 } 731 732 ## handle new glade files 733 while ($input =~ /<(property|atkproperty)\s+[^>]*translatable\s*=\s*"yes"(?:\s+[^>]*comments\s*=\s*"([^"]*)")?[^>]*>([^<]+)<\/\1>/sg) { 734 $messages{entity_decode($3)} = [] unless $3 =~ /^(window|label)[0-9]+$/; 735 if (defined($2) and !($3 =~ /^(window|label)[0-9]+$/)) { 736 $comments{entity_decode($3)} = entity_decode($2) ; 737 } 738 } 739 while ($input =~ /<atkaction\s+action_name="([^>]*)"\s+description="([^>]+)"\/>/sg) { 740 $messages{entity_decode_minimal($2)} = []; 741 } 742} 743 744sub type_scheme { 745 my ($line, $i, $state, $str, $trcomment, $char); 746 for $line (split(/\n/, $input)) { 747 $i = 0; 748 $state = 0; # 0 - nothing, 1 - string, 2 - translatable string 749 while ($i < length($line)) { 750 if (substr($line,$i,1) eq "\"") { 751 if ($state == 2) { 752 $comments{$str} = $trcomment if ($trcomment); 753 $messages{$str} = []; 754 $str = ''; 755 $state = 0; $trcomment = ""; 756 } elsif ($state == 1) { 757 $str = ''; 758 $state = 0; $trcomment = ""; 759 } else { 760 $state = 1; 761 $str = ''; 762 if ($i>0 && substr($line,$i-1,1) eq '_') { 763 $state = 2; 764 } 765 } 766 } elsif (!$state) { 767 if (substr($line,$i,1) eq ";") { 768 $trcomment = substr($line,$i+1); 769 $trcomment =~ s/^;*\s*//; 770 $i = length($line); 771 } elsif ($trcomment && substr($line,$i,1) !~ /\s|\(|\)|_/) { 772 $trcomment = ""; 773 } 774 } else { 775 if (substr($line,$i,1) eq "\\") { 776 $char = substr($line,$i+1,1); 777 if ($char ne "\"" && $char ne "\\") { 778 $str = $str . "\\"; 779 } 780 $i++; 781 } 782 $str = $str . substr($line,$i,1); 783 } 784 $i++; 785 } 786 } 787} 788 789sub msg_write { 790 my @msgids; 791 if (%count) 792 { 793 @msgids = sort { $count{$a} <=> $count{$b} } keys %count; 794 } 795 else 796 { 797 @msgids = sort keys %messages; 798 } 799 for my $message (@msgids) 800 { 801 my $offsetlines = 1; 802 $offsetlines++ if $message =~ /%/; 803 if (defined ($comments{$message})) 804 { 805 while ($comments{$message} =~ m/\n/g) 806 { 807 $offsetlines++; 808 } 809 } 810 print OUT "# ".($loc{$message} - $offsetlines). " \"$FILE\"\n" 811 if defined $loc{$message}; 812 print OUT "/* ".$comments{$message}." */\n" 813 if defined $comments{$message}; 814 print OUT "/* xgettext:no-c-format */\n" if $message =~ /%/; 815 816 my @lines = split (/\n/, $message, -1); 817 for (my $n = 0; $n < @lines; $n++) 818 { 819 if ($n == 0) 820 { 821 print OUT "char *s = N_(\""; 822 } 823 else 824 { 825 print OUT " \""; 826 } 827 828 print OUT escape($lines[$n]); 829 830 if ($n < @lines - 1) 831 { 832 print OUT "\\n\"\n"; 833 } 834 else 835 { 836 print OUT "\");\n"; 837 } 838 } 839 } 840} 841 842