From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 26 May 2004 15:20:22 +0000 (+0000)
Subject: Add new procedure PORT/SUPPORTS-CODING?.
X-Git-Tag: 20090517-FFI~1651
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2d9c12500d21cca8813d0990e7d296ee0783e611;p=mit-scheme.git

Add new procedure PORT/SUPPORTS-CODING?.
---

diff --git a/v7/src/runtime/genio.scm b/v7/src/runtime/genio.scm
index 033e203ac..bb88bbf8b 100644
--- a/v7/src/runtime/genio.scm
+++ b/v7/src/runtime/genio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: genio.scm,v 1.30 2004/02/26 19:03:58 cph Exp $
+$Id: genio.scm,v 1.31 2004/05/26 15:19:53 cph Exp $
 
 Copyright 1991,1993,1995,1996,1999,2002 Massachusetts Institute of Technology
 Copyright 2003,2004 Massachusetts Institute of Technology
@@ -102,6 +102,7 @@ USA.
 	   (LINE-ENDING ,generic-io/line-ending)
 	   (SET-CODING ,generic-io/set-coding)
 	   (SET-LINE-ENDING ,generic-io/set-line-ending)
+	   (SUPPORTS-CODING? ,generic-io/supports-coding?)
 	   (WRITE-SELF ,generic-io/write-self))))
     (set! generic-input-type
 	  (make-port-type (append input-operations
@@ -285,6 +286,10 @@ USA.
 	(else
 	 (write-string " for channel" output-port))))
 
+(define (generic-io/supports-coding? port)
+  port
+  #t)
+
 (define (generic-io/coding port)
   (gstate-coding (port/state port)))
 
diff --git a/v7/src/runtime/port.scm b/v7/src/runtime/port.scm
index 9e5296ffa..a987cdd41 100644
--- a/v7/src/runtime/port.scm
+++ b/v7/src/runtime/port.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: port.scm,v 1.32 2004/02/24 20:35:44 cph Exp $
+$Id: port.scm,v 1.33 2004/05/26 15:20:09 cph Exp $
 
 Copyright 1991,1992,1993,1994,1997,1999 Massachusetts Institute of Technology
 Copyright 2001,2002,2003,2004 Massachusetts Institute of Technology
@@ -682,6 +682,12 @@ USA.
   (if (fix:>= (char->integer char) #x100)
       (error:not-8-bit-char char)))
 
+(define (port/supports-coding? port)
+  (let ((operation (port/operation port 'SUPPORTS-CODING?)))
+    (if operation
+	(operation port)
+	#f)))
+
 (define (port/coding port)
   (let ((operation (port/operation port 'CODING)))
     (if operation
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index dbf619124..8a9987674 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.482 2004/02/24 20:35:48 cph Exp $
+$Id: runtime.pkg,v 14.483 2004/05/26 15:20:22 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -1841,6 +1841,7 @@ USA.
 	  port/set-output-blocking-mode
 	  port/set-output-terminal-mode
 	  port/state
+	  port/supports-coding?
 	  port/thread-mutex
 	  port/type
 	  port/with-input-blocking-mode