Changeset 15733 in project


Ignore:
Timestamp:
09/04/09 09:37:38 (10 years ago)
Author:
iraikov
Message:

rewrite of create-directory

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/posixunix.scm

    r15728 r15733  
    861861
    862862(define-inline (create-directory-helper name)
    863   (unless (zero? (##core#inline "C_mkdir" (##sys#make-c-string name)))
    864     (posix-error #:file-error 'create-directory "cannot create directory" name)) )
     863    (unless (zero? (##core#inline "C_mkdir" (##sys#make-c-string name)))
     864            (posix-error #:file-error 'create-directory
     865                         "cannot create directory" name)))
     866
    865867
    866868(define-inline (create-directory-check name)
    867   (and (file-exists? name)
    868        (if (fx< (##core#inline "C_stat" (##sys#make-c-string name)) 0)
    869            (posix-error #:file-error 'create-directory "cannot stat file" name)
    870            (or (foreign-value "C_isdir" bool)
    871                (posix-error #:file-error 'create-directory "path segment is a file" name)) ) ) )
    872 
    873 (define-inline (create-directory-helper-silent name)
    874   (unless (create-directory-check name)
    875     (create-directory-helper name)))
    876 
    877 (define create-directory-helper-parents
    878   (let ((string-append string-append)
    879         (char=? char=?)
    880         (string-ref string-ref)
    881         (string-split string-split) )
    882     (lambda (name)
    883       (let ((c #f)
    884             (dirs (string-split name "/")) )
    885         (for-each
    886          (lambda (x)
    887            ; take the 1st dir component as-is so as not to create an
    888            ; absoulte pathname
    889            (set! c (if c (string-append c "/" x) x))
    890            (create-directory-helper-silent c) )
    891          ; handle case of an absolute pathanme
    892          (if (char=? #\/ (string-ref name 0)) (cons "/" dirs) dirs)) ) ) ) )
     869    (if (file-exists? name)
     870        (if (fx< (##core#inline "C_stat" (##sys#make-c-string name)) 0)
     871            (posix-error #:file-error 'create-directory
     872                         "cannot stat file" name)
     873            (or (foreign-value "C_isdir" bool)
     874                (posix-error #:file-error 'create-directory
     875                             "path segment is a file" name)))
     876        #f))
     877
     878
     879(define-inline (make-parents name)
     880  (let ((name (normalize-pathname name)))
     881    (let loop ((cur (pathname-directory name))
     882               (lst (list)))
     883      (if (or (not cur) (string-null? cur))
     884          lst
     885          (let ((next (pathname-directory cur)))
     886            (loop next (cons cur lst)))))))
     887
    893888
    894889(define create-directory
    895   (let ((string=? string=?))
    896     (lambda (name #!optional parents?)
    897       (##sys#check-string name 'create-directory)
    898       (let ((name (##sys#expand-home-path name)))
    899         ; do not pass an empty string to helper-parents
    900         (if (and parents? (not (string=? "" name)))
    901             (create-directory-helper-parents name)
    902             (create-directory-helper name) ) ) ) ) )
     890  (lambda (name #!optional parents?)
     891    (##sys#check-string name 'create-directory)
     892    (if (not (string-null? name))
     893        (let ((b (create-directory-check name)))
     894          (if (not b)
     895              (let ((parents
     896                     (or (and parents? (make-parents name))
     897                         '())))
     898                (for-each create-directory parents)
     899                (create-directory-helper name))
     900              ))
     901        )))
     902
    903903
    904904(define change-directory
Note: See TracChangeset for help on using the changeset viewer.