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.

diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index 310928619a0af64ccb33434b47c15653fd861f4c..096c837a9085e40fc8d072a0fb73d5bd8e45a19b 100644 (file)
--- 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 5e7a9f2769500560c9fe2ba8df6e6e67e56364e4..5cab1743f8260c790db0079625a05631cb52f892 100644 (file)
--- 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 cf75550c3e1d9bdb37b6a616cee39768daa17fd7..a5bbea293d0e6a736ab616f9f902a3670494a38c 100644 (file)
--- 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 8ed5b3a965f3a11c1766e0cf30b61dca1aa4ced0..150dff5a2485abb3f086d583dbde8bca58aced9d 100644 (file)
--- 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