Mercurial > hg > xemacs-beta

comparison lib-src/make-mswin-unicode.pl @ 4962:e813cf16c015

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Mon, 01 Feb 2010 05:29:05 -0600
parents 70089046adef
children 7eec2a1f3412
comparison
equal deleted inserted replaced
4961:b90f8cf474e0 4962:e813cf16c015
154 my %bracket; 154 my %bracket;
155 155
156 my $current_file; 156 my $current_file;
157 my @current_bracket; 157 my @current_bracket;
158 158
159 my ($ws_re, $must_ws_re, $tok_ch) =
160 ("\\s*", "\\s+", "\\w");
161 # unfortunately there is no surefire way short of
162 # parsing all include files for typedefs to
163 # distinguish types from parameters, and prototypes
164 # appear in the include files both with and without
165 # parameters -- the latter kinds appear in a very
166 # different style and were obviously added later. so
167 # we rely on the fact that defined types are all
168 # upper-case, and parameters generally are not, and
169 # special-case the exceptions.
170 my $typeword_re =
171 # note the negative lookahead assertions: the first
172 # one excludes the words "X" and "Y" from type
173 # words, since they appear as parameter names in
174 # CreateWindowEx; the second prevents "void
175 # *Argument" from being parsed as a type "void *A"
176 # followed by a parameter "rgument".
177 "(?:(?!(?:X\\b|Y\\b))(?:unsigned|int|long|const|short|va_list|[A-Z_0-9]+)(?!${tok_ch}))";
178 my $typetoken_re = "(?:$typeword_re$ws_re\\**$ws_re)";
179 # Regexp matching a particular argument
180 my $arg_re = "(?:(?:$typetoken_re+)(?:${tok_ch}+)?(?: OPTIONAL)?)";
181 # Same, but with groups to match the type and name
182 my $argmatch_re = "(?:($typetoken_re+)(${tok_ch}+)?(?: OPTIONAL)?)";
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})\\)";
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})";
187 # regexp matching a function name
188 my $funname_re = "(${tok_ch}+)";
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};";
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};";
193
194 # print "regexp: $wfun_re\n";
195
159 while (<>) 196 while (<>)
160 { 197 {
161 chomp; 198 chomp;
162 # remove trailing CR. #### Should not be necessary! Perl should be 199 # remove trailing CR. #### Should not be necessary! Perl should be
163 # opening these in text mode by default, as the docs claim, and 200 # opening these in text mode by default, as the docs claim, and
174 } 211 }
175 elsif ($in_script) 212 elsif ($in_script)
176 { 213 {
177 next if (m!^//!); 214 next if (m!^//!);
178 next if (/^[ \t]*$/); 215 next if (/^[ \t]*$/);
179 if (/(file|yes|soon|no|review|skip|split|begin-bracket|end-bracket)(?: (.*))?/) 216 if (/(file|yes|soon|no|review|skip|split|begin-bracket|end-bracket|override)(?: (.*))?/)
180 { 217 {
181 my ($command, $parms) = ($1, $2); 218 my ($command, $parms) = ($1, $2);
182 if ($command eq "file") 219 if ($command eq "file")
183 { 220 {
184 $current_file = $parms; 221 $current_file = $parms;
197 push @current_bracket, $current_bracket; 234 push @current_bracket, $current_bracket;
198 } 235 }
199 elsif ($command eq "end-bracket") 236 elsif ($command eq "end-bracket")
200 { 237 {
201 pop @current_bracket; 238 pop @current_bracket;
239 }
240 elsif ($command eq "override")
241 {
242 die "Cannot parse prototype $parms" unless $parms =~ /$wfun_re(?: ?(.*))?/;
243 my ($rettype, $fun, $args, $reason) = ($1, $2, $3, $4);
244 $files{$current_file}{$fun} =
245 [$command, $reason, $rettype, $fun, $args];
246 $bracket{$current_file}{$fun} =
247 $current_bracket[$#current_bracket];
202 } 248 }
203 else 249 else
204 { 250 {
205 my ($fun, $reason) = split /\s+/, $parms, 2; 251 my ($fun, $reason) = split /\s+/, $parms, 2;
206 $files{$current_file}{$fun} = [$command, $reason]; 252 $files{$current_file}{$fun} = [$command, $reason];
231 (" " x $alignspaceright) . "*/ 277 (" " x $alignspaceright) . "*/
232 /*----------------------------------------------------------------------*/ 278 /*----------------------------------------------------------------------*/
233 279
234 "; 280 ";
235 281
236 my ($ws_re, $must_ws_re, $tok_ch) = 282 while ($slurp =~ /$wfun_re/g)
237 ("\\s*", "\\s+", "\\w");
238 # unfortunately there is no surefire way short of
239 # parsing all include files for typedefs to
240 # distinguish types from parameters, and prototypes
241 # appear in the include files both with and without
242 # parameters -- the latter kinds appear in a very
243 # different style and were obviously added later. so
244 # we rely on the fact that defined types are all
245 # upper-case, and parameters generally are not, and
246 # special-case the exceptions.
247 my $typeword_re =
248 # note the negative lookahead assertions: the first
249 # one excludes the words "X" and "Y" from type
250 # words, since they appear as parameter names in
251 # CreateWindowEx; the second prevents "void
252 # *Argument" from being parsed as a type "void *A"
253 # followed by a parameter "rgument".
254 "(?:(?!(?:X\\b|Y\\b))(?:unsigned|int|long|const|short|va_list|[A-Z_0-9]+)(?!${tok_ch}))";
255 my $typetoken_re = "(?:$typeword_re$ws_re\\**$ws_re)";
256 my $arg_re = "(?:($typetoken_re+)(${tok_ch}+)?(?: OPTIONAL)?)";
257 my $fun_re = "(SHSTDAPI_\\(${tok_ch}+\\)|${tok_ch}" . "[A-Za-z_0-9 \t\n\r\f]*?${tok_ch})${ws_re}(${tok_ch}+)W${ws_re}\\(((${ws_re}${arg_re}${ws_re},)*${ws_re}${arg_re}${ws_re})\\);";
258
259 # print "regexp: $fun_re\n";
260 while ($slurp =~ /$fun_re/g)
261 { 283 {
262 my ($rettype, $fun, $args) = ($1, $2, $3); 284 my ($rettype, $fun, $args) = ($1, $2, $3);
263 285
264 if ($processed{$fun}) 286 if ($processed{$fun})
265 { 287 {
269 291
270 $processed{$fun} = 1; 292 $processed{$fun} = 1;
271 293
272 print "Processing: $fun"; 294 print "Processing: $fun";
273 295
274 my ($command, $reason) = ($files{$file}{$fun}[0], $files{$file}{$fun}[1]); 296 #my ($command, $reason) = ($files{$file}{$fun}[0], $files{$file}{$fun}[1]);
297 # Fuck perl! There seems to be no way to write something like
298 # my ($command, $reason) = @$files{$file}{$fun};
299 # You have to use a temporary var.
300 my $filesarr = $files{$file}{$fun};
301 my ($command, $reason) = @$filesarr;
275 if (!defined ($command)) 302 if (!defined ($command))
276 { 303 {
277 print " (no command found)\n"; 304 print " (no command found)\n";
278 } 305 }
279 else 306 else
325 $split_rettype); 352 $split_rettype);
326 if ($command eq "split") 353 if ($command eq "split")
327 { 354 {
328 ($split_struct, $reason) = split /\s+/, $reason, 2; 355 ($split_struct, $reason) = split /\s+/, $reason, 2;
329 } 356 }
357 elsif ($command eq "override")
358 {
359 my ($nrettype, $nfun, $nargs) = @$filesarr[2 .. 4];
360 $reason = "$reason.\n NOTE: " if $reason;
361 $reason = "${reason}Prototype manually overridden.
362 Header file claims:
363 $rettype $fun($args)
364 Overridden with:
365 $nrettype $nfun($nargs)
366 Differences in return-type qualifiers, e.g. WINAPI, are not important.
367 ";
368 ($rettype, $fun, $args) = ($nrettype, $nfun, $nargs);
369 }
330 my $argno = 0; 370 my $argno = 0;
331 while ($args =~ /$arg_re/g) 371 while ($args =~ /$argmatch_re/g)
332 { 372 {
333 $argno++; 373 $argno++;
334 my ($argtype, $argname) = ($1, $2); 374 my ($argtype, $argname) = ($1, $2);
335 $argtype =~ s/\s*$//; 375 $argtype =~ s/\s*$//;
336 next if $argtype eq "void" || $argtype eq "VOID"; 376 next if $argtype eq "void" || $argtype eq "VOID";