Update of /cvsroot/wisp/wisp/src/builtin
In directory usw-pr-cvs1:/tmp/cvs-serv17043/src/builtin
Modified Files:
filing.wisp
Log Message:
Implemented the ~buffered~ option for |open-output-file|.
Index: filing.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/filing.wisp,v
retrieving revision 1.112
retrieving revision 1.113
diff -u -d -r1.112 -r1.113
--- filing.wisp 19 Sep 2002 02:43:39 -0000 1.112
+++ filing.wisp 20 Sep 2002 18:34:59 -0000 1.113
@@ -189,6 +189,10 @@
(friend (%file-descriptor port)
fd))
+; Note that we *don't* want (new <file> ...) to actually open
+; a file. |new| can be invoked by everyone who gets access to
+; both it and the created type; |<file>| can usually easily be
+; extracted via |type-of|.
(my (%<file> %make-file %file-fd %file-mode)
(make-record-type 2
'read-string (lambda (%<file> %make-file %file-fd %file-mode)
@@ -235,6 +239,8 @@
(%file-descriptor file)
(%file-fd (%port-host file)))))
+; XXX: Perhaps it would be better to have handler list slots in
+; port structures instead of wrapping?
(my (%<output-buffered-port> %make-obp %obp-host %obp-buffer %obp-bufptr)
(make-record-type 3
'new (lambda (%<obp> %make-obp %obp-host %obp-buffer %obp-bufptr)
@@ -392,7 +398,8 @@
(system-constant 'open 'O_CREAT)
(system-constant 'open 'O_TRUNC)))
(mode #o644)
- (readable? #f))
+ (readable? #f)
+ (buffered? #f))
(while (not (null? flags))
(my f (car flags)
(if (and (integer? f) (<= 0 f #o7777))
@@ -417,6 +424,8 @@
(system-constant 'open 'O_NOFOLLOW))))
((readable)
(set! readable? #t))
+ ((buffered)
+ (set! buffered? #t))
((#f))
(else
(raise 'unknown-open-output-file-flag f)))))
@@ -426,11 +435,14 @@
'O_RDWR
'O_WRONLY))
bitfield) mode)
- (if readable?
- (my port (make-instance <old-file>)
- (init-output-file port readable? fd)
- port)
- (make-file fd 'write)))))
+ (my port (if readable?
+ (my port (make-instance <old-file>)
+ (init-output-file port readable? fd)
+ port)
+ (make-file fd 'write))
+ (if buffered?
+ (set! port (new <output-buffered-port> port 'c8string 1024)))
+ port))))
(let ((*stdin* (make-instance <old-file>))
(*stdout* (make-file 1 'write))
|
