From 92529092edc028b0c957b9e20aeffd4e6ac48e9c Mon Sep 17 00:00:00 2001
From: "Taylor R. Campbell" <net/mumble/campbell>
Date: Fri, 9 Dec 2005 07:06:23 +0000
Subject: [PATCH] Fix a number of small errors in the port abstraction and its
 use:

  - Fix WRITE-CHAR methods supplied to MAKE-PORT-TYPE to return the
    number of characters written, i.e. 1, not an unspecific value.
  - Make sure all of the input & output features in the port
    abstraction for transcript ports actually check whether the
    supplied operation succeeded before transcribing the I/O.
  - Use WIDE-STRING-REF, not STRING-REF, on wide strings.
  - Use XSUBSTRING-MOVE!, not SUBSTRING-MOVE!, on external strings.
---
 v7/src/edwin/editor.scm    |  7 +++++--
 v7/src/runtime/genio.scm   |  4 ++--
 v7/src/runtime/port.scm    | 11 +++++++----
 v7/src/runtime/unicode.scm |  6 ++++--
 4 files changed, 18 insertions(+), 10 deletions(-)

diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index 310928619..096c837a9 100644
--- a/v7/src/edwin/editor.scm
+++ b/v7/src/edwin/editor.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: editor.scm,v 1.259 2004/02/16 05:43:21 cph Exp $
+$Id: editor.scm,v 1.260 2005/12/09 07:06:23 riastradh Exp $
 
 Copyright 1986,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -526,7 +526,10 @@ TRANSCRIPT    messages appear in transcript buffer, if it is enabled;
 
 (define null-output-port
   (make-port (make-port-type
-	      `((WRITE-CHAR ,(lambda (port char) port char unspecific)))
+	      `((WRITE-CHAR ,(lambda (port char)
+			       port char
+			       ;; Return the number of characters written.
+			       1)))
 	      #f)
 	     #f))
 
diff --git a/v7/src/runtime/genio.scm b/v7/src/runtime/genio.scm
index 5e7a9f276..5cab1743f 100644
--- a/v7/src/runtime/genio.scm
+++ b/v7/src/runtime/genio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: genio.scm,v 1.33 2005/11/29 06:41:45 cph Exp $
+$Id: genio.scm,v 1.34 2005/12/09 07:06:23 riastradh Exp $
 
 Copyright 1991,1993,1995,1996,1999,2002 Massachusetts Institute of Technology
 Copyright 2003,2004,2005 Massachusetts Institute of Technology
@@ -669,7 +669,7 @@ USA.
 	    (be (min page-size (- end start))))
 	(let ((n (read-to-8-bit ib bounce 0 be)))
 	  (if (and n (fix:> n 0))
-	      (substring-move! bounce 0 n string start))
+	      (xsubstring-move! bounce 0 n string start))
 	  n))))
 
 (define (input-buffer-in-8-bit-mode? ib)
diff --git a/v7/src/runtime/port.scm b/v7/src/runtime/port.scm
index cf75550c3..a5bbea293 100644
--- a/v7/src/runtime/port.scm
+++ b/v7/src/runtime/port.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: port.scm,v 1.38 2005/10/24 01:45:41 cph Exp $
+$Id: port.scm,v 1.39 2005/12/09 07:06:23 riastradh Exp $
 
 Copyright 1991,1992,1993,1994,1997,1999 Massachusetts Institute of Technology
 Copyright 2001,2002,2003,2004,2005 Massachusetts Institute of Technology
@@ -381,7 +381,9 @@ USA.
 		   (set-port/unread! port #f)
 		   1)
 		 (let ((n (defer port string start end)))
-		   (transcribe-substring string start (fix:+ start n) port)
+		   (if (and n (fix:> n 0))
+		       (transcribe-substring string start (fix:+ start n)
+					     port))
 		   n)))))
 	(read-wide-substring
 	 (let ((defer (op 'READ-WIDE-SUBSTRING)))
@@ -407,7 +409,8 @@ USA.
 		   (set-port/unread! port #f)
 		   1)
 		 (let ((n (defer port string start end)))
-		   (transcribe-substring string start (+ start n) port)
+		   (if (and n (fix:> n 0))
+		       (transcribe-substring string start (+ start n) port))
 		   n))))))
     (lambda (name)
       (case name
@@ -452,7 +455,7 @@ USA.
 		   (begin
 		     (set-port/previous!
 		      port
-		      (string-ref string (fix:+ start (fix:- n 1))))
+		      (wide-string-ref string (fix:+ start (fix:- n 1))))
 		     (transcribe-substring string start (fix:+ start n) port)))
 	       n))))
 	(write-external-substring
diff --git a/v7/src/runtime/unicode.scm b/v7/src/runtime/unicode.scm
index 8ed5b3a96..150dff5a2 100644
--- a/v7/src/runtime/unicode.scm
+++ b/v7/src/runtime/unicode.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: unicode.scm,v 1.23 2005/05/30 04:10:47 cph Exp $
+$Id: unicode.scm,v 1.24 2005/12/09 07:06:23 riastradh Exp $
 
 Copyright 2001,2003,2004,2005 Massachusetts Institute of Technology
 
@@ -1215,7 +1215,9 @@ USA.
 		`((WRITE-CHAR
 		   ,(lambda (port char)
 		      (guarantee-wide-char char 'WRITE-CHAR)
-		      ((port/state port) char)))
+		      ((port/state port) char)
+		      ;; Return the number of characters written.
+		      1))
 		  (EXTRACT-OUTPUT
 		   ,(lambda (port)
 		      (%make-wide-string
-- 
2.25.1