Permalink
Browse files

0.9.10.46

    Commit sbcl-devel "WIN32 patch v.2. - part1 v.2."
    ... get default-external-format via api calls on win32
  • Loading branch information...
rudi committed Mar 21, 2006
1 parent 83af803 commit dfaba352352815b4fbce2bfc281b4023d0de0553
Showing with 196 additions and 8 deletions.
  1. +10 −7 src/code/octets.lisp
  2. +183 −0 src/code/win32.lisp
  3. +2 −0 src/runtime/win32-os.c
  4. +1 −1 version.lisp-expr
View
@@ -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)
View
@@ -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))))
View
@@ -639,6 +639,8 @@ void scratch(void)
FlushConsoleInputBuffer(0);
PeekConsoleInput(0, 0, 0, 0);
Sleep(0);
+ GetACP();
+ GetOEMCP();
}
char *
View
@@ -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"

0 comments on commit dfaba35

Please sign in to comment.