update.
[chise/xemacs-chise.git-] / src / doprnt.c
1 /* Output like sprintf to a buffer of specified size.
2    Also takes args differently: pass one pointer to an array of strings
3    in addition to the format string which is separate.
4    Copyright (C) 1995 Free Software Foundation, Inc.
5    Rewritten by mly to use varargs.h.
6    Rewritten from scratch by Ben Wing (February 1995) for Mule; expanded
7    to full printf spec.
8
9 This file is part of XEmacs.
10
11 XEmacs is free software; you can redistribute it and/or modify it
12 under the terms of the GNU General Public License as published by the
13 Free Software Foundation; either version 2, or (at your option) any
14 later version.
15
16 XEmacs is distributed in the hope that it will be useful, but WITHOUT
17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
18 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
19 for more details.
20
21 You should have received a copy of the GNU General Public License
22 along with XEmacs; see the file COPYING.  If not, write to
23 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 Boston, MA 02111-1307, USA.  */
25
26 /* Synched up with: Rewritten.  Not in FSF. */
27
28 #include <config.h>
29 #include "lisp.h"
30
31 #include "buffer.h"
32 #include "lstream.h"
33
34 static const char * const valid_flags = "-+ #0";
35 static const char * const valid_converters = "dic" "ouxX" "feEgG" "sS";
36 static const char * const int_converters = "dic";
37 static const char * const unsigned_int_converters = "ouxXc";
38 static const char * const double_converters = "feEgG";
39 static const char * const string_converters = "sS";
40
41 typedef struct printf_spec printf_spec;
42 struct printf_spec
43 {
44   int argnum; /* which argument does this spec want?  This is one-based:
45                  The first argument given is numbered 1, the second
46                  is 2, etc.  This is to handle %##$x-type specs. */
47   int minwidth;
48   int precision;
49   unsigned int minus_flag:1;
50   unsigned int plus_flag:1;
51   unsigned int space_flag:1;
52   unsigned int number_flag:1;
53   unsigned int zero_flag:1;
54   unsigned int h_flag:1;
55   unsigned int l_flag:1;
56   unsigned int forwarding_precision:1;
57   char converter; /* converter character or 0 for dummy marker
58                      indicating literal text at the end of the
59                      specification */
60   Bytecount text_before; /* position of the first character of the
61                             block of literal text before this spec */
62   Bytecount text_before_len; /* length of that text */
63 };
64
65 typedef union printf_arg printf_arg;
66 union printf_arg
67 {
68   long l;
69   unsigned long ul;
70   double d;
71   Bufbyte *bp;
72 };
73
74 /* We maintain a list of all the % specs in the specification,
75    along with the offset and length of the block of literal text
76    before each spec.  In addition, we have a "dummy" spec that
77    represents all the literal text at the end of the specification.
78    Its converter is 0. */
79
80 typedef struct
81 {
82   Dynarr_declare (struct printf_spec);
83 } printf_spec_dynarr;
84
85 typedef struct
86 {
87   Dynarr_declare (union printf_arg);
88 } printf_arg_dynarr;
89
90 /* Append STRING (of length LEN bytes) to STREAM.
91    MINLEN is the minimum field width.
92    If MINUS_FLAG is set, left-justify the string in its field;
93     otherwise, right-justify.
94    If ZERO_FLAG is set, pad with 0's; otherwise pad with spaces.
95    If MAXLEN is non-negative, the string is first truncated on the
96     right to that many characters.
97
98    Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */
99
100 static void
101 doprnt_1 (Lisp_Object stream, const Bufbyte *string, Bytecount len,
102           Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag)
103 {
104   Lstream *lstr = XLSTREAM (stream);
105   Charcount cclen = bytecount_to_charcount (string, len);
106   int to_add = minlen - cclen;
107
108   /* Padding at beginning to right-justify ... */
109   if (!minus_flag)
110     while (to_add-- > 0)
111       Lstream_putc (lstr, zero_flag ? '0' : ' ');
112
113   if (0 <= maxlen && maxlen < cclen)
114     len = charcount_to_bytecount (string, maxlen);
115   Lstream_write (lstr, string, len);
116
117   /* Padding at end to left-justify ... */
118   if (minus_flag)
119     while (to_add-- > 0)
120       Lstream_putc (lstr, zero_flag ? '0' : ' ');
121 }
122
123 static const Bufbyte *
124 parse_off_posnum (const Bufbyte *start, const Bufbyte *end, int *returned_num)
125 {
126   Bufbyte arg_convert[100];
127   REGISTER Bufbyte *arg_ptr = arg_convert;
128
129   *returned_num = -1;
130   while (start != end && isdigit (*start))
131     {
132       if ((size_t) (arg_ptr - arg_convert) >= sizeof (arg_convert) - 1)
133         error ("Format converter number too large");
134       *arg_ptr++ = *start++;
135     }
136   *arg_ptr = '\0';
137   if (arg_convert != arg_ptr)
138     *returned_num = atoi ((char *) arg_convert);
139   return start;
140 }
141
142 #define NEXT_ASCII_BYTE(ch)                                     \
143   do {                                                          \
144     if (fmt == fmt_end)                                         \
145       error ("Premature end of format string");                 \
146     ch = *fmt;                                                  \
147     if (ch >= 0200)                                             \
148       error ("Non-ASCII character in format converter spec");   \
149     fmt++;                                                      \
150   } while (0)
151
152 #define RESOLVE_FLAG_CONFLICTS(spec)                            \
153   do {                                                          \
154     if (spec.space_flag && spec.plus_flag)                      \
155       spec.space_flag = 0;                                      \
156     if (spec.zero_flag && spec.space_flag)                      \
157       spec.zero_flag = 0;                                       \
158   } while (0)
159
160 static printf_spec_dynarr *
161 parse_doprnt_spec (const Bufbyte *format, Bytecount format_length)
162 {
163   const Bufbyte *fmt = format;
164   const Bufbyte *fmt_end = format + format_length;
165   printf_spec_dynarr *specs = Dynarr_new (printf_spec);
166   int prev_argnum = 0;
167
168   while (1)
169     {
170       struct printf_spec spec;
171       const Bufbyte *text_end;
172       Bufbyte ch;
173
174       xzero (spec);
175       if (fmt == fmt_end)
176         return specs;
177       text_end = (Bufbyte *) memchr (fmt, '%', fmt_end - fmt);
178       if (!text_end)
179         text_end = fmt_end;
180       spec.text_before = fmt - format;
181       spec.text_before_len = text_end - fmt;
182       fmt = text_end;
183       if (fmt != fmt_end)
184         {
185           fmt++; /* skip over % */
186
187           /* A % is special -- no arg number.  According to ANSI specs,
188              field width does not apply to %% conversion. */
189           if (fmt != fmt_end && *fmt == '%')
190             {
191               spec.converter = '%';
192               Dynarr_add (specs, spec);
193               fmt++;
194               continue;
195             }
196
197           /* Is there a field number specifier? */
198           {
199             const Bufbyte *ptr;
200             int fieldspec;
201
202             ptr = parse_off_posnum (fmt, fmt_end, &fieldspec);
203             if (fieldspec > 0 && ptr != fmt_end && *ptr == '$')
204               {
205                 /* There is a format specifier */
206                 prev_argnum = fieldspec;
207                 fmt = ptr + 1;
208               }
209             else
210               prev_argnum++;
211             spec.argnum = prev_argnum;
212           }
213
214           /* Parse off any flags */
215           NEXT_ASCII_BYTE (ch);
216           while (strchr (valid_flags, ch))
217             {
218               switch (ch)
219                 {
220                 case '-': spec.minus_flag  = 1; break;
221                 case '+': spec.plus_flag   = 1; break;
222                 case ' ': spec.space_flag  = 1; break;
223                 case '#': spec.number_flag = 1; break;
224                 case '0': spec.zero_flag   = 1; break;
225                 default: ABORT ();
226                 }
227               NEXT_ASCII_BYTE (ch);
228             }
229
230           /* Parse off the minimum field width */
231           fmt--; /* back up */
232
233           /*
234            * * means the field width was passed as an argument.
235            * Mark the current spec as one that forwards its
236            * field width and flags to the next spec in the array.
237            * Then create a new spec and continue with the parsing.
238            */
239           if (fmt != fmt_end && *fmt == '*')
240             {
241               spec.converter = '*';
242               RESOLVE_FLAG_CONFLICTS(spec);
243               Dynarr_add (specs, spec);
244               xzero (spec);
245               spec.argnum = ++prev_argnum;
246               fmt++;
247             }
248           else
249             {
250               fmt = parse_off_posnum (fmt, fmt_end, &spec.minwidth);
251               if (spec.minwidth == -1)
252                 spec.minwidth = 0;
253             }
254
255           /* Parse off any precision specified */
256           NEXT_ASCII_BYTE (ch);
257           if (ch == '.')
258             {
259               /*
260                * * means the precision was passed as an argument.
261                * Mark the current spec as one that forwards its
262                * fieldwidth, flags and precision to the next spec in
263                * the array.  Then create a new spec and continue
264                * with the parse.
265                */
266               if (fmt != fmt_end && *fmt == '*')
267                 {
268                   spec.converter = '*';
269                   spec.forwarding_precision = 1;
270                   RESOLVE_FLAG_CONFLICTS(spec);
271                   Dynarr_add (specs, spec);
272                   xzero (spec);
273                   spec.argnum = ++prev_argnum;
274                   fmt++;
275                 }
276               else
277                 {
278                   fmt = parse_off_posnum (fmt, fmt_end, &spec.precision);
279                   if (spec.precision == -1)
280                     spec.precision = 0;
281                 }
282               NEXT_ASCII_BYTE (ch);
283             }
284           else
285             /* No precision specified */
286             spec.precision = -1;
287
288           /* Parse off h or l flag */
289           if (ch == 'h' || ch == 'l')
290             {
291               if (ch == 'h')
292                 spec.h_flag = 1;
293               else
294                 spec.l_flag = 1;
295               NEXT_ASCII_BYTE (ch);
296             }
297
298           if (!strchr (valid_converters, ch))
299             error ("Invalid converter character %c", ch);
300           spec.converter = ch;
301         }
302
303       RESOLVE_FLAG_CONFLICTS(spec);
304       Dynarr_add (specs, spec);
305     }
306
307   RETURN_NOT_REACHED(specs) /* suppress compiler warning */
308 }
309
310 static int
311 get_args_needed (printf_spec_dynarr *specs)
312 {
313   int args_needed = 0;
314   REGISTER int i;
315
316   /* Figure out how many args are needed.  This may be less than
317      the number of specs because a spec could be %% or could be
318      missing (literal text at end of format string) or there
319      could be specs where the field number is explicitly given.
320      We just look for the maximum argument number that's referenced. */
321
322   for (i = 0; i < Dynarr_length (specs); i++)
323     {
324       char ch = Dynarr_at (specs, i).converter;
325       if (ch && ch != '%')
326         {
327           int argnum = Dynarr_at (specs, i).argnum;
328           if (argnum > args_needed)
329             args_needed = argnum;
330         }
331     }
332
333   return args_needed;
334 }
335
336 static printf_arg_dynarr *
337 get_doprnt_args (printf_spec_dynarr *specs, va_list vargs)
338 {
339   printf_arg_dynarr *args = Dynarr_new (printf_arg);
340   union printf_arg arg;
341   REGISTER int i;
342   int args_needed = get_args_needed (specs);
343
344   xzero (arg);
345   for (i = 1; i <= args_needed; i++)
346     {
347       int j;
348       char ch;
349       struct printf_spec *spec = 0;
350
351       for (j = 0; j < Dynarr_length (specs); j++)
352         {
353           spec = Dynarr_atp (specs, j);
354           if (spec->argnum == i)
355             break;
356         }
357
358       if (j == Dynarr_length (specs))
359         error ("No conversion spec for argument %d", i);
360
361       ch = spec->converter;
362
363       if (strchr (int_converters, ch))
364         {
365           if (spec->l_flag)
366             arg.l = va_arg (vargs, long);
367           else
368             /* int even if ch == 'c' or spec->h_flag:
369                "the type used in va_arg is supposed to match the
370                actual type **after default promotions**."
371                Hence we read an int, not a short, if spec->h_flag. */
372             arg.l = va_arg (vargs, int);
373         }
374       else if (strchr (unsigned_int_converters, ch))
375         {
376           if (spec->l_flag)
377             arg.ul = va_arg (vargs, unsigned long);
378           else
379             /* unsigned int even if ch == 'c' or spec->h_flag */
380             arg.ul = (unsigned long) va_arg (vargs, unsigned int);
381         }
382       else if (strchr (double_converters, ch))
383         arg.d = va_arg (vargs, double);
384       else if (strchr (string_converters, ch))
385         arg.bp = va_arg (vargs, Bufbyte *);
386       else ABORT ();
387
388       Dynarr_add (args, arg);
389     }
390
391   return args;
392 }
393
394 /* Generate output from a format-spec FORMAT, of length FORMAT_LENGTH.
395    Output goes in BUFFER, which has room for BUFSIZE bytes.
396    If the output does not fit, truncate it to fit.
397    Returns the number of bytes stored into BUFFER.
398    LARGS or VARGS points to the arguments, and NARGS says how many.
399    if LARGS is non-zero, it should be a pointer to NARGS worth of
400    Lisp arguments.  Otherwise, VARGS should be a va_list referring
401    to the arguments. */
402
403 static Bytecount
404 emacs_doprnt_1 (Lisp_Object stream, const Bufbyte *format_nonreloc,
405                 Lisp_Object format_reloc, Bytecount format_length,
406                 int nargs,
407                 /* #### Gag me, gag me, gag me */
408                 const Lisp_Object *largs, va_list vargs)
409 {
410   printf_spec_dynarr *specs = 0;
411   printf_arg_dynarr *args = 0;
412   REGISTER int i;
413   int init_byte_count = Lstream_byte_count (XLSTREAM (stream));
414
415   if (!NILP (format_reloc))
416     {
417       format_nonreloc = XSTRING_DATA (format_reloc);
418       format_length = XSTRING_LENGTH (format_reloc);
419     }
420   if (format_length < 0)
421     format_length = (Bytecount) strlen ((const char *) format_nonreloc);
422
423   specs = parse_doprnt_spec (format_nonreloc, format_length);
424   if (largs)
425     {
426       /* allow too many args for string, but not too few */
427       if (nargs < get_args_needed (specs))
428         signal_error (Qwrong_number_of_arguments,
429                       list3 (Qformat,
430                              make_int (nargs),
431                              !NILP (format_reloc) ? format_reloc :
432                              make_string (format_nonreloc, format_length)));
433     }
434   else
435     {
436       args = get_doprnt_args (specs, vargs);
437     }
438
439   for (i = 0; i < Dynarr_length (specs); i++)
440     {
441       struct printf_spec *spec = Dynarr_atp (specs, i);
442       char ch;
443
444       /* Copy the text before */
445       if (!NILP (format_reloc)) /* refetch in case of GC below */
446         format_nonreloc = XSTRING_DATA (format_reloc);
447
448       doprnt_1 (stream, format_nonreloc + spec->text_before,
449                 spec->text_before_len, 0, -1, 0, 0);
450
451       ch = spec->converter;
452
453       if (!ch)
454         continue;
455
456       if (ch == '%')
457         {
458           doprnt_1 (stream, (Bufbyte *) &ch, 1, 0, -1, 0, 0);
459           continue;
460         }
461
462       /* The char '*' as converter means the field width, precision
463          was specified as an argument.  Extract the data and forward
464          it to the next spec, to which it will apply.  */
465       if (ch == '*')
466         {
467           struct printf_spec *nextspec = Dynarr_atp (specs, i + 1);
468           Lisp_Object obj = largs[spec->argnum - 1];
469
470           if (INTP (obj))
471             {
472               if (spec->forwarding_precision)
473                 {
474                   nextspec->precision = XINT (obj);
475                   nextspec->minwidth = spec->minwidth;
476                 }
477               else
478                 {
479                   nextspec->minwidth = XINT (obj);
480                   if (XINT (obj) < 0)
481                     {
482                       spec->minus_flag = 1;
483                       nextspec->minwidth = - nextspec->minwidth;
484                     }
485                 }
486               nextspec->minus_flag  = spec->minus_flag;
487               nextspec->plus_flag   = spec->plus_flag;
488               nextspec->space_flag  = spec->space_flag;
489               nextspec->number_flag = spec->number_flag;
490               nextspec->zero_flag   = spec->zero_flag;
491             }
492           continue;
493         }
494
495       if (largs && (spec->argnum < 1 || spec->argnum > nargs))
496         error ("Invalid repositioning argument %d", spec->argnum);
497
498       else if (ch == 'S' || ch == 's')
499         {
500           Bufbyte *string;
501           Bytecount string_len;
502
503           if (!largs)
504             {
505               string = Dynarr_at (args, spec->argnum - 1).bp;
506               /* error() can be called with null string arguments.
507                  E.g., in fileio.c, the return value of strerror()
508                  is never checked.  We'll print (null), like some
509                  printf implementations do.  Would it be better (and safe)
510                  to signal an error instead?  Or should we just use the
511                  empty string?  -dkindred@cs.cmu.edu 8/1997
512               */
513               if (!string)
514                 string = (Bufbyte *) "(null)";
515               string_len = strlen ((char *) string);
516             }
517           else
518             {
519               Lisp_Object obj = largs[spec->argnum - 1];
520               Lisp_String *ls;
521
522               if (ch == 'S')
523                 {
524                   /* For `S', prin1 the argument and then treat like
525                      a string.  */
526                   ls = XSTRING (Fprin1_to_string (obj, Qnil));
527                 }
528               else if (STRINGP (obj))
529                 ls = XSTRING (obj);
530               else if (SYMBOLP (obj))
531                 ls = XSYMBOL (obj)->name;
532               else
533                 {
534                   /* convert to string using princ. */
535                   ls = XSTRING (Fprin1_to_string (obj, Qt));
536                 }
537               string = string_data (ls);
538               string_len = string_length (ls);
539             }
540
541           doprnt_1 (stream, string, string_len, spec->minwidth,
542                     spec->precision, spec->minus_flag, spec->zero_flag);
543         }
544
545       else
546         {
547           /* Must be a number. */
548           union printf_arg arg;
549
550           if (!largs)
551             {
552               arg = Dynarr_at (args, spec->argnum - 1);
553             }
554           else
555             {
556               Lisp_Object obj = largs[spec->argnum - 1];
557               if (CHARP (obj))
558                 obj = make_int (XCHAR (obj));
559               if (!INT_OR_FLOATP (obj))
560                 {
561                   error ("format specifier %%%c doesn't match argument type",
562                          ch);
563                 }
564               else if (strchr (double_converters, ch))
565                 arg.d = XFLOATINT (obj);
566               else
567                 {
568                   if (FLOATP (obj))
569                     obj = Ftruncate (obj);
570
571                   if (strchr (unsigned_int_converters, ch))
572                     arg.ul = (unsigned long) XUINT (obj);
573                   else
574                     arg.l = XINT (obj);
575                 }
576             }
577
578
579           if (ch == 'c')
580             {
581               Emchar a;
582               Bytecount charlen;
583               Bufbyte charbuf[MAX_EMCHAR_LEN];
584
585               a = (Emchar) arg.l;
586
587               if (!valid_char_p (a))
588                 error ("invalid character value %d to %%c spec", a);
589
590               charlen = set_charptr_emchar (charbuf, a);
591               doprnt_1 (stream, charbuf, charlen, spec->minwidth,
592                         -1, spec->minus_flag, spec->zero_flag);
593             }
594           else
595             {
596               /* ASCII Decimal representation uses 2.4 times as many
597                  bits as machine binary.  */
598               char *text_to_print =
599                 alloca_array (char, 32 +
600                               max (spec->minwidth,
601                                    (EMACS_INT)
602                                     max (sizeof (double), sizeof (long)) * 3 +
603                                    max (spec->precision, 0)));
604               char constructed_spec[100];
605               char *p = constructed_spec;
606
607               /* Mostly reconstruct the spec and use sprintf() to
608                  format the string. */
609
610               *p++ = '%';
611               if (spec->plus_flag)   *p++ = '+';
612               if (spec->space_flag)  *p++ = ' ';
613               if (spec->number_flag) *p++ = '#';
614               if (spec->minus_flag)  *p++ = '-';
615               if (spec->zero_flag)   *p++ = '0';
616
617               if (spec->minwidth >= 0)
618                 p = long_to_string (p, spec->minwidth);
619               if (spec->precision >= 0)
620                 {
621                   *p++ = '.';
622                   p = long_to_string (p, spec->precision);
623                 }
624               
625               if (strchr (double_converters, ch))
626                 {
627                   *p++ = ch;
628                   *p++ = '\0';
629                   sprintf (text_to_print, constructed_spec, arg.d);
630                 }
631               else
632                 {
633                   *p++ = 'l';   /* Always use longs with sprintf() */
634                   *p++ = ch;
635                   *p++ = '\0';
636
637                   if (strchr (unsigned_int_converters, ch))
638                     sprintf (text_to_print, constructed_spec, arg.ul);
639                   else
640                     sprintf (text_to_print, constructed_spec, arg.l);
641                 }
642
643               doprnt_1 (stream, (Bufbyte *) text_to_print,
644                         strlen (text_to_print), 0, -1, 0, 0);
645             }
646         }
647     }
648
649   /* #### will not get freed if error */
650   if (specs)
651     Dynarr_free (specs);
652   if (args)
653     Dynarr_free (args);
654   return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count;
655 }
656
657 /* You really don't want to know why this is necessary... */
658 static Bytecount
659 emacs_doprnt_2 (Lisp_Object stream, const Bufbyte *format_nonreloc,
660                 Lisp_Object format_reloc, Bytecount format_length, int nargs,
661                 const Lisp_Object *largs, ...)
662 {
663   va_list vargs;
664   Bytecount val;
665   va_start (vargs, largs);
666   val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
667                         format_length, nargs, largs, vargs);
668   va_end (vargs);
669   return val;
670 }
671
672 /*********************** external entry points ***********************/
673
674 #ifdef I18N3
675   /* A note about I18N3 translating: the format string should get
676      translated, but not under all circumstances.  When the format
677      string is a Lisp string, what should happen is that Fformat()
678      should format the untranslated args[0] and return that, and also
679      call Fgettext() on args[0] and, if that is different, format it
680      and store it in the `string-translatable' property of
681      the returned string.  See Fgettext(). */
682 #endif
683
684 /* Send formatted output to STREAM.  The format string comes from
685    either FORMAT_NONRELOC (of length FORMAT_LENGTH; -1 means use
686    strlen() to determine the length) or from FORMAT_RELOC, which
687    should be a Lisp string.  Return the number of bytes written
688    to the stream.
689
690    DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC
691    parameter, because this function can cause GC. */
692
693 Bytecount
694 emacs_doprnt_c (Lisp_Object stream, const Bufbyte *format_nonreloc,
695                 Lisp_Object format_reloc, Bytecount format_length,
696                 ...)
697 {
698   int val;
699   va_list vargs;
700
701   va_start (vargs, format_length);
702   val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
703                         format_length, 0, 0, vargs);
704   va_end (vargs);
705   return val;
706 }
707
708 /* Like emacs_doprnt_c but the args come in va_list format. */
709
710 Bytecount
711 emacs_doprnt_va (Lisp_Object stream, const Bufbyte *format_nonreloc,
712                  Lisp_Object format_reloc, Bytecount format_length,
713                  va_list vargs)
714 {
715   return emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
716                          format_length, 0, 0, vargs);
717 }
718
719 /* Like emacs_doprnt_c but the args are Lisp objects instead of
720    C arguments.  This causes somewhat different behavior from
721    the above two functions (which should act like printf).
722    See `format' for a description of this behavior. */
723
724 Bytecount
725 emacs_doprnt_lisp (Lisp_Object stream, const Bufbyte *format_nonreloc,
726                    Lisp_Object format_reloc, Bytecount format_length,
727                    int nargs, const Lisp_Object *largs)
728 {
729   return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
730                          format_length, nargs, largs);
731 }
732
733 /* Like the previous function but takes a variable number of arguments. */
734
735 Bytecount
736 emacs_doprnt_lisp_2 (Lisp_Object stream, const Bufbyte *format_nonreloc,
737                      Lisp_Object format_reloc, Bytecount format_length,
738                      int nargs, ...)
739 {
740   va_list vargs;
741   int i;
742   Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
743
744   va_start (vargs, nargs);
745   for (i = 0; i < nargs; i++)
746     foo[i] = va_arg (vargs, Lisp_Object);
747   va_end (vargs);
748
749   return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
750                          format_length, nargs, foo);
751 }
752
753 /* The following four functions work like the above three but
754    return their output as a Lisp string instead of sending it
755    to a stream. */
756
757 Lisp_Object
758 emacs_doprnt_string_c (const Bufbyte *format_nonreloc,
759                        Lisp_Object format_reloc, Bytecount format_length,
760                        ...)
761 {
762   va_list vargs;
763   Lisp_Object obj;
764   Lisp_Object stream = make_resizing_buffer_output_stream ();
765   struct gcpro gcpro1;
766
767   GCPRO1 (stream);
768   va_start (vargs, format_length);
769   emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
770                   format_length, 0, 0, vargs);
771   va_end (vargs);
772   Lstream_flush (XLSTREAM (stream));
773   obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
774                      Lstream_byte_count (XLSTREAM (stream)));
775   UNGCPRO;
776   Lstream_delete (XLSTREAM (stream));
777   return obj;
778 }
779
780 Lisp_Object
781 emacs_doprnt_string_va (const Bufbyte *format_nonreloc,
782                         Lisp_Object format_reloc, Bytecount format_length,
783                         va_list vargs)
784 {
785   /* I'm fairly sure that this function cannot actually GC.
786      That can only happen when the arguments to emacs_doprnt_1() are
787      Lisp objects rather than C args. */
788   Lisp_Object obj;
789   Lisp_Object stream = make_resizing_buffer_output_stream ();
790   struct gcpro gcpro1;
791
792   GCPRO1 (stream);
793   emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
794                   format_length, 0, 0, vargs);
795   Lstream_flush (XLSTREAM (stream));
796   obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
797                      Lstream_byte_count (XLSTREAM (stream)));
798   UNGCPRO;
799   Lstream_delete (XLSTREAM (stream));
800   return obj;
801 }
802
803 Lisp_Object
804 emacs_doprnt_string_lisp (const Bufbyte *format_nonreloc,
805                           Lisp_Object format_reloc, Bytecount format_length,
806                           int nargs, const Lisp_Object *largs)
807 {
808   Lisp_Object obj;
809   Lisp_Object stream = make_resizing_buffer_output_stream ();
810   struct gcpro gcpro1;
811
812   GCPRO1 (stream);
813   emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
814                   format_length, nargs, largs);
815   Lstream_flush (XLSTREAM (stream));
816   obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
817                      Lstream_byte_count (XLSTREAM (stream)));
818   UNGCPRO;
819   Lstream_delete (XLSTREAM (stream));
820   return obj;
821 }
822
823 Lisp_Object
824 emacs_doprnt_string_lisp_2 (const Bufbyte *format_nonreloc,
825                             Lisp_Object format_reloc, Bytecount format_length,
826                             int nargs, ...)
827 {
828   Lisp_Object obj;
829   Lisp_Object stream = make_resizing_buffer_output_stream ();
830   struct gcpro gcpro1;
831   va_list vargs;
832   int i;
833   Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
834
835   va_start (vargs, nargs);
836   for (i = 0; i < nargs; i++)
837     foo[i] = va_arg (vargs, Lisp_Object);
838   va_end (vargs);
839
840   GCPRO1 (stream);
841   emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
842                   format_length, nargs, foo);
843   Lstream_flush (XLSTREAM (stream));
844   obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
845                      Lstream_byte_count (XLSTREAM (stream)));
846   UNGCPRO;
847   Lstream_delete (XLSTREAM (stream));
848   return obj;
849 }