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
9 This file is part of XEmacs.
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
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
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. */
26 /* Synched up with: Rewritten. Not in FSF. */
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";
41 typedef struct printf_spec printf_spec;
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. */
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
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 */
65 typedef union printf_arg printf_arg;
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. */
82 Dynarr_declare (struct printf_spec);
87 Dynarr_declare (union printf_arg);
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.
98 Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */
101 doprnt_1 (Lisp_Object stream, const Bufbyte *string, Bytecount len,
102 Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag)
104 Lstream *lstr = XLSTREAM (stream);
105 Charcount cclen = bytecount_to_charcount (string, len);
106 int to_add = minlen - cclen;
108 /* Padding at beginning to right-justify ... */
111 Lstream_putc (lstr, zero_flag ? '0' : ' ');
113 if (0 <= maxlen && maxlen < cclen)
114 len = charcount_to_bytecount (string, maxlen);
115 Lstream_write (lstr, string, len);
117 /* Padding at end to left-justify ... */
120 Lstream_putc (lstr, zero_flag ? '0' : ' ');
123 static const Bufbyte *
124 parse_off_posnum (const Bufbyte *start, const Bufbyte *end, int *returned_num)
126 Bufbyte arg_convert[100];
127 REGISTER Bufbyte *arg_ptr = arg_convert;
130 while (start != end && isdigit (*start))
132 if ((size_t) (arg_ptr - arg_convert) >= sizeof (arg_convert) - 1)
133 error ("Format converter number too large");
134 *arg_ptr++ = *start++;
137 if (arg_convert != arg_ptr)
138 *returned_num = atoi ((char *) arg_convert);
142 #define NEXT_ASCII_BYTE(ch) \
144 if (fmt == fmt_end) \
145 error ("Premature end of format string"); \
148 error ("Non-ASCII character in format converter spec"); \
152 #define RESOLVE_FLAG_CONFLICTS(spec) \
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; \
160 static printf_spec_dynarr *
161 parse_doprnt_spec (const Bufbyte *format, Bytecount format_length)
163 const Bufbyte *fmt = format;
164 const Bufbyte *fmt_end = format + format_length;
165 printf_spec_dynarr *specs = Dynarr_new (printf_spec);
170 struct printf_spec spec;
171 const Bufbyte *text_end;
177 text_end = (Bufbyte *) memchr (fmt, '%', fmt_end - fmt);
180 spec.text_before = fmt - format;
181 spec.text_before_len = text_end - fmt;
185 fmt++; /* skip over % */
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 == '%')
191 spec.converter = '%';
192 Dynarr_add (specs, spec);
197 /* Is there a field number specifier? */
202 ptr = parse_off_posnum (fmt, fmt_end, &fieldspec);
203 if (fieldspec > 0 && ptr != fmt_end && *ptr == '$')
205 /* There is a format specifier */
206 prev_argnum = fieldspec;
211 spec.argnum = prev_argnum;
214 /* Parse off any flags */
215 NEXT_ASCII_BYTE (ch);
216 while (strchr (valid_flags, ch))
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;
227 NEXT_ASCII_BYTE (ch);
230 /* Parse off the minimum field width */
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.
239 if (fmt != fmt_end && *fmt == '*')
241 spec.converter = '*';
242 RESOLVE_FLAG_CONFLICTS(spec);
243 Dynarr_add (specs, spec);
245 spec.argnum = ++prev_argnum;
250 fmt = parse_off_posnum (fmt, fmt_end, &spec.minwidth);
251 if (spec.minwidth == -1)
255 /* Parse off any precision specified */
256 NEXT_ASCII_BYTE (ch);
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
266 if (fmt != fmt_end && *fmt == '*')
268 spec.converter = '*';
269 spec.forwarding_precision = 1;
270 RESOLVE_FLAG_CONFLICTS(spec);
271 Dynarr_add (specs, spec);
273 spec.argnum = ++prev_argnum;
278 fmt = parse_off_posnum (fmt, fmt_end, &spec.precision);
279 if (spec.precision == -1)
282 NEXT_ASCII_BYTE (ch);
285 /* No precision specified */
288 /* Parse off h or l flag */
289 if (ch == 'h' || ch == 'l')
295 NEXT_ASCII_BYTE (ch);
298 if (!strchr (valid_converters, ch))
299 error ("Invalid converter character %c", ch);
303 RESOLVE_FLAG_CONFLICTS(spec);
304 Dynarr_add (specs, spec);
307 RETURN_NOT_REACHED(specs) /* suppress compiler warning */
311 get_args_needed (printf_spec_dynarr *specs)
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. */
322 for (i = 0; i < Dynarr_length (specs); i++)
324 char ch = Dynarr_at (specs, i).converter;
327 int argnum = Dynarr_at (specs, i).argnum;
328 if (argnum > args_needed)
329 args_needed = argnum;
336 static printf_arg_dynarr *
337 get_doprnt_args (printf_spec_dynarr *specs, va_list vargs)
339 printf_arg_dynarr *args = Dynarr_new (printf_arg);
340 union printf_arg arg;
342 int args_needed = get_args_needed (specs);
345 for (i = 1; i <= args_needed; i++)
349 struct printf_spec *spec = 0;
351 for (j = 0; j < Dynarr_length (specs); j++)
353 spec = Dynarr_atp (specs, j);
354 if (spec->argnum == i)
358 if (j == Dynarr_length (specs))
359 error ("No conversion spec for argument %d", i);
361 ch = spec->converter;
363 if (strchr (int_converters, ch))
366 arg.l = va_arg (vargs, long);
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);
374 else if (strchr (unsigned_int_converters, ch))
377 arg.ul = va_arg (vargs, unsigned long);
379 /* unsigned int even if ch == 'c' or spec->h_flag */
380 arg.ul = (unsigned long) va_arg (vargs, unsigned int);
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 *);
388 Dynarr_add (args, arg);
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
404 emacs_doprnt_1 (Lisp_Object stream, const Bufbyte *format_nonreloc,
405 Lisp_Object format_reloc, Bytecount format_length,
407 /* #### Gag me, gag me, gag me */
408 const Lisp_Object *largs, va_list vargs)
410 printf_spec_dynarr *specs = 0;
411 printf_arg_dynarr *args = 0;
413 int init_byte_count = Lstream_byte_count (XLSTREAM (stream));
415 if (!NILP (format_reloc))
417 format_nonreloc = XSTRING_DATA (format_reloc);
418 format_length = XSTRING_LENGTH (format_reloc);
420 if (format_length < 0)
421 format_length = (Bytecount) strlen ((const char *) format_nonreloc);
423 specs = parse_doprnt_spec (format_nonreloc, format_length);
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,
431 !NILP (format_reloc) ? format_reloc :
432 make_string (format_nonreloc, format_length)));
436 args = get_doprnt_args (specs, vargs);
439 for (i = 0; i < Dynarr_length (specs); i++)
441 struct printf_spec *spec = Dynarr_atp (specs, i);
444 /* Copy the text before */
445 if (!NILP (format_reloc)) /* refetch in case of GC below */
446 format_nonreloc = XSTRING_DATA (format_reloc);
448 doprnt_1 (stream, format_nonreloc + spec->text_before,
449 spec->text_before_len, 0, -1, 0, 0);
451 ch = spec->converter;
458 doprnt_1 (stream, (Bufbyte *) &ch, 1, 0, -1, 0, 0);
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. */
467 struct printf_spec *nextspec = Dynarr_atp (specs, i + 1);
468 Lisp_Object obj = largs[spec->argnum - 1];
472 if (spec->forwarding_precision)
474 nextspec->precision = XINT (obj);
475 nextspec->minwidth = spec->minwidth;
479 nextspec->minwidth = XINT (obj);
482 spec->minus_flag = 1;
483 nextspec->minwidth = - nextspec->minwidth;
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;
495 if (largs && (spec->argnum < 1 || spec->argnum > nargs))
496 error ("Invalid repositioning argument %d", spec->argnum);
498 else if (ch == 'S' || ch == 's')
501 Bytecount string_len;
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
514 string = (Bufbyte *) "(null)";
515 string_len = strlen ((char *) string);
519 Lisp_Object obj = largs[spec->argnum - 1];
524 /* For `S', prin1 the argument and then treat like
526 ls = XSTRING (Fprin1_to_string (obj, Qnil));
528 else if (STRINGP (obj))
530 else if (SYMBOLP (obj))
531 ls = XSYMBOL (obj)->name;
534 /* convert to string using princ. */
535 ls = XSTRING (Fprin1_to_string (obj, Qt));
537 string = string_data (ls);
538 string_len = string_length (ls);
541 doprnt_1 (stream, string, string_len, spec->minwidth,
542 spec->precision, spec->minus_flag, spec->zero_flag);
547 /* Must be a number. */
548 union printf_arg arg;
552 arg = Dynarr_at (args, spec->argnum - 1);
556 Lisp_Object obj = largs[spec->argnum - 1];
558 obj = make_int (XCHAR (obj));
559 if (!INT_OR_FLOATP (obj))
561 error ("format specifier %%%c doesn't match argument type",
564 else if (strchr (double_converters, ch))
565 arg.d = XFLOATINT (obj);
569 obj = Ftruncate (obj);
571 if (strchr (unsigned_int_converters, ch))
572 arg.ul = (unsigned long) XUINT (obj);
583 Bufbyte charbuf[MAX_EMCHAR_LEN];
587 if (!valid_char_p (a))
588 error ("invalid character value %d to %%c spec", a);
590 charlen = set_charptr_emchar (charbuf, a);
591 doprnt_1 (stream, charbuf, charlen, spec->minwidth,
592 -1, spec->minus_flag, spec->zero_flag);
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 +
602 max (sizeof (double), sizeof (long)) * 3 +
603 max (spec->precision, 0)));
604 char constructed_spec[100];
605 char *p = constructed_spec;
607 /* Mostly reconstruct the spec and use sprintf() to
608 format the string. */
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';
617 if (spec->minwidth >= 0)
618 p = long_to_string (p, spec->minwidth);
619 if (spec->precision >= 0)
622 p = long_to_string (p, spec->precision);
625 if (strchr (double_converters, ch))
629 sprintf (text_to_print, constructed_spec, arg.d);
633 *p++ = 'l'; /* Always use longs with sprintf() */
637 if (strchr (unsigned_int_converters, ch))
638 sprintf (text_to_print, constructed_spec, arg.ul);
640 sprintf (text_to_print, constructed_spec, arg.l);
643 doprnt_1 (stream, (Bufbyte *) text_to_print,
644 strlen (text_to_print), 0, -1, 0, 0);
649 /* #### will not get freed if error */
654 return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count;
657 /* You really don't want to know why this is necessary... */
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, ...)
665 va_start (vargs, largs);
666 val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
667 format_length, nargs, largs, vargs);
672 /*********************** external entry points ***********************/
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(). */
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
690 DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC
691 parameter, because this function can cause GC. */
694 emacs_doprnt_c (Lisp_Object stream, const Bufbyte *format_nonreloc,
695 Lisp_Object format_reloc, Bytecount format_length,
701 va_start (vargs, format_length);
702 val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
703 format_length, 0, 0, vargs);
708 /* Like emacs_doprnt_c but the args come in va_list format. */
711 emacs_doprnt_va (Lisp_Object stream, const Bufbyte *format_nonreloc,
712 Lisp_Object format_reloc, Bytecount format_length,
715 return emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
716 format_length, 0, 0, vargs);
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. */
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)
729 return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
730 format_length, nargs, largs);
733 /* Like the previous function but takes a variable number of arguments. */
736 emacs_doprnt_lisp_2 (Lisp_Object stream, const Bufbyte *format_nonreloc,
737 Lisp_Object format_reloc, Bytecount format_length,
742 Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
744 va_start (vargs, nargs);
745 for (i = 0; i < nargs; i++)
746 foo[i] = va_arg (vargs, Lisp_Object);
749 return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
750 format_length, nargs, foo);
753 /* The following four functions work like the above three but
754 return their output as a Lisp string instead of sending it
758 emacs_doprnt_string_c (const Bufbyte *format_nonreloc,
759 Lisp_Object format_reloc, Bytecount format_length,
764 Lisp_Object stream = make_resizing_buffer_output_stream ();
768 va_start (vargs, format_length);
769 emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
770 format_length, 0, 0, vargs);
772 Lstream_flush (XLSTREAM (stream));
773 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
774 Lstream_byte_count (XLSTREAM (stream)));
776 Lstream_delete (XLSTREAM (stream));
781 emacs_doprnt_string_va (const Bufbyte *format_nonreloc,
782 Lisp_Object format_reloc, Bytecount format_length,
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. */
789 Lisp_Object stream = make_resizing_buffer_output_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)));
799 Lstream_delete (XLSTREAM (stream));
804 emacs_doprnt_string_lisp (const Bufbyte *format_nonreloc,
805 Lisp_Object format_reloc, Bytecount format_length,
806 int nargs, const Lisp_Object *largs)
809 Lisp_Object stream = make_resizing_buffer_output_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)));
819 Lstream_delete (XLSTREAM (stream));
824 emacs_doprnt_string_lisp_2 (const Bufbyte *format_nonreloc,
825 Lisp_Object format_reloc, Bytecount format_length,
829 Lisp_Object stream = make_resizing_buffer_output_stream ();
833 Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
835 va_start (vargs, nargs);
836 for (i = 0; i < nargs; i++)
837 foo[i] = va_arg (vargs, Lisp_Object);
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)));
847 Lstream_delete (XLSTREAM (stream));