source: git/lib/makemsgs.pl @ d5bd3a7

RELEASE/1.0RELEASE/1.1RELEASE/1.2debug-cidebug-ci-sanitisersstereowalls-data
Last change on this file since d5bd3a7 was d5bd3a7, checked in by Olly Betts <olly@…>, 23 years ago

Compiled in messages are now translated according to the value of the
pre-processor macro DEFAULTLANG.

(MS Windows): Use GetConsoleOutputCP() to discover the code page for
console apps.

Turn off some warnings for cross-compiles.

git-svn-id: file:///home/survex-svn/survex/trunk@995 4b37db11-9a0c-4f06-9ece-9ab7cdaee568

  • Property mode set to 100755
File size: 4.9 KB
Line 
1#!/usr/bin/perl -w
2require 5.004;
3use strict;
4
5use integer;
6
7# messages >= this value are written to a header file
8my $dontextract_threshold = 1000;
9
10# Magic identifier (12 bytes)
11my $magic = "Svx\nMsg\r\n\xfe\xff\0";
12# Designed to be corrupted by ASCII ftp, top bit stripping (or
13# being used for parity).  Contains a zero byte so more likely
14# to be flagged as data (e.g. by perl's "-B" test).
15
16my $major = 0;
17my $minor = 8;
18
19# File format (multi-byte numbers in network order (bigendian)):
20# 12 bytes: Magic identifier
21# 1 byte:   File format major version number (0)
22# 1 byte:   File format minor version number (8)
23# 2 bytes:  Number of messages (N)
24# 4 bytes:  Offset from XXXX to end of file
25# XXXX:
26# N*:
27# <message> NUL
28
29my %ent = ();
30
31open ENT, "named-entities.txt" or die $!;
32while (<ENT>) {
33   my ($e, $v) = /^(\w+),(\d+)/;
34   $ent{$e} = $v;
35}
36close ENT;
37
38my %msgs = ();
39my %dontextract = ();
40
41while (<>) {
42   next if /^\s*#/; # skip comments
43   
44   # en:  0 0.81 the message
45   # en-us: 0 0.81 " the message "
46   my ($langs, $msgno, $dummy, $msg) = /^([-\w,]+):\s*(\d+)\s+("?)(.*)\3/;
47
48   unless (defined $langs) {
49      chomp;
50      print STDERR "Warning: Bad line: \"$_\"\n";
51      next;
52   }
53
54   $langs =~ tr/-/_/;
55
56   if ($msg =~ /[\0-\x1f\x7f-\xff]/) {
57      print STDERR "Warning: literal character in message $msgno\n";
58   }
59
60   my $utf8 = string_to_utf8($msg);
61   for (split /,/, $langs) {
62      if ($msgno >= $dontextract_threshold) {
63         ${$dontextract{$_}}[$msgno - $dontextract_threshold] = $utf8;
64      } else {
65         ${$msgs{$_}}[$msgno] = $utf8;
66      }
67   }
68}
69
70my $lang;
71my @langs = sort grep ! /_\*$/, keys %msgs;
72
73my $num_msgs = -1;
74foreach $lang (@langs) {
75   my $aref = $msgs{$lang};
76   $num_msgs = scalar @$aref if scalar @$aref > $num_msgs;
77}
78
79foreach $lang (@langs) {
80   my $fnm = $lang;
81   $fnm =~ s/(_.*)$/\U$1/;
82   open OUT, ">$fnm.msg" or die $!;
83   
84   my $aref = $msgs{$lang};
85 
86   my $parentaref;
87   my $mainlang = $lang;
88   $parentaref = $msgs{$mainlang} if $mainlang =~ s/_.*$//;
89
90   print OUT $magic or die $!;
91   print OUT pack("CCn", $major, $minor, $num_msgs) or die $!;
92
93   my $buff = '';
94
95   my $n;
96   for $n (0 .. $num_msgs - 1) {
97      my $msg = $$aref[$n];
98      if (!defined $msg) {
99         $msg = $$parentaref[$n] if defined $parentaref;
100         if (!defined $msg) {
101            $msg = ${$msgs{'en'}}[$n];
102            if (defined $msg && $msg ne '') {
103               # don't report if we have a parent (as the omission will be reported there)
104               print STDERR "Warning: message $n not in language $lang\n" unless defined $parentaref;
105            } else {
106               $msg = '';
107            }
108         }
109      }
110      $buff .= $msg . "\0";
111   }
112   
113   print OUT pack('N',length($buff)), $buff or die $!;
114   close OUT or die $!;
115}
116
117my $num_dontextract = -1;
118foreach $lang (@langs) {
119   my $aref = $dontextract{$lang};
120   if (defined(@$aref)) {
121       $num_dontextract = scalar @$aref if scalar @$aref > $num_dontextract;
122   }
123}
124
125foreach $lang (@langs) {
126   open OUT, ">$lang.h" or die $!;
127   print OUT "#define N_DONTEXTRACTMSGS ", $num_dontextract, "\n";
128   print OUT "static unsigned char dontextractmsgs[] =";
129
130   for my $n (0 .. $num_dontextract - 1) {
131      print OUT "\n";
132
133      my $aref = $dontextract{$lang};
134 
135      my $parentaref;
136      my $mainlang = $lang;
137      $parentaref = $dontextract{$mainlang} if $mainlang =~ s/_.*$//;
138
139      my $msg = $$aref[$n];
140      if (!defined $msg) {
141         $msg = $$parentaref[$n] if defined $parentaref;
142         if (!defined $msg) {
143            $msg = ${$dontextract{'en'}}[$n];
144            if (defined $msg && $msg ne '') {
145               # don't report if we have a parent (as the omission will be reported there)
146               print STDERR "Warning: message ", $dontextract_threshold + $n, " not in language $lang\n" unless defined $parentaref;
147            } else {
148               $msg = '';
149            }
150         }
151      }
152      $msg =~ s/\\/\\\\/g;
153      $msg =~ s/"/\\"/g;
154      $msg =~ s/\t/\\t/g;
155      $msg =~ s/\n/\\n/g;
156      $msg =~ s/\r/\\r/g;
157      if ($msg =~ /^ / || $msg =~ / $/) {
158         $msg =~ s/\\"/\\\\\\"/g;
159         $msg = '\\"'.$msg.'\\"';
160      }
161      print OUT "   /*", $dontextract_threshold + $n, "*/ \"$msg\\0\"";
162   }
163   print OUT ";\n";
164   close OUT or die $!;
165}
166
167sub string_to_utf8 {
168   my $s = shift;
169   $s =~ s/([\x80-\xff])/char_to_utf8(ord($1))/eg;
170   $s =~ s/\&(#\d+|#x[a-f0-9]+|[a-z0-9]+);?/decode_entity($1)/eig;
171   return $s;
172}
173
174sub decode_entity {
175   my $ent = shift;
176   return char_to_utf8($1) if $ent =~ /^#(\d+)$/;
177   return char_to_utf8(hex($1)) if $ent =~ /^#x([a-f0-9]+)$/;
178   return char_to_utf8($ent{$ent}) if exists $ent{$ent};
179   $ent = "\&$ent;";
180   print STDERR "Warning: entity \"$ent\" unknown\n";
181   return $ent;
182}
183
184sub char_to_utf8 {
185   my $unicode = shift;
186   # ASCII is easy, and the most common case
187   return chr($unicode) if $unicode < 0x80;
188
189   my $result = '';
190   my $n = 0x20;
191   while (1) {
192      $result = chr(0x80 | ($unicode & 0x3f)) . $result;
193      $unicode >>= 6;
194      last if $unicode < $n;
195      $n >>= 1;
196   }
197   $result = chr((0x100 - $n*2) | $unicode) . $result;
198   return $result;
199}
200
Note: See TracBrowser for help on using the repository browser.