Mercurial > hg > xemacs-beta
annotate lib-src/make-mswin-unicode.pl @ 5142:f965e31a35f0
reduce lcrecord headers to 2 words, rename printing_unreadable_object
-------------------- ChangeLog entries follow: --------------------
man/ChangeLog addition:
2010-03-13 Ben Wing <ben@xemacs.org>
* internals/internals.texi (Working with Lisp Objects):
* internals/internals.texi (Writing Macros):
* internals/internals.texi (lrecords):
More rewriting to correspond with changes from
*LRECORD* to *LISP_OBJECT*.
modules/ChangeLog addition:
2010-03-13 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c (print_pgconn):
* postgresql/postgresql.c (print_pgresult):
printing_unreadable_object -> printing_unreadable_object_fmt.
2010-03-13 Ben Wing <ben@xemacs.org>
* ldap/eldap.c (print_ldap):
printing_unreadable_object -> printing_unreadable_object_fmt.
src/ChangeLog addition:
2010-03-13 Ben Wing <ben@xemacs.org>
* alloc.c (alloc_sized_lrecord_1):
* alloc.c (alloc_sized_lrecord_array):
* alloc.c (old_alloc_sized_lcrecord):
* alloc.c (disksave_object_finalization_1):
* alloc.c (mark_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (tick_lcrecord_stats):
* alloc.c (sweep_lcrecords_1):
* buffer.c (print_buffer):
* buffer.c (DEFVAR_BUFFER_LOCAL_1):
* casetab.c:
* casetab.c (print_case_table):
* console.c (print_console):
* console.c (DEFVAR_CONSOLE_LOCAL_1):
* data.c (print_weak_list):
* data.c (print_weak_box):
* data.c (print_ephemeron):
* data.c (ephemeron_equal):
* database.c (print_database):
* database.c (finalize_database):
* device-msw.c (sync_printer_with_devmode):
* device-msw.c (print_devmode):
* device-msw.c (finalize_devmode):
* device.c:
* device.c (print_device):
* elhash.c:
* elhash.c (print_hash_table):
* eval.c (print_subr):
* eval.c (print_multiple_value):
* event-stream.c (event_stream_resignal_wakeup):
* events.c (clear_event_resource):
* events.c (zero_event):
* events.c (print_event):
* extents.c:
* extents.c (print_extent):
* file-coding.c (print_coding_system):
* font-mgr.c:
* font-mgr.c (Ffc_init):
* frame.c:
* frame.c (print_frame):
* gc.c:
* gc.c (GC_CHECK_NOT_FREE):
* glyphs.c:
* glyphs.c (print_image_instance):
* glyphs.c (print_glyph):
* gui.c (print_gui_item):
* gui.c (copy_gui_item):
* keymap.c (print_keymap):
* keymap.c (MARKED_SLOT):
* lisp.h:
* lisp.h (struct Lisp_String):
* lisp.h (DEFUN):
* lisp.h (DEFUN_NORETURN):
* lrecord.h:
* lrecord.h (NORMAL_LISP_OBJECT_UID):
* lrecord.h (struct lrecord_header):
* lrecord.h (set_lheader_implementation):
* lrecord.h (struct old_lcrecord_header):
* lrecord.h (struct free_lcrecord_header):
* marker.c (print_marker):
* mule-charset.c:
* mule-charset.c (print_charset):
* objects.c (print_color_instance):
* objects.c (print_font_instance):
* objects.c (finalize_font_instance):
* print.c (print_cons):
* print.c (printing_unreadable_object_fmt):
* print.c (printing_unreadable_lisp_object):
* print.c (external_object_printer):
* print.c (internal_object_printer):
* print.c (debug_p4):
* print.c (ext_print_begin):
* process.c (print_process):
* rangetab.c (print_range_table):
* rangetab.c (range_table_equal):
* scrollbar.c (free_scrollbar_instance):
* specifier.c (print_specifier):
* specifier.c (finalize_specifier):
* symbols.c (guts_of_unbound_marker):
* symeval.h:
* symeval.h (DEFVAR_SYMVAL_FWD):
* tooltalk.c:
* tooltalk.c (print_tooltalk_message):
* tooltalk.c (print_tooltalk_pattern):
* ui-gtk.c (ffi_object_printer):
* ui-gtk.c (emacs_gtk_object_printer):
* ui-gtk.c (emacs_gtk_boxed_printer):
* window.c (print_window):
* window.c (free_window_mirror):
* window.c (debug_print_window):
* xemacs.def.in.in:
(1) printing_unreadable_object -> printing_unreadable_object_fmt.
(2) printing_unreadable_lcrecord -> printing_unreadable_lisp_object
and fix up so it no longer requires an lcrecord.
These previous changes eliminate most of the remaining places where
the terms `lcrecord' and `lrecord' occurred outside of specialized
code.
(3) Fairly major change: Reduce the number of words in an lcrecord
from 3 to 2. The third word consisted of a uid that duplicated the
lrecord uid, and a single free bit, which was moved into the lrecord
structure. This reduces the size of the `uid' slot from 21 bits to
20 bits. Arguably this isn't enough -- we could easily have more than
1,000,000 or so objects created in a session. The answer is
(a) It doesn't really matter if we overflow the uid field because
it's only used for debugging, to identify an object uniquely
(or pretty much so).
(b) If we cared about it overflowing and wanted to reduce this,
we could make it so that cons, string, float and certain other
frob-block types that never print out the uid simply don't
store a uid in them and don't increment the lrecord_uid_counter.
(4) In conjunction with (3), create new macro NORMAL_LISP_OBJECT_UID()
and use it to abstract out the differences between NEWGC and old-GC
in accessing the `uid' value from a "normal Lisp Object pointer".
(5) In events.c, use zero_nonsized_lisp_object() in place of custom-
written equivalent. In font-mgr.c use external_object_printer()
in place of custom-written equivalents.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Sat, 13 Mar 2010 05:38:08 -0600 |
| 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 } |