/* Generic stream implementation.
   Copyright (C) 1995 Amdahl Corporation.

This file is part of XEmacs.

XEmacs is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.

XEmacs is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with XEmacs; see the file COPYING.  If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */

/* Synched up with: Not in FSF. */

/* Written by Ben Wing. */

#include <config.h>
#include "lisp.h"

#include "buffer.h"
#include "lstream.h"

/* This function provides a generic buffering stream implementation.
   Conceptually, you send data to the stream or read data from the
   stream, not caring what's on the other end of the stream.  The
   other end could be another stream, a file descriptor, a stdio
   stream, a fixed block of memory, a reallocating block of memory,
   etc.  The main purpose of the stream is to provide a standard
   interface and to do buffering.  Macros are defined to read
   or write characters, so the calling functions do not have to
   worry about blocking data together in order to achieve efficiency.
   */

/* Note that this object is called "stream" in Lisp but "lstream"
   in C.  The reason for this is that "stream" is too generic a name
   for C; too much likelihood of conflict/confusion with C++, etc. */

/* Functions are as follows:

Lstream *Lstream_new (Lstream_implementation *imp)
	Allocate and return a new Lstream.  This function is not
	really meant to be called directly; rather, each stream type
	should provide its own stream creation function, which
	creates the stream and does any other necessary creation
	stuff (e.g. opening a file).

void Lstream_set_buffering (Lstream *lstr, Lstream_buffering buffering,
			    int buffering_size)
	Change the buffering of a stream.  See lstream.h.  By default
	the buffering is STREAM_BLOCK_BUFFERED.

int Lstream_flush (Lstream *lstr)
	Flush out any pending unwritten data in the stream.  Clear
	any buffered input data.  Returns 0 on success, -1 on error.

int Lstream_putc (Lstream *stream, int c)
	Write out one byte to the stream.  This is a macro and so
	it is very efficient.  The C argument is only evaluated once
	but the STREAM argument is evaluated more than once.  Returns
	0 on success, -1 on error.
	
int Lstream_getc (Lstream *stream)
	Read one byte from the stream.  This is a macro and so it
	is very efficient.  The STREAM argument is evaluated more
	than once.  Return value is -1 for EOF or error.

void Lstream_ungetc (Lstream *stream, int c)
	Push one byte back onto the input queue.  This will be
	the next byte read from the stream.  Any number of
	bytes can be pushed back and will be read in the order
	they were pushed back.  This is a macro and so it is very
	efficient.  The C argument is only evaluated once but the
	STREAM argument is evaluated more than once.

int Lstream_fputc (Lstream *stream, int c)
int Lstream_fgetc (Lstream *stream)
void Lstream_fungetc (Lstream *stream, int c)
	Function equivalents of the above macros. 

int Lstream_read (Lstream *stream, void *data, int size)
	Read SIZE bytes of DATA from the stream.  Return the number of
	bytes read.  0 means EOF. -1 means an error occurred and no
	bytes were read.

int Lstream_write (Lstream *stream, void *data, int size)
	Write SIZE bytes of DATA to the stream.  Return the number of
	bytes written.  -1 means an error occurred and no bytes were
	written.

void Lstream_unread (Lstream *stream, void *data, int size)
	Push back SIZE bytes of DATA onto the input queue.  The
	bytes will be read back in the order they were pushed.  There
	is no limit on the number of bytes that can be pushed back.

int Lstream_close (Lstream *stream)
	Close the stream.  All data will be flushed out.

void
Lstream_reopen (Lstream *stream)
	Reopen a closed stream.  This enables I/O on it again.

*/   

static Lisp_Object mark_lstream (Lisp_Object, void (*) (Lisp_Object));
static void print_lstream (Lisp_Object obj, Lisp_Object printcharfun,
			   int escapeflag);
static void finalize_lstream (void *header, int for_disksave);
static unsigned int sizeof_lstream (CONST void *header);
DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("stream", lstream,
					mark_lstream, print_lstream,
					finalize_lstream, 0, 0,
					sizeof_lstream, Lstream);
Lisp_Object Qstreamp;

#define DEFAULT_BLOCK_BUFFERING_SIZE 512
#define MAX_READ_SIZE 512

static Lisp_Object
mark_lstream (Lisp_Object obj, void (*markobj) (Lisp_Object))
{
  Lstream *lstr = XLSTREAM (obj);
  if (lstr->imp->marker)
    return (lstr->imp->marker) (obj, markobj);
  else
    return Qnil;
}

static void
print_lstream (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
{
  Lstream *lstr = XLSTREAM (obj);
  char buf[200];

  if (print_readably)
    error ("printing unreadable object #<%s stream 0x%x>",
	   lstr->imp->name, lstr->header.uid);

  sprintf (buf, "#<%s stream 0x%x>", lstr->imp->name, lstr->header.uid);
  write_c_string (buf, printcharfun);
}

static void
finalize_lstream (void *header, int for_disksave)
{
  /* WARNING WARNING WARNING.  This function (and all finalize functions)
     may get called more than once on the same object, and may get called
     (at dump time) on objects that are not being released. */
  Lstream *lstr = (Lstream *) header;
  if (lstr->is_open)
    Lstream_close (lstr);
  /* We set the pointers to 0 so that we don't lose when this function
     is called more than once on the same object */
  if (lstr->out_buffer)
    {
      xfree (lstr->out_buffer);
      lstr->out_buffer = 0;
    }
  if (lstr->in_buffer)
    {
      xfree (lstr->in_buffer);
      lstr->in_buffer = 0;
    }
  if (lstr->unget_buffer)
    {
      xfree (lstr->unget_buffer);
      lstr->unget_buffer = 0;
    }
}

static unsigned int
sizeof_lstream (CONST void *header)
{
  CONST Lstream *lstr = (CONST Lstream *) header;
  return sizeof (*lstr) + lstr->imp->size - 1;
}

void
Lstream_set_buffering (Lstream *lstr, Lstream_buffering buffering,
		       int buffering_size)
{
  lstr->buffering = buffering;
  switch (buffering)
    {
    case LSTREAM_UNBUFFERED:
      lstr->buffering_size = 0; break;
    case LSTREAM_BLOCK_BUFFERED:
      lstr->buffering_size = DEFAULT_BLOCK_BUFFERING_SIZE; break;
    case LSTREAM_BLOCKN_BUFFERED:
      lstr->buffering_size = buffering_size; break;
    case LSTREAM_LINE_BUFFERED:
    case LSTREAM_UNLIMITED:
      lstr->buffering_size = INT_MAX; break;
    }
}

Lstream *
Lstream_new (CONST Lstream_implementation *imp)
{
  Lstream *p = alloc_lcrecord (sizeof (*p) + imp->size - 1,
			       lrecord_lstream);
  /* Zero it out, except the header. */
  memset ((char *) p + sizeof (p->header), 0,
	  sizeof (*p) - sizeof (p->header) + imp->size - 1);
  p->imp = imp;
  Lstream_set_buffering (p, LSTREAM_BLOCK_BUFFERED, 0);
  p->is_open = 1;
  return p;
}

void
Lstream_reopen (Lstream *lstr)
{
  if (lstr->is_open)
    {
      Lisp_Object obj = Qnil;
      XSETLSTREAM (obj, lstr);
      signal_simple_error ("Internal error: lstream already open", obj);
    }
  lstr->is_open = 1;
}

int
Lstream_flush_out (Lstream *lstr)
{
  int num_written;

  while (lstr->out_buffer_ind > 0)
    {
      if (!lstr->is_open)
	{
	  Lisp_Object obj = Qnil;
	  XSETLSTREAM (obj, lstr);
	  signal_simple_error ("Internal error: lstream not open", obj);
	}
      if (!lstr->imp->writer)
	{
	  Lisp_Object obj = Qnil;
	  XSETLSTREAM (obj, lstr);
	  signal_simple_error ("Internal error: lstream has no writer", obj);
	}
      num_written =
	(lstr->imp->writer) (lstr, lstr->out_buffer, lstr->out_buffer_ind);
      if (num_written == 0 || num_written >= lstr->out_buffer_ind)
	lstr->out_buffer_ind = 0;
      else if (num_written >= 0)
	{
	  memmove (lstr->out_buffer, lstr->out_buffer + num_written,
		   lstr->out_buffer_ind - num_written);
	  lstr->out_buffer_ind -= num_written;
	}
      if (num_written <= 0)
	/* #### should we discard the data on an error? */
	return -1;
    }

  return 0;
}

int
Lstream_flush (Lstream *lstr)
{
  if (Lstream_flush_out (lstr) < 0)
    return -1;

  /* clear out buffered data */
  lstr->in_buffer_current = lstr->in_buffer_ind = 0;
  lstr->unget_buffer_start = lstr->unget_buffer_end = 0;

  return 0;
}

/* We want to add NUM characters.  This function ensures that the
   buffer is large enough for this (per the buffering size specified
   in the stream) and returns the number of characters we can
   actually write. */

static int
Lstream_adding (Lstream *lstr, int num)
{
  int size_needed = min (lstr->buffering_size,
			 max (lstr->out_buffer_size,
			      num + lstr->out_buffer_ind));
  DO_REALLOC (lstr->out_buffer, lstr->out_buffer_size,
	      size_needed, unsigned char);
  return min (num, size_needed - lstr->out_buffer_ind);
}

/* Like Lstream_write(), but does not handle line-buffering correctly. */

static int
Lstream_write_1 (Lstream *stream, CONST void *data, int size)
{
  unsigned char *p = (unsigned char *) data;
  int off = 0;
  if (!stream->is_open)
    {
      Lisp_Object obj = Qnil;
      XSETLSTREAM (obj, stream);
      signal_simple_error ("Internal error: lstream not open", obj);
    }
  while (1)
    {
      /* Figure out how much we can add to the buffer */
      int chunk = Lstream_adding (stream, size);
      /* Do it. */
      if (chunk > 0)
	memcpy (stream->out_buffer + stream->out_buffer_ind, p + off, chunk);
      stream->out_buffer_ind += chunk;
      stream->byte_count += chunk;
      size -= chunk;
      off += chunk;
      /* If the buffer is full and we have more to add, flush it out. */
      if (size > 0)
	{
	  if (Lstream_flush_out (stream) < 0)
	    {
	      if (off == 0)
		return -1;
	      else
		return off;
	    }
	}
      else
	break;
    }
  return off;
}

/* If the stream is not line-buffered, then we can just call
   Lstream_write_1(), which writes in chunks.  Otherwise, we
   repeatedly call Lstream_putc(), which knows how to handle
   line buffering. */

int
Lstream_write (Lstream *stream, CONST void *data, int size)
{
  int i;
  unsigned char *p = (unsigned char *) data;

  assert (size >= 0);
  if (size == 0)
    return size;
  if (stream->buffering != LSTREAM_LINE_BUFFERED)
    return Lstream_write_1 (stream, data, size);
  for (i = 0; i < size; i++)
    {
      if (Lstream_putc (stream, p[i]) < 0)
	break;
    }
  return i == 0 ? -1 : 0;
}

/* Assuming the buffer is empty, fill it up again. */

static int
Lstream_read_more (Lstream *lstr)
{
#if 0
  int size_needed = max (1, min (MAX_READ_SIZE, lstr->buffering_size));
#else
  /* If someone requested a larger buffer size, so be it! */
  int size_needed = max (1, lstr->buffering_size);
#endif
  int size_gotten;

  if (!lstr->is_open)
    {
      Lisp_Object obj = Qnil;
      XSETLSTREAM (obj, lstr);
      signal_simple_error ("Internal error: lstream not open", obj);
    }
  if (!lstr->imp->reader)
    {
      Lisp_Object obj = Qnil;
      XSETLSTREAM (obj, lstr);
      signal_simple_error ("Internal error: lstream has no reader", obj);
    }
  DO_REALLOC (lstr->in_buffer, lstr->in_buffer_size,
	      size_needed, unsigned char);
  size_gotten = (lstr->imp->reader) (lstr, lstr->in_buffer,
				     size_needed);
  lstr->in_buffer_current = max (0, size_gotten);
  lstr->in_buffer_ind = 0;
  return size_gotten < 0 ? -1 : size_gotten;
}  

int
Lstream_read (Lstream *stream, void *data, int size)
{
  unsigned char *p = (unsigned char *) data;
  int off = 0;
  int chunk;
  int error_occurred = 0;

  assert (size >= 0);
  if (size == 0)
    return 0;

  /* First try to get some data from the unget buffer */
  chunk = min (size, stream->unget_buffer_end - stream->unget_buffer_start);
  if (chunk > 0)
    {
      memcpy (p, &stream->unget_buffer[stream->unget_buffer_start], chunk);
      stream->unget_buffer_start += chunk;
      stream->byte_count += chunk;
      off = chunk;
      size -= chunk;
    }

  while (size > 0)
    {
      /* Take whatever we can from the in buffer */
      chunk = min (size, stream->in_buffer_current - stream->in_buffer_ind);
      if (chunk > 0)
	memcpy (p + off, stream->in_buffer + stream->in_buffer_ind, chunk);
      stream->in_buffer_ind += chunk;
      stream->byte_count += chunk;
      size -= chunk;
      off += chunk;

      /* If we need some more, try to get some more from the stream's end */
      if (size > 0)
	{
	  int retval = Lstream_read_more (stream);
	  if (retval < 0)
	    error_occurred = 1;
	  if (retval <= 0)
	    break;
	}
    }

  return ((off == 0 && error_occurred) ? -1 : off);
}

void
Lstream_unread (Lstream *stream, void *data, int size)
{
  /* Move any existing unget characters to the beginning of the buffer */
  if (stream->unget_buffer_start != stream->unget_buffer_end)
    memmove (stream->unget_buffer,
	     stream->unget_buffer + stream->unget_buffer_start,
	     stream->unget_buffer_end - stream->unget_buffer_start);
  stream->unget_buffer_end -= stream->unget_buffer_start;
  stream->unget_buffer_start = 0;

  /* Make sure buffer is big enough */

  DO_REALLOC (stream->unget_buffer, stream->unget_buffer_size,
	      stream->unget_buffer_end + size, unsigned char);

  memcpy (stream->unget_buffer + stream->unget_buffer_end, data, size);
  stream->unget_buffer_end += size;
  stream->byte_count -= size;
}

int
Lstream_rewind (Lstream *stream)
{
  if (!stream->imp->rewinder)
    {
      Lisp_Object obj = Qnil;
      XSETLSTREAM (obj, stream);
      signal_simple_error ("Internal error: lstream has no rewinder", obj);
    }
  if (Lstream_flush (stream) < 0)
    return -1;
  stream->byte_count = 0;
  return (stream->imp->rewinder) (stream);
}
  
int
Lstream_close (Lstream *stream)
{
  if (stream->is_open)
    {
      if (Lstream_flush (stream) < 0)
	return -1;
      if (stream->imp->closer)
	{
	  if ((stream->imp->closer) (stream) < 0)
	    return -1;
	}
    }

  stream->is_open = 0;
  stream->byte_count = 0;
  /* Note that Lstream_flush() reset all the buffer indices.  That way,
     the next call to Lstream_putc(), Lstream_getc(), or Lstream_ungetc()
     on a closed stream will call into the function equivalents, which will
     cause an error. */
  return 0;
}

int
Lstream_fputc (Lstream *stream, int c)
{
  unsigned char ch = (unsigned char) c;
  int retval = Lstream_write_1 (stream, &ch, 1);
  if (retval >= 0 && stream->buffering == LSTREAM_LINE_BUFFERED && ch == '\n')
    return Lstream_flush_out (stream);
  return retval < 0 ? -1 : 0;
}

int
Lstream_fgetc (Lstream *stream)
{
  unsigned char ch;
  if (Lstream_read (stream, &ch, 1) <= 0)
    return -1;
  return ch;
}

void
Lstream_fungetc (Lstream *stream, int c)
{
  unsigned char ch = (unsigned char) c;
  Lstream_unread (stream, &ch, 1);
}

DEFUN ("streamp", Fstreamp, Sstreamp, 1, 1, 0,
       "Return non-nil if OBJECT is a stream.")
  (object)
  Lisp_Object object;
{
  return (LSTREAMP (object) ? Qt : Qnil);
}


/************************ some stream implementations *********************/

/*********** a stdio stream ***********/

struct stdio_stream
{
  FILE *file;
  int closing;
};

#define get_stdio_stream(stream) \
  ((struct stdio_stream *) Lstream_data (stream))

static int stdio_reader (Lstream *stream, unsigned char *data, int size);
static int stdio_writer (Lstream *stream, CONST unsigned char *data, int size);
static int stdio_rewinder (Lstream *stream);
static int stdio_closer (Lstream *stream);

DEFINE_LSTREAM_IMPLEMENTATION ("stdio", lstream_stdio, stdio_reader,
			       stdio_writer, stdio_rewinder, stdio_closer,
			       0, sizeof (struct stdio_stream));

Lisp_Object
make_stdio_stream (FILE *stream, int flags)
{
  Lisp_Object obj = Qnil;
  Lstream *lstr = Lstream_new (lstream_stdio);
  struct stdio_stream *str = get_stdio_stream (lstr);
  str->file = stream;
  str->closing = flags & LSTR_CLOSING;
  XSETLSTREAM (obj, lstr);
  return obj;
}

static int
stdio_reader (Lstream *stream, unsigned char *data, int size)
{
  struct stdio_stream *str = get_stdio_stream (stream);
  size_t val = fread (data, 1, (size_t) size, str->file);
  if (!val && ferror (str->file))
    return -1;
  return (int) val;
}

static int
stdio_writer (Lstream *stream, CONST unsigned char *data, int size)
{
  struct stdio_stream *str = get_stdio_stream (stream);
  size_t val = fwrite (data, 1, (size_t) size, str->file);
  if (!val && ferror (str->file))
    return -1;
  return (int) val;
}

static int
stdio_closer (Lstream *stream)
{
  struct stdio_stream *str = get_stdio_stream (stream);
  if (str->closing)
    return fclose (str->file);
  else
    return fflush (str->file);
}

static int
stdio_rewinder (Lstream *stream)
{
  rewind (get_stdio_stream (stream)->file);
  return 0;
}

/*********** a file descriptor ***********/

struct filedesc_stream
{
  int fd;
  int pty_max_bytes;
  Bufbyte eof_char;
  int closing:1;
  int allow_quit:1;
};

#define get_filedesc_stream(stream) \
  ((struct filedesc_stream *) Lstream_data (stream))

static int filedesc_reader (Lstream *stream, unsigned char *data, int size);
static int filedesc_writer (Lstream *stream, CONST unsigned char *data,
			    int size);
static int filedesc_rewinder (Lstream *stream);
static int filedesc_closer (Lstream *stream);

DEFINE_LSTREAM_IMPLEMENTATION ("filedesc", lstream_filedesc, filedesc_reader,
			       filedesc_writer, filedesc_rewinder,
			       filedesc_closer, 0,
			       sizeof (struct filedesc_stream));

Lisp_Object
make_filedesc_stream (int filedesc, int flags)
{
  Lisp_Object obj = Qnil;
  Lstream *lstr = Lstream_new (lstream_filedesc);
  struct filedesc_stream *fstr = get_filedesc_stream (lstr);
  fstr->fd = filedesc;
  fstr->closing = !!(flags & LSTR_CLOSING);
  fstr->allow_quit = !!(flags & LSTR_ALLOW_QUIT);
  XSETLSTREAM (obj, lstr);
  return obj;
}

static int
filedesc_reader (Lstream *stream, unsigned char *data, int size)
{
  struct filedesc_stream *str = get_filedesc_stream (stream);
  return (str->allow_quit ? read_allowing_quit : read)
    (str->fd, data, size);
}

static int
filedesc_writer (Lstream *stream, CONST unsigned char *data, int size)
{
  /* !!#### needs to handle PTY eof output */
  struct filedesc_stream *str = get_filedesc_stream (stream);
  return (str->allow_quit ? write_allowing_quit : write)
    (str->fd, data, size);
}

static int
filedesc_rewinder (Lstream *stream)
{
  if (lseek (get_filedesc_stream (stream)->fd, 0, SEEK_SET) == -1)
    return -1;
  else
    return 0;
}

static int
filedesc_closer (Lstream *stream)
{
  struct filedesc_stream *str = get_filedesc_stream (stream);
  if (str->closing)
    return close (str->fd);
  else
    return 0;
}

void
filedesc_stream_set_pty_flushing (Lstream *stream, int pty_max_bytes,
				  Bufbyte eof_char)
{
  struct filedesc_stream *str = get_filedesc_stream (stream);
  str->pty_max_bytes = pty_max_bytes;
  str->eof_char = eof_char;
}

/*********** read from a Lisp string ***********/

#define get_lisp_string_stream(stream) \
  ((struct lisp_string_stream *) Lstream_data (stream))

struct lisp_string_stream
{
  Lisp_Object obj;
  Bytecount offset, end;
};

static int lisp_string_reader (Lstream *stream, unsigned char *data, int size);
static int lisp_string_rewinder (Lstream *stream);
static Lisp_Object lisp_string_marker (Lisp_Object stream,
				       void (*markobj) (Lisp_Object));

DEFINE_LSTREAM_IMPLEMENTATION ("lisp-string", lstream_lisp_string,
			       lisp_string_reader, 0, lisp_string_rewinder,
			       0, lisp_string_marker,
			       sizeof (struct lisp_string_stream));

Lisp_Object
make_lisp_string_stream (Lisp_Object string, Bytecount offset,
			 Bytecount len)
{
  Lisp_Object obj = Qnil;
  Lstream *lstr;
  struct lisp_string_stream *str;

  CHECK_STRING (string, 0);
  if (len < 0)
    len = string_length (XSTRING (string)) - offset;
  assert (offset >= 0);
  assert (len >= 0);
  assert (offset + len <= string_length (XSTRING (string)));

  lstr = Lstream_new (lstream_lisp_string);
  str = get_lisp_string_stream (lstr);
  str->offset = offset;
  str->end = offset + len;
  str->obj = string;
  XSETLSTREAM (obj, lstr);
  return obj;
}
			      
static int
lisp_string_reader (Lstream *stream, unsigned char *data, int size)
{
  struct lisp_string_stream *str = get_lisp_string_stream (stream);
  /* Don't lose if the string shrank past us ... */
  Bytecount offset = min (str->offset, string_length (XSTRING (str->obj)));
  Bufbyte *strstart = string_data (XSTRING (str->obj));
  Bufbyte *start = strstart + offset;

  /* ... or if someone changed the string and we ended up in the
     middle of a character. */
  VALIDATE_CHARPTR_BACKWARD (start);
  offset = start - strstart;
  size = min (size, str->end - offset);
  assert (size >= 0); /* paranoia */
  memcpy (data, start, size);
  str->offset = offset + size;
  return size;
}

static int
lisp_string_rewinder (Lstream *stream)
{
  get_lisp_string_stream (stream)->offset = 0;
  return 0;
}

static Lisp_Object
lisp_string_marker (Lisp_Object stream, void (*markobj) (Lisp_Object))
{
  struct lisp_string_stream *str = get_lisp_string_stream (XLSTREAM (stream));
  return str->obj;
}

/*********** a fixed buffer ***********/

#define get_fixed_buffer_stream(stream) \
  ((struct fixed_buffer_stream *) Lstream_data (stream))

struct fixed_buffer_stream
{
  unsigned char *buf;
  int size;
  int offset;
};

static int fixed_buffer_reader (Lstream *stream, unsigned char *data,
				int size);
static int fixed_buffer_writer (Lstream *stream, CONST unsigned char *data,
				int size);
static int fixed_buffer_rewinder (Lstream *stream);

DEFINE_LSTREAM_IMPLEMENTATION ("fixed-buffer", lstream_fixed_buffer,
			       fixed_buffer_reader, fixed_buffer_writer,
			       fixed_buffer_rewinder,
			       0, 0,
			       sizeof (struct fixed_buffer_stream));

Lisp_Object
make_fixed_buffer_stream (unsigned char *buf, int size)
{
  Lisp_Object obj = Qnil;
  Lstream *lstr;
  struct fixed_buffer_stream *str;

  lstr = Lstream_new (lstream_fixed_buffer);
  str = get_fixed_buffer_stream (lstr);
  str->buf = buf;
  str->size = size;
  XSETLSTREAM (obj, lstr);
  return obj;
}
			      
static int
fixed_buffer_reader (Lstream *stream, unsigned char *data, int size)
{
  struct fixed_buffer_stream *str = get_fixed_buffer_stream (stream);
  size = min (size, str->size - str->offset);
  memcpy (data, str->buf + str->offset, size);
  str->offset += size;
  return size;
}

static int
fixed_buffer_writer (Lstream *stream, CONST unsigned char *data, int size)
{
  struct fixed_buffer_stream *str = get_fixed_buffer_stream (stream);
  if (str->offset == str->size)
    {
      /* If we're at the end, just throw away the data and pretend
	 we wrote all of it.  If we return 0, then the lstream routines
	 will try again and again to write it out. */
      return size;
    }
  size = min (size, str->size - str->offset);
  memcpy (str->buf + str->offset, data, size);
  str->offset += size;
  return size;
}

static int
fixed_buffer_rewinder (Lstream *stream)
{
  get_fixed_buffer_stream (stream)->offset = 0;
  return 0;
}

unsigned char *
fixed_buffer_stream_ptr (Lstream *stream)
{
  assert (stream->imp == lstream_fixed_buffer);
  return get_fixed_buffer_stream (stream)->buf;
}

/*********** write to a resizing buffer ***********/

#define get_resizing_buffer_stream(stream) \
  ((struct resizing_buffer_stream *) Lstream_data (stream))

struct resizing_buffer_stream
{
  unsigned char *buf;
  int allocked;
  int stored;
};

static int resizing_buffer_writer (Lstream *stream, CONST unsigned char *data,
				   int size);
static int resizing_buffer_rewinder (Lstream *stream);
static int resizing_buffer_closer (Lstream *stream);

DEFINE_LSTREAM_IMPLEMENTATION ("resizing-buffer", lstream_resizing_buffer,
			       0, resizing_buffer_writer,
			       resizing_buffer_rewinder,
			       resizing_buffer_closer, 0,
			       sizeof (struct resizing_buffer_stream));

Lisp_Object
make_resizing_buffer_stream (void)
{
  Lisp_Object obj = Qnil;
  XSETLSTREAM (obj, Lstream_new (lstream_resizing_buffer));
  return obj;
}
			      
static int
resizing_buffer_writer (Lstream *stream, CONST unsigned char *data, int size)
{
  struct resizing_buffer_stream *str = get_resizing_buffer_stream (stream);
  DO_REALLOC (str->buf, str->allocked, str->stored + size, unsigned char);
  memcpy (str->buf + str->stored, data, size);
  str->stored += size;
  return size;
}

static int
resizing_buffer_rewinder (Lstream *stream)
{
  get_resizing_buffer_stream (stream)->stored = 0;
  return 0;
}

static int
resizing_buffer_closer (Lstream *stream)
{
  struct resizing_buffer_stream *str = get_resizing_buffer_stream (stream);
  if (str->buf)
    {
      xfree (str->buf);
      str->buf = 0;
    }
  return 0;
}

unsigned char *
resizing_buffer_stream_ptr (Lstream *stream)
{
  assert (stream->imp == lstream_resizing_buffer);
  return get_resizing_buffer_stream (stream)->buf;
}

/************ read from a Lisp buffer ************/

#define get_lisp_buffer_stream(stream) \
  ((struct lisp_buffer_stream *) Lstream_data (stream))

struct lisp_buffer_stream
{
  struct buffer *buf;
  Bufpos start, end;
  int flags;
};

static int lisp_buffer_reader (Lstream *stream, unsigned char *data,
				   int size);
static Lisp_Object lisp_buffer_marker (Lisp_Object stream,
				       void (*markobj) (Lisp_Object));

DEFINE_LSTREAM_IMPLEMENTATION ("lisp-buffer", lstream_lisp_buffer,
			       lisp_buffer_reader, 0,
			       0, 0, lisp_buffer_marker,
			       sizeof (struct lisp_buffer_stream));

Lisp_Object
make_lisp_buffer_stream (struct buffer *buf, Bufpos start, Bufpos end,
			 int flags)
{
  Lisp_Object obj = Qnil;
  Lstream *lstr;
  struct lisp_buffer_stream *str;
  Bufpos bmin, bmax;

  if (flags & LSTR_IGNORE_ACCESSIBLE)
    {
      bmin = BUF_BEG (buf);
      bmax = BUF_Z (buf);
    }
  else
    {
      bmin = BUF_BEGV (buf);
      bmax = BUF_ZV (buf);
    }

  if (start == -1)
    start = bmin;
  if (end == -1)
    end = bmax;
  assert (bmin <= start);
  assert (start <= bmax);
  assert (bmin <= end);
  assert (end <= bmax);
  assert (start <= end);

  lstr = Lstream_new (lstream_lisp_buffer);
  str = get_lisp_buffer_stream (lstr);
  str->buf = buf;
  str->start = start;
  str->end = end;
  str->flags = flags;
  XSETLSTREAM (obj, lstr);
  return obj;
}

static int
lisp_buffer_reader (Lstream *stream, unsigned char *data, int size)
{
  struct lisp_buffer_stream *str = get_lisp_buffer_stream (stream);
  Bytind bimin, bimax;
  unsigned char *orig_data = data;
  Bytind start;
  Bytind end;


  /* It's safer to keep START and END in the stream structure in
     Bufpos's in case the buffer's text changes, but we need to
     do all our operations in Bytind's.  Keep in mind that SIZE
     is a value in bytes, not chars. */
  if (str->flags & LSTR_IGNORE_ACCESSIBLE)
    {
      bimin = BI_BUF_BEG (str->buf);
      bimax = BI_BUF_Z (str->buf);
    }
  else
    {
      bimin = BI_BUF_BEGV (str->buf);
      bimax = BI_BUF_ZV (str->buf);
    }
  start = bytind_clip_to_bounds (bimin,
				 bufpos_to_bytind (str->buf, str->start),
				 bimax);
  end = bytind_clip_to_bounds (bimin,
			       bufpos_to_bytind (str->buf, str->end),
			       bimax);
  
  size = min (size, end - start);
  end = start + size;
  VALIDATE_BYTIND_BACKWARD (str->buf, end);

  while (start < end)
    {
      Bytind ceil;
      Bytecount chunk;

      if (str->flags & LSTR_IGNORE_ACCESSIBLE)
	ceil = BI_BUF_CEILING_OF_IGNORE_ACCESSIBLE (str->buf, start);
      else
	ceil = BI_BUF_CEILING_OF (str->buf, start);
      chunk = min (ceil, end) - start;
      memcpy (data, BI_BUF_BYTE_ADDRESS (str->buf, start), chunk);
      data += chunk;
      start += chunk;
    }

  str->start = bytind_to_bufpos (str->buf, end);

  if (EQ (str->buf->selective_display, Qt) && str->flags & LSTR_SELECTIVE)
    {
      /* What a kludge.  What a kludge.  What a kludge. */
      unsigned char *p;
      for (p = orig_data; p < data; p++)
	if (*p == '\r')
	  *p = '\n';
    }

  return data - orig_data;
}

static Lisp_Object
lisp_buffer_marker (Lisp_Object stream, void (*markobj) (Lisp_Object))
{
  struct lisp_buffer_stream *str =
    get_lisp_buffer_stream (XLSTREAM (stream));
  Lisp_Object buffer = Qnil;

  XSETBUFFER (buffer, str->buf);
  return buffer;
}


/************************************************************************/
/*                            initialization                            */
/************************************************************************/

void
syms_of_lstream (void)
{
  defsymbol (&Qstreamp, "streamp");
  defsubr (&Sstreamp);
}
