Commit dfaba352 authored by Rudi Schlatte's avatar Rudi Schlatte
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
parent 83af803d
Loading
Loading
Loading
Loading
+10 −7
Original line number Diff line number Diff line
@@ -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
      (let ((external-format #!-win32 (intern (or (sb!alien:alien-funcall
                                                    (extern-alien
                                                      "nl_langinfo"
                                                      (function c-string int))
                                                    sb!unix:codeset)
                                                  "LATIN-1")
                                     "KEYWORD")))
                                              "KEYWORD")
                             #!+win32
                               #!+sb-unicode (sb!win32::ansi-cp)
                               #!-sb-unicode :LATIN-1))
        (/show0 "cold-printing defaulted external-format:")
        #!+sb-show
        (cold-print external-format)
+183 −0
Original line number Diff line number Diff line
@@ -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))))
+2 −0
Original line number Diff line number Diff line
@@ -639,6 +639,8 @@ void scratch(void)
    FlushConsoleInputBuffer(0);
    PeekConsoleInput(0, 0, 0, 0);
    Sleep(0);
    GetACP();
    GetOEMCP();
}

char *
+1 −1
Original line number Diff line number Diff line
@@ -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"