Mercurial > hg > xemacs-beta
annotate lib-src/make-mswin-unicode.pl @ 4690:257b468bf2ca
Move the #'query-coding-region implementation to C.
This is necessary because there is no reasonable way to access the
corresponding mswindows-multibyte functionality from Lisp, and we need such
functionality if we're going to have a reliable and portable
#'query-coding-region implementation. However, this change doesn't yet
provide #'query-coding-region for the mswindow-multibyte coding systems,
there should be no functional differences between an XEmacs with this change
and one without it.
src/ChangeLog addition:
2009-09-19 Aidan Kehoe <kehoea@parhasard.net>
Move the #'query-coding-region implementation to C.
This is necessary because there is no reasonable way to access the
corresponding mswindows-multibyte functionality from Lisp, and we
need such functionality if we're going to have a reliable and
portable #'query-coding-region implementation. However, this
change doesn't yet provide #'query-coding-region for the
mswindow-multibyte coding systems, there should be no functional
differences between an XEmacs with this change and one without it.
* mule-coding.c (struct fixed_width_coding_system):
Add a new coding system type, fixed_width, and implement it. It
uses the CCL infrastructure but has a much simpler creation API,
and its own query_method, formerly in lisp/mule/mule-coding.el.
* unicode.c:
Move the Unicode query method implementation here from
unicode.el.
* lisp.h: Declare Fmake_coding_system_internal, Fcopy_range_table
here.
* intl-win32.c (complex_vars_of_intl_win32):
Use Fmake_coding_system_internal, not Fmake_coding_system.
* general-slots.h: Add Qsucceeded, Qunencodable, Qinvalid_sequence
here.
* file-coding.h (enum coding_system_variant):
Add fixed_width_coding_system here.
(struct coding_system_methods):
Add query_method and query_lstream_method to the coding system
methods.
Provide flags for the query methods.
Declare the default query method; initialise it correctly in
INITIALIZE_CODING_SYSTEM_TYPE.
* file-coding.c (default_query_method):
New function, the default query method for coding systems that do
not set it. Moved from coding.el.
(make_coding_system_1):
Accept new elements in PROPS in #'make-coding-system; aliases, a
list of aliases; safe-chars and safe-charsets (these were
previously accepted but not saved); and category.
(Fmake_coding_system_internal):
New function, what used to be #'make-coding-system--on Mule
builds, we've now moved some of the functionality of this to
Lisp.
(Fcoding_system_canonical_name_p):
Move this earlier in the file, since it's now called from within
make_coding_system_1.
(Fquery_coding_region):
Move the implementation of this here, from coding.el.
(complex_vars_of_file_coding):
Call Fmake_coding_system_internal, not Fmake_coding_system;
specify safe-charsets properties when we're a mule build.
* extents.h (mouse_highlight_priority, Fset_extent_priority,
Fset_extent_face, Fmap_extents):
Make these available to other C files.
lisp/ChangeLog addition:
2009-09-19 Aidan Kehoe <kehoea@parhasard.net>
Move the #'query-coding-region implementation to C.
* coding.el:
Consolidate code that depends on the presence or absence of Mule
at the end of this file.
(default-query-coding-region, query-coding-region):
Move these functions to C.
(default-query-coding-region-safe-charset-skip-chars-map):
Remove this variable, the corresponding C variable is
Vdefault_query_coding_region_chartab_cache in file-coding.c.
(query-coding-string): Update docstring to reflect actual multiple
values, be more careful about not modifying a range table that
we're currently mapping over.
(encode-coding-char): Make the implementation of this simpler.
(featurep 'mule): Autoload #'make-coding-system from
mule/make-coding-system.el if we're a mule build; provide an
appropriate compiler macro.
Do various non-mule compatibility things if we're not a mule
build.
* update-elc.el (additional-dump-dependencies):
Add mule/make-coding-system as a dump time dependency if we're a
mule build.
* unicode.el (ccl-encode-to-ucs-2):
(decode-char):
(encode-char):
Move these earlier in the file, for the sake of some byte compile
warnings.
(unicode-query-coding-region):
Move this to unicode.c
* mule/make-coding-system.el:
New file, not dumped. Contains the functionality to rework the
arguments necessary for fixed-width coding systems, and contains
the implementation of #'make-coding-system, which now calls
#'make-coding-system-internal.
* mule/vietnamese.el (viscii):
* mule/latin.el (iso-8859-2):
(windows-1250):
(iso-8859-3):
(iso-8859-4):
(iso-8859-14):
(iso-8859-15):
(iso-8859-16):
(iso-8859-9):
(macintosh):
(windows-1252):
* mule/hebrew.el (iso-8859-8):
* mule/greek.el (iso-8859-7):
(windows-1253):
* mule/cyrillic.el (iso-8859-5):
(koi8-r):
(koi8-u):
(windows-1251):
(alternativnyj):
(koi8-ru):
(koi8-t):
(koi8-c):
(koi8-o):
* mule/arabic.el (iso-8859-6):
(windows-1256):
Move all these coding systems to being of type fixed-width, not of
type CCL. This allows the distinct query-coding-region for them to
be in C, something which will eventually allow us to implement
query-coding-region for the mswindows-multibyte coding systems.
* mule/general-late.el (posix-charset-to-coding-system-hash):
Document why we're pre-emptively persuading the byte compiler that
the ELC for this file needs to be written using escape-quoted.
Call #'set-unicode-query-skip-chars-args, now the Unicode
query-coding-region implementation is in C.
* mule/thai-xtis.el (tis-620):
Don't bother checking whether we're XEmacs or not here.
* mule/mule-coding.el:
Move the eight bit fixed-width functionality from this file to
make-coding-system.el.
tests/ChangeLog addition:
2009-09-19 Aidan Kehoe <kehoea@parhasard.net>
* automated/mule-tests.el:
Check a coding system's type, not an 8-bit-fixed property, for
whether that coding system should be treated as a fixed-width
coding system.
* automated/query-coding-tests.el:
Don't test the query coding functionality for mswindows-multibyte
coding systems, it's not yet implemented.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 19 Sep 2009 22:53:13 +0100 |
| parents | 23ef20edf6ba |
| children | 50861fea97f6 |
| rev | line source |
|---|---|
| 771 | 1 : #-*- Perl -*- |
| 2 | |
| 3 ### make-mswin-unicode --- generate Unicode-encapsulation code for MS Windows | |
| 4 | |
| 2367 | 5 ## Copyright (C) 2001, 2002, 2004 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). | |
| 71 skip indicates a function we support manually; only a comment about this | |
| 72 will be generated. | |
| 73 split indicates a function with a split structure (different versions | |
| 74 for Unicode and ANSI), but where the only difference is in pointer | |
| 75 types, and the actual size does not differ. The structure name | |
| 76 should follow the function name, and it will be automatically | |
| 77 Unicode-encapsulated with appropriate casts. | |
| 78 begin-bracket indicates a #if statement to be inserted here. | |
| 79 end-bracket indicates the corresponding #endif statement. | |
| 80 blank lines and lines beginning with // are ignored. | |
| 81 "; | |
| 82 | |
| 83 # ------------------ process command-line options ------------------ | |
| 84 | |
| 85 my %options; | |
| 86 my @SAVE_ARGV = @ARGV; | |
| 87 | |
| 88 $Getopt::Long::ignorecase = 0; | |
| 89 &GetOptions ( | |
| 90 \%options, | |
| 91 'c-output=s', | |
| 92 'h-output=s', | |
| 778 | 93 'includedir=s', |
| 771 | 94 'help', |
| 95 ); | |
| 96 | |
| 97 die $usage if $options{"help"}; | |
| 98 | |
| 99 my $in_script; | |
| 100 my $slurp; | |
| 101 | |
| 778 | 102 my ($cout, $hout, $dir) = ($options{"c-output"}, |
| 103 $options{"h-output"}, | |
| 104 $options{"includedir"}); | |
| 105 if (!$dir) | |
| 106 { | |
|
4467
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
107 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
|
108 { |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
109 if (defined $ENV{$sdkroot}) { |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
110 $dir = $ENV{$sdkroot}; |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
111 last; |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
112 } |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
113 } |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
114 unless (defined $dir) |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
115 { |
|
23ef20edf6ba
Check %WindowsSdkDir%, %MSSddk% for the Windows header files too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3728
diff
changeset
|
116 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
|
117 } |
| 778 | 118 $dir.='/include'; |
| 119 } | |
| 3728 | 120 die "Can't find MSVC include files in \"$dir\"" unless ((-f $dir.'/WINDOWS.H') || (-f $dir.'/windows.h')); |
| 771 | 121 |
| 122 open (COUT, ">$cout") or die "Can't open C output file $cout: $!"; | |
| 123 open (HOUT, ">$hout") or die "Can't open C output file $hout: $!"; | |
| 124 | |
| 125 select (STDOUT); $| = 1; | |
| 126 | |
| 127 print COUT "/* Automatically-generated Unicode-encapsulation file, | |
| 128 using the command | |
| 129 | |
| 130 $myPath$myName @SAVE_ARGV | |
| 131 | |
| 132 Do not edit. See `$myName'. | |
| 133 */ | |
| 134 | |
| 135 #include <config.h> | |
| 136 #include \"lisp.h\" | |
| 137 | |
| 138 #include \"syswindows.h\" | |
| 139 | |
| 140 "; | |
| 141 print HOUT "/* Automatically-generated Unicode-encapsulation header file. | |
| 142 Do not edit. See `$myName'. | |
| 143 */\n\n"; | |
| 144 | |
| 145 my %files; | |
| 146 my %processed; | |
| 147 my %bracket; | |
| 148 | |
| 149 my $current_file; | |
| 150 my @current_bracket; | |
| 151 | |
| 152 while (<>) | |
| 153 { | |
| 154 chomp; | |
| 800 | 155 # remove trailing CR. #### Should not be necessary! Perl should be |
| 156 # opening these in text mode by default, as the docs claim, and | |
| 157 # automatically remove the CR's. | |
| 158 tr/\r//d; | |
| 771 | 159 |
| 160 if (/^begin-unicode-encapsulation-script$/) | |
| 161 { | |
| 162 $in_script = 1; | |
| 163 } | |
| 164 elsif (/^end-unicode-encapsulation-script$/) | |
| 165 { | |
| 166 $in_script = 0; | |
| 167 } | |
| 168 elsif ($in_script) | |
| 169 { | |
| 170 next if (m!^//!); | |
| 171 next if (/^[ \t]*$/); | |
| 778 | 172 if (/(file|yes|soon|no|skip|split|begin-bracket|end-bracket)(?: (.*))?/) |
| 771 | 173 { |
| 174 my ($command, $parms) = ($1, $2); | |
| 778 | 175 if ($command eq "file") |
| 771 | 176 { |
| 177 $current_file = $parms; | |
| 178 } | |
| 179 elsif ($command eq "begin-bracket") | |
| 180 { | |
| 181 my $current_bracket = $current_bracket[$#current_bracket]; | |
| 182 if (defined ($current_bracket)) | |
| 183 { | |
| 184 $current_bracket .= "&& $parms"; | |
| 185 } | |
| 186 else | |
| 187 { | |
| 188 $current_bracket = "$parms"; | |
| 189 } | |
| 190 push @current_bracket, $current_bracket; | |
| 191 } | |
| 192 elsif ($command eq "end-bracket") | |
| 193 { | |
| 194 pop @current_bracket; | |
| 195 } | |
| 196 else | |
| 197 { | |
| 198 my ($fun, $reason) = split /\s+/, $parms, 2; | |
| 199 $files{$current_file}{$fun} = [$command, $reason]; | |
| 200 $bracket{$current_file}{$fun} = | |
| 201 $current_bracket[$#current_bracket]; | |
| 202 } | |
| 203 } | |
| 204 else | |
| 205 { | |
| 206 print "WARNING: Unknown line $_\n"; | |
| 207 } | |
| 208 } | |
| 209 } | |
| 210 | |
| 211 | |
| 212 foreach my $file (keys %files) | |
| 213 { | |
| 214 $slurp = &FileContents ($file); | |
| 215 print "Processing file $file\n"; | |
| 216 print HOUT "\n/* Processing file $file */\n\n"; | |
| 217 my $totalspace = 70 - length ("Processing file $file"); | |
| 218 $totalspace = 0 if $totalspace < 0; | |
| 219 my $alignspaceleft = $totalspace / 2; | |
| 220 my $alignspaceright = ($totalspace + 1) / 2; | |
| 221 print COUT " | |
| 222 /*----------------------------------------------------------------------*/ | |
| 223 /*" . (" " x $alignspaceleft) . "Processing file $file" . | |
| 224 (" " x $alignspaceright) . "*/ | |
| 225 /*----------------------------------------------------------------------*/ | |
| 226 | |
| 227 "; | |
| 228 | |
| 229 my ($ws_re, $must_ws_re, $tok_ch) = | |
| 230 ("\\s*", "\\s+", "\\w"); | |
| 231 # unfortunately there is no surefire way short of | |
| 232 # parsing all include files for typedefs to | |
| 233 # distinguish types from parameters, and prototypes | |
| 234 # appear in the include files both with and without | |
| 235 # parameters -- the latter kinds appear in a very | |
| 236 # different style and were obviously added later. so | |
| 237 # we rely on the fact that defined types are all | |
| 238 # upper-case, and parameters generally are not, and | |
| 239 # special-case the exceptions. | |
| 240 my $typeword_re = | |
| 241 # note the negative lookahead assertions: the first | |
| 242 # one excludes the words "X" and "Y" from type | |
| 243 # words, since they appear as parameter names in | |
| 244 # CreateWindowEx; the second prevents "void | |
| 245 # *Argument" from being parsed as a type "void *A" | |
| 246 # followed by a parameter "rgument". | |
| 247 "(?:(?!(?:X\\b|Y\\b))(?:unsigned|int|long|short|va_list|[A-Z_0-9]+)(?!${tok_ch}))"; | |
| 248 my $typetoken_re = "(?:$typeword_re$ws_re\\**$ws_re)"; | |
| 249 my $arg_re = "(?:($typetoken_re+)(${tok_ch}+)?(?: OPTIONAL)?)"; | |
| 250 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})\\);"; | |
| 251 | |
| 252 # print "regexp: $fun_re\n"; | |
| 253 while ($slurp =~ /$fun_re/g) | |
| 254 { | |
| 255 my ($rettype, $fun, $args) = ($1, $2, $3); | |
| 256 $processed{$fun} = 1; | |
| 257 print "Processing: $fun"; | |
| 258 | |
| 259 my ($command, $reason) = ($files{$file}{$fun}[0], $files{$file}{$fun}[1]); | |
| 260 if (!defined ($command)) | |
| 261 { | |
| 262 print " (no command found)\n"; | |
| 263 } | |
| 264 else | |
| 265 { | |
| 266 print "\n"; | |
| 267 my $bracket = $bracket{$file}{$fun}; | |
| 268 if (defined ($bracket)) | |
| 269 { | |
| 270 print HOUT "#if $bracket\n"; | |
| 271 print COUT "#if $bracket\n\n"; | |
| 272 } | |
| 273 if ($command eq "no") | |
| 274 { | |
| 275 if (!defined ($reason)) | |
| 276 { | |
| 277 print "WARNING: No reason given for `no' with function $fun\n"; | |
| 278 $reason = ""; | |
| 279 } | |
| 280 | |
| 281 print HOUT "#undef $fun\n"; | |
| 2367 | 282 (my $munged_reason = $reason) =~ s/[^A-Za-z0-9]/_/g; |
| 283 print HOUT "#define $fun error_$munged_reason\n"; | |
| 771 | 284 print COUT "/* Error if $fun used: $reason */\n\n"; |
| 285 } | |
| 286 elsif ($command eq "skip") | |
| 287 { | |
| 288 if (!defined ($reason)) | |
| 289 { | |
| 290 print "WARNING: No reason given for `skip' with function $fun\n"; | |
| 291 $reason = ""; | |
| 292 } | |
| 293 | |
| 294 print HOUT "/* Skipping $fun because $reason */\n"; | |
| 295 print COUT "/* Skipping $fun because $reason */\n\n"; | |
| 296 } | |
| 297 elsif ($command eq "soon") | |
| 298 { | |
| 299 $reason = "" if !defined ($reason); | |
| 300 | |
| 301 print HOUT "/* Not yet: $fun $reason */\n"; | |
| 302 print COUT "/* Not yet: $fun $reason */\n\n"; | |
| 303 } | |
| 304 else | |
| 305 { | |
| 306 my (@args, %argtype, %ansiarg, %xarg, $split_struct, | |
| 307 $split_rettype); | |
| 308 if ($command eq "split") | |
| 309 { | |
| 310 ($split_struct, $reason) = split /\s+/, $reason, 2; | |
| 311 } | |
| 312 my $argno = 0; | |
| 313 while ($args =~ /$arg_re/g) | |
| 314 { | |
| 315 $argno++; | |
| 316 my ($argtype, $argname) = ($1, $2); | |
| 317 $argtype =~ s/\s*$//; | |
| 318 next if $argtype eq "void" || $argtype eq "VOID"; | |
| 319 $argname = "arg$argno" if !defined ($argname); | |
| 320 $argtype{$argname} = $argtype; | |
| 321 $ansiarg{$argname} = $argtype; | |
| 322 $ansiarg{$argname} =~ s/\bLPWSTR\b/LPSTR/; | |
| 323 $ansiarg{$argname} =~ s/\bLPCWSTR\b/LPCSTR/; | |
| 324 $xarg{$argname} = $argtype; | |
| 325 $xarg{$argname} =~ s/\bLPWSTR\b/Extbyte */; | |
| 326 $xarg{$argname} =~ s/\bLPCWSTR\b/const Extbyte */; | |
| 327 if (defined ($split_struct)) | |
| 328 { | |
| 329 my $fuck_cperl1 = "\\b${split_struct}W\\b"; | |
| 330 my $fuck_cperl2 = "${split_struct}A"; | |
| 331 $ansiarg{$argname} =~ s/$fuck_cperl1/$fuck_cperl2/; | |
| 332 } | |
| 333 push @args, $argname; | |
| 334 } | |
| 335 $rettype =~ s/\bSHSTDAPI_\((.*)\)/$1/; | |
| 336 $rettype =~ s/\s*WIN\w*?API\s*//g; | |
| 337 $rettype =~ s/\bAPIENTRY\b//; | |
| 338 $rettype =~ s/\bSHSTDAPI\b/HRESULT/; | |
| 339 if ($rettype =~ /LPC?WSTR/) | |
| 340 { | |
| 341 $split_rettype = 1; | |
| 342 $rettype =~ s/\bLPWSTR\b/Extbyte */; | |
| 343 $rettype =~ s/\bLPCWSTR\b/const Extbyte */; | |
| 344 } | |
| 800 | 345 print HOUT "#ifdef ERROR_WHEN_NONINTERCEPTED_FUNS_USED\n"; |
| 346 print HOUT "#undef $fun\n"; | |
| 2367 | 347 print HOUT "#define $fun error_use_qxe${fun}_or_${fun}A_and_${fun}W\n"; |
| 800 | 348 print HOUT "#endif\n"; |
| 771 | 349 if (defined ($reason)) |
| 350 { | |
| 351 print COUT "/* NOTE: $reason */\n"; | |
| 352 } | |
| 353 print COUT "$rettype\nqxe$fun ("; | |
| 354 print HOUT "$rettype qxe$fun ("; | |
| 355 my $first = 1; | |
| 356 if (!@args) | |
| 357 { | |
| 358 print COUT "void"; | |
| 359 print HOUT "void"; | |
| 360 } | |
| 361 else | |
| 362 { | |
| 363 foreach my $x (@args) | |
| 364 { | |
| 365 print COUT ", " if !$first; | |
| 366 print HOUT ", " if !$first; | |
| 367 $first = 0; | |
| 368 print COUT "$xarg{$x} $x"; | |
| 369 print HOUT "$xarg{$x} $x"; | |
| 370 } | |
| 371 } | |
| 372 print HOUT ");\n"; | |
| 373 print COUT ")\n{\n if (XEUNICODE_P)\n "; | |
| 374 if ($rettype ne "void" && $rettype ne "VOID") | |
| 375 { | |
| 376 print COUT "return "; | |
| 377 print COUT "($rettype) " if $split_rettype; | |
| 378 } | |
| 379 print COUT "${fun}W ("; | |
| 380 $first = 1; | |
| 381 foreach my $x (@args) | |
| 382 { | |
| 383 print COUT ", " if !$first; | |
| 384 $first = 0; | |
| 385 print COUT ($argtype{$x} eq $xarg{$x} ? $x : | |
| 386 "($argtype{$x}) $x"); | |
| 387 } | |
| 388 print COUT ");\n else\n "; | |
| 389 if ($rettype ne "void" && $rettype ne "VOID") | |
| 390 { | |
| 391 print COUT "return "; | |
| 392 print COUT "($rettype) " if $split_rettype; | |
| 393 } | |
| 394 print COUT "${fun}A ("; | |
| 395 $first = 1; | |
| 396 foreach my $x (@args) | |
| 397 { | |
| 398 print COUT ", " if !$first; | |
| 399 $first = 0; | |
| 400 print COUT ($argtype{$x} eq $ansiarg{$x} ? $x : | |
| 401 "($ansiarg{$x}) $x"); | |
| 402 } | |
| 403 print COUT ");\n}\n\n"; | |
| 404 } | |
| 405 if (defined ($bracket)) | |
| 406 { | |
| 407 print HOUT "#endif /* $bracket */\n"; | |
| 408 print COUT "#endif /* $bracket */\n\n"; | |
| 409 } | |
| 800 | 410 print HOUT "\n"; |
| 771 | 411 } |
| 412 } | |
| 413 } | |
| 414 | |
| 415 foreach my $file (keys %files) | |
| 416 { | |
| 417 foreach my $fun (keys %{$files{$file}}) | |
| 418 { | |
| 419 if (!$processed{$fun} && $files{$file}{$fun}[0] =~ /^(yes|soon|split)$/) | |
| 420 { | |
| 421 print "WARNING: Can't locate prototype for $fun\n"; | |
| 422 } | |
| 423 } | |
| 424 } | |
| 425 | |
| 426 | |
| 427 sub FileContents | |
| 428 { | |
| 429 local $/ = undef; | |
| 778 | 430 open (FILE, "< $dir/$_[0]") or die "$dir/$_[0]: $!"; |
| 771 | 431 my $retval = scalar <FILE>; |
| 432 # must hack away CRLF junk. | |
| 433 $retval =~ s/\r\n/\n/g; | |
| 434 return $retval; | |
| 435 } |