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