From: Rudi Schlatte Date: Tue, 21 Mar 2006 15:51:51 +0000 (+0000) Subject: 0.9.10.46 X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=dfaba352352815b4fbce2bfc281b4023d0de0553;p=sbcl.git 0.9.10.46 Commit sbcl-devel "WIN32 patch v.2. - part1 v.2." ... get default-external-format via api calls on win32 --- diff --git a/src/code/octets.lisp b/src/code/octets.lisp index e768fb3..922e8eb 100644 --- a/src/code/octets.lisp +++ b/src/code/octets.lisp @@ -641,13 +641,16 @@ one-past-the-end" (defun default-external-format () (or *default-external-format* - (let ((external-format (intern (or #!-win32 (sb!alien:alien-funcall - (extern-alien - "nl_langinfo" - (function c-string int)) - sb!unix:codeset) - "LATIN-1") - "KEYWORD"))) + (let ((external-format #!-win32 (intern (or (sb!alien:alien-funcall + (extern-alien + "nl_langinfo" + (function c-string int)) + sb!unix:codeset) + "LATIN-1") + "KEYWORD") + #!+win32 + #!+sb-unicode (sb!win32::ansi-cp) + #!-sb-unicode :LATIN-1)) (/show0 "cold-printing defaulted external-format:") #!+sb-show (cold-print external-format) diff --git a/src/code/win32.lisp b/src/code/win32.lisp index 34ee5ca..eaa54df 100644 --- a/src/code/win32.lisp +++ b/src/code/win32.lisp @@ -20,6 +20,7 @@ (define-alien-type handle int-ptr) (define-alien-type dword unsigned-long) (define-alien-type bool int) +(define-alien-type UINT unsigned-int) ;;; HANDLEs are actually pointers, but an invalid handle is -1 cast ;;; to a pointer. @@ -149,3 +150,185 @@ ;;; Sleep for MILLISECONDS milliseconds. (define-alien-routine ("Sleep@4" millisleep) void (milliseconds dword)) + +#!+sb-unicode (defvar *ANSI-CP* nil) +#!+sb-unicode (defvar *OEM-CP* nil) + +#!+sb-unicode +(defparameter *cp-to-external-format* (make-hash-table)) + +#!+sb-unicode +(dolist (cp + '(;;037 IBM EBCDIC - U.S./Canada + (437 :CP437) ;; OEM - United States + ;;500 IBM EBCDIC - International + ;;708 Arabic - ASMO 708 + ;;709 Arabic - ASMO 449+, BCON V4 + ;;710 Arabic - Transparent Arabic + ;;720 Arabic - Transparent ASMO + ;;737 OEM - Greek (formerly 437G) + ;;775 OEM - Baltic + (850 :CP850) ;; OEM - Multilingual Latin I + (852 :CP852) ;; OEM - Latin II + (855 :CP855) ;; OEM - Cyrillic (primarily Russian) + (857 :CP857) ;; OEM - Turkish + ;;858 OEM - Multilingual Latin I + Euro symbol + (860 :CP860) ;; OEM - Portuguese + (861 :CP861) ;; OEM - Icelandic + (862 :CP862) ;; OEM - Hebrew + (863 :CP863) ;; OEM - Canadian-French + (864 :CP864) ;; OEM - Arabic + (865 :CP865) ;; OEM - Nordic + (866 :CP866) ;; OEM - Russian + (869 :CP869) ;; OEM - Modern Greek + ;;870 IBM EBCDIC - Multilingual/ROECE (Latin-2) + (874 :CP874) ;; ANSI/OEM - Thai (same as 28605, ISO 8859-15) + ;;875 IBM EBCDIC - Modern Greek + ;;932 ANSI/OEM - Japanese, Shift-JIS + ;;936 ANSI/OEM - Simplified Chinese (PRC, Singapore) + ;;949 ANSI/OEM - Korean (Unified Hangul Code) + ;;950 ANSI/OEM - Traditional Chinese (Taiwan; Hong Kong SAR, PRC) + ;;1026 IBM EBCDIC - Turkish (Latin-5) + ;;1047 IBM EBCDIC - Latin 1/Open System + ;;1140 IBM EBCDIC - U.S./Canada (037 + Euro symbol) + ;;1141 IBM EBCDIC - Germany (20273 + Euro symbol) + ;;1142 IBM EBCDIC - Denmark/Norway (20277 + Euro symbol) + ;;1143 IBM EBCDIC - Finland/Sweden (20278 + Euro symbol) + ;;1144 IBM EBCDIC - Italy (20280 + Euro symbol) + ;;1145 IBM EBCDIC - Latin America/Spain (20284 + Euro symbol) + ;;1146 IBM EBCDIC - United Kingdom (20285 + Euro symbol) + ;;1147 IBM EBCDIC - France (20297 + Euro symbol) + ;;1148 IBM EBCDIC - International (500 + Euro symbol) + ;;1149 IBM EBCDIC - Icelandic (20871 + Euro symbol) + ;;1200 Unicode UCS-2 Little-Endian (BMP of ISO 10646) + ;;1201 Unicode UCS-2 Big-Endian + (1250 :CP1250) ;; ANSI - Central European + (1251 :CP1251) ;; ANSI - Cyrillic + (1252 :CP1252) ;; ANSI - Latin I + (1253 :CP1253) ;; ANSI - Greek + (1254 :CP1254) ;; ANSI - Turkish + (1255 :CP1255) ;; ANSI - Hebrew + (1256 :CP1256) ;; ANSI - Arabic + (1257 :CP1257) ;; ANSI - Baltic + (1258 :CP1258) ;; ANSI/OEM - Vietnamese + ;;1361 Korean (Johab) + ;;10000 MAC - Roman + ;;10001 MAC - Japanese + ;;10002 MAC - Traditional Chinese (Big5) + ;;10003 MAC - Korean + ;;10004 MAC - Arabic + ;;10005 MAC - Hebrew + ;;10006 MAC - Greek I + (10007 :X-MAC-CYRILLIC) ;; MAC - Cyrillic + ;;10008 MAC - Simplified Chinese (GB 2312) + ;;10010 MAC - Romania + ;;10017 MAC - Ukraine + ;;10021 MAC - Thai + ;;10029 MAC - Latin II + ;;10079 MAC - Icelandic + ;;10081 MAC - Turkish + ;;10082 MAC - Croatia + ;;12000 Unicode UCS-4 Little-Endian + ;;12001 Unicode UCS-4 Big-Endian + ;;20000 CNS - Taiwan + ;;20001 TCA - Taiwan + ;;20002 Eten - Taiwan + ;;20003 IBM5550 - Taiwan + ;;20004 TeleText - Taiwan + ;;20005 Wang - Taiwan + ;;20105 IA5 IRV International Alphabet No. 5 (7-bit) + ;;20106 IA5 German (7-bit) + ;;20107 IA5 Swedish (7-bit) + ;;20108 IA5 Norwegian (7-bit) + ;;20127 US-ASCII (7-bit) + ;;20261 T.61 + ;;20269 ISO 6937 Non-Spacing Accent + ;;20273 IBM EBCDIC - Germany + ;;20277 IBM EBCDIC - Denmark/Norway + ;;20278 IBM EBCDIC - Finland/Sweden + ;;20280 IBM EBCDIC - Italy + ;;20284 IBM EBCDIC - Latin America/Spain + ;;20285 IBM EBCDIC - United Kingdom + ;;20290 IBM EBCDIC - Japanese Katakana Extended + ;;20297 IBM EBCDIC - France + ;;20420 IBM EBCDIC - Arabic + ;;20423 IBM EBCDIC - Greek + ;;20424 IBM EBCDIC - Hebrew + ;;20833 IBM EBCDIC - Korean Extended + ;;20838 IBM EBCDIC - Thai + (20866 :KOI8-R) ;; Russian - KOI8-R + ;;20871 IBM EBCDIC - Icelandic + ;;20880 IBM EBCDIC - Cyrillic (Russian) + ;;20905 IBM EBCDIC - Turkish + ;;20924 IBM EBCDIC - Latin-1/Open System (1047 + Euro symbol) + ;;20932 JIS X 0208-1990 & 0121-1990 + ;;20936 Simplified Chinese (GB2312) + ;;21025 IBM EBCDIC - Cyrillic (Serbian, Bulgarian) + ;;21027 (deprecated) + (21866 :KOI8-U) ;; Ukrainian (KOI8-U) + (28591 :LATIN-1) ;; ISO 8859-1 Latin I + (28592 :ISO-8859-2) ;; ISO 8859-2 Central Europe + (28593 :ISO-8859-3) ;; ISO 8859-3 Latin 3 + (28594 :ISO-8859-4) ;; ISO 8859-4 Baltic + (28595 :ISO-8859-5) ;; ISO 8859-5 Cyrillic + (28596 :ISO-8859-6) ;; ISO 8859-6 Arabic + (28597 :ISO-8859-7) ;; ISO 8859-7 Greek + (28598 :ISO-8859-8) ;; ISO 8859-8 Hebrew + (28599 :ISO-8859-9) ;; ISO 8859-9 Latin 5 + (28605 :LATIN-9) ;; ISO 8859-15 Latin 9 + ;;29001 Europa 3 + (38598 :ISO-8859-8) ;; ISO 8859-8 Hebrew + ;;50220 ISO 2022 Japanese with no halfwidth Katakana + ;;50221 ISO 2022 Japanese with halfwidth Katakana + ;;50222 ISO 2022 Japanese JIS X 0201-1989 + ;;50225 ISO 2022 Korean + ;;50227 ISO 2022 Simplified Chinese + ;;50229 ISO 2022 Traditional Chinese + ;;50930 Japanese (Katakana) Extended + ;;50931 US/Canada and Japanese + ;;50933 Korean Extended and Korean + ;;50935 Simplified Chinese Extended and Simplified Chinese + ;;50936 Simplified Chinese + ;;50937 US/Canada and Traditional Chinese + ;;50939 Japanese (Latin) Extended and Japanese + (51932 :EUC-JP) ;; EUC - Japanese + ;;51936 EUC - Simplified Chinese + ;;51949 EUC - Korean + ;;51950 EUC - Traditional Chinese + ;;52936 HZ-GB2312 Simplified Chinese + ;;54936 Windows XP: GB18030 Simplified Chinese (4 Byte) + ;;57002 ISCII Devanagari + ;;57003 ISCII Bengali + ;;57004 ISCII Tamil + ;;57005 ISCII Telugu + ;;57006 ISCII Assamese + ;;57007 ISCII Oriya + ;;57008 ISCII Kannada + ;;57009 ISCII Malayalam + ;;57010 ISCII Gujarati + ;;57011 ISCII Punjabi + ;;65000 Unicode UTF-7 + (65001 :UTF8))) ;; Unicode UTF-8 + (setf (gethash (car cp) *cp-to-external-format*) (cadr cp))) + +#!+sb-unicode +(declaim (ftype (function () keyword) ansi-cp)) +#!+sb-unicode +(defun ansi-cp () + (or *ANSI-CP* + (setq *ANSI-CP* + (or + (gethash (alien-funcall (extern-alien "GetACP@0" (function UINT))) + *cp-to-external-format*) + :LATIN-1)))) + +#!+sb-unicode +(declaim (ftype (function () keyword) oem-cp)) +#!+sb-unicode +(defun oem-cp () + (or *OEM-CP* + (setq *OEM-CP* + (or + (gethash (alien-funcall (extern-alien "GetOEMCP@0" (function UINT))) + *cp-to-external-format*) + :LATIN-1)))) diff --git a/src/runtime/win32-os.c b/src/runtime/win32-os.c index 4af0f79..9c3f594 100644 --- a/src/runtime/win32-os.c +++ b/src/runtime/win32-os.c @@ -639,6 +639,8 @@ void scratch(void) FlushConsoleInputBuffer(0); PeekConsoleInput(0, 0, 0, 0); Sleep(0); + GetACP(); + GetOEMCP(); } char * diff --git a/version.lisp-expr b/version.lisp-expr index aaaf20d..62dc10f 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.10.45" +"0.9.10.46"