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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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"