X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fwin32.lisp;h=98bc440b232318d63612028611abcebd15199daf;hb=2561033fd3ed9e224dffc445262e097e5abfa920;hp=c4b7589f47b1d98fb2804f5fa1bc76b14289dab2;hpb=fdf46e7bd7aba9b5c8af629fdb2692d9b33b9207;p=sbcl.git

diff --git a/src/code/win32.lisp b/src/code/win32.lisp
index c4b7589..98bc440 100644
--- a/src/code/win32.lisp
+++ b/src/code/win32.lisp
@@ -121,7 +121,7 @@
     (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)))
@@ -170,7 +170,7 @@
   (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
@@ -334,7 +334,7 @@
               (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*
@@ -345,7 +345,7 @@
 
 ;; 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*)
@@ -355,7 +355,7 @@
 (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))
@@ -402,26 +402,27 @@
             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))
@@ -469,7 +470,7 @@
     (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)