Mercurial > hg > xemacs-beta

comparison lib-src/make-mswin-unicode.pl @ 5920:0f2338afbabf cygwin

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Minimum necessary to get started: sufficient to compile OK, run -nw, but not with window
author Henry Thompson <ht@markup.co.uk>
date Mon, 21 Apr 2014 11:42:50 +0100
parents 308d34e9f07d
children 2f34b59f451a
comparison
equal deleted inserted replaced
5919:2800105fcc9f 5920:0f2338afbabf
181 # Same, but with groups to match the type and name 181 # Same, but with groups to match the type and name
182 my $argmatch_re = "(?:($typetoken_re+)(${tok_ch}+)?(?: OPTIONAL)?)"; 182 my $argmatch_re = "(?:($typetoken_re+)(${tok_ch}+)?(?: OPTIONAL)?)";
183 # regexp matching a parenthesized argument list in a prototype 183 # regexp matching a parenthesized argument list in a prototype
184 my $args_re = "\\(((?:${ws_re}${arg_re}${ws_re},)*${ws_re}${arg_re}${ws_re})\\)"; 184 my $args_re = "\\(((?:${ws_re}${arg_re}${ws_re},)*${ws_re}${arg_re}${ws_re})\\)";
185 # regexp matching a return type in a protype 185 # regexp matching a return type in a protype
186 my $rettype_re = "(SHSTDAPI_\\(${tok_ch}+\\)|${tok_ch}" . "[A-Za-z_0-9 \t\n\r\f]*?${tok_ch})"; 186 my $rettype_re = "(SHSTDAPI_\\([${tok_ch} *]+\\)|${tok_ch}" . "[A-Za-z_0-9 \t\n\r\f]*?${tok_ch})";
187 # regexp matching a function name 187 # regexp matching a function name
188 my $funname_re = "(${tok_ch}+)"; 188 my $funname_re = "(${tok_ch}+)";
189 # Regexp matching a function prototype, $1 = rettype, $2 = name, $3 = args 189 # Regexp matching a function prototype, $1 = rettype, $2 = name, $3 = args
190 my $fun_re = "${rettype_re}${ws_re}${funname_re}${ws_re}${args_re};"; 190 my $fun_re = "${rettype_re}${ws_re}${funname_re}${ws_re}${args_re};";
191 # Regexp matching a particular Unicode function (ending in ...W) 191 # Regexp matching a particular Unicode function (ending in ...W)
192 my $wfun_re = "${rettype_re}${ws_re}${funname_re}W${ws_re}${args_re};"; 192 my $wfun_re = "(?:#endif|#ifndef ${tok_ch}+)?${ws_re}${rettype_re}${ws_re}${funname_re}W${ws_re}${args_re};";
193 193
194 # print "regexp: $wfun_re\n"; 194 #print "regexp: $wfun_re\n";
195 195
196 while (<>) 196 while (<>)
197 { 197 {
198 chomp; 198 chomp;
199 # remove trailing CR. #### Should not be necessary! Perl should be 199 # remove trailing CR. #### Should not be necessary! Perl should be
248 } 248 }
249 else 249 else
250 { 250 {
251 my ($fun, $reason) = split /\s+/, $parms, 2; 251 my ($fun, $reason) = split /\s+/, $parms, 2;
252 $files{$current_file}{$fun} = [$command, $reason]; 252 $files{$current_file}{$fun} = [$command, $reason];
253 #print "$current_file : $fun = $command, $reason\n";
253 $bracket{$current_file}{$fun} = 254 $bracket{$current_file}{$fun} =
254 $current_bracket[$#current_bracket]; 255 $current_bracket[$#current_bracket];
255 } 256 }
256 } 257 }
257 else 258 else
280 "; 281 ";
281 282
282 while ($slurp =~ /$wfun_re/g) 283 while ($slurp =~ /$wfun_re/g)
283 { 284 {
284 my ($rettype, $fun, $args) = ($1, $2, $3); 285 my ($rettype, $fun, $args) = ($1, $2, $3);
286 #print "slurped: $1 $2 $3\n";
285 287
286 if ($processed{$fun}) 288 if ($processed{$fun})
287 { 289 {
288 print "Warning: Function $fun already seen\n"; 290 print "Warning: Function $fun already seen\n";
289 next; 291 next;
296 #my ($command, $reason) = ($files{$file}{$fun}[0], $files{$file}{$fun}[1]); 298 #my ($command, $reason) = ($files{$file}{$fun}[0], $files{$file}{$fun}[1]);
297 # Fuck perl! There seems to be no way to write something like 299 # Fuck perl! There seems to be no way to write something like
298 # my ($command, $reason) = @$files{$file}{$fun}; 300 # my ($command, $reason) = @$files{$file}{$fun};
299 # You have to use a temporary var. 301 # You have to use a temporary var.
300 my $filesarr = $files{$file}{$fun}; 302 my $filesarr = $files{$file}{$fun};
303 if (!defined ($filesarr)) {print "\nlosing: |$file|$fun|\n"; next}
301 my ($command, $reason) = @$filesarr; 304 my ($command, $reason) = @$filesarr;
302 if (!defined ($command)) 305 if (!defined ($command))
303 { 306 {
304 print " (no command found)\n"; 307 print " (no command found)\n";
305 } 308 }