35 lines
856 B
Scheme
35 lines
856 B
Scheme
(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)
|
|
(really-make-fs-object
|
|
name path
|
|
(delay
|
|
(with-fatal-error-handler
|
|
(lambda (condition more)
|
|
(format #t "condition while fs-object-info: ~a" condition)
|
|
#f)
|
|
(file-info (combine-path path name))))))
|
|
|
|
(define-record-discloser :fs-object
|
|
(lambda (r)
|
|
`(fs-object ,(fs-object-name r))))
|
|
|
|
(define (combine-path parent name)
|
|
(if (string=? parent "")
|
|
name
|
|
(string-append parent
|
|
"/"
|
|
name)))
|
|
|
|
(define (fs-object-complete-path fs-object)
|
|
(combine-path (fs-object-path fs-object)
|
|
(fs-object-name fs-object)))
|