Eliminate reference to PORT/UNREAD by implementing UNREAD-CHAR

operation.

diff --git a/v7/src/edwin/bufinp.scm b/v7/src/edwin/bufinp.scm
index 6217cac311cb1a8d2bd0d650fffb03fd4d1cf8a0..3f7b12380809ed6c454a47b76ebfe070fdb0470c 100644 (file)
--- a/v7/src/edwin/bufinp.scm
+++ b/v7/src/edwin/bufinp.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: bufinp.scm,v 1.18 2008/07/11 05:26:42 cph Exp $
+$Id: bufinp.scm,v 1.19 2008/07/19 00:56:06 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -54,18 +54,20 @@ USA.
   (make-port buffer-input-port-type
             (make-bstate (mark-group start)
                          (mark-index start)
-                         (mark-index end))))
+                         (mark-index end)
+                         (mark-index start))))
 
 (define (input-port/mark port)
   (let ((operation (port/operation port 'BUFFER-MARK)))
     (if (not operation)
        (error:bad-range-argument port 'INPUT-PORT/MARK))
     (operation port)))
-
+\f
 (define-structure bstate
   (group #f read-only #t)
-  (start #f)
-  (end #f read-only #t))
+  (start #f read-only #t)
+  (end #f read-only #t)
+  (index #f))
 
 (define buffer-input-port-type
   (make-port-type
@@ -73,30 +75,38 @@ USA.
       ,(lambda (port)
        (let ((state (port/state port)))
          (make-mark (bstate-group state)
-                    (if (port/unread port)
-                        (- (bstate-start state) 1)
-                        (bstate-start state))))))
+                    (bstate-index state)))))
      (CHAR-READY?
       ,(lambda (port)
         (let ((state (port/state port)))
-          (fix:< (bstate-start state)
+          (fix:< (bstate-index state)
                  (bstate-end state)))))
      (PEEK-CHAR
       ,(lambda (port)
         (let ((state (port/state port)))
-          (let ((start (bstate-start state)))
-            (if (fix:< start (bstate-end state))
-                (group-right-char (bstate-group state) start)
+          (let ((index (bstate-index state)))
+            (if (fix:< index (bstate-end state))
+                (group-right-char (bstate-group state) index)
                 (eof-object))))))
      (READ-CHAR
       ,(lambda (port)
         (let ((state (port/state port)))
-          (let ((start (bstate-start state)))
-            (if (fix:< start (bstate-end state))
-                (let ((char (group-right-char (bstate-group state) start)))
-                  (set-bstate-start! state (fix:+ start 1))
+          (let ((index (bstate-index state)))
+            (if (fix:< index (bstate-end state))
+                (let ((char (group-right-char (bstate-group state) index)))
+                  (set-bstate-index! state (fix:+ index 1))
                   char)
                 (eof-object))))))
+     (UNREAD-CHAR
+      ,(lambda (port char)
+        (let ((state (port/state port)))
+          (let ((index (bstate-index state)))
+            (if (fix:<= index (bstate-start state))
+                (error "No character to unread:" port))
+            (if (not (char=? (group-left-char (bstate-group state) index)
+                             char))
+                (error "Incorrect char being unread:" char))
+            (set-bstate-index! state (fix:- index 1))))))
      (WRITE-SELF
       ,(lambda (port output)
         (write-string " from buffer at " output)

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index d468a984f26327d2089429b075835359c6c2014c..538e604f82c6cb70817c28da761e8d0722c5c386 100644 (file)
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.307 2008/05/05 04:42:02 cph Exp $
+$Id: edwin.pkg,v 1.308 2008/07/19 00:56:19 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -540,9 +540,7 @@ USA.
          call-with-input-region
          make-buffer-input-port
          with-input-from-mark
-         with-input-from-region)
-  (import (runtime port)
-         port/unread))
+         with-input-from-region))
 
 (define-package (edwin buffer-output-port)
   (files "bufout")