--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/doprnt.c	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,802 @@
+/* Output like sprintf to a buffer of specified size.
+   Also takes args differently: pass one pointer to an array of strings
+   in addition to the format string which is separate.
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Rewritten by mly to use varargs.h.
+   Rewritten from scratch by Ben Wing (February 1995) for Mule; expanded
+   to full printf spec.
+
+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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Rewritten.  Not in FSF. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "lstream.h"
+
+static CONST char *valid_flags = "-+ #0";
+
+static CONST char *valid_converters = "diouxXfeEgGcsS";
+static CONST char *int_converters = "dic";
+static CONST char *unsigned_int_converters = "ouxX";
+static CONST char *double_converters = "feEgG";
+static CONST char *string_converters = "sS";
+
+struct printf_spec
+{
+  int argnum; /* which argument does this spec want?  This is one-based:
+		 The first argument given is numbered 1, the second
+		 is 2, etc.  This is to handle %##$x-type specs. */
+  int minwidth;
+  int precision;
+  int minus_flag:1;
+  int plus_flag:1;
+  int space_flag:1;
+  int number_flag:1;
+  int zero_flag:1;
+  int h_flag:1;
+  int l_flag:1;
+  char converter; /* converter character or 0 for dummy marker
+		     indicating literal text at the end of the
+		     specification */
+  Bytecount text_before; /* position of the first character of the
+			    block of literal text before this spec */
+  Bytecount text_before_len; /* length of that text */
+};
+
+union printf_arg
+{
+  int i;
+  unsigned int ui;
+  long l;
+  unsigned long ul;
+  double d;
+  Bufbyte *bp;
+};
+
+/* We maintain a list of all the % specs in the specification,
+   along with the offset and length of the block of literal text
+   before each spec.  In addition, we have a "dummy" spec that
+   represents all the literal text at the end of the specification.
+   Its converter is 0. */
+
+typedef struct
+{
+  Dynarr_declare (struct printf_spec);
+} printf_spec_dynarr;
+
+typedef struct
+{
+  Dynarr_declare (union printf_arg);
+} printf_arg_dynarr;
+
+/* Append STRING (of length LEN) to STREAM.  MINLEN is the minimum field
+   width.  If MINUS_FLAG is set, left-justify the string in its field;
+   otherwise, right-justify.  If ZERO_FLAG is set, pad with 0's; otherwise
+   pad with spaces.  If MAXLEN is non-negative, the string is first
+   truncated to that many character.
+
+   Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */
+
+static void
+doprnt_1 (Lisp_Object stream, CONST Bufbyte *string, Bytecount len,
+	  Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag)
+{
+  Charcount cclen;
+  Bufbyte pad;
+  Lstream *lstr = XLSTREAM (stream);
+
+  cclen = bytecount_to_charcount (string, len);
+
+  if (zero_flag)
+    pad = '0';
+  else
+    pad = ' ';
+
+  /* Padding at beginning to right-justify ... */
+  if (minlen > cclen && !minus_flag)
+    {
+      int to_add = minlen - cclen;
+      while (to_add > 0)
+	{
+	  Lstream_putc (lstr, pad);
+	  to_add--;
+	}
+    }
+  
+  if (maxlen >= 0)
+    len = charcount_to_bytecount (string, min (maxlen, cclen));
+  Lstream_write (lstr, string, len);
+
+  /* Padding at end to left-justify ... */
+  if (minlen > cclen && minus_flag)
+    {
+      int to_add = minlen - cclen;
+      while (to_add > 0)
+	{
+	  Lstream_putc (lstr, pad);
+	  to_add--;
+	}
+    }
+}
+
+static CONST Bufbyte *
+parse_off_posnum (CONST Bufbyte *start, CONST Bufbyte *end, int *returned_num)
+{
+  Bufbyte arg_convert[100];
+  REGISTER Bufbyte *arg_ptr = arg_convert;
+  
+  *returned_num = -1;
+  while (start != end && isdigit (*start))
+    {
+      if (arg_ptr - arg_convert >= sizeof (arg_convert) - 1)
+	error ("Format converter number too large");
+      *arg_ptr++ = *start++;
+    }
+  *arg_ptr = '\0';
+  if (arg_convert != arg_ptr)
+    *returned_num = atoi ((char *) arg_convert);
+  return start;
+}
+
+#define NEXT_ASCII_BYTE(ch)					\
+  do {								\
+    if (fmt == fmt_end)						\
+      error ("Premature end of format string");			\
+    ch = *fmt;							\
+    if (ch >= 0200)						\
+      error ("Non-ASCII character in format converter spec");	\
+    fmt++;							\
+  } while (0)
+
+static printf_spec_dynarr *
+parse_doprnt_spec (CONST Bufbyte *format, Bytecount format_length)
+{
+  CONST Bufbyte *fmt = format;
+  CONST Bufbyte *fmt_end = format + format_length;
+  printf_spec_dynarr *specs = Dynarr_new (struct printf_spec);
+  int prev_argnum = 0;
+
+  while (1)
+    {
+      struct printf_spec spec;
+      CONST Bufbyte *text_end;
+      Bufbyte ch;
+
+      memset (&spec, 0, sizeof (spec));
+      if (fmt == fmt_end)
+	return specs;
+      text_end = (Bufbyte *) memchr (fmt, '%', fmt_end - fmt);
+      if (!text_end)
+	text_end = fmt_end;
+      spec.text_before = fmt - format;
+      spec.text_before_len = text_end - fmt;
+      fmt = text_end;
+      if (fmt != fmt_end)
+	{
+	  fmt++; /* skip over % */
+
+	  /* A % is special -- no arg number.  According to ANSI specs,
+	     field width does not apply to %% conversion. */
+	  if (fmt != fmt_end && *fmt == '%')
+	    {
+	      spec.converter = '%';
+	      Dynarr_add (specs, spec);
+	      fmt++;
+	      continue;
+	    }
+
+	  /* Is there a field number specifier? */
+	  {
+	    CONST Bufbyte *ptr;
+	    int fieldspec;
+
+	    ptr = parse_off_posnum (fmt, fmt_end, &fieldspec);
+	    if (fieldspec > 0 && ptr != fmt_end && *ptr == '$')
+	      {
+		/* There is a format specifier */
+		prev_argnum = fieldspec;
+		fmt = ptr + 1;
+	      }
+	    else
+	      prev_argnum++;
+	    spec.argnum = prev_argnum;
+	  }
+
+	  /* Parse off any flags */
+	  NEXT_ASCII_BYTE (ch);
+	  while (strchr (valid_flags, ch))
+	    {
+	      switch (ch)
+		{
+		case '-': spec.minus_flag = 1; break;
+		case '+': spec.plus_flag = 1; break;
+		case ' ': spec.space_flag = 1; break;
+		case '#': spec.number_flag = 1; break;
+		case '0': spec.zero_flag = 1; break;
+		default: abort ();
+		}
+	      NEXT_ASCII_BYTE (ch);
+	    }
+	  
+	  /* Parse off the minimum field width */
+	  fmt--; /* back up */
+	  fmt = parse_off_posnum (fmt, fmt_end, &spec.minwidth);
+	  if (spec.minwidth == -1)
+	    spec.minwidth = 0;
+
+	  /* Parse off any precision specified */
+	  NEXT_ASCII_BYTE (ch);
+	  if (ch == '.')
+	    {
+	      fmt = parse_off_posnum (fmt, fmt_end, &spec.precision);
+	      if (spec.precision == -1)
+		spec.precision = 0;
+	      NEXT_ASCII_BYTE (ch);
+	    }
+	  else
+	    /* No precision specified */
+	    spec.precision = -1;
+
+	  /* Parse off h or l flag */
+	  if (ch == 'h' || ch == 'l')
+	    {
+	      if (ch == 'h')
+		spec.h_flag = 1;
+	      else
+		spec.l_flag = 1;
+	      NEXT_ASCII_BYTE (ch);
+	    }
+
+	  if (!strchr (valid_converters, ch))
+	    error ("Invalid converter character %c", ch);
+	  spec.converter = ch;
+	}
+
+      if (spec.space_flag && spec.plus_flag)
+	spec.space_flag = 0;
+      if (spec.zero_flag && spec.space_flag)
+	spec.zero_flag = 0;
+
+      Dynarr_add (specs, spec);
+    }
+
+  RETURN_NOT_REACHED(specs) /* suppress compiler warning */
+}
+
+static int
+get_args_needed (printf_spec_dynarr *specs)
+{
+  int args_needed = 0;
+  REGISTER int i;
+
+  /* Figure out how many args are needed.  This may be less than
+     the number of specs because a spec could be %% or could be
+     missing (literal text at end of format string) or there
+     could be specs where the field number is explicitly given.
+     We just look for the maximum argument number that's referenced. */
+
+  for (i = 0; i < Dynarr_length (specs); i++)
+    {
+      char ch = Dynarr_at (specs, i).converter;
+      if (ch && ch != '%')
+	{
+	  int argnum = Dynarr_at (specs, i).argnum;
+	  if (argnum > args_needed)
+	    args_needed = argnum;
+	}
+    }
+
+  return args_needed;
+}
+
+static printf_arg_dynarr *
+get_doprnt_args (printf_spec_dynarr *specs, va_list vargs)
+{
+  printf_arg_dynarr *args = Dynarr_new (union printf_arg);
+  union printf_arg arg;
+  REGISTER int i;
+  int args_needed = get_args_needed (specs);
+
+  memset (&arg, 0, sizeof (union printf_arg));
+  for (i = 1; i <= args_needed; i++)
+    {
+      int j;
+      char ch;
+      struct printf_spec *spec = 0;
+
+      for (j = 0; j < Dynarr_length (specs); j++)
+	{
+	  spec = Dynarr_atp (specs, j);
+	  if (spec->argnum == i)
+	    break;
+	}
+
+      if (j == Dynarr_length (specs))
+	error ("No conversion spec for argument %d", i);
+
+      ch = spec->converter;
+
+      /* int even if ch == 'c': "the type used in va_arg is supposed to
+	 match the actual type **after default promotions**." */
+
+      if (strchr (int_converters, ch))
+	{
+	  if (spec->h_flag)
+	    arg.i = va_arg (vargs, short);
+	  else if (spec->l_flag)
+	    arg.l = va_arg (vargs, long);
+	  else
+	    arg.i = va_arg (vargs, int);
+	}
+      else if (strchr (unsigned_int_converters, ch))
+	{
+	  if (spec->h_flag)
+	    arg.ui = va_arg (vargs, unsigned short);
+	  else if (spec->l_flag)
+	    arg.ul = va_arg (vargs, unsigned long);
+	  else
+	    arg.ui = va_arg (vargs, unsigned int);
+	}
+      else if (strchr (double_converters, ch))
+	arg.d = va_arg (vargs, double);
+      else if (strchr (string_converters, ch))
+	arg.bp = va_arg (vargs, Bufbyte *);
+      else abort ();
+
+      Dynarr_add (args, arg);
+    }
+
+  return args;
+}
+
+/* Generate output from a format-spec FORMAT, of length FORMAT_LENGTH.
+   Output goes in BUFFER, which has room for BUFSIZE bytes.
+   If the output does not fit, truncate it to fit.
+   Returns the number of bytes stored into BUFFER.
+   LARGS or VARGS points to the arguments, and NARGS says how many.
+   if LARGS is non-zero, it should be a pointer to NARGS worth of
+   Lisp arguments.  Otherwise, VARGS should be a va_list referring
+   to the arguments. */
+
+static Bytecount
+emacs_doprnt_1 (Lisp_Object stream, CONST Bufbyte *format_nonreloc,
+		Lisp_Object format_reloc, Bytecount format_length,
+		int nargs, 
+		/* #### Gag me, gag me, gag me */
+		CONST Lisp_Object *largs, va_list vargs)
+{
+  printf_spec_dynarr *specs = 0;
+  printf_arg_dynarr *args = 0;
+  REGISTER int i;
+  int init_byte_count = Lstream_byte_count (XLSTREAM (stream));
+
+  if (!NILP (format_reloc))
+    {
+      format_nonreloc = string_data (XSTRING (format_reloc));
+      format_length = string_length (XSTRING (format_reloc));
+    }
+  if (format_length < 0)
+    format_length = (Bytecount) strlen ((CONST char *) format_nonreloc);
+
+  specs = parse_doprnt_spec (format_nonreloc, format_length);
+  if (largs)
+    {
+	/* allow too many args for string, but not too few */
+      if (nargs < get_args_needed (specs))
+	signal_error (Qwrong_number_of_arguments,
+		      list3 (Qformat,
+			     make_int (nargs),
+			     !NILP (format_reloc) ? format_reloc :
+			     make_string (format_nonreloc, format_length)));
+    }
+  else
+    {
+      args = get_doprnt_args (specs, vargs);
+    }
+
+  for (i = 0; i < Dynarr_length (specs); i++)
+    {
+      struct printf_spec *spec = Dynarr_atp (specs, i);
+      char ch;
+
+      /* Copy the text before */
+      if (!NILP (format_reloc)) /* refetch in case of GC below */
+	format_nonreloc = string_data (XSTRING (format_reloc));
+       doprnt_1 (stream, format_nonreloc + spec->text_before,
+		 spec->text_before_len, 0, -1, 0, 0);
+
+      ch = spec->converter;
+
+      if (!ch)
+	continue;
+
+      if (ch == '%')
+	{
+	  doprnt_1 (stream, (Bufbyte *) &ch, 1, 0, -1, 0, 0);
+	  continue;
+	}
+
+      if (largs && (spec->argnum < 1 || spec->argnum > nargs))
+	error ("Invalid repositioning argument %d", spec->argnum);
+
+      else if (ch == 'S' || ch == 's')
+	{
+	  Bufbyte *string;
+	  Bytecount string_len;
+
+	  if (!largs)
+	    {
+	      string = Dynarr_at (args, spec->argnum - 1).bp;
+	      string_len = strlen ((char *) string);
+	    }
+	  else
+	    {
+	      Lisp_Object obj = largs[spec->argnum - 1];
+	      struct Lisp_String *ls;
+
+	      if (ch == 'S')
+		{
+		  /* For `S', prin1 the argument and then treat like
+		     a string.  */
+		  ls = XSTRING (Fprin1_to_string (obj, Qnil));
+		}
+	      else if (STRINGP (obj))
+		ls = XSTRING (obj);
+	      else if (SYMBOLP (obj))
+		ls = XSYMBOL (obj)->name;
+	      else
+		{
+		  /* convert to string using princ. */
+		  ls = XSTRING (Fprin1_to_string (obj, Qt));
+		}
+	      string = string_data (ls);
+	      string_len = string_length (ls);
+	    }
+
+	  doprnt_1 (stream, string, string_len, spec->minwidth,
+		    spec->precision, spec->minus_flag, spec->zero_flag);
+	}
+
+      else
+	{
+	  /* Must be a number. */
+	  union printf_arg arg;
+
+	  if (!largs)
+	    {
+	      arg = Dynarr_at (args, spec->argnum - 1);
+	    }
+	  else
+	    {
+	      Lisp_Object obj = largs[spec->argnum - 1];
+	      if (!INT_OR_FLOATP (obj))
+		{
+		  error ("format specifier %%%c doesn't match argument type",
+			 ch);
+		}
+	      else if (strchr (double_converters, ch))
+		arg.d = XFLOATINT (obj);
+	      else
+		{
+		  int val;
+
+		  if (FLOATP (obj))
+		    val = XINT (Ftruncate (obj));
+		  else
+		    val = XINT (obj);
+		  if (strchr (unsigned_int_converters, ch))
+		    {
+		      if (spec->l_flag)
+			arg.ul = (unsigned long) val;
+		      else
+			arg.ui = (unsigned int) val;
+		    }
+		  else
+		    {
+		      if (spec->l_flag)
+			arg.l = (long) val;
+		      else
+			arg.i = val;
+		    }
+		}
+	    }
+
+
+	  if (ch == 'c')
+	    {
+	      Emchar a;
+	      Bytecount charlen;
+	      Bufbyte charbuf[MAX_EMCHAR_LEN];
+
+	      if (spec->l_flag)
+		a = (Emchar) arg.l;
+	      else
+		a = (Emchar) arg.i;
+		
+	      if (!valid_char_p (a))
+		error ("invalid character value %d to %%c spec", a);
+
+	      charlen = set_charptr_emchar (charbuf, a);
+	      doprnt_1 (stream, charbuf, charlen, spec->minwidth,
+			-1, spec->minus_flag, spec->zero_flag);
+	    }
+
+	  else
+	    {
+	      char text_to_print[500];
+	      char constructed_spec[100];
+
+	      /* Partially reconstruct the spec and use sprintf() to
+		 format the string. */
+
+	      /* Make sure nothing stupid happens */
+	      /* DO NOT REMOVE THE (int) CAST!  Incorrect results will
+		 follow! */
+	      spec->precision = min (spec->precision,
+				     (int) (sizeof (text_to_print) - 50));
+
+	      constructed_spec[0] = 0;
+	      strcat (constructed_spec, "%");
+	      if (spec->plus_flag)
+		strcat (constructed_spec, "+");
+	      if (spec->space_flag)
+		strcat (constructed_spec, " ");
+	      if (spec->number_flag)
+		strcat (constructed_spec, "#");
+	      if (spec->precision >= 0)
+		{
+		  strcat (constructed_spec, ".");
+		  sprintf (constructed_spec + strlen (constructed_spec), "%d",
+			   spec->precision);
+		}
+	      sprintf (constructed_spec + strlen (constructed_spec), "%c", ch);
+
+	      /* sprintf the mofo */
+	      /* we have to use separate calls to sprintf(), rather than
+		 a single big conditional, because of the different types
+		 of the arguments */
+	      if (strchr (double_converters, ch))
+		sprintf (text_to_print, constructed_spec, arg.d);
+	      else if (strchr (unsigned_int_converters, ch))
+		{
+		  if (spec->l_flag)
+		    sprintf (text_to_print, constructed_spec, arg.ul);
+		  else
+		    sprintf (text_to_print, constructed_spec, arg.ui);
+		}
+	      else
+		{
+		  if (spec->l_flag)
+		    sprintf (text_to_print, constructed_spec, arg.l);
+		  else
+		    sprintf (text_to_print, constructed_spec, arg.i);
+		}
+
+	      doprnt_1 (stream, (Bufbyte *) text_to_print,
+			strlen (text_to_print),
+			spec->minwidth, -1, spec->minus_flag, spec->zero_flag);
+	    }
+	}
+    }
+
+  /* #### will not get freed if error */
+  if (specs)
+    Dynarr_free (specs);
+  if (args)
+    Dynarr_free (args);
+  return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count;
+}
+
+/* You really don't want to know why this is necessary... */
+static Bytecount
+emacs_doprnt_2 (Lisp_Object stream, CONST Bufbyte *format_nonreloc,
+		Lisp_Object format_reloc, Bytecount format_length, int nargs,
+		CONST Lisp_Object *largs, ...)
+{
+  va_list vargs;
+  Bytecount val;
+  va_start (vargs, largs);
+  val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
+			format_length, nargs, largs, vargs);
+  va_end (vargs);
+  return val;
+}
+
+/*********************** external entry points ***********************/
+
+#ifdef I18N3
+  /* A note about I18N3 translating: the format string should get
+     translated, but not under all circumstances.  When the format
+     string is a Lisp string, what should happen is that Fformat()
+     should format the untranslated args[0] and return that, and also
+     call Fgettext() on args[0] and, if that is different, format it
+     and store it in the `string-translatable' property of
+     the returned string.  See Fgettext(). */
+#endif
+
+/* Send formatted output to STREAM.  The format string comes from
+   either FORMAT_NONRELOC (of length FORMAT_LENGTH; -1 means use
+   strlen() to determine the length) or from FORMAT_RELOC, which
+   should be a Lisp string.  Return the number of bytes written
+   to the stream.
+
+   DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC
+   parameter, because this function can cause GC. */
+
+Bytecount
+emacs_doprnt_c (Lisp_Object stream, CONST Bufbyte *format_nonreloc,
+		Lisp_Object format_reloc, Bytecount format_length,
+		...)
+{
+  int val;
+  va_list vargs;
+
+  va_start (vargs, format_length);
+  val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
+			format_length, 0, 0, vargs);
+  va_end (vargs);
+  return val;
+}
+
+/* Like emacs_doprnt_c but the args come in va_list format. */
+
+Bytecount
+emacs_doprnt_va (Lisp_Object stream, CONST Bufbyte *format_nonreloc,
+		 Lisp_Object format_reloc, Bytecount format_length,
+		 va_list vargs)
+{
+  return emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
+			 format_length, 0, 0, vargs);
+}
+
+/* Like emacs_doprnt_c but the args are Lisp objects instead of
+   C arguments.  This causes somewhat different behavior from
+   the above two functions (which should act like printf).
+   See `format' for a description of this behavior. */
+
+Bytecount
+emacs_doprnt_lisp (Lisp_Object stream, CONST Bufbyte *format_nonreloc,
+		   Lisp_Object format_reloc, Bytecount format_length,
+		   int nargs, CONST Lisp_Object *largs)
+{
+  return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
+			 format_length, nargs, largs);
+}
+
+/* Like the previous function but takes a variable number of arguments. */
+
+Bytecount
+emacs_doprnt_lisp_2 (Lisp_Object stream, CONST Bufbyte *format_nonreloc,
+		     Lisp_Object format_reloc, Bytecount format_length,
+		     int nargs, ...)
+{
+  Lisp_Object *foo;
+  va_list vargs;
+  int i;
+
+  foo = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
+  va_start (vargs, nargs);
+  for (i = 0; i < nargs; i++)
+    foo[i] = va_arg (vargs, Lisp_Object);
+  va_end (vargs);
+      
+  return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
+			 format_length, nargs, foo);
+}
+
+/* The following four functions work like the above three but
+   return their output as a Lisp string instead of sending it
+   to a stream. */
+
+Lisp_Object
+emacs_doprnt_string_c (CONST Bufbyte *format_nonreloc,
+		       Lisp_Object format_reloc, Bytecount format_length,
+		       ...)
+{
+  va_list vargs;
+  Lisp_Object obj;
+  Lisp_Object stream = make_resizing_buffer_output_stream ();
+  struct gcpro gcpro1;
+
+  GCPRO1 (stream);
+  va_start (vargs, format_length);
+  emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
+		  format_length, 0, 0, vargs);
+  va_end (vargs);
+  Lstream_flush (XLSTREAM (stream));
+  obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
+		     Lstream_byte_count (XLSTREAM (stream)));
+  UNGCPRO;
+  Lstream_delete (XLSTREAM (stream));
+  return obj;
+}
+
+Lisp_Object
+emacs_doprnt_string_va (CONST Bufbyte *format_nonreloc,
+			Lisp_Object format_reloc, Bytecount format_length,
+			va_list vargs)
+{
+  /* I'm fairly sure that this function cannot actually GC.
+     That can only happen when the arguments to emacs_doprnt_1() are
+     Lisp objects rather than C args. */
+  Lisp_Object obj;
+  Lisp_Object stream = make_resizing_buffer_output_stream ();
+  struct gcpro gcpro1;
+
+  GCPRO1 (stream);
+  emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
+		  format_length, 0, 0, vargs);
+  Lstream_flush (XLSTREAM (stream));
+  obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
+		     Lstream_byte_count (XLSTREAM (stream)));
+  UNGCPRO;
+  Lstream_delete (XLSTREAM (stream));
+  return obj;
+}
+
+Lisp_Object
+emacs_doprnt_string_lisp (CONST Bufbyte *format_nonreloc,
+			  Lisp_Object format_reloc, Bytecount format_length,
+			  int nargs, CONST Lisp_Object *largs)
+{
+  Lisp_Object obj;
+  Lisp_Object stream = make_resizing_buffer_output_stream ();
+  struct gcpro gcpro1;
+
+  GCPRO1 (stream);
+  emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
+		  format_length, nargs, largs);
+  Lstream_flush (XLSTREAM (stream));
+  obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
+		     Lstream_byte_count (XLSTREAM (stream)));
+  UNGCPRO;
+  Lstream_delete (XLSTREAM (stream));
+  return obj;
+}
+
+Lisp_Object
+emacs_doprnt_string_lisp_2 (CONST Bufbyte *format_nonreloc,
+			    Lisp_Object format_reloc, Bytecount format_length,
+			    int nargs, ...)
+{
+  Lisp_Object obj;
+  Lisp_Object stream = make_resizing_buffer_output_stream ();
+  struct gcpro gcpro1;
+  Lisp_Object *foo;
+  va_list vargs;
+  int i;
+
+  foo = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
+  va_start (vargs, nargs);
+  for (i = 0; i < nargs; i++)
+    foo[i] = va_arg (vargs, Lisp_Object);
+  va_end (vargs);
+      
+  GCPRO1 (stream);
+  emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
+		  format_length, nargs, foo);
+  Lstream_flush (XLSTREAM (stream));
+  obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
+		     Lstream_byte_count (XLSTREAM (stream)));
+  UNGCPRO;
+  Lstream_delete (XLSTREAM (stream));
+  return obj;
+}