Adding directory traversing, deleting, and changing utilities.

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.

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

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.