Add support for codings and line endings to string ports.

diff --git a/v7/src/runtime/genio.scm b/v7/src/runtime/genio.scm
index c53889b6decbb36d61eda56315a04a56e6f4cd92..5e7a9f2769500560c9fe2ba8df6e6e67e56364e4 100644 (file)
--- a/v7/src/runtime/genio.scm
+++ b/v7/src/runtime/genio.scm
@@ -1,9 +1,9 @@
 #| -*-Scheme-*-
 
-$Id: genio.scm,v 1.32 2004/05/27 16:06:31 cph Exp $
+$Id: genio.scm,v 1.33 2005/11/29 06:41:45 cph Exp $
 
 Copyright 1991,1993,1995,1996,1999,2002 Massachusetts Institute of Technology
-Copyright 2003,2004 Massachusetts Institute of Technology
+Copyright 2003,2004,2005 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -43,7 +43,7 @@ USA.
 
 (define-structure (gstate (type vector) (constructor #f))
   ;; Changes to this structure must be copied to "fileio.scm" and
-  ;; "ttyio.scm".
+  ;; "ttyio.scm", "strnin.scm", "strout.scm", and "strott.scm".
   (input-buffer #f read-only #t)
   (output-buffer #f read-only #t)
   coding
@@ -116,6 +116,9 @@ USA.
          (make-port-type (append input-operations
                                  output-operations
                                  other-operations)
+                         #f))
+    (set! generic-no-i/o-type
+         (make-port-type other-operations
                          #f)))
   (initialize-name-maps!)
   (initialize-conditions!))
@@ -123,6 +126,7 @@ USA.
 (define generic-input-type)
 (define generic-output-type)
 (define generic-i/o-type)
+(define generic-no-i/o-type)
 \f
 ;;;; Input operations
 
@@ -312,7 +316,8 @@ USA.
         (eq-intersection (known-input-codings)
                          (known-output-codings)))
        ((input-port? port) (known-input-codings))
-       (else (known-output-codings))))
+       ((output-port? port) (known-output-codings))
+       (else '())))
 
 (define (generic-io/line-ending port)
   (gstate-line-ending (port/state port)))
@@ -340,7 +345,8 @@ USA.
         (eq-intersection (known-input-line-endings)
                          (known-output-line-endings)))
        ((input-port? port) (known-input-line-endings))
-       (else (known-output-line-endings))))
+       ((output-port? port) (known-output-line-endings))
+       (else '())))
 
 (define (line-ending channel name for-output?)
   (guarantee-symbol name #f)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 9b9bf2850d87eb3ef07c0deb306580eb0b1c7288..78cd5c33d44a1db4f4e9f83212be0df8f8133e98 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.565 2005/10/24 02:30:08 cph Exp $
+$Id: runtime.pkg,v 14.566 2005/11/29 06:46:06 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -1737,6 +1737,15 @@ USA.
          generic-input-type
          generic-output-type
          make-gstate)
+  (export (runtime string-input)
+         generic-no-i/o-type
+         make-gstate)
+  (export (runtime string-output)
+         generic-no-i/o-type
+         make-gstate)
+  (export (runtime truncated-string-output)
+         generic-no-i/o-type
+         make-gstate)
   (initialization (initialize-package!)))
 
 (define-package (runtime gensym)

diff --git a/v7/src/runtime/strnin.scm b/v7/src/runtime/strnin.scm
index 9a278aa00481c1406c3505d23c156f2aca00d898..3a769a0513f60c67095c50a92a2d87215a23c823 100644 (file)
--- a/v7/src/runtime/strnin.scm
+++ b/v7/src/runtime/strnin.scm
@@ -1,8 +1,9 @@
 #| -*-Scheme-*-
 
-$Id: strnin.scm,v 14.13 2004/02/16 05:38:37 cph Exp $
+$Id: strnin.scm,v 14.14 2005/11/29 06:50:59 cph Exp $
 
 Copyright 1988,1990,1993,1999,2003,2004 Massachusetts Institute of Technology
+Copyright 2005 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -33,19 +34,17 @@ USA.
 
 (define (open-input-string string #!optional start end)
   (guarantee-string string 'OPEN-INPUT-STRING)
-  (let ((end
-        (if (or (default-object? end) (not end))
-            (string-length string)
-            (guarantee-substring-end-index end (string-length string)
-                                           'OPEN-INPUT-STRING))))
+  (let* ((end
+         (if (or (default-object? end) (not end))
+             (string-length string)
+             (guarantee-substring-end-index end (string-length string)
+                                            'OPEN-INPUT-STRING)))
+        (start
+         (if (or (default-object? start) (not start))
+             0
+             (guarantee-substring-start-index start end 'OPEN-INPUT-STRING))))
     (make-port input-string-port-type
-              (make-istate
-               string
-               (if (or (default-object? start) (not start))
-                   0
-                   (guarantee-substring-start-index start end
-                                                    'OPEN-INPUT-STRING))
-               end))))
+              (make-gstate #f #f 'TEXT string start end))))
 
 (define input-string-port-type)
 (define (initialize-package!)
@@ -70,10 +69,12 @@ USA.
            ,(lambda (port output-port)
               port
               (write-string " from string" output-port))))
-        #f))
+        generic-no-i/o-type))
   unspecific)
 
-(define-structure (istate (type vector))
+(define-structure (istate (type vector)
+                         (initial-offset 4) ;must match "genio.scm"
+                         (constructor #f))
   (string #f read-only #t)
   start
   (end #f read-only #t))
\ No newline at end of file

diff --git a/v7/src/runtime/strott.scm b/v7/src/runtime/strott.scm
index 2eef3c2209febf608b7f0ef4cda7e65cba72b846..03ff27067a9e082bebbaac059f28cf7b41879311 100644 (file)
--- a/v7/src/runtime/strott.scm
+++ b/v7/src/runtime/strott.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: strott.scm,v 14.12 2004/02/16 05:38:42 cph Exp $
+$Id: strott.scm,v 14.13 2005/11/29 06:52:28 cph Exp $
 
-Copyright 1988,1993,1999,2004 Massachusetts Institute of Technology
+Copyright 1988,1993,1999,2004,2005 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -31,7 +31,8 @@ USA.
 (define (with-output-to-truncated-string max thunk)
   (call-with-current-continuation
    (lambda (k)
-     (let ((state (make-astate k max (make-string (fix:min max 128)) 0)))
+     (let ((state
+           (make-gstate #f #f 'TEXT k max (make-string (fix:min max 128)) 0)))
        (with-output-to-port (make-port output-string-port-type state)
         thunk)
        (cons #f
@@ -64,10 +65,12 @@ USA.
            ,(lambda (port output-port)
               port
               (write-string " to string (truncating)" output-port))))
-        #f))
+        generic-no-i/o-type))
   unspecific)
 
-(define-structure (astate (type vector))
+(define-structure (astate (type vector)
+                         (initial-offset 4) ;must match "genio.scm"
+                         (constructor #f))
   (return #f read-only #t)
   (max-length #f read-only #t)
   chars

diff --git a/v7/src/runtime/strout.scm b/v7/src/runtime/strout.scm
index 0ba38a823faff4666e1c8b3aa2fa5cc9c2d0b7d3..d5977d0e3e76012d14abb3538b81ed944f33e614 100644 (file)
--- a/v7/src/runtime/strout.scm
+++ b/v7/src/runtime/strout.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: strout.scm,v 14.20 2005/05/30 04:10:38 cph Exp $
+$Id: strout.scm,v 14.21 2005/11/29 06:54:11 cph Exp $
 
 Copyright 1988,1990,1993,1999,2000,2001 Massachusetts Institute of Technology
 Copyright 2003,2004,2005 Massachusetts Institute of Technology
@@ -30,7 +30,8 @@ USA.
 (declare (usual-integrations))
 \f
 (define (open-output-string)
-  (make-port accumulator-output-port-type (make-astate)))
+  (make-port accumulator-output-port-type
+            (make-gstate #f #f 'TEXT #f #f)))
 
 (define (get-output-string port)
   ((port/operation port 'EXTRACT-OUTPUT) port))
@@ -48,8 +49,10 @@ USA.
     (lambda (port)
       (with-output-to-port port thunk))))
 
-(define-structure (astate (type vector) (constructor make-astate ()))
-  (chars #f)
+(define-structure (astate (type vector)
+                         (initial-offset 4) ;must match "genio.scm"
+                         (constructor #f))
+  chars
   index)
 
 (define (maybe-reset-astate state)
@@ -123,5 +126,5 @@ USA.
            ,(lambda (port output-port)
               port
               (write-string " to string" output-port))))
-        #f))
+        generic-no-i/o-type))
   unspecific)
\ No newline at end of file