Mercurial > hg > xemacs-beta
annotate lib-src/make-mswin-unicode.pl @ 4875:49de55c09f18
add "review" lines in intl-encap-win32.c for all unseen functions in processed headers
-------------------- ChangeLog entries follow: --------------------
lib-src/ChangeLog addition:
2010-01-15 Ben Wing <ben@xemacs.org>
* make-mswin-unicode.pl:
Process the command `review'. Cause an error to happen if we try to
use the command, indicating that the command needs review to determine
how to handle it.
src/ChangeLog addition:
2010-01-15 Ben Wing <ben@xemacs.org>
* intl-encap-win32.c:
Add `review' lines for all functions seen in the headers that we
process but not yet associated with an encapsulation command.
These will cause an error to be signaled if these functions are
used.
* intl-auto-encap-win32.c:
* intl-auto-encap-win32.h:
Regenerate.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Fri, 15 Jan 2010 05:42:21 -0600 |
| parents | 50861fea97f6 |
| children | 70089046adef |
| rev | line source |
|---|---|
| 771 | 1 : #-*- Perl -*- |
| 2 | |
| 3 ### make-mswin-unicode --- generate Unicode-encapsulation code for MS Windows | |
| 4 | |
|
4875
49de55c09f18
add "review" lines in intl-encap-win32.c for all unseen functions in processed headers
Ben Wing <ben@xemacs.org>
parents:
4873
diff
changeset
|
5 ## Copyright (C) 2001, 2002, 2004, 2010 Ben Wing. |
| 771 | 6 |
| 7 ## Author: Ben Wing <ben@xemacs.org> | |
| 8 ## Maintainer: Ben Wing <ben@xemacs.org> | |
| 9 ## Current Version: 1.0, August 24, 2001 | |
| 10 | |
| 11 ## This file is part of XEmacs. | |
| 12 | |
| 13 ## XEmacs is free software; you can redistribute it and/or modify it | |
| 14 ## under the terms of the GNU General Public License as published by | |
| 15 ## the Free Software Foundation; either version 2, or (at your option) | |
| 16 ## any later version. | |
| 17 | |
| 18 ## XEmacs is distributed in the hope that it will be useful, but | |
| 19 ## WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 20 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 21 ## General Public License for more details. | |
| 22 | |
| 23 ## You should have received a copy of the GNU General Public License | |
| 24 ## along with XEmacs; see the file COPYING. If not, write to the Free | |
| 25 ## Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
| 26 ## 02111-1307, USA. | |
| 27 | |
| 28 eval 'exec perl -w -S $0 ${1+"$@"}' | |
| 29 if 0; | |
| 30 | |
| 31 use strict; | |
| 32 use File::Basename; | |
| 33 use Getopt::Long; | |
| 34 | |
| 35 my ($myName, $myPath) = fileparse ($0); | |
| 36 | |
| 37 my $usage=" | |
| 38 Usage: $myName [--c-output FILE] [--h-output FILE] [--help] [FILES ...] | |
| 39 | |
| 40 The purpose of this script is to auto-generate Unicode-encapsulation | |
| 41 code for MS Windows library functions that come in two versions (ANSI | |
| 42 and Unicode). The MS Windows header files provide a way of | |
| 43 automatically calling the right version, but only at compile-time, | |
| 44 which is *NOT* sufficient for any real-world program. The solution is | |
| 45 run-time Unicode encapsulation, which is not conceptually difficult | |
| 46 but is time-consuming, and is not supported standardly only due to | |
| 47 evil marketing decisions made by Microsoft. See src/intl-win32.c | |
| 48 for more information. | |
| 49 | |
| 800 | 50 In XEmacs, this file is normally run using `nmake -f xemacs.mak |
| 51 unicode-encapsulate'. | |
| 52 | |
| 771 | 53 This script processes the specified files, looking for commands |
| 54 indicating library routines to Unicode-encapsulate, as follows: | |
| 55 | |
| 56 Portions of the files that should be processed are enclosed in lines | |
| 57 consisting only of the words \"begin-unicode-encapsulation-script\" | |
| 58 and \"end-unicode-encapsulation-script\". More than one section can | |
| 59 occur in a single file. Processed lines begin with a command word, | |
| 60 followed by one or more args (no quotes are necessary for spaces): | |
| 61 | |
| 62 file specifies a file to start reading from. | |
| 63 yes indicates a function to be automatically Unicode-encapsulated. | |
| 64 (All parameters either need no special processing or are LPTSTR or | |
| 65 LPCTSTR.) | |
| 66 soon indicates a function that should be automatically Unicode-encapsulated, | |
| 67 but we're not ready to process it yet. | |
| 68 no indicates a function we don't support (it will be #defined to cause | |
| 69 a compile error, with the text after the function included in the | |
| 70 erroneous definition to indicate why we don't support it). | |
|
4875
49de55c09f18
add "review" lines in intl-encap-win32.c for all unseen functions in processed headers
Ben Wing <ben@xemacs.org>
parents:
4873
diff
changeset
|
71 review indicates a function that we still need to review to determine whether |
|
49de55c09f18
add "review" lines in intl-encap-win32.c for all unseen functions in processed headers
Ben Wing <ben@xemacs.org>
parents:
4873
diff
changeset
|
72 or how to support it. This has the same effect as `no', with a comment |
|
49de55c09f18
add "review" lines in intl-encap-win32.c for all unseen functions in processed headers
Ben Wing <ben@xemacs.org>
parents:
4873
diff
changeset
|
73 indicating that the function needs review. |
| 771 | 74 skip indicates a function we support manually; only a comment about this |
| 75 will be generated. | |
| 76 split indicates a function with a split structure (different versions | |
| 77 for Unicode and ANSI), but where the only difference is in pointer | |
| 78 types, and the actual size does not differ. The structure name | |
| 79 should follow the function name, and it will be automatically | |
| 80 Unicode-encapsulated with appropriate casts. | |
| 81 begin-bracket indicates a #if statement to be inserted here. | |
| 82 end-bracket indicates the corresponding #endif statement. | |
| 83 blank lines and lines beginning with // are ignored. | |
| 84 "; | |
| 85 | |
| 86 # ------------------ process command-line options ------------------ | |
| 87 | |
| 88 my %options; | |
| 89 my @SAVE_ARGV = @ARGV; | |
| 90 | |
| 91 $Getopt::Long::ignorecase = 0; | |
| 92 &GetOptions ( | |
| 93 \%options, | |
| 94 'c-output=s', | |
| 95 'h-output=s', | |
| 778 | 96 'includedir=s', |
| 771 | 97 'help', |
| 98 ); | |
| 99 | |
| 100 die $usage if $options{"help"}; | |
| 101 | |
| 102 my $in_script; | |
| 103 my $slurp; | |
| 104 | |
| 778 | 105 my ($cout, $hout, $dir) = ($options{"c-output"}, |
| 106 $options{"h-output"}, | |
| 107 $options{"includedir"}); | |
|
4873
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
108 |
|
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
109 $dir = '/usr/include/w32api' if !$dir && -f '/usr/include/w32api/windows.h'; |
|
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
110 |
| 778 | 111 if (!$dir) |
| 112 { | |
|
4467
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
113 for my $sdkroot (("WindowsSdkDir", "MSSdk", "MSVCDIR")) |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
114 { |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
115 if (defined $ENV{$sdkroot}) { |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
116 $dir = $ENV{$sdkroot}; |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
117 last; |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
118 } |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
119 } |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
120 unless (defined $dir) |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
121 { |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
122 die "Can't find the Windows SDK headers; run vcvars32.bat from your MSVC installation, or setenv.cmd from the Platform SDK installation"; |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
123 } |
| 778 | 124 } |
|
4873
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
125 $dir.='/include' if ((-f $dir.'/include/WINDOWS.H') || |
|
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
126 (-f $dir.'/include/windows.h')); |
| 3728 | 127 die "Can't find MSVC include files in \"$dir\"" unless ((-f $dir.'/WINDOWS.H') || (-f $dir.'/windows.h')); |
| 771 | 128 |
| 129 open (COUT, ">$cout") or die "Can't open C output file $cout: $!"; | |
| 130 open (HOUT, ">$hout") or die "Can't open C output file $hout: $!"; | |
| 131 | |
| 132 select (STDOUT); $| = 1; | |
| 133 | |
| 134 print COUT "/* Automatically-generated Unicode-encapsulation file, | |
| 135 using the command | |
| 136 | |
| 137 $myPath$myName @SAVE_ARGV | |
| 138 | |
| 139 Do not edit. See `$myName'. | |
| 140 */ | |
| 141 | |
| 142 #include <config.h> | |
| 143 #include \"lisp.h\" | |
| 144 | |
| 145 #include \"syswindows.h\" | |
| 146 | |
| 147 "; | |
| 148 print HOUT "/* Automatically-generated Unicode-encapsulation header file. | |
| 149 Do not edit. See `$myName'. | |
| 150 */\n\n"; | |
| 151 | |
| 152 my %files; | |
| 153 my %processed; | |
| 154 my %bracket; | |
| 155 | |
| 156 my $current_file; | |
| 157 my @current_bracket; | |
| 158 | |
| 159 while (<>) | |
| 160 { | |
| 161 chomp; | |
| 800 | 162 # remove trailing CR. #### Should not be necessary! Perl should be |
| 163 # opening these in text mode by default, as the docs claim, and | |
| 164 # automatically remove the CR's. | |
| 165 tr/\r//d; | |
| 771 | 166 |
| 167 if (/^begin-unicode-encapsulation-script$/) | |
| 168 { | |
| 169 $in_script = 1; | |
| 170 } | |
| 171 elsif (/^end-unicode-encapsulation-script$/) | |
| 172 { | |
| 173 $in_script = 0; | |
| 174 } | |
| 175 elsif ($in_script) | |
| 176 { | |
| 177 next if (m!^//!); | |
| 178 next if (/^[ \t]*$/); | |
|
4875
49de55c09f18
add "review" lines in intl-encap-win32.c for all unseen functions in processed headers
Ben Wing <ben@xemacs.org>
parents:
4873
diff
changeset
|
179 if (/(file|yes|soon|no|review|skip|split|begin-bracket|end-bracket)(?: (.*))?/) |
| 771 | 180 { |
| 181 my ($command, $parms) = ($1, $2); | |
| 778 | 182 if ($command eq "file") |
| 771 | 183 { |
| 184 $current_file = $parms; | |
| 185 } | |
| 186 elsif ($command eq "begin-bracket") | |
| 187 { | |
| 188 my $current_bracket = $current_bracket[$#current_bracket]; | |
| 189 if (defined ($current_bracket)) | |
| 190 { | |
| 191 $current_bracket .= "&& $parms"; | |
| 192 } | |
| 193 else | |
| 194 { | |
| 195 $current_bracket = "$parms"; | |
| 196 } | |
| 197 push @current_bracket, $current_bracket; | |
| 198 } | |
| 199 elsif ($command eq "end-bracket") | |
| 200 { | |
| 201 pop @current_bracket; | |
| 202 } | |
| 203 else | |
| 204 { | |
| 205 my ($fun, $reason) = split /\s+/, $parms, 2; | |
| 206 $files{$current_file}{$fun} = [$command, $reason]; | |
| 207 $bracket{$current_file}{$fun} = | |
| 208 $current_bracket[$#current_bracket]; | |
| 209 } | |
| 210 } | |
| 211 else | |
| 212 { | |
| 213 print "WARNING: Unknown line $_\n"; | |
| 214 } | |
| 215 } | |
| 216 } | |
| 217 | |
| 218 | |
| 219 foreach my $file (keys %files) | |
| 220 { | |
| 221 $slurp = &FileContents ($file); | |
| 222 print "Processing file $file\n"; | |
| 223 print HOUT "\n/* Processing file $file */\n\n"; | |
| 224 my $totalspace = 70 - length ("Processing file $file"); | |
| 225 $totalspace = 0 if $totalspace < 0; | |
| 226 my $alignspaceleft = $totalspace / 2; | |
| 227 my $alignspaceright = ($totalspace + 1) / 2; | |
| 228 print COUT " | |
| 229 /*----------------------------------------------------------------------*/ | |
| 230 /*" . (" " x $alignspaceleft) . "Processing file $file" . | |
| 231 (" " x $alignspaceright) . "*/ | |
| 232 /*----------------------------------------------------------------------*/ | |
| 233 | |
| 234 "; | |
| 235 | |
| 236 my ($ws_re, $must_ws_re, $tok_ch) = | |
| 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". | |
|
4873
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
254 "(?:(?!(?:X\\b|Y\\b))(?:unsigned|int|long|const|short|va_list|[A-Z_0-9]+)(?!${tok_ch}))"; |
| 771 | 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 { | |
| 262 my ($rettype, $fun, $args) = ($1, $2, $3); | |
|
4873
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
263 |
|
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
264 if ($processed{$fun}) |
|
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
265 { |
|
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
266 print "Warning: Function $fun already seen\n"; |
|
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
267 next; |
|
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
268 } |
|
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
269 |
| 771 | 270 $processed{$fun} = 1; |
|
4873
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
271 |
| 771 | 272 print "Processing: $fun"; |
| 273 | |
| 274 my ($command, $reason) = ($files{$file}{$fun}[0], $files{$file}{$fun}[1]); | |
| 275 if (!defined ($command)) | |
| 276 { | |
| 277 print " (no command found)\n"; | |
| 278 } | |
| 279 else | |
| 280 { | |
| 281 print "\n"; | |
| 282 my $bracket = $bracket{$file}{$fun}; | |
| 283 if (defined ($bracket)) | |
| 284 { | |
| 285 print HOUT "#if $bracket\n"; | |
| 286 print COUT "#if $bracket\n\n"; | |
| 287 } | |
|
4875
49de55c09f18
add "review" lines in intl-encap-win32.c for all unseen functions in processed headers
Ben Wing <ben@xemacs.org>
parents:
4873
diff
changeset
|
288 if ($command eq "no" || $command eq "review") |
| 771 | 289 { |
|
4875
49de55c09f18
add "review" lines in intl-encap-win32.c for all unseen functions in processed headers
Ben Wing <ben@xemacs.org>
parents:
4873
diff
changeset
|
290 $reason = "Function needs review to determine how to handle it" |
|
49de55c09f18
add "review" lines in intl-encap-win32.c for all unseen functions in processed headers
Ben Wing <ben@xemacs.org>
parents:
4873
diff
changeset
|
291 if !defined ($reason) && $command eq "review"; |
|
49de55c09f18
add "review" lines in intl-encap-win32.c for all unseen functions in processed headers
Ben Wing <ben@xemacs.org>
parents:
4873
diff
changeset
|
292 |
| 771 | 293 if (!defined ($reason)) |
| 294 { | |
| 295 print "WARNING: No reason given for `no' with function $fun\n"; | |
| 296 $reason = ""; | |
| 297 } | |
| 298 | |
| 299 print HOUT "#undef $fun\n"; | |
| 2367 | 300 (my $munged_reason = $reason) =~ s/[^A-Za-z0-9]/_/g; |
| 301 print HOUT "#define $fun error_$munged_reason\n"; | |
| 771 | 302 print COUT "/* Error if $fun used: $reason */\n\n"; |
| 303 } | |
| 304 elsif ($command eq "skip") | |
| 305 { | |
| 306 if (!defined ($reason)) | |
| 307 { | |
| 308 print "WARNING: No reason given for `skip' with function $fun\n"; | |
| 309 $reason = ""; | |
| 310 } | |
| 311 | |
| 312 print HOUT "/* Skipping $fun because $reason */\n"; | |
| 313 print COUT "/* Skipping $fun because $reason */\n\n"; | |
| 314 } | |
| 315 elsif ($command eq "soon") | |
| 316 { | |
| 317 $reason = "" if !defined ($reason); | |
| 318 | |
| 319 print HOUT "/* Not yet: $fun $reason */\n"; | |
| 320 print COUT "/* Not yet: $fun $reason */\n\n"; | |
| 321 } | |
| 322 else | |
| 323 { | |
| 324 my (@args, %argtype, %ansiarg, %xarg, $split_struct, | |
| 325 $split_rettype); | |
| 326 if ($command eq "split") | |
| 327 { | |
| 328 ($split_struct, $reason) = split /\s+/, $reason, 2; | |
| 329 } | |
| 330 my $argno = 0; | |
| 331 while ($args =~ /$arg_re/g) | |
| 332 { | |
| 333 $argno++; | |
| 334 my ($argtype, $argname) = ($1, $2); | |
| 335 $argtype =~ s/\s*$//; | |
| 336 next if $argtype eq "void" || $argtype eq "VOID"; | |
| 337 $argname = "arg$argno" if !defined ($argname); | |
| 338 $argtype{$argname} = $argtype; | |
| 339 $ansiarg{$argname} = $argtype; | |
| 340 $ansiarg{$argname} =~ s/\bLPWSTR\b/LPSTR/; | |
| 341 $ansiarg{$argname} =~ s/\bLPCWSTR\b/LPCSTR/; | |
| 342 $xarg{$argname} = $argtype; | |
| 343 $xarg{$argname} =~ s/\bLPWSTR\b/Extbyte */; | |
| 344 $xarg{$argname} =~ s/\bLPCWSTR\b/const Extbyte */; | |
| 345 if (defined ($split_struct)) | |
| 346 { | |
| 347 my $fuck_cperl1 = "\\b${split_struct}W\\b"; | |
| 348 my $fuck_cperl2 = "${split_struct}A"; | |
| 349 $ansiarg{$argname} =~ s/$fuck_cperl1/$fuck_cperl2/; | |
| 350 } | |
| 351 push @args, $argname; | |
| 352 } | |
| 353 $rettype =~ s/\bSHSTDAPI_\((.*)\)/$1/; | |
| 354 $rettype =~ s/\s*WIN\w*?API\s*//g; | |
|
4873
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
355 $rettype =~ s/\bAPIENTRY\b\s*//; |
| 771 | 356 $rettype =~ s/\bSHSTDAPI\b/HRESULT/; |
|
4873
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
357 $rettype =~ s/\bextern\b\s*//; |
| 771 | 358 if ($rettype =~ /LPC?WSTR/) |
| 359 { | |
| 360 $split_rettype = 1; | |
| 361 $rettype =~ s/\bLPWSTR\b/Extbyte */; | |
| 362 $rettype =~ s/\bLPCWSTR\b/const Extbyte */; | |
| 363 } | |
| 800 | 364 print HOUT "#ifdef ERROR_WHEN_NONINTERCEPTED_FUNS_USED\n"; |
| 365 print HOUT "#undef $fun\n"; | |
| 2367 | 366 print HOUT "#define $fun error_use_qxe${fun}_or_${fun}A_and_${fun}W\n"; |
| 800 | 367 print HOUT "#endif\n"; |
| 771 | 368 if (defined ($reason)) |
| 369 { | |
| 370 print COUT "/* NOTE: $reason */\n"; | |
| 371 } | |
| 372 print COUT "$rettype\nqxe$fun ("; | |
| 373 print HOUT "$rettype qxe$fun ("; | |
| 374 my $first = 1; | |
| 375 if (!@args) | |
| 376 { | |
| 377 print COUT "void"; | |
| 378 print HOUT "void"; | |
| 379 } | |
| 380 else | |
| 381 { | |
| 382 foreach my $x (@args) | |
| 383 { | |
| 384 print COUT ", " if !$first; | |
| 385 print HOUT ", " if !$first; | |
| 386 $first = 0; | |
| 387 print COUT "$xarg{$x} $x"; | |
| 388 print HOUT "$xarg{$x} $x"; | |
| 389 } | |
| 390 } | |
| 391 print HOUT ");\n"; | |
| 392 print COUT ")\n{\n if (XEUNICODE_P)\n "; | |
| 393 if ($rettype ne "void" && $rettype ne "VOID") | |
| 394 { | |
| 395 print COUT "return "; | |
| 396 print COUT "($rettype) " if $split_rettype; | |
| 397 } | |
| 398 print COUT "${fun}W ("; | |
| 399 $first = 1; | |
| 400 foreach my $x (@args) | |
| 401 { | |
| 402 print COUT ", " if !$first; | |
| 403 $first = 0; | |
| 404 print COUT ($argtype{$x} eq $xarg{$x} ? $x : | |
| 405 "($argtype{$x}) $x"); | |
| 406 } | |
| 407 print COUT ");\n else\n "; | |
| 408 if ($rettype ne "void" && $rettype ne "VOID") | |
| 409 { | |
| 410 print COUT "return "; | |
| 411 print COUT "($rettype) " if $split_rettype; | |
| 412 } | |
| 413 print COUT "${fun}A ("; | |
| 414 $first = 1; | |
| 415 foreach my $x (@args) | |
| 416 { | |
| 417 print COUT ", " if !$first; | |
| 418 $first = 0; | |
| 419 print COUT ($argtype{$x} eq $ansiarg{$x} ? $x : | |
| 420 "($ansiarg{$x}) $x"); | |
| 421 } | |
| 422 print COUT ");\n}\n\n"; | |
| 423 } | |
| 424 if (defined ($bracket)) | |
| 425 { | |
| 426 print HOUT "#endif /* $bracket */\n"; | |
| 427 print COUT "#endif /* $bracket */\n\n"; | |
| 428 } | |
| 800 | 429 print HOUT "\n"; |
| 771 | 430 } |
| 431 } | |
| 432 } | |
| 433 | |
| 434 foreach my $file (keys %files) | |
| 435 { | |
| 436 foreach my $fun (keys %{$files{$file}}) | |
| 437 { | |
| 438 if (!$processed{$fun} && $files{$file}{$fun}[0] =~ /^(yes|soon|split)$/) | |
| 439 { | |
| 440 print "WARNING: Can't locate prototype for $fun\n"; | |
| 441 } | |
| 442 } | |
| 443 } | |
| 444 | |
| 445 | |
| 446 sub FileContents | |
| 447 { | |
| 448 local $/ = undef; | |
| 778 | 449 open (FILE, "< $dir/$_[0]") or die "$dir/$_[0]: $!"; |
| 771 | 450 my $retval = scalar <FILE>; |
| 451 # must hack away CRLF junk. | |
| 452 $retval =~ s/\r\n/\n/g; | |
| 453 return $retval; | |
| 454 } |