Mercurial > hg > xemacs-beta

comparison src/doprnt.c @ 428:3ecd8885ac67 r21-2-22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children 8de8e3f6228a
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
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 }