(zilch vfs): add parent directories when using vfs-append-file

This commit is contained in:
puck 2025-05-01 13:20:05 +00:00
parent 0cf6d7a9af
commit 8080da3ba0

View file

@ -139,5 +139,14 @@
(define split (string-contains-right path "/")) (define split (string-contains-right path "/"))
(define dirname (if split (string-copy path 0 split) "")) (define dirname (if split (string-copy path 0 split) ""))
(define filename (if split (string-copy path (+ 1 split)) path)) (define filename (if split (string-copy path (+ 1 split)) path))
(make-vfs (mapping-set (vfs-contents vfs) (cons dirname filename) contents)))))
(define new-mapping (mapping-set (vfs-contents vfs) (cons dirname filename) contents))
(define (add-parent-dir name)
(define split (string-contains-right name "/"))
(define dirname (if split (string-copy name 0 split) ""))
(define filename (if split (string-copy name (+ 1 split)) name))
(unless (mapping-ref/default new-mapping (cons dirname filename) #f) (set! new-mapping (mapping-set! new-mapping (cons dirname filename) 'directory)))
(unless (string=? dirname "") (add-parent-dir dirname)))
(unless (string=? dirname "") (add-parent-dir dirname))
(make-vfs new-mapping))))