module/rnrs/files.scm

   1 ;;; files.scm --- The R6RS file system library
   2
   3 ;;      Copyright (C) 2010 Free Software Foundation, Inc.
   4 ;;
   5 ;; This library is free software; you can redistribute it and/or
   6 ;; modify it under the terms of the GNU Lesser General Public
   7 ;; License as published by the Free Software Foundation; either
   8 ;; version 3 of the License, or (at your option) any later version.
   9 ;;
  10 ;; This library is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;; Lesser General Public License for more details.
  14 ;;
  15 ;; You should have received a copy of the GNU Lesser General Public
  16 ;; License along with this library; if not, write to the Free Software
  17 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18 \f
  19
  20 (library (rnrs files (6))
  21   (export file-exists?
  22           delete-file
  23
  24           &i/o make-i/o-error i/o-error?
  25           &i/o-read make-i/o-read-error i/o-read-error?
  26           &i/o-write make-i/o-write-error i/o-write-error?
  27
  28           &i/o-invalid-position
  29           make-i/o-invalid-position-error
  30           i/o-invalid-position-error?
  31           i/o-error-position
  32
  33           &i/o-filename
  34           make-i/o-filename-error
  35           i/o-filename-error?
  36           i/o-error-filename
  37
  38           &i/o-file-protection
  39           make-i/o-file-protection-error
  40           i/o-file-protection-error?
  41
  42           &i/o-file-is-read-only
  43           make-i/o-file-is-read-only-error
  44           i/o-file-is-read-only-error?
  45
  46           &i/o-file-already-exists
  47           make-i/o-file-already-exists-error
  48           i/o-file-already-exists-error?
  49
  50           &i/o-file-does-not-exist
  51           make-i/o-file-does-not-exist-error
  52           i/o-file-does-not-exist-error?
  53
  54           &i/o-port
  55           make-i/o-port-error
  56           i/o-port-error?
  57           i/o-error-port)
  58
  59   (import (rename (only (guile) file-exists? delete-file catch @@)
  60                   (delete-file delete-file-internal))
  61           (rnrs base (6))
  62           (rnrs conditions (6))
  63           (rnrs exceptions (6)))
  64
  65   (define (delete-file filename)
  66     (catch #t
  67            (lambda () (delete-file-internal filename))
  68            (lambda (key . args) (raise (make-i/o-filename-error filename)))))
  69
  70   ;; Condition types that are used by (rnrs files), (rnrs io ports), and
  71   ;; (rnrs io simple).  These are defined here so as to be easily shareable by
  72   ;; these three libraries.
  73
  74   (define-condition-type &i/o &error make-i/o-error i/o-error?)
  75   (define-condition-type &i/o-read &i/o make-i/o-read-error i/o-read-error?)
  76   (define-condition-type &i/o-write &i/o make-i/o-write-error i/o-write-error?)
  77   (define-condition-type &i/o-invalid-position
  78     &i/o make-i/o-invalid-position-error i/o-invalid-position-error?
  79     (position i/o-error-position))
  80   (define-condition-type &i/o-filename
  81     &i/o make-i/o-filename-error i/o-filename-error?
  82     (filename i/o-error-filename))
  83   (define-condition-type &i/o-file-protection
  84     &i/o-filename make-i/o-file-protection-error i/o-file-protection-error?)
  85   (define-condition-type &i/o-file-is-read-only
  86     &i/o-file-protection make-i/o-file-is-read-only-error
  87     i/o-file-is-read-only-error?)
  88   (define-condition-type &i/o-file-already-exists
  89     &i/o-filename make-i/o-file-already-exists-error
  90     i/o-file-already-exists-error?)
  91   (define-condition-type &i/o-file-does-not-exist
  92     &i/o-filename make-i/o-file-does-not-exist-error
  93     i/o-file-does-not-exist-error?)
  94   (define-condition-type &i/o-port &i/o make-i/o-port-error i/o-port-error?
  95     (port i/o-error-port))
  96 )