diff --git a/lib/chibi/filesystem.scm b/lib/chibi/filesystem.scm index 7b11d2d8..e8893d53 100644 --- a/lib/chibi/filesystem.scm +++ b/lib/chibi/filesystem.scm @@ -2,6 +2,22 @@ ;; Copyright (c) 2009-2012 Alex Shinn. All rights reserved. ;; 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 ;;> each filename in directory \var{dir} and the result of the ;;> previous application, beginning with \var{knil}. With diff --git a/lib/chibi/filesystem.sld b/lib/chibi/filesystem.sld index 6a5087cd..996859f4 100644 --- a/lib/chibi/filesystem.sld +++ b/lib/chibi/filesystem.sld @@ -11,7 +11,7 @@ delete-file link-file symbolic-link-file rename-file directory-files directory-fold directory-fold-tree delete-file-hierarchy delete-directory - create-directory + create-directory create-directory* current-directory change-directory with-directory open open-pipe make-fifo file-status @@ -30,7 +30,7 @@ open/create open/exclusive open/truncate open/append open/non-block is-a-tty?) - (import (chibi)) + (import (chibi) (chibi string)) (include-shared "filesystem") (include "filesystem.scm"))