(define-record-type fs-object :fs-object (really-make-fs-object name path info) fs-object? (name fs-object-name) (path fs-object-path) (info really-fs-object-info)) (define (fs-object-info fso) (force (really-fs-object-info fso))) (define (make-fs-object name path) ;; TODO check path for being absolute, name for being relative ;; and slashless (if (not (file-name-absolute? path)) (error "path argument of make-fs-object not absolute" path)) (really-make-fs-object name path ;; TODO: this delay is rather useless, we need the info anyway (delay (with-fatal-error-handler (lambda (condition more) (format #t "condition while fs-object-info: ~a" condition) #f) (file-info (combine-path path name) #f))))) (define-record-discloser :fs-object (lambda (r) `(fs-object ,(fs-object-path r) ,(fs-object-name r)))) (define (combine-path parent name) (if (string=? parent "") name (string-append parent "/" name))) (define (fs-object-complete-path fs-object) (absolute-file-name (fs-object-name fs-object) (fs-object-path fs-object))) (define (file-name->fs-object file-name) (if (file-name-absolute? file-name) (make-fs-object (file-name-nondirectory file-name) (file-name-directory file-name)) (let ((rest-dirs (file-name-directory file-name))) (make-fs-object (file-name-nondirectory file-name) (string-append (cwd) "/" rest-dirs)))))