xref: /aoo41x/main/sc/addin/util/cl2c.pl (revision 7e90fac2)
1#!/usr/solar/bin/perl
2
3#**************************************************************
4#
5#  Licensed to the Apache Software Foundation (ASF) under one
6#  or more contributor license agreements.  See the NOTICE file
7#  distributed with this work for additional information
8#  regarding copyright ownership.  The ASF licenses this file
9#  to you under the Apache License, Version 2.0 (the
10#  "License"); you may not use this file except in compliance
11#  with the License.  You may obtain a copy of the License at
12#
13#    http://www.apache.org/licenses/LICENSE-2.0
14#
15#  Unless required by applicable law or agreed to in writing,
16#  software distributed under the License is distributed on an
17#  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
18#  KIND, either express or implied.  See the License for the
19#  specific language governing permissions and limitations
20#  under the License.
21#
22#**************************************************************
23
24if ( $#ARGV != 3 ) {
25	print STDERR "usage: cl2c.pl <file.cl> <file.c> <file.src> <resname>\n";
26	exit -1;
27}
28
29$CL=$ARGV[0];
30$C=$ARGV[1];
31$SRC=$ARGV[2];
32$RNAME=$ARGV[3];
33
34sub sconv
35{
36	local($s)=@_[0];
37	local($o,$c);
38	$_="";
39	foreach $o ( unpack("C*",$s) ) {
40		$c=chr($o);
41		if ( $o >= 32 && $o < 127 ) {
42			$_ .= $c;
43		} else {
44			$_ .= sprintf("\\%o", $o);
45		}
46	}
47	return $_;
48}
49
50
51sub makeneutral {
52
53	print COUT "\n\n/**\n";
54	print COUT " * Get neutral language for specific language.\n";
55	print COUT " * This simplifies the getText switch cases and allows to handle\n";
56	print COUT " * previously unknown language derivates due to foreign installations.\n";
57	print COUT " * If you want to distinguish between some dialects change this function\n";
58	print COUT " * to return the desired nLang before doing the bit masking stuff.\n";
59	print COUT " * See xlang.h for defined LANGUAGE_*\n";
60	print COUT " */\n";
61
62	# taken from tools/source/intntl/intn.cxx International::GetNeutralLanguage
63	print COUT "static USHORT GetNeutralLanguage( USHORT nLang )\n";
64	print COUT "{\n";
65	print COUT "\tUSHORT nPrimLang;\n";
66	print COUT "\n";
67	print COUT "\t/* ignore LANGUAGE_USER* */\n";
68	print COUT "\tif ( (nLang & 0x03FF) >= 0x0200 )\n";
69	print COUT "\t	return nLang;\n";
70	print COUT "\n";
71	print COUT "\tnLang &= 0x03FF;\n";
72	print COUT "\n";
73	print COUT "\tnPrimLang = nLang | 0x0400;\n";
74	print COUT "\n";
75	print COUT "\tswitch ( nPrimLang )\n";
76	print COUT "\t{\n";
77	print COUT "\t\tcase LANGUAGE_CHINESE_TRADITIONAL:\n";
78	print COUT "\t\t\tnLang = LANGUAGE_CHINESE;\n";
79	print COUT "\t\t\tbreak;\n";
80	print COUT "\t\tcase LANGUAGE_ENGLISH_US:\n";
81	print COUT "\t\t\tnLang = LANGUAGE_ENGLISH;\n";
82	print COUT "\t\t\tbreak;\n";
83	print COUT "\t\tcase LANGUAGE_NORWEGIAN_BOKMAL:\n";
84	print COUT "\t\t\tnLang = LANGUAGE_NORWEGIAN;\n";
85	print COUT "\t\t\tbreak;\n";
86	print COUT "\t\tcase LANGUAGE_PORTUGUESE_BRAZILIAN:\n";
87	print COUT "\t\t\tnLang = LANGUAGE_PORTUGUESE;\n";
88	print COUT "\t\t\tbreak;\n";
89	print COUT "\n";
90	print COUT "\t\tdefault:\n";
91	print COUT "\t\t\tnLang = nPrimLang;\n";
92	print COUT "\t\t\tbreak;\n";
93	print COUT "\t}\n";
94	print COUT "\n";
95	print COUT "\treturn nLang;\n";
96	print COUT "}\n";
97	print COUT "\n";
98
99}
100
101
102sub maketext {
103
104	print COUT "\n\n/**\n";
105	print COUT " * Get text resource for current language.\n";
106	print COUT " * Remember that 8-bit characters are shown in\n";
107	print COUT " * system dependend code pages!\n";
108	print COUT " * To get correct results you will have to distuinguish\n";
109	print COUT " * for example between UNIX and WIN and OS2 target systems.\n";
110	print COUT " */\n";
111
112	print COUT "static char* getText( int nResource )\n{\n";
113	print COUT "\tswitch( nResource ) {\n";
114
115	$resflag=0;
116	$strname="";
117	$cnt=0;
118	$text_english="";
119
120	while (<SRCIN>) {
121		$resflag=1 if ( /Resource\s$RNAME/ );
122
123		if ( /\{/ ) {
124			if ( ++$cnt == 2 ) {
125				# start language
126				$text_english="";
127				print COUT "\t\t\tswitch( _nLanguage ) {\n";
128				next;
129			}
130		}
131
132		if ( /\}/ ) {
133			if ( --$cnt == 1 ) {
134				# end language
135
136				if ( $text_english ne "" ) {
137					print COUT "\t\t\t\tcase LANGUAGE_ENGLISH:\n\t\t\t\tdefault:\n";
138					print COUT "\t\t\t\treturn(" . $text_english . ")\;\n";
139				}
140
141				print COUT "\t\t\t}\n\t\t\tbreak;\n";
142				next;
143			} elsif ( $cnt == 0 ) {
144				# end of resource
145				$resflag=0;
146				print COUT "\t\tdefault:\n\t\t\tbreak;\n";
147				print COUT "\t}\n\treturn(\"\");\n}\n";
148				next;
149			}
150
151		}
152
153		if ( $resflag && $cnt == 1) {
154			if ( /\sString\s(([A-Z]|\_|[0-9]|[a-z])*)/ ) {
155				$strname=$1;
156				print COUT "\t\tcase " . $strname . ":\n";
157			}
158		}
159
160		if ( $cnt == 2 && /^\s*Text/ ) {
161			$langname="german";
162			($textdef,@textx)=split(/=/);
163			$text=join("=",@textx);
164			if ( $textdef =~ /\[\s+(.*)\s+\]/ ) {
165				$langname=$1;
166			}
167            else {
168                $langname="ENGLISH_US";     # no [...] => not to be translated
169            }
170
171			$langname="LANGUAGE_" . uc($langname);
172
173			chop($text) while ( $text=~/(\r|\n|\;)$/ );
174			$text=sconv($text);
175			# english_us, not english because it's developer's pigeon
176			if ( $langname eq "LANGUAGE_ENGLISH_US" ) {
177				$text_english=$text;
178			}
179            # ISO coded, obtain at least the default
180            elsif ( $langname =~ /^LANGUAGE_EN-US$/ ) {
181				$text_english=$text;
182            }
183			# we don't know about USER languages, ENGLISH will be appended later
184			elsif ( ! ( $langname =~ /LANGUAGE_USER/ || $langname =~ /^LANGUAGE_ENGLISH$/ ) ) {
185				# ER 28.04.99: for the moment only German and English are
186				# exported, because we have a problem with non-existing
187				# character code tables for systems other than Windoze.
188				# => Chinese would be definitely mixed up and we don't
189				# want to insult anybody.. others like Spanish would look
190				# very ugly, but we'll have to live with bad German Umlauts.
191				if ( $langname =~ /LANGUAGE_(GERMAN|ENGLISH)/ ) {
192					print COUT "\t\t\t\tcase " . $langname . ":\n";
193					print COUT "\t\t\t\treturn(" . $text . ")\;\n";
194				}
195			}
196
197		}
198	}
199
200	makeneutral();
201
202}
203
204open(CLIN,"<$CL") || die "can not open $CL\n";
205open(SRCIN,"<$SRC") || die "can not open $CL\n";
206open(COUT,">$C") || die "can not open $CL\n";
207
208$ccnt=0;
209$incomment=0;
210while(<CLIN>) {
211	if ( /^\/\*--(-*)/ ) {
212		$incomment=1;
213		$ccnt++;
214	}
215
216	print COUT $_ if ( $incomment==0 || $ccnt==1 );
217
218	&maketext() if ( /^static USHORT _nLanguage=/ );
219
220	if ( /(-*)--\*\/$/ ) {
221		$incomment=0;
222	}
223
224}
225
226close(CLIN);
227close(SRCIN);
228close(COUT);
229
230exit 0;
231
232
233