From 88269a157d660447237f477f117f87ab4ad7430a Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 29 Nov 2005 06:54:11 +0000
Subject: [PATCH] Add support for codings and line endings to string ports.

---
 v7/src/runtime/genio.scm   | 16 +++++++++++-----
 v7/src/runtime/runtime.pkg | 11 ++++++++++-
 v7/src/runtime/strnin.scm  | 31 ++++++++++++++++---------------
 v7/src/runtime/strott.scm  | 13 ++++++++-----
 v7/src/runtime/strout.scm  | 13 ++++++++-----
 5 files changed, 53 insertions(+), 31 deletions(-)

diff --git a/v7/src/runtime/genio.scm b/v7/src/runtime/genio.scm
index c53889b6d..5e7a9f276 100644
--- 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)
 
 ;;;; 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 9b9bf2850..78cd5c33d 100644
--- 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 9a278aa00..3a769a051 100644
--- 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 2eef3c220..03ff27067 100644
--- 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 0ba38a823..d5977d0e3 100644
--- 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))
 
 (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
-- 
2.25.1