This is lstream.c in view mode; [Download] [Up]
/* 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);
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.