From: Chris Hanson Date: Wed, 14 Dec 2005 05:44:53 +0000 (+0000) Subject: Change MAKE-GSTATE to take separate arguments for coding and X-Git-Tag: 20090517-FFI~1163 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fe2a5ade13490ad27b9b94edd22cb7b9e7c81155;p=mit-scheme.git Change MAKE-GSTATE to take separate arguments for coding and line-ending names. Initialize string I/O ports to ISO-8859-1 and NEWLINE, respectively, as TEXT is wrong on non-unix systems. --- diff --git a/v7/src/runtime/fileio.scm b/v7/src/runtime/fileio.scm index 4fc6c55e3..c24f4e181 100644 --- a/v7/src/runtime/fileio.scm +++ b/v7/src/runtime/fileio.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: fileio.scm,v 1.26 2005/12/12 21:41:23 cph Exp $ +$Id: fileio.scm,v 1.27 2005/12/14 05:44:31 cph Exp $ Copyright 1991,1993,1994,1995,1996,1999 Massachusetts Institute of Technology Copyright 2001,2004,2005 Massachusetts Institute of Technology @@ -76,7 +76,7 @@ USA. (channel (file-open-input-channel (->namestring pathname))) (port (make-port input-file-type - (make-gstate channel #f 'TEXT pathname)))) + (make-gstate channel #f 'TEXT 'TEXT pathname)))) (set-channel-port! channel port) (port/set-line-ending port (file-line-ending pathname)) port)) @@ -90,7 +90,7 @@ USA. (file-open-output-channel filename)))) (port (make-port output-file-type - (make-gstate #f channel 'TEXT pathname)))) + (make-gstate #f channel 'TEXT 'TEXT pathname)))) (set-channel-port! channel port) (port/set-line-ending port (file-line-ending pathname)) port)) @@ -100,7 +100,7 @@ USA. (channel (file-open-io-channel (->namestring pathname))) (port (make-port i/o-file-type - (make-gstate channel channel 'TEXT pathname)))) + (make-gstate channel channel 'TEXT 'TEXT pathname)))) (set-channel-port! channel port) (port/set-line-ending port (file-line-ending pathname)) port)) @@ -110,7 +110,7 @@ USA. (channel (file-open-input-channel (->namestring pathname))) (port (make-port input-file-type - (make-gstate channel #f 'BINARY pathname)))) + (make-gstate channel #f 'BINARY 'BINARY pathname)))) (set-channel-port! channel port) port)) @@ -123,7 +123,7 @@ USA. (file-open-output-channel filename)))) (port (make-port output-file-type - (make-gstate #f channel 'BINARY pathname)))) + (make-gstate #f channel 'BINARY 'BINARY pathname)))) (set-channel-port! channel port) port)) @@ -132,7 +132,7 @@ USA. (channel (file-open-io-channel (->namestring pathname))) (port (make-port i/o-file-type - (make-gstate channel channel 'BINARY pathname)))) + (make-gstate channel channel 'BINARY 'BINARY pathname)))) (set-channel-port! channel port) port)) diff --git a/v7/src/runtime/genio.scm b/v7/src/runtime/genio.scm index 6b23c1a99..07785de26 100644 --- a/v7/src/runtime/genio.scm +++ b/v7/src/runtime/genio.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: genio.scm,v 1.35 2005/12/12 21:45:36 cph Exp $ +$Id: genio.scm,v 1.36 2005/12/14 05:44:36 cph Exp $ Copyright 1991,1993,1995,1996,1999,2002 Massachusetts Institute of Technology Copyright 2003,2004,2005 Massachusetts Institute of Technology @@ -35,7 +35,7 @@ USA. (let ((port (make-port (generic-i/o-port-type (source-type source) (sink-type sink)) - (make-gstate source sink 'TEXT)))) + (make-gstate source sink 'TEXT 'TEXT)))) (let ((ib (port-input-buffer port))) (if ib ((source/set-port (input-buffer-source ib)) port))) @@ -80,14 +80,18 @@ USA. coding line-ending) -(define (make-gstate source sink type . extra) +(define (make-gstate source sink coder-name normalizer-name . extra) (list->vector (cons* (and source - (make-input-buffer (->source source 'MAKE-GSTATE) type)) + (make-input-buffer (->source source 'MAKE-GSTATE) + coder-name + normalizer-name)) (and sink - (make-output-buffer (->sink sink 'MAKE-GSTATE) type)) - type - type + (make-output-buffer (->sink sink 'MAKE-GSTATE) + coder-name + normalizer-name)) + coder-name + normalizer-name extra))) (define-integrable (port-input-buffer port) @@ -394,7 +398,7 @@ USA. (and for-output? (known-input-line-ending? name) (not (known-output-line-ending? name)))) - (if (and channel (eq? 'TCP-STREAM-SOCKET (channel-type channel))) + (if (and channel (eq? (channel-type channel) 'TCP-STREAM-SOCKET)) 'CRLF (default-line-ending)) name)) @@ -623,14 +627,16 @@ USA. decode normalize) -(define (make-input-buffer source type) +(define (make-input-buffer source coder-name normalizer-name) (%make-input-buffer source (make-string byte-buffer-length) byte-buffer-length byte-buffer-length - (name->decoder type) + (name->decoder coder-name) (name->normalizer - (line-ending ((source/get-channel source)) type #f)))) + (line-ending ((source/get-channel source)) + normalizer-name + #f)))) (define (input-buffer-open? ib) ((source/open? (input-buffer-source ib)))) @@ -821,13 +827,15 @@ USA. encode denormalize) -(define (make-output-buffer sink type) +(define (make-output-buffer sink coder-name normalizer-name) (%make-output-buffer sink (make-string byte-buffer-length) 0 - (name->encoder type) + (name->encoder coder-name) (name->denormalizer - (line-ending ((sink/get-channel sink)) type #t)))) + (line-ending ((sink/get-channel sink)) + normalizer-name + #t)))) (define (output-buffer-open? ob) ((sink/open? (output-buffer-sink ob)))) diff --git a/v7/src/runtime/strnin.scm b/v7/src/runtime/strnin.scm index 96484d95b..8461fea5a 100644 --- a/v7/src/runtime/strnin.scm +++ b/v7/src/runtime/strnin.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: strnin.scm,v 14.15 2005/12/12 21:52:35 cph Exp $ +$Id: strnin.scm,v 14.16 2005/12/14 05:44:41 cph Exp $ Copyright 1988,1990,1993,1999,2003,2004 Massachusetts Institute of Technology Copyright 2005 Massachusetts Institute of Technology @@ -44,7 +44,10 @@ USA. 0 (guarantee-substring-start-index start end 'OPEN-INPUT-STRING)))) (make-port input-string-port-type - (make-gstate (make-string-source string start end) #f 'TEXT)))) + (make-gstate (make-string-source string start end) + #f + 'ISO-8859-1 + 'NEWLINE)))) (define (make-string-source string start end) (let ((index start)) diff --git a/v7/src/runtime/strott.scm b/v7/src/runtime/strott.scm index 184c7aac6..90c5bccfc 100644 --- a/v7/src/runtime/strott.scm +++ b/v7/src/runtime/strott.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: strott.scm,v 14.14 2005/12/12 21:55:23 cph Exp $ +$Id: strott.scm,v 14.15 2005/12/14 05:44:45 cph Exp $ Copyright 1988,1993,1999,2004,2005 Massachusetts Institute of Technology @@ -35,7 +35,12 @@ USA. (make-port output-string-port-type (receive (sink extract extract!) (make-accumulator-sink limit k) - (make-gstate #f sink 'TEXT extract extract!))))) + (make-gstate #f + sink + 'ISO-8859-1 + 'NEWLINE + extract + extract!))))) (generator port) (cons #f (get-output-string port)))))) diff --git a/v7/src/runtime/strout.scm b/v7/src/runtime/strout.scm index cef6a7ed3..8ff6df2ed 100644 --- a/v7/src/runtime/strout.scm +++ b/v7/src/runtime/strout.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: strout.scm,v 14.22 2005/12/12 21:55:39 cph Exp $ +$Id: strout.scm,v 14.23 2005/12/14 05:44:49 cph Exp $ Copyright 1988,1990,1993,1999,2000,2001 Massachusetts Institute of Technology Copyright 2003,2004,2005 Massachusetts Institute of Technology @@ -32,7 +32,7 @@ USA. (define (open-output-string) (make-port accumulator-output-port-type (receive (sink extract extract!) (make-accumulator-sink) - (make-gstate #f sink 'TEXT extract extract!)))) + (make-gstate #f sink 'ISO-8859-1 'NEWLINE extract extract!)))) (define (get-output-string port) ((port/operation port 'EXTRACT-OUTPUT) port)) diff --git a/v7/src/runtime/ttyio.scm b/v7/src/runtime/ttyio.scm index 2f6bb6fa7..9b1b5f947 100644 --- a/v7/src/runtime/ttyio.scm +++ b/v7/src/runtime/ttyio.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: ttyio.scm,v 1.22 2005/12/12 21:55:44 cph Exp $ +$Id: ttyio.scm,v 1.23 2005/12/14 05:44:53 cph Exp $ Copyright 1991,1993,1996,1999,2003,2004 Massachusetts Institute of Technology Copyright 2005 Massachusetts Institute of Technology @@ -83,6 +83,7 @@ USA. (make-gstate input-channel output-channel 'TEXT + 'TEXT (channel-type=file? input-channel))) (define (set-console-i/o-port! port)