* ports.c (scm_seek): Add a special case for SEEK_CUR, offset 0,

	so that unread chars are not needlessly discarded.  (thanks to
	Roland Orre).

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 1be7c14..2e0ff69 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,9 @@
+1999-10-20  Gary Houston  <ghouston@freewire.co.uk>
+
+       * ports.c (scm_seek): Add a special case for SEEK_CUR, offset 0,
+       so that unread chars are not needlessly discarded.  (thanks to
+       Roland Orre).
+
 1999-10-18  Gary Houston  <ghouston@freewire.co.uk>
 
        * fports.c (scm_fdes_to_port): always set rw_random if the fdes is

diff --git a/libguile/ports.c b/libguile/ports.c
index 5ff9cfe..6a162a2 100644 (file)
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -965,12 +965,31 @@ scm_seek (SCM object, SCM offset, SCM whence)
                        scm_cons (object, SCM_EOL));
       else
        {
-         if (pt->rw_active == SCM_PORT_READ)
-           scm_end_input (object);
-         else if (pt->rw_active == SCM_PORT_WRITE)
-           ptob->flush (object);
+         /* there's no need to worry about what happens to the buffers
+            if the port isn't random-access: seek will fail anyway.  */
+         if (off == 0 && how == SEEK_CUR)
+           {
+             /* special case to avoid discarding put-back chars when
+                reading current position.  */
+             rv = ptob->seek (object, off, how);
+             if (pt->rw_active == SCM_PORT_READ)
+               {
+                 rv -= pt->read_end - pt->read_pos;
+                 if (pt->read_buf == pt->putback_buf)
+                   rv -= pt->saved_read_end - pt->saved_read_pos;
+               }
+             else if (pt->rw_active == SCM_PORT_WRITE)
+               rv += pt->write_pos - pt->write_buf;
+           }
+         else
+           {
+             if (pt->rw_active == SCM_PORT_READ)
+               scm_end_input (object);
+             else if (pt->rw_active == SCM_PORT_WRITE)
+               ptob->flush (object);
          
-         rv = ptob->seek (object, off, how);
+             rv = ptob->seek (object, off, how);
+           }
        }
     }
   else /* file descriptor?.  */