mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 13:49:17 +02:00
Adding create-directory*.
This commit is contained in:
parent
d198557c8b
commit
080cdef849
2 changed files with 18 additions and 2 deletions
|
@ -2,6 +2,22 @@
|
||||||
;; Copyright (c) 2009-2012 Alex Shinn. All rights reserved.
|
;; Copyright (c) 2009-2012 Alex Shinn. All rights reserved.
|
||||||
;; BSD-style license: http://synthcode.com/license.txt
|
;; BSD-style license: http://synthcode.com/license.txt
|
||||||
|
|
||||||
|
;;> Creates the directory \var{dir}, including any parent directories
|
||||||
|
;;> as needed. Returns \scheme{#t} on success and \scheme{#f} on
|
||||||
|
;;> failure.
|
||||||
|
|
||||||
|
(define (create-directory* dir . o)
|
||||||
|
(let ((mode (if (pair? o) (car o) #o755)))
|
||||||
|
(or (create-directory dir mode)
|
||||||
|
(let ((slash
|
||||||
|
(string-find-right dir #\/ 0 (string-skip-right dir #\/))))
|
||||||
|
(and (> slash 0)
|
||||||
|
(let ((parent (substring-cursor dir 0 slash)))
|
||||||
|
(and (not (equal? parent dir))
|
||||||
|
(not (file-exists? parent))
|
||||||
|
(create-directory* parent mode)
|
||||||
|
(create-directory dir mode))))))))
|
||||||
|
|
||||||
;;> The fundamental directory iterator. Applies \var{kons} to
|
;;> The fundamental directory iterator. Applies \var{kons} to
|
||||||
;;> each filename in directory \var{dir} and the result of the
|
;;> each filename in directory \var{dir} and the result of the
|
||||||
;;> previous application, beginning with \var{knil}. With
|
;;> previous application, beginning with \var{knil}. With
|
||||||
|
|
|
@ -11,7 +11,7 @@
|
||||||
delete-file link-file symbolic-link-file rename-file
|
delete-file link-file symbolic-link-file rename-file
|
||||||
directory-files directory-fold directory-fold-tree
|
directory-files directory-fold directory-fold-tree
|
||||||
delete-file-hierarchy delete-directory
|
delete-file-hierarchy delete-directory
|
||||||
create-directory
|
create-directory create-directory*
|
||||||
current-directory change-directory with-directory
|
current-directory change-directory with-directory
|
||||||
open open-pipe make-fifo
|
open open-pipe make-fifo
|
||||||
file-status
|
file-status
|
||||||
|
@ -30,7 +30,7 @@
|
||||||
open/create open/exclusive open/truncate
|
open/create open/exclusive open/truncate
|
||||||
open/append open/non-block
|
open/append open/non-block
|
||||||
is-a-tty?)
|
is-a-tty?)
|
||||||
(import (chibi))
|
(import (chibi) (chibi string))
|
||||||
(include-shared "filesystem")
|
(include-shared "filesystem")
|
||||||
(include "filesystem.scm"))
|
(include "filesystem.scm"))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue