Mercurial > hg > xemacs-beta
annotate lib-src/make-mswin-unicode.pl @ 5466:3600e23880f7
Added tag last-gplv2 for changeset 1c87bdc11d65
| author | Stephen J. Turnbull <stephen@xemacs.org> |
|---|---|
| date | Wed, 27 Apr 2011 04:17:14 +0900 |
| parents | 7eec2a1f3412 |
| children | 308d34e9f07d |
| 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.) | |
| 4911 | 66 override indidates a function where the prototype can be overridden |
| 67 due to errors in Cygwin or Visual Studio. | |
| 771 | 68 soon indicates a function that should be automatically Unicode-encapsulated, |
| 69 but we're not ready to process it yet. | |
| 70 no indicates a function we don't support (it will be #defined to cause | |
| 71 a compile error, with the text after the function included in the | |
| 72 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
|
73 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
|
74 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
|
75 indicating that the function needs review. |
| 771 | 76 skip indicates a function we support manually; only a comment about this |
| 77 will be generated. | |
| 78 split indicates a function with a split structure (different versions | |
| 79 for Unicode and ANSI), but where the only difference is in pointer | |
| 80 types, and the actual size does not differ. The structure name | |
| 81 should follow the function name, and it will be automatically | |
| 82 Unicode-encapsulated with appropriate casts. | |
| 83 begin-bracket indicates a #if statement to be inserted here. | |
| 84 end-bracket indicates the corresponding #endif statement. | |
| 85 blank lines and lines beginning with // are ignored. | |
| 86 "; | |
| 87 | |
| 88 # ------------------ process command-line options ------------------ | |
| 89 | |
| 90 my %options; | |
| 91 my @SAVE_ARGV = @ARGV; | |
| 92 | |
| 93 $Getopt::Long::ignorecase = 0; | |
| 94 &GetOptions ( | |
| 95 \%options, | |
| 96 'c-output=s', | |
| 97 'h-output=s', | |
| 778 | 98 'includedir=s', |
| 771 | 99 'help', |
| 100 ); | |
| 101 | |
| 102 die $usage if $options{"help"}; | |
| 103 | |
| 104 my $in_script; | |
| 105 my $slurp; | |
| 106 | |
| 778 | 107 my ($cout, $hout, $dir) = ($options{"c-output"}, |
| 108 $options{"h-output"}, | |
| 109 $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
|
110 |
|
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
111 $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
|
112 |
| 778 | 113 if (!$dir) |
| 114 { | |
|
4467
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
115 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
|
116 { |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
117 if (defined $ENV{$sdkroot}) { |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
118 $dir = $ENV{$sdkroot}; |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
119 last; |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
120 } |
|
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 unless (defined $dir) |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
123 { |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
124 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
|
125 } |
| 778 | 126 } |
|
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
|
127 $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
|
128 (-f $dir.'/include/windows.h')); |
| 3728 | 129 die "Can't find MSVC include files in \"$dir\"" unless ((-f $dir.'/WINDOWS.H') || (-f $dir.'/windows.h')); |
| 771 | 130 |
| 131 open (COUT, ">$cout") or die "Can't open C output file $cout: $!"; | |
| 132 open (HOUT, ">$hout") or die "Can't open C output file $hout: $!"; | |
| 133 | |
| 134 select (STDOUT); $| = 1; | |
| 135 | |
| 136 print COUT "/* Automatically-generated Unicode-encapsulation file, | |
| 137 using the command | |
| 138 | |
| 139 $myPath$myName @SAVE_ARGV | |
| 140 | |
| 141 Do not edit. See `$myName'. | |
| 142 */ | |
| 143 | |
| 144 #include <config.h> | |
| 145 #include \"lisp.h\" | |
| 146 | |
| 147 #include \"syswindows.h\" | |
| 148 | |
| 149 "; | |
| 150 print HOUT "/* Automatically-generated Unicode-encapsulation header file. | |
| 151 Do not edit. See `$myName'. | |
| 152 */\n\n"; | |
| 153 | |
| 154 my %files; | |
| 155 my %processed; | |
| 156 my %bracket; | |
| 157 | |
| 158 my $current_file; | |
| 159 my @current_bracket; | |
| 160 | |
|
4903
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
161 my ($ws_re, $must_ws_re, $tok_ch) = |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
162 ("\\s*", "\\s+", "\\w"); |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
163 # unfortunately there is no surefire way short of |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
164 # parsing all include files for typedefs to |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
165 # distinguish types from parameters, and prototypes |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
166 # appear in the include files both with and without |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
167 # parameters -- the latter kinds appear in a very |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
168 # different style and were obviously added later. so |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
169 # we rely on the fact that defined types are all |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
170 # upper-case, and parameters generally are not, and |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
171 # special-case the exceptions. |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
172 my $typeword_re = |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
173 # note the negative lookahead assertions: the first |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
174 # one excludes the words "X" and "Y" from type |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
175 # words, since they appear as parameter names in |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
176 # CreateWindowEx; the second prevents "void |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
177 # *Argument" from being parsed as a type "void *A" |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
178 # followed by a parameter "rgument". |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
179 "(?:(?!(?:X\\b|Y\\b))(?:unsigned|int|long|const|short|va_list|[A-Z_0-9]+)(?!${tok_ch}))"; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
180 my $typetoken_re = "(?:$typeword_re$ws_re\\**$ws_re)"; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
181 # Regexp matching a particular argument |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
182 my $arg_re = "(?:(?:$typetoken_re+)(?:${tok_ch}+)?(?: OPTIONAL)?)"; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
183 # Same, but with groups to match the type and name |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
184 my $argmatch_re = "(?:($typetoken_re+)(${tok_ch}+)?(?: OPTIONAL)?)"; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
185 # regexp matching a parenthesized argument list in a prototype |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
186 my $args_re = "\\(((?:${ws_re}${arg_re}${ws_re},)*${ws_re}${arg_re}${ws_re})\\)"; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
187 # regexp matching a return type in a protype |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
188 my $rettype_re = "(SHSTDAPI_\\(${tok_ch}+\\)|${tok_ch}" . "[A-Za-z_0-9 \t\n\r\f]*?${tok_ch})"; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
189 # regexp matching a function name |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
190 my $funname_re = "(${tok_ch}+)"; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
191 # Regexp matching a function prototype, $1 = rettype, $2 = name, $3 = args |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
192 my $fun_re = "${rettype_re}${ws_re}${funname_re}${ws_re}${args_re};"; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
193 # Regexp matching a particular Unicode function (ending in ...W) |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
194 my $wfun_re = "${rettype_re}${ws_re}${funname_re}W${ws_re}${args_re};"; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
195 |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
196 # print "regexp: $wfun_re\n"; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
197 |
| 771 | 198 while (<>) |
| 199 { | |
| 200 chomp; | |
| 800 | 201 # remove trailing CR. #### Should not be necessary! Perl should be |
| 202 # opening these in text mode by default, as the docs claim, and | |
| 203 # automatically remove the CR's. | |
| 204 tr/\r//d; | |
| 771 | 205 |
| 206 if (/^begin-unicode-encapsulation-script$/) | |
| 207 { | |
| 208 $in_script = 1; | |
| 209 } | |
| 210 elsif (/^end-unicode-encapsulation-script$/) | |
| 211 { | |
| 212 $in_script = 0; | |
| 213 } | |
| 214 elsif ($in_script) | |
| 215 { | |
| 216 next if (m!^//!); | |
| 217 next if (/^[ \t]*$/); | |
|
4903
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
218 if (/(file|yes|soon|no|review|skip|split|begin-bracket|end-bracket|override)(?: (.*))?/) |
| 771 | 219 { |
| 220 my ($command, $parms) = ($1, $2); | |
| 778 | 221 if ($command eq "file") |
| 771 | 222 { |
| 223 $current_file = $parms; | |
| 224 } | |
| 225 elsif ($command eq "begin-bracket") | |
| 226 { | |
| 227 my $current_bracket = $current_bracket[$#current_bracket]; | |
| 228 if (defined ($current_bracket)) | |
| 229 { | |
| 230 $current_bracket .= "&& $parms"; | |
| 231 } | |
| 232 else | |
| 233 { | |
| 234 $current_bracket = "$parms"; | |
| 235 } | |
| 236 push @current_bracket, $current_bracket; | |
| 237 } | |
| 238 elsif ($command eq "end-bracket") | |
| 239 { | |
| 240 pop @current_bracket; | |
| 241 } | |
|
4903
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
242 elsif ($command eq "override") |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
243 { |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
244 die "Cannot parse prototype $parms" unless $parms =~ /$wfun_re(?: ?(.*))?/; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
245 my ($rettype, $fun, $args, $reason) = ($1, $2, $3, $4); |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
246 $files{$current_file}{$fun} = |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
247 [$command, $reason, $rettype, $fun, $args]; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
248 $bracket{$current_file}{$fun} = |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
249 $current_bracket[$#current_bracket]; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
250 } |
| 771 | 251 else |
| 252 { | |
| 253 my ($fun, $reason) = split /\s+/, $parms, 2; | |
| 254 $files{$current_file}{$fun} = [$command, $reason]; | |
| 255 $bracket{$current_file}{$fun} = | |
| 256 $current_bracket[$#current_bracket]; | |
| 257 } | |
| 258 } | |
| 259 else | |
| 260 { | |
| 261 print "WARNING: Unknown line $_\n"; | |
| 262 } | |
| 263 } | |
| 264 } | |
| 265 | |
| 266 | |
| 267 foreach my $file (keys %files) | |
| 268 { | |
| 269 $slurp = &FileContents ($file); | |
| 270 print "Processing file $file\n"; | |
| 271 print HOUT "\n/* Processing file $file */\n\n"; | |
| 272 my $totalspace = 70 - length ("Processing file $file"); | |
| 273 $totalspace = 0 if $totalspace < 0; | |
| 274 my $alignspaceleft = $totalspace / 2; | |
| 275 my $alignspaceright = ($totalspace + 1) / 2; | |
| 276 print COUT " | |
| 277 /*----------------------------------------------------------------------*/ | |
| 278 /*" . (" " x $alignspaceleft) . "Processing file $file" . | |
| 279 (" " x $alignspaceright) . "*/ | |
| 280 /*----------------------------------------------------------------------*/ | |
| 281 | |
| 282 "; | |
| 283 | |
|
4903
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
284 while ($slurp =~ /$wfun_re/g) |
| 771 | 285 { |
| 286 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
|
287 |
|
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
288 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
|
289 { |
|
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
290 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
|
291 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
|
292 } |
|
50861fea97f6
regenerate intl-auto-encap-win32.c, now possible from Cygwin /usr/include/w32api headers
Ben Wing <ben@xemacs.org>
parents:
4467
diff
changeset
|
293 |
| 771 | 294 $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
|
295 |
| 771 | 296 print "Processing: $fun"; |
| 297 | |
|
4903
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
298 #my ($command, $reason) = ($files{$file}{$fun}[0], $files{$file}{$fun}[1]); |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
299 # Fuck perl! There seems to be no way to write something like |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
300 # my ($command, $reason) = @$files{$file}{$fun}; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
301 # You have to use a temporary var. |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
302 my $filesarr = $files{$file}{$fun}; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
303 my ($command, $reason) = @$filesarr; |
| 771 | 304 if (!defined ($command)) |
| 305 { | |
| 306 print " (no command found)\n"; | |
| 307 } | |
| 308 else | |
| 309 { | |
| 310 print "\n"; | |
| 311 my $bracket = $bracket{$file}{$fun}; | |
| 312 if (defined ($bracket)) | |
| 313 { | |
| 314 print HOUT "#if $bracket\n"; | |
| 315 print COUT "#if $bracket\n\n"; | |
| 316 } | |
|
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
|
317 if ($command eq "no" || $command eq "review") |
| 771 | 318 { |
|
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
|
319 $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
|
320 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
|
321 |
| 771 | 322 if (!defined ($reason)) |
| 323 { | |
| 324 print "WARNING: No reason given for `no' with function $fun\n"; | |
| 325 $reason = ""; | |
| 326 } | |
| 327 | |
| 328 print HOUT "#undef $fun\n"; | |
| 2367 | 329 (my $munged_reason = $reason) =~ s/[^A-Za-z0-9]/_/g; |
| 330 print HOUT "#define $fun error_$munged_reason\n"; | |
| 771 | 331 print COUT "/* Error if $fun used: $reason */\n\n"; |
| 332 } | |
| 333 elsif ($command eq "skip") | |
| 334 { | |
| 335 if (!defined ($reason)) | |
| 336 { | |
| 337 print "WARNING: No reason given for `skip' with function $fun\n"; | |
| 338 $reason = ""; | |
| 339 } | |
| 340 | |
| 341 print HOUT "/* Skipping $fun because $reason */\n"; | |
| 342 print COUT "/* Skipping $fun because $reason */\n\n"; | |
| 343 } | |
| 344 elsif ($command eq "soon") | |
| 345 { | |
| 346 $reason = "" if !defined ($reason); | |
| 347 | |
| 348 print HOUT "/* Not yet: $fun $reason */\n"; | |
| 349 print COUT "/* Not yet: $fun $reason */\n\n"; | |
| 350 } | |
| 351 else | |
| 352 { | |
| 353 my (@args, %argtype, %ansiarg, %xarg, $split_struct, | |
| 354 $split_rettype); | |
| 355 if ($command eq "split") | |
| 356 { | |
| 357 ($split_struct, $reason) = split /\s+/, $reason, 2; | |
| 358 } | |
|
4903
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
359 elsif ($command eq "override") |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
360 { |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
361 my ($nrettype, $nfun, $nargs) = @$filesarr[2 .. 4]; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
362 $reason = "$reason.\n NOTE: " if $reason; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
363 $reason = "${reason}Prototype manually overridden. |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
364 Header file claims: |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
365 $rettype $fun($args) |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
366 Overridden with: |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
367 $nrettype $nfun($nargs) |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
368 Differences in return-type qualifiers, e.g. WINAPI, are not important. |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
369 "; |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
370 ($rettype, $fun, $args) = ($nrettype, $nfun, $nargs); |
|
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
371 } |
| 771 | 372 my $argno = 0; |
|
4903
70089046adef
fix compile problems in intl-encap* under VS6
Ben Wing <ben@xemacs.org>
parents:
4875
diff
changeset
|
373 while ($args =~ /$argmatch_re/g) |
| 771 | 374 { |
| 375 $argno++; | |
| 376 my ($argtype, $argname) = ($1, $2); | |
| 377 $argtype =~ s/\s*$//; | |
| 378 next if $argtype eq "void" || $argtype eq "VOID"; | |
| 379 $argname = "arg$argno" if !defined ($argname); | |
| 380 $argtype{$argname} = $argtype; | |
| 381 $ansiarg{$argname} = $argtype; | |
| 382 $ansiarg{$argname} =~ s/\bLPWSTR\b/LPSTR/; | |
| 383 $ansiarg{$argname} =~ s/\bLPCWSTR\b/LPCSTR/; | |
| 384 $xarg{$argname} = $argtype; | |
| 385 $xarg{$argname} =~ s/\bLPWSTR\b/Extbyte */; | |
| 386 $xarg{$argname} =~ s/\bLPCWSTR\b/const Extbyte */; | |
| 387 if (defined ($split_struct)) | |
| 388 { | |
| 389 my $fuck_cperl1 = "\\b${split_struct}W\\b"; | |
| 390 my $fuck_cperl2 = "${split_struct}A"; | |
| 391 $ansiarg{$argname} =~ s/$fuck_cperl1/$fuck_cperl2/; | |
| 392 } | |
| 393 push @args, $argname; | |
| 394 } | |
| 395 $rettype =~ s/\bSHSTDAPI_\((.*)\)/$1/; | |
| 396 $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
|
397 $rettype =~ s/\bAPIENTRY\b\s*//; |
| 771 | 398 $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
|
399 $rettype =~ s/\bextern\b\s*//; |
| 771 | 400 if ($rettype =~ /LPC?WSTR/) |
| 401 { | |
| 402 $split_rettype = 1; | |
| 403 $rettype =~ s/\bLPWSTR\b/Extbyte */; | |
| 404 $rettype =~ s/\bLPCWSTR\b/const Extbyte */; | |
| 405 } | |
| 800 | 406 print HOUT "#ifdef ERROR_WHEN_NONINTERCEPTED_FUNS_USED\n"; |
| 407 print HOUT "#undef $fun\n"; | |
| 2367 | 408 print HOUT "#define $fun error_use_qxe${fun}_or_${fun}A_and_${fun}W\n"; |
| 800 | 409 print HOUT "#endif\n"; |
| 771 | 410 if (defined ($reason)) |
| 411 { | |
| 412 print COUT "/* NOTE: $reason */\n"; | |
| 413 } | |
| 414 print COUT "$rettype\nqxe$fun ("; | |
| 415 print HOUT "$rettype qxe$fun ("; | |
| 416 my $first = 1; | |
| 417 if (!@args) | |
| 418 { | |
| 419 print COUT "void"; | |
| 420 print HOUT "void"; | |
| 421 } | |
| 422 else | |
| 423 { | |
| 424 foreach my $x (@args) | |
| 425 { | |
| 426 print COUT ", " if !$first; | |
| 427 print HOUT ", " if !$first; | |
| 428 $first = 0; | |
| 429 print COUT "$xarg{$x} $x"; | |
| 430 print HOUT "$xarg{$x} $x"; | |
| 431 } | |
| 432 } | |
| 433 print HOUT ");\n"; | |
| 434 print COUT ")\n{\n if (XEUNICODE_P)\n "; | |
| 435 if ($rettype ne "void" && $rettype ne "VOID") | |
| 436 { | |
| 437 print COUT "return "; | |
| 438 print COUT "($rettype) " if $split_rettype; | |
| 439 } | |
| 440 print COUT "${fun}W ("; | |
| 441 $first = 1; | |
| 442 foreach my $x (@args) | |
| 443 { | |
| 444 print COUT ", " if !$first; | |
| 445 $first = 0; | |
| 446 print COUT ($argtype{$x} eq $xarg{$x} ? $x : | |
| 447 "($argtype{$x}) $x"); | |
| 448 } | |
| 449 print COUT ");\n else\n "; | |
| 450 if ($rettype ne "void" && $rettype ne "VOID") | |
| 451 { | |
| 452 print COUT "return "; | |
| 453 print COUT "($rettype) " if $split_rettype; | |
| 454 } | |
| 455 print COUT "${fun}A ("; | |
| 456 $first = 1; | |
| 457 foreach my $x (@args) | |
| 458 { | |
| 459 print COUT ", " if !$first; | |
| 460 $first = 0; | |
| 461 print COUT ($argtype{$x} eq $ansiarg{$x} ? $x : | |
| 462 "($ansiarg{$x}) $x"); | |
| 463 } | |
| 464 print COUT ");\n}\n\n"; | |
| 465 } | |
| 466 if (defined ($bracket)) | |
| 467 { | |
| 468 print HOUT "#endif /* $bracket */\n"; | |
| 469 print COUT "#endif /* $bracket */\n\n"; | |
| 470 } | |
| 800 | 471 print HOUT "\n"; |
| 771 | 472 } |
| 473 } | |
| 474 } | |
| 475 | |
| 476 foreach my $file (keys %files) | |
| 477 { | |
| 478 foreach my $fun (keys %{$files{$file}}) | |
| 479 { | |
| 480 if (!$processed{$fun} && $files{$file}{$fun}[0] =~ /^(yes|soon|split)$/) | |
| 481 { | |
| 482 print "WARNING: Can't locate prototype for $fun\n"; | |
| 483 } | |
| 484 } | |
| 485 } | |
| 486 | |
| 487 | |
| 488 sub FileContents | |
| 489 { | |
| 490 local $/ = undef; | |
| 778 | 491 open (FILE, "< $dir/$_[0]") or die "$dir/$_[0]: $!"; |
| 771 | 492 my $retval = scalar <FILE>; |
| 493 # must hack away CRLF junk. | |
| 494 $retval =~ s/\r\n/\n/g; | |
| 495 return $retval; | |
| 496 } |
