Mercurial > hg > xemacs-beta

comparison lib-src/make-mswin-unicode.pl @ 4903:70089046adef

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fix compile problems in intl-encap* under VS6 -------------------- ChangeLog entries follow: -------------------- lib-src/ChangeLog addition: 2010-01-30 Ben Wing <ben@xemacs.org> * make-mswin-unicode.pl: Make it possible to specify an overridden prototype in cases where either Cygwin or Visual Studio has errors in their headers that can be corrected by falling back to a less qualified type (typically without const). src/ChangeLog addition: 2010-01-30 Ben Wing <ben@xemacs.org> * intl-auto-encap-win32.c: * intl-auto-encap-win32.c (qxeExtractAssociatedIcon): * intl-auto-encap-win32.c (qxeExtractIconEx): * intl-auto-encap-win32.c (qxeCreateMDIWindow): * intl-auto-encap-win32.c (qxeCreateWindowStation): * intl-auto-encap-win32.c (qxeDdeCreateStringHandle): * intl-auto-encap-win32.c (qxeAbortSystemShutdown): * intl-auto-encap-win32.c (qxeRegConnectRegistry): * intl-auto-encap-win32.c (qxeGetICMProfile): * intl-auto-encap-win32.h: Rebuild. * intl-encap-win32.c: * intl-encap-win32.c (qxeUpdateICMRegKey): Delete manual definitions of functions with former errors in Cygwin headers but no longer. Use "override" with some functions where Cygwin or VS6 accidentally omits a const declaration or includes an extra one. Use "no" on SendMessageTimeout, which has an error in the VS6 prototype (you could manually fix this with an ifdef to split the Cygwin vs. VS6 calls, if we ever actually used this function).
author Ben Wing <ben@xemacs.org>
date Sat, 30 Jan 2010 20:34:23 -0600
parents 49de55c09f18
children 7eec2a1f3412
comparison
equal deleted inserted replaced
4902:c902301f8b7d 4903:70089046adef
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";