* eval.c (eval_init): Registered existing make_catenated_stream as

intrinsic.

* stream.c (cat_get_line, cat_get_char, cat_get_byte): Do not
remove the last stream from the stream list, so that there is
some stream object there which can take the unget-char or
unget-byte operations.
(cat_unget_byte, cat_unget_char): New static functions.
(cat_stream_ops): unget_char and unget_byte function pointers
filled in.

* txr.1: Documented catenated-streams.

4 files changed, 95 insertions, 5 deletions

diff --git a/ChangeLog b/ChangeLog
index 0dec145e..f1435385 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,20 @@
 2014-01-28  Kaz Kylheku  <kaz@kylheku.com>
 
+	* eval.c (eval_init): Registered existing make_catenated_stream as
+	intrinsic.
+
+	* stream.c (cat_get_line, cat_get_char, cat_get_byte): Do not
+	remove the last stream from the stream list, so that there is
+	some stream object there which can take the unget-char or
+	unget-byte operations.
+	(cat_unget_byte, cat_unget_char): New static functions.
+	(cat_stream_ops): unget_char and unget_byte function pointers
+	filled in.
+
+	* txr.1: Documented catenated-streams.
+
+2014-01-28  Kaz Kylheku  <kaz@kylheku.com>
+
 	* stream.c (struct stdio_handle): New member, is_rotated.
 	Moved mode member down.
 	(make_stdio_stream_common): Initialize is_rotated.
diff --git a/eval.c b/eval.c
index d526954d..1cfd76f6 100644
--- a/eval.c
+++ b/eval.c
@@ -2542,6 +2542,7 @@ void eval_init(void)
   reg_fun(intern(lit("real-time-stream-p"), user_package), func_n1(real_time_stream_p));
   reg_fun(intern(lit("stream-set-prop"), user_package), func_n3(stream_set_prop));
   reg_fun(intern(lit("stream-get-prop"), user_package), func_n2(stream_get_prop));
+  reg_fun(intern(lit("make-catenated-stream"), user_package), func_n0v(make_catenated_stream));
   reg_var(intern(lit("s-ifmt"), user_package), &s_ifmt);
   reg_var(intern(lit("s-iflnk"), user_package), &s_iflnk);
   reg_var(intern(lit("s-ifreg"), user_package), &s_ifreg);
@@ -2573,6 +2574,7 @@ void eval_init(void)
   reg_fun(intern(lit("open-process"), user_package), func_n3o(open_process, 2));
   reg_fun(intern(lit("remove-path"), user_package), func_n1(remove_path));
   reg_fun(intern(lit("rename-path"), user_package), func_n2(rename_path));
+
   reg_var(intern(lit("*user-package*"), user_package), &user_package);
   reg_var(intern(lit("*keyword-package*"), user_package), &keyword_package);
   reg_var(intern(lit("*system-package*"), user_package), &system_package);
diff --git a/stream.c b/stream.c
index 3256efc4..be78229d 100644
--- a/stream.c
+++ b/stream.c
@@ -2253,7 +2253,8 @@ static val cat_get_line(val stream)
     val line = get_line(first(streams));
     if (line)
       return line;
-    stream->co.handle = (mem_t *) (streams = rest(streams));
+    if ((streams = rest(streams)) != nil)
+      stream->co.handle = (mem_t *) streams;
   }
 
   return nil;
@@ -2267,7 +2268,8 @@ static val cat_get_char(val stream)
     val ch = get_char(first(streams));
     if (ch)
       return ch;
-    stream->co.handle = (mem_t *) (streams = rest(streams));
+    if ((streams = rest(streams)) != nil)
+      stream->co.handle = (mem_t *) streams;
   }
 
   return nil;
@@ -2281,12 +2283,43 @@ static val cat_get_byte(val stream)
     val byte = get_byte(first(streams));
     if (byte)
       return byte;
-    stream->co.handle = (mem_t *) (streams = rest(streams));
+    if ((streams = rest(streams)) != nil)
+      stream->co.handle = (mem_t *) streams;
   }
 
   return nil;
 }
 
+static val cat_unget_byte(val stream, int byte)
+{
+  val streams = (val) stream->co.handle;
+
+  if (!streams) {
+    uw_throwf(file_error_s,
+              lit("unget-byte on catenated stream ~a: stream list empty"),
+              stream, nao);
+  } else {
+    val stream = car(streams);
+    return unget_byte(stream, num_fast(byte));
+  }
+
+  return nil;
+}
+
+static val cat_unget_char(val stream, val ch)
+{
+  val streams = (val) stream->co.handle;
+
+  if (!streams) {
+    uw_throwf(file_error_s,
+              lit("unget-char on catenated stream ~a: stream list empty"),
+              stream, nao);
+  } else {
+    val stream = car(streams);
+    return unget_char(stream, ch);
+  }
+}
+
 static val cat_get_prop(val stream, val ind)
 {
   val streams = (val) stream->co.handle;
@@ -2307,8 +2340,8 @@ static struct strm_ops cat_stream_ops = {
   cat_get_line,
   cat_get_char,
   cat_get_byte,
-  0, /* unget_char, */
-  0, /* unget_byte, */
+  cat_unget_char,
+  cat_unget_byte,
   0, /* close, */
   0, /* flush, */
   0, /* seek, */
diff --git a/txr.1 b/txr.1
index f84455bf..89148672 100644
--- a/txr.1
+++ b/txr.1
@@ -10983,6 +10983,46 @@ the stream-real-time-p function above), and also for setting the priority at
 which messages are reported to syslog by the *stdlog* stream (see *stdlog*
 in the UNIX SYSLOG section).
 
+If <stream> is a catenated stream (see the function make-catenated-stream)
+then these functions transparently operate on the current head stream of the
+catenation.
+
+.SS Function make-catenated-stream
+
+.TP
+Syntax:
+
+  (make-catenated-stream . streams)
+
+.TP
+Description
+
+The make-catenated-stream function takes zero or more arguments which
+are input streams of the same type.
+
+A concatenaed stream does not support seeking operations or output,
+regardless of the capabilities of the streams in the list.
+
+If the stream list is not empty, then the leftmost element of the
+list is called the head stream.
+
+The get-char, get-byte, get-line, unget-char and unget-byte delegate
+to the corresponding operations on the head stream, if it exists.
+If the stream list is empty, they return nil to the caller.
+
+The a get-char, get-byte or get-line operation on the head stream yields nil,
+and there are more lists in the stream, then the stream is removed from the
+list, and the next stream, if any, becomes the head list. The operation is then
+tried again.  If any of these operations fail on the last list, it is not
+removed from the list, so that a stream remains in place which can take
+the unget-char or unget-byte operations.
+
+In this manner, the catenated streams appear to be a single stream.
+
+Note that the operations can fail due to being unsupported. It is
+the caller's responsibility to make sure all of the streams in the list
+are compatible with the intended operations.
+
 .SS Function read
 
 .TP