← Back to branch summary

~ubuntu-branches/ubuntu/trusty/mit-scheme/trusty

« back to all changes in this revision

Viewing changes to src/runtime/fileio.scm

  • Committer: Bazaar Package Importer
  • Author(s): Chris Hanson
  • Date: 2010-03-10 02:00:45 UTC
  • mfrom: (1.1.7 upstream) (3.1.6 sid)
  • Revision ID: james.westby@ubuntu.com-20100310020045-4np1y3ro6sk2oz92
Tags: 9.0.1-1
* New upstream.
* debian/watch: Fix, previous version was broken.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/runtime/fileio.scm
1
1
#| -*-Scheme-*-
2
2
 
3
 
$Id: fileio.scm,v 1.38 2008/07/11 05:26:42 cph Exp $
4
 
 
5
3
Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
6
4
    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
7
 
    2006, 2007, 2008 Massachusetts Institute of Technology
 
5
    2006, 2007, 2008, 2009, 2010 Massachusetts Institute of Technology
8
6
 
9
7
This file is part of MIT/GNU Scheme.
10
8
 
118
116
    (port/set-line-ending port (file-line-ending pathname))
119
117
    port))
120
118
 
 
119
(define (open-exclusive-output-file filename)
 
120
  (let* ((pathname (merge-pathnames filename))
 
121
         (channel (file-open-exclusive-output-channel (->namestring pathname)))
 
122
         (port (make-generic-i/o-port #f channel output-file-type pathname)))
 
123
    (set-channel-port! channel port)
 
124
    (port/set-line-ending port (file-line-ending pathname))
 
125
    port))
 
126
 
121
127
(define (open-i/o-file filename)
122
128
  (let* ((pathname (merge-pathnames filename))
123
129
         (channel (file-open-io-channel (->namestring pathname)))
148
154
    (port/set-line-ending port 'BINARY)
149
155
    port))
150
156
 
 
157
(define (open-exclusive-binary-output-file filename)
 
158
  (let* ((pathname (merge-pathnames filename))
 
159
         (channel (file-open-exclusive-output-channel (->namestring pathname)))
 
160
         (port (make-generic-i/o-port #f channel output-file-type pathname)))
 
161
    (set-channel-port! channel port)
 
162
    (port/set-coding port 'BINARY)
 
163
    (port/set-line-ending port 'BINARY)
 
164
    port))
 
165
 
151
166
(define (open-binary-i/o-file filename)
152
167
  (let* ((pathname (merge-pathnames filename))
153
168
         (channel (file-open-io-channel (->namestring pathname)))
172
187
(define call-with-output-file
173
188
  (make-call-with-file open-output-file))
174
189
 
 
190
(define call-with-exclusive-output-file
 
191
  (make-call-with-file open-exclusive-output-file))
 
192
 
175
193
(define call-with-binary-output-file
176
194
  (make-call-with-file open-binary-output-file))
177
195
 
 
196
(define call-with-exclusive-binary-output-file
 
197
  (make-call-with-file open-exclusive-binary-output-file))
 
198
 
178
199
(define call-with-append-file
179
200
  (make-call-with-file (lambda (filename) (open-output-file filename #t))))
180
201
 
201
222
(define with-output-to-file
202
223
  (make-with-output-to-file call-with-output-file))
203
224
 
 
225
(define with-output-to-exclusive-file
 
226
  (make-with-output-to-file call-with-exclusive-output-file))
 
227
 
204
228
(define with-output-to-binary-file
205
 
  (make-with-output-to-file call-with-binary-output-file))
 
 
b'\\ No newline at end of file'
 
229
  (make-with-output-to-file call-with-binary-output-file))
 
230
 
 
231
(define with-output-to-exclusive-binary-file
 
232
  (make-with-output-to-file call-with-exclusive-binary-output-file))
 
 
b'\\ No newline at end of file'