commander-s/scheme/fs-object.scm

(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))
      (error "WRITE-ME file-name->fs-object")))