Mercurial > hg > xemacs-beta

comparison src/doprnt.c @ 0:376386a54a3c r19-14

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