Changeset 7408 for branches/working-0710


Ignore:
Timestamp:
Oct 12, 2007, 9:44:30 AM (12 years ago)
Author:
gb
Message:

On OSX, assume that namestrings that come back from the OS are UTF-8
encoded and decomposed. Decode and precompose them.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0710/ccl/level-1/linux-files.lisp

    r7308 r7408  
    3030  )
    3131
     32
     33(defun get-foreign-namestring (pointer)
     34  ;; On Darwin, foreign namestrings are encoded in UTF-8 and
     35  ;; are canonically decomposed (NFD).  Use PRECOMPOSE-SIMPLE-STRING
     36  ;; to ensure that the string is "precomposed" (NFC), like the
     37  ;; rest of the world and most sane people would expect.
     38  #+darwin-target
     39  (precompose-simple-string (%get-utf-8-cstring pointer))
     40  ;; On some other platforms, the namestring is assumed to
     41  ;; be encoded according to the current locale's character
     42  ;; encoding (though FreeBSD seems to be moving towards
     43  ;; precomposed UTF-8.).
     44  ;; In any case, the use if %GET-CSTRING here is wrong ...
     45  #-darwin-target
     46  (%get-cstring pointer))
    3247
    3348(defun nanoseconds (n)
     
    156171                     ((< len bufsize)
    157172                      (setf (%get-unsigned-byte buf len) 0)
    158                       (values (%get-cstring buf) len))
     173                      (values (get-foreign-namestring buf) len))
    159174                     (t (values nil len)))))))
    160175    (do* ((string nil)
     
    176191
    177192(defun %chdir (dirname)
    178   (with-cstrs ((dirname dirname))
     193  (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((dirname dirname))
    179194    (syscall syscalls::chdir dirname)))
    180195
    181196(defun %mkdir (name mode)
    182   (let* ((last (1- (length name))))
    183     (with-cstrs ((name name))
    184       (when (and (>= last 0)
    185                  (eql (%get-byte name last) (char-code #\/)))
    186         (setf (%get-byte name last) 0))
    187     (syscall syscalls::mkdir name mode))))
     197  (let* ((name name)
     198         (len (length name)))
     199    (when (and (> len 0) (eql (char name (1- len)) #\/))
     200      (setq name (subseq name 0 (1- len))))
     201    (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((name name))
     202      (syscall syscalls::mkdir name mode))))
    188203
    189204(defun getenv (key)
     
    239254
    240255(defun %%stat (name stat)
    241   (with-cstrs ((cname name))
     256  (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((cname name))
    242257    (%stat-values
    243258     #+linux-target
     
    256271
    257272(defun %%lstat (name stat)
    258   (with-cstrs ((cname name))
     273  (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((cname name))
    259274    (%stat-values
    260275     #+linux-target
     
    369384    (setq namestring (current-directory-name)))
    370385  (%stack-block ((resultbuf #$PATH_MAX))
    371     (with-cstrs ((name (tilde-expand namestring)))
     386    (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((name namestring #|(tilde-expand namestring)|#))
    372387      (let* ((result (#_realpath name resultbuf)))
    373388        (declare (dynamic-extent result))
    374389        (unless (%null-ptr-p result)
    375           (%get-cstring result))))))
     390          (get-foreign-namestring result))))))
    376391
    377392;;; Return fully resolved pathname & file kind, or (values nil nil)
     
    428443
    429444(defun %utimes (namestring)
    430   (with-cstrs ((cnamestring namestring))
     445  (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((cnamestring namestring))
    431446    (let* ((err (#_utimes cnamestring (%null-ptr))))
    432447      (declare (fixnum err))
     
    446461
    447462(defun %open-dir (namestring)
    448   (with-cstrs ((name namestring))
     463  (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((name namestring))
    449464    (let* ((DIR (#_opendir name)))
    450465      (unless (%null-ptr-p DIR)
     
    456471(defun %read-dir (dir)
    457472  (let* ((res (#_readdir dir)))
    458     (unless (%null-ptr-p res)       
    459       (%get-cstring (pref res :dirent.d_name)))))
     473    (unless (%null-ptr-p res)
     474      (get-foreign-namestring (pref res :dirent.d_name)))))
    460475
    461476(defun tcgetpgrp (fd)
     
    481496        (let* ((err (#_getpwuid_r userid pwd buf buflen result)))
    482497          (if (eql 0 err)
    483             (return (%get-cstring (pref pwd :passwd.pw_dir)))
     498            (return (get-foreign-namestring (pref pwd :passwd.pw_dir)))
    484499            (unless (eql err #$ERANGE)
    485500              (return nil))))))))
Note: See TracChangeset for help on using the changeset viewer.