Commit | Line | Data |
---|---|---|
0113507e JG |
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 | ||
2470bda7 | 59 | (import (rename (only (guile) file-exists? delete-file catch @@) |
0113507e JG |
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 | (define &i/o (@@ (rnrs conditions) &i/o)) | |
71 | (define make-i/o-error (@@ (rnrs conditions) make-i/o-error)) | |
72 | (define i/o-error? (@@ (rnrs conditions) i/o-error?)) | |
73 | ||
74 | (define &i/o-read (@@ (rnrs conditions) &i/o-read)) | |
75 | (define make-i/o-read-error (@@ (rnrs conditions) make-i/o-read-error)) | |
76 | (define i/o-read-error? (@@ (rnrs conditions) i/o-read-error?)) | |
77 | ||
78 | (define &i/o-write (@@ (rnrs conditions) &i/o-write)) | |
79 | (define make-i/o-write-error (@@ (rnrs conditions) make-i/o-write-error)) | |
80 | (define i/o-write-error? (@@ (rnrs conditions) i/o-write-error?)) | |
81 | ||
82 | (define &i/o-invalid-position (@@ (rnrs conditions) &i/o-invalid-position)) | |
83 | (define make-i/o-invalid-position-error | |
84 | (@@ (rnrs conditions) make-i/o-invalid-position-error)) | |
85 | (define i/o-invalid-position-error? | |
86 | (@@ (rnrs conditions) i/o-invalid-position-error?)) | |
87 | (define i/o-error-position (@@ (rnrs conditions) i/o-error-position)) | |
88 | ||
89 | (define &i/o-filename (@@ (rnrs conditions) &i/o-filename)) | |
90 | (define make-i/o-filename-error | |
91 | (@@ (rnrs conditions) make-i/o-filename-error)) | |
92 | (define i/o-filename-error? (@@ (rnrs conditions) i/o-filename-error?)) | |
93 | (define i/o-error-filename (@@ (rnrs conditions) i/o-error-filename)) | |
94 | ||
95 | (define &i/o-file-protection (@@ (rnrs conditions) &i/o-file-protection)) | |
96 | (define make-i/o-file-protection-error | |
97 | (@@ (rnrs conditions) make-i/o-file-protection-error)) | |
98 | (define i/o-file-protection-error? | |
99 | (@@ (rnrs conditions) i/o-file-protection-error?)) | |
100 | ||
101 | (define &i/o-file-is-read-only (@@ (rnrs conditions) &i/o-file-is-read-only)) | |
102 | (define make-i/o-file-is-read-only-error | |
103 | (@@ (rnrs conditions) make-i/o-file-is-read-only-error)) | |
104 | (define i/o-file-is-read-only-error? | |
105 | (@@ (rnrs conditions) i/o-file-is-read-only-error?)) | |
106 | ||
107 | (define &i/o-file-already-exists | |
108 | (@@ (rnrs conditions) &i/o-file-already-exists)) | |
109 | (define make-i/o-file-already-exists-error | |
110 | (@@ (rnrs conditions) make-i/o-file-already-exists-error)) | |
111 | (define i/o-file-already-exists-error? | |
112 | (@@ (rnrs conditions) i/o-file-already-exists-error?)) | |
113 | ||
114 | (define &i/o-file-does-not-exist | |
115 | (@@ (rnrs conditions) &i/o-file-does-not-exist)) | |
116 | (define make-i/o-file-does-not-exist-error | |
117 | (@@ (rnrs conditions) make-i/o-file-does-not-exist-error)) | |
118 | (define i/o-file-does-not-exist-error? | |
119 | (@@ (rnrs conditions) i/o-file-does-not-exist-error?)) | |
120 | ||
121 | (define &i/o-port (@@ (rnrs conditions) &i/o-port)) | |
122 | (define make-i/o-port-error (@@ (rnrs conditions) make-i/o-port-error)) | |
123 | (define i/o-port-error? (@@ (rnrs conditions) i/o-port-error?)) | |
124 | (define i/o-error-port (@@ (rnrs conditions) i/o-error-port)) | |
125 | ) |