[Wisp-cvs] wisp/src/builtin filing.wisp,1.112,1.113

[<di...@us...>]

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))