| #!/usr/solar/bin/perl |
| |
| #************************************************************** |
| # |
| # Licensed to the Apache Software Foundation (ASF) under one |
| # or more contributor license agreements. See the NOTICE file |
| # distributed with this work for additional information |
| # regarding copyright ownership. The ASF licenses this file |
| # to you under the Apache License, Version 2.0 (the |
| # "License"); you may not use this file except in compliance |
| # with the License. You may obtain a copy of the License at |
| # |
| # http://www.apache.org/licenses/LICENSE-2.0 |
| # |
| # Unless required by applicable law or agreed to in writing, |
| # software distributed under the License is distributed on an |
| # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY |
| # KIND, either express or implied. See the License for the |
| # specific language governing permissions and limitations |
| # under the License. |
| # |
| #************************************************************** |
| |
| if ( $#ARGV != 3 ) { |
| print STDERR "usage: cl2c.pl <file.cl> <file.c> <file.src> <resname>\n"; |
| exit -1; |
| } |
| |
| $CL=$ARGV[0]; |
| $C=$ARGV[1]; |
| $SRC=$ARGV[2]; |
| $RNAME=$ARGV[3]; |
| |
| sub sconv |
| { |
| local($s)=@_[0]; |
| local($o,$c); |
| $_=""; |
| foreach $o ( unpack("C*",$s) ) { |
| $c=chr($o); |
| if ( $o >= 32 && $o < 127 ) { |
| $_ .= $c; |
| } else { |
| $_ .= sprintf("\\%o", $o); |
| } |
| } |
| return $_; |
| } |
| |
| |
| sub makeneutral { |
| |
| print COUT "\n\n/**\n"; |
| print COUT " * Get neutral language for specific language.\n"; |
| print COUT " * This simplifies the getText switch cases and allows to handle\n"; |
| print COUT " * previously unknown language derivates due to foreign installations.\n"; |
| print COUT " * If you want to distinguish between some dialects change this function\n"; |
| print COUT " * to return the desired nLang before doing the bit masking stuff.\n"; |
| print COUT " * See xlang.h for defined LANGUAGE_*\n"; |
| print COUT " */\n"; |
| |
| # taken from tools/source/intntl/intn.cxx International::GetNeutralLanguage |
| print COUT "static USHORT GetNeutralLanguage( USHORT nLang )\n"; |
| print COUT "{\n"; |
| print COUT "\tUSHORT nPrimLang;\n"; |
| print COUT "\n"; |
| print COUT "\t/* ignore LANGUAGE_USER* */\n"; |
| print COUT "\tif ( (nLang & 0x03FF) >= 0x0200 )\n"; |
| print COUT "\t return nLang;\n"; |
| print COUT "\n"; |
| print COUT "\tnLang &= 0x03FF;\n"; |
| print COUT "\n"; |
| print COUT "\tnPrimLang = nLang | 0x0400;\n"; |
| print COUT "\n"; |
| print COUT "\tswitch ( nPrimLang )\n"; |
| print COUT "\t{\n"; |
| print COUT "\t\tcase LANGUAGE_CHINESE_TRADITIONAL:\n"; |
| print COUT "\t\t\tnLang = LANGUAGE_CHINESE;\n"; |
| print COUT "\t\t\tbreak;\n"; |
| print COUT "\t\tcase LANGUAGE_ENGLISH_US:\n"; |
| print COUT "\t\t\tnLang = LANGUAGE_ENGLISH;\n"; |
| print COUT "\t\t\tbreak;\n"; |
| print COUT "\t\tcase LANGUAGE_NORWEGIAN_BOKMAL:\n"; |
| print COUT "\t\t\tnLang = LANGUAGE_NORWEGIAN;\n"; |
| print COUT "\t\t\tbreak;\n"; |
| print COUT "\t\tcase LANGUAGE_PORTUGUESE_BRAZILIAN:\n"; |
| print COUT "\t\t\tnLang = LANGUAGE_PORTUGUESE;\n"; |
| print COUT "\t\t\tbreak;\n"; |
| print COUT "\n"; |
| print COUT "\t\tdefault:\n"; |
| print COUT "\t\t\tnLang = nPrimLang;\n"; |
| print COUT "\t\t\tbreak;\n"; |
| print COUT "\t}\n"; |
| print COUT "\n"; |
| print COUT "\treturn nLang;\n"; |
| print COUT "}\n"; |
| print COUT "\n"; |
| |
| } |
| |
| |
| sub maketext { |
| |
| print COUT "\n\n/**\n"; |
| print COUT " * Get text resource for current language.\n"; |
| print COUT " * Remember that 8-bit characters are shown in\n"; |
| print COUT " * system dependend code pages!\n"; |
| print COUT " * To get correct results you will have to distuinguish\n"; |
| print COUT " * for example between UNIX and WIN and OS2 target systems.\n"; |
| print COUT " */\n"; |
| |
| print COUT "static char* getText( int nResource )\n{\n"; |
| print COUT "\tswitch( nResource ) {\n"; |
| |
| $resflag=0; |
| $strname=""; |
| $cnt=0; |
| $text_english=""; |
| |
| while (<SRCIN>) { |
| $resflag=1 if ( /Resource\s$RNAME/ ); |
| |
| if ( /\{/ ) { |
| if ( ++$cnt == 2 ) { |
| # start language |
| $text_english=""; |
| print COUT "\t\t\tswitch( _nLanguage ) {\n"; |
| next; |
| } |
| } |
| |
| if ( /\}/ ) { |
| if ( --$cnt == 1 ) { |
| # end language |
| |
| if ( $text_english ne "" ) { |
| print COUT "\t\t\t\tcase LANGUAGE_ENGLISH:\n\t\t\t\tdefault:\n"; |
| print COUT "\t\t\t\treturn(" . $text_english . ")\;\n"; |
| } |
| |
| print COUT "\t\t\t}\n\t\t\tbreak;\n"; |
| next; |
| } elsif ( $cnt == 0 ) { |
| # end of resource |
| $resflag=0; |
| print COUT "\t\tdefault:\n\t\t\tbreak;\n"; |
| print COUT "\t}\n\treturn(\"\");\n}\n"; |
| next; |
| } |
| |
| } |
| |
| if ( $resflag && $cnt == 1) { |
| if ( /\sString\s(([A-Z]|\_|[0-9]|[a-z])*)/ ) { |
| $strname=$1; |
| print COUT "\t\tcase " . $strname . ":\n"; |
| } |
| } |
| |
| if ( $cnt == 2 && /^\s*Text/ ) { |
| $langname="german"; |
| ($textdef,@textx)=split(/=/); |
| $text=join("=",@textx); |
| if ( $textdef =~ /\[\s+(.*)\s+\]/ ) { |
| $langname=$1; |
| } |
| else { |
| $langname="ENGLISH_US"; # no [...] => not to be translated |
| } |
| |
| $langname="LANGUAGE_" . uc($langname); |
| |
| chop($text) while ( $text=~/(\r|\n|\;)$/ ); |
| $text=sconv($text); |
| # english_us, not english because it's developer's pigeon |
| if ( $langname eq "LANGUAGE_ENGLISH_US" ) { |
| $text_english=$text; |
| } |
| # ISO coded, obtain at least the default |
| elsif ( $langname =~ /^LANGUAGE_EN-US$/ ) { |
| $text_english=$text; |
| } |
| # we don't know about USER languages, ENGLISH will be appended later |
| elsif ( ! ( $langname =~ /LANGUAGE_USER/ || $langname =~ /^LANGUAGE_ENGLISH$/ ) ) { |
| # ER 28.04.99: for the moment only German and English are |
| # exported, because we have a problem with non-existing |
| # character code tables for systems other than Windoze. |
| # => Chinese would be definitely mixed up and we don't |
| # want to insult anybody.. others like Spanish would look |
| # very ugly, but we'll have to live with bad German Umlauts. |
| if ( $langname =~ /LANGUAGE_(GERMAN|ENGLISH)/ ) { |
| print COUT "\t\t\t\tcase " . $langname . ":\n"; |
| print COUT "\t\t\t\treturn(" . $text . ")\;\n"; |
| } |
| } |
| |
| } |
| } |
| |
| makeneutral(); |
| |
| } |
| |
| open(CLIN,"<$CL") || die "can not open $CL\n"; |
| open(SRCIN,"<$SRC") || die "can not open $CL\n"; |
| open(COUT,">$C") || die "can not open $CL\n"; |
| |
| $ccnt=0; |
| $incomment=0; |
| while(<CLIN>) { |
| if ( /^\/\*--(-*)/ ) { |
| $incomment=1; |
| $ccnt++; |
| } |
| |
| print COUT $_ if ( $incomment==0 || $ccnt==1 ); |
| |
| &maketext() if ( /^static USHORT _nLanguage=/ ); |
| |
| if ( /(-*)--\*\/$/ ) { |
| $incomment=0; |
| } |
| |
| } |
| |
| close(CLIN); |
| close(SRCIN); |
| close(COUT); |
| |
| exit 0; |
| |
| |