From: Rudi Schlatte <rudi@constantly.at>
Date: Wed, 22 Mar 2006 11:39:27 +0000 (+0000)
Subject: 0.9.10.47
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=766970bdf375cc3fd28c6abc049f48a7dd9e0564;p=sbcl.git

0.9.10.47
    Merge "Re: [Sbcl-devel] WIN32 patch v.2. - part1" (sbcl-devel 2006-03-22)
    ... Get external format for *stdin*, *stdout*, *stderr* via appropriate
        API calls
    ... cosmetic change: s/cp/codepage/ throughout
---

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index efa1d05..9503594 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -2120,11 +2120,14 @@
   (setf *available-buffers* nil)
   (with-output-to-string (*error-output*)
     (setf *stdin*
-          (make-fd-stream 0 :name "standard input" :input t :buffering :line))
+          (make-fd-stream 0 :name "standard input" :input t :buffering :line
+                            #!+win32 :external-format #!+win32 (sb!win32::console-input-codepage)))
     (setf *stdout*
-          (make-fd-stream 1 :name "standard output" :output t :buffering :line))
+          (make-fd-stream 1 :name "standard output" :output t :buffering :line
+                            #!+win32 :external-format #!+win32 (sb!win32::console-output-codepage)))
     (setf *stderr*
-          (make-fd-stream 2 :name "standard error" :output t :buffering :line))
+          (make-fd-stream 2 :name "standard error" :output t :buffering :line
+                            #!+win32 :external-format #!+win32 (sb!win32::console-output-codepage)))
     (let* ((ttyname #.(coerce "/dev/tty" 'simple-base-string))
            (tty (sb!unix:unix-open ttyname sb!unix:o_rdwr #o666)))
       (if tty
diff --git a/src/code/octets.lisp b/src/code/octets.lisp
index 922e8eb..b86a1be 100644
--- a/src/code/octets.lisp
+++ b/src/code/octets.lisp
@@ -649,7 +649,7 @@ one-past-the-end"
                                                   "LATIN-1")
                                               "KEYWORD")
                              #!+win32
-                               #!+sb-unicode (sb!win32::ansi-cp)
+                               #!+sb-unicode (sb!win32::ansi-codepage)
                                #!-sb-unicode :LATIN-1))
         (/show0 "cold-printing defaulted external-format:")
         #!+sb-show
diff --git a/src/code/win32.lisp b/src/code/win32.lisp
index eaa54df..4176938 100644
--- a/src/code/win32.lisp
+++ b/src/code/win32.lisp
@@ -151,11 +151,11 @@
 (define-alien-routine ("Sleep@4" millisleep) void
   (milliseconds dword))
 
-#!+sb-unicode (defvar *ANSI-CP* nil)
-#!+sb-unicode (defvar *OEM-CP* nil)
+#!+sb-unicode (defvar *ANSI-CODEPAGE* nil)
+#!+sb-unicode (defvar *OEM-CODEPAGE* nil)
 
 #!+sb-unicode
-(defparameter *cp-to-external-format* (make-hash-table))
+(defparameter *codepage-to-external-format* (make-hash-table))
 
 #!+sb-unicode
 (dolist (cp
@@ -309,26 +309,42 @@
     ;;57011     ISCII Punjabi
     ;;65000     Unicode UTF-7
     (65001 :UTF8))) ;; Unicode UTF-8
-  (setf (gethash (car cp) *cp-to-external-format*) (cadr cp)))
+  (setf (gethash (car cp) *codepage-to-external-format*) (cadr cp)))
 
 #!+sb-unicode
-(declaim (ftype (function () keyword) ansi-cp))
+(declaim (ftype (function () keyword) ansi-codepage))
 #!+sb-unicode
-(defun ansi-cp ()
-  (or *ANSI-CP*
-      (setq *ANSI-CP*
+(defun ansi-codepage ()
+  (or *ANSI-CODEPAGE*
+      (setq *ANSI-CODEPAGE*
         (or
           (gethash (alien-funcall (extern-alien "GetACP@0" (function UINT)))
-                   *cp-to-external-format*)
+                   *codepage-to-external-format*)
           :LATIN-1))))
 
 #!+sb-unicode
-(declaim (ftype (function () keyword) oem-cp))
+(declaim (ftype (function () keyword) oem-codepage))
 #!+sb-unicode
-(defun oem-cp ()
-  (or *OEM-CP*
-      (setq *OEM-CP*
+(defun oem-codepage ()
+  (or *OEM-CODEPAGE*
+      (setq *OEM-CODEPAGE*
         (or
           (gethash (alien-funcall (extern-alien "GetOEMCP@0" (function UINT)))
-                   *cp-to-external-format*)
+                   *codepage-to-external-format*)
           :LATIN-1))))
+
+;; http://msdn.microsoft.com/library/en-us/dllproc/base/getconsolecp.asp
+(declaim (ftype (function () keyword) console-input-codepage))
+(defun console-input-codepage ()
+  (or #!+sb-unicode
+      (gethash (alien-funcall (extern-alien "GetConsoleCP@0" (function UINT)))
+               *codepage-to-external-format*)
+      :LATIN-1))
+
+;; http://msdn.microsoft.com/library/en-us/dllproc/base/getconsoleoutputcp.asp
+(declaim (ftype (function () keyword) console-output-codepage))
+(defun console-output-codepage ()
+  (or #!+sb-unicode
+      (gethash (alien-funcall (extern-alien "GetConsoleOutputCP@0" (function UINT)))
+               *codepage-to-external-format*)
+      :LATIN-1))
diff --git a/src/runtime/win32-os.c b/src/runtime/win32-os.c
index 9c3f594..0073c60 100644
--- a/src/runtime/win32-os.c
+++ b/src/runtime/win32-os.c
@@ -641,6 +641,8 @@ void scratch(void)
     Sleep(0);
     GetACP();
     GetOEMCP();
+    GetConsoleCP();
+    GetConsoleOutputCP();
 }
 
 char *
diff --git a/version.lisp-expr b/version.lisp-expr
index 62dc10f..a886493 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.46"
+"0.9.10.47"