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) 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.
96 Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */
99 doprnt_1 (Lisp_Object stream, const Bufbyte *string, Bytecount len,
100 Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag)
104 Lstream *lstr = XLSTREAM (stream);
106 cclen = bytecount_to_charcount (string, len);
113 /* Padding at beginning to right-justify ... */
114 if (minlen > cclen && !minus_flag)
116 int to_add = minlen - cclen;
119 Lstream_putc (lstr, pad);
125 len = charcount_to_bytecount (string, min (maxlen, cclen));
126 Lstream_write (lstr, string, len);
128 /* Padding at end to left-justify ... */
129 if (minlen > cclen && minus_flag)
131 int to_add = minlen - cclen;
134 Lstream_putc (lstr, pad);
140 static const Bufbyte *
141 parse_off_posnum (const Bufbyte *start, const Bufbyte *end, int *returned_num)
143 Bufbyte arg_convert[100];
144 REGISTER Bufbyte *arg_ptr = arg_convert;
147 while (start != end && isdigit (*start))
149 if ((size_t) (arg_ptr - arg_convert) >= sizeof (arg_convert) - 1)
150 error ("Format converter number too large");
151 *arg_ptr++ = *start++;
154 if (arg_convert != arg_ptr)
155 *returned_num = atoi ((char *) arg_convert);
159 #define NEXT_ASCII_BYTE(ch) \
161 if (fmt == fmt_end) \
162 error ("Premature end of format string"); \
165 error ("Non-ASCII character in format converter spec"); \
169 #define RESOLVE_FLAG_CONFLICTS(spec) \
171 if (spec.space_flag && spec.plus_flag) \
172 spec.space_flag = 0; \
173 if (spec.zero_flag && spec.space_flag) \
174 spec.zero_flag = 0; \
177 static printf_spec_dynarr *
178 parse_doprnt_spec (const Bufbyte *format, Bytecount format_length)
180 const Bufbyte *fmt = format;
181 const Bufbyte *fmt_end = format + format_length;
182 printf_spec_dynarr *specs = Dynarr_new (printf_spec);
187 struct printf_spec spec;
188 const Bufbyte *text_end;
194 text_end = (Bufbyte *) memchr (fmt, '%', fmt_end - fmt);
197 spec.text_before = fmt - format;
198 spec.text_before_len = text_end - fmt;
202 fmt++; /* skip over % */
204 /* A % is special -- no arg number. According to ANSI specs,
205 field width does not apply to %% conversion. */
206 if (fmt != fmt_end && *fmt == '%')
208 spec.converter = '%';
209 Dynarr_add (specs, spec);
214 /* Is there a field number specifier? */
219 ptr = parse_off_posnum (fmt, fmt_end, &fieldspec);
220 if (fieldspec > 0 && ptr != fmt_end && *ptr == '$')
222 /* There is a format specifier */
223 prev_argnum = fieldspec;
228 spec.argnum = prev_argnum;
231 /* Parse off any flags */
232 NEXT_ASCII_BYTE (ch);
233 while (strchr (valid_flags, ch))
237 case '-': spec.minus_flag = 1; break;
238 case '+': spec.plus_flag = 1; break;
239 case ' ': spec.space_flag = 1; break;
240 case '#': spec.number_flag = 1; break;
241 case '0': spec.zero_flag = 1; break;
244 NEXT_ASCII_BYTE (ch);
247 /* Parse off the minimum field width */
251 * * means the field width was passed as an argument.
252 * Mark the current spec as one that forwards its
253 * field width and flags to the next spec in the array.
254 * Then create a new spec and continue with the parsing.
256 if (fmt != fmt_end && *fmt == '*')
258 spec.converter = '*';
259 RESOLVE_FLAG_CONFLICTS(spec);
260 Dynarr_add (specs, spec);
262 spec.argnum = ++prev_argnum;
267 fmt = parse_off_posnum (fmt, fmt_end, &spec.minwidth);
268 if (spec.minwidth == -1)
272 /* Parse off any precision specified */
273 NEXT_ASCII_BYTE (ch);
277 * * means the precision was passed as an argument.
278 * Mark the current spec as one that forwards its
279 * fieldwidth, flags and precision to the next spec in
280 * the array. Then create a new spec and continue
283 if (fmt != fmt_end && *fmt == '*')
285 spec.converter = '*';
286 spec.forwarding_precision = 1;
287 RESOLVE_FLAG_CONFLICTS(spec);
288 Dynarr_add (specs, spec);
290 spec.argnum = ++prev_argnum;
295 fmt = parse_off_posnum (fmt, fmt_end, &spec.precision);
296 if (spec.precision == -1)
299 NEXT_ASCII_BYTE (ch);
302 /* No precision specified */
305 /* Parse off h or l flag */
306 if (ch == 'h' || ch == 'l')
312 NEXT_ASCII_BYTE (ch);
315 if (!strchr (valid_converters, ch))
316 error ("Invalid converter character %c", ch);
320 RESOLVE_FLAG_CONFLICTS(spec);
321 Dynarr_add (specs, spec);
324 RETURN_NOT_REACHED(specs) /* suppress compiler warning */
328 get_args_needed (printf_spec_dynarr *specs)
333 /* Figure out how many args are needed. This may be less than
334 the number of specs because a spec could be %% or could be
335 missing (literal text at end of format string) or there
336 could be specs where the field number is explicitly given.
337 We just look for the maximum argument number that's referenced. */
339 for (i = 0; i < Dynarr_length (specs); i++)
341 char ch = Dynarr_at (specs, i).converter;
344 int argnum = Dynarr_at (specs, i).argnum;
345 if (argnum > args_needed)
346 args_needed = argnum;
353 static printf_arg_dynarr *
354 get_doprnt_args (printf_spec_dynarr *specs, va_list vargs)
356 printf_arg_dynarr *args = Dynarr_new (printf_arg);
357 union printf_arg arg;
359 int args_needed = get_args_needed (specs);
362 for (i = 1; i <= args_needed; i++)
366 struct printf_spec *spec = 0;
368 for (j = 0; j < Dynarr_length (specs); j++)
370 spec = Dynarr_atp (specs, j);
371 if (spec->argnum == i)
375 if (j == Dynarr_length (specs))
376 error ("No conversion spec for argument %d", i);
378 ch = spec->converter;
380 if (strchr (int_converters, ch))
383 arg.l = va_arg (vargs, long);
385 /* int even if ch == 'c' or spec->h_flag:
386 "the type used in va_arg is supposed to match the
387 actual type **after default promotions**."
388 Hence we read an int, not a short, if spec->h_flag. */
389 arg.l = va_arg (vargs, int);
391 else if (strchr (unsigned_int_converters, ch))
394 arg.ul = va_arg (vargs, unsigned long);
396 /* unsigned int even if ch == 'c' or spec->h_flag */
397 arg.ul = (unsigned long) va_arg (vargs, unsigned int);
399 else if (strchr (double_converters, ch))
400 arg.d = va_arg (vargs, double);
401 else if (strchr (string_converters, ch))
402 arg.bp = va_arg (vargs, Bufbyte *);
405 Dynarr_add (args, arg);
411 /* Generate output from a format-spec FORMAT, of length FORMAT_LENGTH.
412 Output goes in BUFFER, which has room for BUFSIZE bytes.
413 If the output does not fit, truncate it to fit.
414 Returns the number of bytes stored into BUFFER.
415 LARGS or VARGS points to the arguments, and NARGS says how many.
416 if LARGS is non-zero, it should be a pointer to NARGS worth of
417 Lisp arguments. Otherwise, VARGS should be a va_list referring
421 emacs_doprnt_1 (Lisp_Object stream, const Bufbyte *format_nonreloc,
422 Lisp_Object format_reloc, Bytecount format_length,
424 /* #### Gag me, gag me, gag me */
425 const Lisp_Object *largs, va_list vargs)
427 printf_spec_dynarr *specs = 0;
428 printf_arg_dynarr *args = 0;
430 int init_byte_count = Lstream_byte_count (XLSTREAM (stream));
432 if (!NILP (format_reloc))
434 format_nonreloc = XSTRING_DATA (format_reloc);
435 format_length = XSTRING_LENGTH (format_reloc);
437 if (format_length < 0)
438 format_length = (Bytecount) strlen ((const char *) format_nonreloc);
440 specs = parse_doprnt_spec (format_nonreloc, format_length);
443 /* allow too many args for string, but not too few */
444 if (nargs < get_args_needed (specs))
445 signal_error (Qwrong_number_of_arguments,
448 !NILP (format_reloc) ? format_reloc :
449 make_string (format_nonreloc, format_length)));
453 args = get_doprnt_args (specs, vargs);
456 for (i = 0; i < Dynarr_length (specs); i++)
458 struct printf_spec *spec = Dynarr_atp (specs, i);
461 /* Copy the text before */
462 if (!NILP (format_reloc)) /* refetch in case of GC below */
463 format_nonreloc = XSTRING_DATA (format_reloc);
465 doprnt_1 (stream, format_nonreloc + spec->text_before,
466 spec->text_before_len, 0, -1, 0, 0);
468 ch = spec->converter;
475 doprnt_1 (stream, (Bufbyte *) &ch, 1, 0, -1, 0, 0);
479 /* The char '*' as converter means the field width, precision
480 was specified as an argument. Extract the data and forward
481 it to the next spec, to which it will apply. */
484 struct printf_spec *nextspec = Dynarr_atp (specs, i + 1);
485 Lisp_Object obj = largs[spec->argnum - 1];
489 if (spec->forwarding_precision)
491 nextspec->precision = XINT (obj);
492 nextspec->minwidth = spec->minwidth;
496 nextspec->minwidth = XINT (obj);
499 spec->minus_flag = 1;
500 nextspec->minwidth = - nextspec->minwidth;
503 nextspec->minus_flag = spec->minus_flag;
504 nextspec->plus_flag = spec->plus_flag;
505 nextspec->space_flag = spec->space_flag;
506 nextspec->number_flag = spec->number_flag;
507 nextspec->zero_flag = spec->zero_flag;
512 if (largs && (spec->argnum < 1 || spec->argnum > nargs))
513 error ("Invalid repositioning argument %d", spec->argnum);
515 else if (ch == 'S' || ch == 's')
518 Bytecount string_len;
522 string = Dynarr_at (args, spec->argnum - 1).bp;
523 /* error() can be called with null string arguments.
524 E.g., in fileio.c, the return value of strerror()
525 is never checked. We'll print (null), like some
526 printf implementations do. Would it be better (and safe)
527 to signal an error instead? Or should we just use the
528 empty string? -dkindred@cs.cmu.edu 8/1997
531 string = (Bufbyte *) "(null)";
532 string_len = strlen ((char *) string);
536 Lisp_Object obj = largs[spec->argnum - 1];
541 /* For `S', prin1 the argument and then treat like
543 ls = XSTRING (Fprin1_to_string (obj, Qnil));
545 else if (STRINGP (obj))
547 else if (SYMBOLP (obj))
548 ls = XSYMBOL (obj)->name;
551 /* convert to string using princ. */
552 ls = XSTRING (Fprin1_to_string (obj, Qt));
554 string = string_data (ls);
555 string_len = string_length (ls);
558 doprnt_1 (stream, string, string_len, spec->minwidth,
559 spec->precision, spec->minus_flag, spec->zero_flag);
564 /* Must be a number. */
565 union printf_arg arg;
569 arg = Dynarr_at (args, spec->argnum - 1);
573 Lisp_Object obj = largs[spec->argnum - 1];
575 obj = make_int (XCHAR (obj));
576 if (!INT_OR_FLOATP (obj))
578 error ("format specifier %%%c doesn't match argument type",
581 else if (strchr (double_converters, ch))
582 arg.d = XFLOATINT (obj);
586 obj = Ftruncate (obj);
588 if (strchr (unsigned_int_converters, ch))
589 arg.ul = (unsigned long) XUINT (obj);
600 Bufbyte charbuf[MAX_EMCHAR_LEN];
604 if (!valid_char_p (a))
605 error ("invalid character value %d to %%c spec", a);
607 charlen = set_charptr_emchar (charbuf, a);
608 doprnt_1 (stream, charbuf, charlen, spec->minwidth,
609 -1, spec->minus_flag, spec->zero_flag);
613 char text_to_print[500];
614 char constructed_spec[100];
615 char *p = constructed_spec;
617 /* Partially reconstruct the spec and use sprintf() to
618 format the string. */
620 /* Make sure nothing stupid happens */
621 /* DO NOT REMOVE THE (int) CAST! Incorrect results will
623 spec->precision = min (spec->precision,
624 (int) (sizeof (text_to_print) - 50));
627 if (spec->plus_flag) *p++ = '+';
628 if (spec->space_flag) *p++ = ' ';
629 if (spec->number_flag) *p++ = '#';
631 if (spec->precision >= 0 && !spec->minwidth)
634 p = long_to_string (p, spec->precision);
637 /* sprintf the mofo */
638 /* we have to use separate calls to sprintf(), rather than
639 a single big conditional, because of the different types
641 if (strchr (double_converters, ch))
645 sprintf (text_to_print, constructed_spec, arg.d);
649 if (spec->zero_flag && spec->minwidth)
650 sprintf (p, "0%dl%c", spec->minwidth, ch);
652 sprintf (p, "l%c", ch);
654 if (strchr (unsigned_int_converters, ch))
655 sprintf (text_to_print, constructed_spec, arg.ul);
657 sprintf (text_to_print, constructed_spec, arg.l);
660 doprnt_1 (stream, (Bufbyte *) text_to_print,
661 strlen (text_to_print),
662 spec->minwidth, -1, spec->minus_flag, spec->zero_flag);
667 /* #### will not get freed if error */
672 return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count;
675 /* You really don't want to know why this is necessary... */
677 emacs_doprnt_2 (Lisp_Object stream, const Bufbyte *format_nonreloc,
678 Lisp_Object format_reloc, Bytecount format_length, int nargs,
679 const Lisp_Object *largs, ...)
683 va_start (vargs, largs);
684 val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
685 format_length, nargs, largs, vargs);
690 /*********************** external entry points ***********************/
693 /* A note about I18N3 translating: the format string should get
694 translated, but not under all circumstances. When the format
695 string is a Lisp string, what should happen is that Fformat()
696 should format the untranslated args[0] and return that, and also
697 call Fgettext() on args[0] and, if that is different, format it
698 and store it in the `string-translatable' property of
699 the returned string. See Fgettext(). */
702 /* Send formatted output to STREAM. The format string comes from
703 either FORMAT_NONRELOC (of length FORMAT_LENGTH; -1 means use
704 strlen() to determine the length) or from FORMAT_RELOC, which
705 should be a Lisp string. Return the number of bytes written
708 DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC
709 parameter, because this function can cause GC. */
712 emacs_doprnt_c (Lisp_Object stream, const Bufbyte *format_nonreloc,
713 Lisp_Object format_reloc, Bytecount format_length,
719 va_start (vargs, format_length);
720 val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
721 format_length, 0, 0, vargs);
726 /* Like emacs_doprnt_c but the args come in va_list format. */
729 emacs_doprnt_va (Lisp_Object stream, const Bufbyte *format_nonreloc,
730 Lisp_Object format_reloc, Bytecount format_length,
733 return emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
734 format_length, 0, 0, vargs);
737 /* Like emacs_doprnt_c but the args are Lisp objects instead of
738 C arguments. This causes somewhat different behavior from
739 the above two functions (which should act like printf).
740 See `format' for a description of this behavior. */
743 emacs_doprnt_lisp (Lisp_Object stream, const Bufbyte *format_nonreloc,
744 Lisp_Object format_reloc, Bytecount format_length,
745 int nargs, const Lisp_Object *largs)
747 return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
748 format_length, nargs, largs);
751 /* Like the previous function but takes a variable number of arguments. */
754 emacs_doprnt_lisp_2 (Lisp_Object stream, const Bufbyte *format_nonreloc,
755 Lisp_Object format_reloc, Bytecount format_length,
760 Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
762 va_start (vargs, nargs);
763 for (i = 0; i < nargs; i++)
764 foo[i] = va_arg (vargs, Lisp_Object);
767 return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
768 format_length, nargs, foo);
771 /* The following four functions work like the above three but
772 return their output as a Lisp string instead of sending it
776 emacs_doprnt_string_c (const Bufbyte *format_nonreloc,
777 Lisp_Object format_reloc, Bytecount format_length,
782 Lisp_Object stream = make_resizing_buffer_output_stream ();
786 va_start (vargs, format_length);
787 emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
788 format_length, 0, 0, vargs);
790 Lstream_flush (XLSTREAM (stream));
791 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
792 Lstream_byte_count (XLSTREAM (stream)));
794 Lstream_delete (XLSTREAM (stream));
799 emacs_doprnt_string_va (const Bufbyte *format_nonreloc,
800 Lisp_Object format_reloc, Bytecount format_length,
803 /* I'm fairly sure that this function cannot actually GC.
804 That can only happen when the arguments to emacs_doprnt_1() are
805 Lisp objects rather than C args. */
807 Lisp_Object stream = make_resizing_buffer_output_stream ();
811 emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
812 format_length, 0, 0, vargs);
813 Lstream_flush (XLSTREAM (stream));
814 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
815 Lstream_byte_count (XLSTREAM (stream)));
817 Lstream_delete (XLSTREAM (stream));
822 emacs_doprnt_string_lisp (const Bufbyte *format_nonreloc,
823 Lisp_Object format_reloc, Bytecount format_length,
824 int nargs, const Lisp_Object *largs)
827 Lisp_Object stream = make_resizing_buffer_output_stream ();
831 emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
832 format_length, nargs, largs);
833 Lstream_flush (XLSTREAM (stream));
834 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
835 Lstream_byte_count (XLSTREAM (stream)));
837 Lstream_delete (XLSTREAM (stream));
842 emacs_doprnt_string_lisp_2 (const Bufbyte *format_nonreloc,
843 Lisp_Object format_reloc, Bytecount format_length,
847 Lisp_Object stream = make_resizing_buffer_output_stream ();
851 Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
853 va_start (vargs, nargs);
854 for (i = 0; i < nargs; i++)
855 foo[i] = va_arg (vargs, Lisp_Object);
859 emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
860 format_length, nargs, foo);
861 Lstream_flush (XLSTREAM (stream));
862 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
863 Lstream_byte_count (XLSTREAM (stream)));
865 Lstream_delete (XLSTREAM (stream));