diff --git a/lib/chibi/filesystem.scm b/lib/chibi/filesystem.scm index bae76556..00c87eb3 100644 --- a/lib/chibi/filesystem.scm +++ b/lib/chibi/filesystem.scm @@ -20,6 +20,61 @@ (define (directory-files dir) (directory-fold dir cons '())) +;;> The fundamental directory traverser. + +(define (directory-fold-tree file down up here . o) + ;; TODO: Use link count to reduce stats. + ;; TODO: Provide higher-level wrapper for filtering and avoids links. + (let ((knil (and (pair? o) (car o))) + (down (or down (lambda (f acc) acc))) + (up (or up (lambda (f acc) acc))) + (here (or here (lambda (f acc) acc)))) + (let fold ((file file) (acc knil)) + (cond + ((file-directory? file) + (let ((d (opendir file))) + (let lp ((acc acc)) + (let ((e (readdir d))) + (cond + (e + (let ((f (dirent-name e))) + (if (member f '("." "..")) + (lp acc) + (let ((path (string-append file "/" f))) + (lp (fold path (down path acc))))))) + (else + (up file acc))))))) + (else + (here file acc)))))) + +;;> Recursively delete all files and directories under @var{dir}. +;;> Unless optional arg @var{ignore-errors?} is true, raises an error +;;> if any file can't be deleted. + +(define (delete-directory-hierarchy dir . o) + (let ((ignore-errors? (and (pair? o) (car o)))) + (if (member dir '("" "/")) + (error "won't delete unsafe directory" dir)) + (directory-fold-tree + dir + #f + (lambda (d acc) + (if (and (not (delete-directory d)) (not ignore-errors?)) + (error "couldn't delete directory" d))) + (lambda (f acc) + (if (and (not (delete-file f)) (not ignore-errors?)) + (error "couldn't delete file" f)))))) + +;;> Runs @var{thunk} with the current directory of the process temporarily +;;> set to @var{dir}. + +(define (with-directory dir thunk) + (let ((pwd (current-directory))) + (dynamic-wind + (lambda () (change-directory dir)) + thunk + (lambda () (change-directory pwd))))) + ;;> Returns the @scheme{status} object for the given @var{file}, ;;> which should be a string indicating the path or a file ;;> descriptor. diff --git a/lib/chibi/filesystem.sld b/lib/chibi/filesystem.sld index 720dac98..dec92f20 100644 --- a/lib/chibi/filesystem.sld +++ b/lib/chibi/filesystem.sld @@ -9,7 +9,9 @@ close-file-descriptor renumber-file-descriptor open-input-file-descriptor open-output-file-descriptor delete-file link-file symbolic-link-file rename-file - directory-files directory-fold create-directory delete-directory + directory-files directory-fold directory-fold-tree + delete-directory-hierarchy create-directory delete-directory + current-directory change-directory with-directory open open-pipe make-fifo file-status file-device file-inode diff --git a/lib/chibi/filesystem.stub b/lib/chibi/filesystem.stub index 906bf317..e0acc0fb 100644 --- a/lib/chibi/filesystem.stub +++ b/lib/chibi/filesystem.stub @@ -105,6 +105,10 @@ (define-c non-null-string (current-directory "getcwd") ((result (array char (auto-expand arg1))) (value 256 int))) +;;> Change the current working directory of the process. + +(define-c errno (change-directory "chdir") (string)) + ;;> Creates a new directory with the given mode. ;;> Returns @scheme{#t} on success and @scheme{#f} on failure.