(unless (zerop (peek-named-pipe handle nil 0 nil (addr avail) nil))
(return-from handle-listen (plusp avail)))
- (unless (zerop (peek-console-input handle
+ (unless (zerop (peek-console-input handle
(cast buf (* t))
input-record-size (addr avail)))
(return-from handle-listen (plusp avail)))
(defvar *codepage-to-external-format* (make-hash-table)))
#+sb-unicode
-(dolist
+(dolist
(cp '(;;037 IBM EBCDIC - U.S./Canada
(437 :CP437) ;; OEM - United States
;;500 IBM EBCDIC - International
(gethash (alien-funcall (extern-alien "GetACP@0" (function UINT)))
*codepage-to-external-format*
:latin-1))))
-
+
(declaim (ftype (function () keyword) oem-codepage))
(defun oem-codepage ()
(or *oem-codepage*
;; http://msdn.microsoft.com/library/en-us/dllproc/base/getconsolecp.asp
(declaim (ftype (function () keyword) console-input-codepage))
-(defun console-input-codepage ()
+(defun console-input-codepage ()
(or #!+sb-unicode
(gethash (alien-funcall (extern-alien "GetConsoleCP@0" (function UINT)))
*codepage-to-external-format*)
(declaim (ftype (function () keyword) console-output-codepage))
(defun console-output-codepage ()
(or #!+sb-unicode
- (gethash (alien-funcall
+ (gethash (alien-funcall
(extern-alien "GetConsoleOutputCP@0" (function UINT)))
*codepage-to-external-format*)
:latin-1))
err-code
(sb!win32::get-last-error-message err-code))))
-(defun get-folder-path (CSIDL)
+(defun get-folder-pathname (csidl)
"http://msdn.microsoft.com/library/en-us/shellcc/platform/shell/reference/functions/shgetfolderpath.asp"
- (with-alien ((apath (* tchar) (make-alien tchar (1+ MAX_PATH))))
+ (with-alien ((apath (* tchar) (make-alien tchar (1+ max_path))))
(alien-funcall
(extern-alien #!-sb-unicode "SHGetFolderPathA@20"
#!+sb-unicode "SHGetFolderPathW@20"
(function int handle int handle dword (* tchar)))
- 0 CSIDL 0 0 apath)
- (concatenate 'string (ucs2->string&free apath) "\\")))
+ 0 csidl 0 0 apath)
+ (parse-native-namestring
+ (concatenate 'string (ucs2->string&free apath) "\\"))))
(defun sb!unix:posix-getcwd ()
- (with-alien ((apath (* tchar) (make-alien tchar (1+ MAX_PATH)))
+ (with-alien ((apath (* tchar) (make-alien tchar (1+ max_path)))
(afunc (function dword dword (* tchar))
- :extern
+ :extern
#!-sb-unicode "GetCurrentDirectoryA@8"
#!+sb-unicode "GetCurrentDirectoryW@8"))
- (let ((ret (alien-funcall afunc (1+ MAX_PATH) apath)))
+ (let ((ret (alien-funcall afunc (1+ max_path) apath)))
(when (zerop ret)
(win32-error "GetCurrentDirectory"))
- (when (> ret (1+ MAX_PATH))
+ (when (> ret (1+ max_path))
(free-alien apath)
(setf apath (make-alien tchar ret))
(alien-funcall afunc ret apath))
(with-alien ((aname (* tchar) (make-alien tchar (1+ name-length)))
(aenv (* tchar) (make-alien tchar default-environment-length))
(afunc (function dword (* tchar) (* tchar) dword)
- :extern
+ :extern
#!-sb-unicode "GetEnvironmentVariableA@12"
#!+sb-unicode "GetEnvironmentVariableW@12"))
(dotimes (i name-length)