428
+ − 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
446
+ − 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 = "ouxX";
+ − 38 static const char * const double_converters = "feEgG";
+ − 39 static const char * const string_converters = "sS";
428
+ − 40
+ − 41 typedef struct printf_spec printf_spec;
+ − 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 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
+ − 59 specification */
+ − 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 */
+ − 63 };
+ − 64
+ − 65 typedef union printf_arg printf_arg;
+ − 66 union printf_arg
+ − 67 {
+ − 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
448
+ − 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.
428
+ − 97
+ − 98 Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */
+ − 99
+ − 100 static void
442
+ − 101 doprnt_1 (Lisp_Object stream, const Bufbyte *string, Bytecount len,
428
+ − 102 Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag)
+ − 103 {
+ − 104 Lstream *lstr = XLSTREAM (stream);
448
+ − 105 Charcount cclen = bytecount_to_charcount (string, len);
+ − 106 int to_add = minlen - cclen;
428
+ − 107
+ − 108 /* Padding at beginning to right-justify ... */
448
+ − 109 if (!minus_flag)
+ − 110 while (to_add-- > 0)
+ − 111 Lstream_putc (lstr, zero_flag ? '0' : ' ');
428
+ − 112
448
+ − 113 if (0 <= maxlen && maxlen < cclen)
+ − 114 len = charcount_to_bytecount (string, maxlen);
428
+ − 115 Lstream_write (lstr, string, len);
+ − 116
+ − 117 /* Padding at end to left-justify ... */
448
+ − 118 if (minus_flag)
+ − 119 while (to_add-- > 0)
+ − 120 Lstream_putc (lstr, zero_flag ? '0' : ' ');
428
+ − 121 }
+ − 122
442
+ − 123 static const Bufbyte *
+ − 124 parse_off_posnum (const Bufbyte *start, const Bufbyte *end, int *returned_num)
428
+ − 125 {
+ − 126 Bufbyte arg_convert[100];
+ − 127 REGISTER Bufbyte *arg_ptr = arg_convert;
+ − 128
+ − 129 *returned_num = -1;
+ − 130 while (start != end && isdigit (*start))
+ − 131 {
+ − 132 if ((size_t) (arg_ptr - arg_convert) >= sizeof (arg_convert) - 1)
563
+ − 133 syntax_error ("Format converter number too large", Qunbound);
428
+ − 134 *arg_ptr++ = *start++;
+ − 135 }
+ − 136 *arg_ptr = '\0';
+ − 137 if (arg_convert != arg_ptr)
+ − 138 *returned_num = atoi ((char *) arg_convert);
+ − 139 return start;
+ − 140 }
+ − 141
+ − 142 #define NEXT_ASCII_BYTE(ch) \
+ − 143 do { \
+ − 144 if (fmt == fmt_end) \
563
+ − 145 syntax_error ("Premature end of format string", Qunbound); \
428
+ − 146 ch = *fmt; \
+ − 147 if (ch >= 0200) \
563
+ − 148 syntax_error ("Non-ASCII character in format converter spec", Qunbound); \
428
+ − 149 fmt++; \
+ − 150 } while (0)
+ − 151
+ − 152 #define RESOLVE_FLAG_CONFLICTS(spec) \
+ − 153 do { \
+ − 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; \
+ − 158 } while (0)
+ − 159
+ − 160 static printf_spec_dynarr *
442
+ − 161 parse_doprnt_spec (const Bufbyte *format, Bytecount format_length)
428
+ − 162 {
442
+ − 163 const Bufbyte *fmt = format;
+ − 164 const Bufbyte *fmt_end = format + format_length;
428
+ − 165 printf_spec_dynarr *specs = Dynarr_new (printf_spec);
+ − 166 int prev_argnum = 0;
+ − 167
+ − 168 while (1)
+ − 169 {
+ − 170 struct printf_spec spec;
442
+ − 171 const Bufbyte *text_end;
428
+ − 172 Bufbyte ch;
+ − 173
+ − 174 xzero (spec);
+ − 175 if (fmt == fmt_end)
+ − 176 return specs;
+ − 177 text_end = (Bufbyte *) memchr (fmt, '%', fmt_end - fmt);
+ − 178 if (!text_end)
+ − 179 text_end = fmt_end;
+ − 180 spec.text_before = fmt - format;
+ − 181 spec.text_before_len = text_end - fmt;
+ − 182 fmt = text_end;
+ − 183 if (fmt != fmt_end)
+ − 184 {
+ − 185 fmt++; /* skip over % */
+ − 186
+ − 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 == '%')
+ − 190 {
+ − 191 spec.converter = '%';
+ − 192 Dynarr_add (specs, spec);
+ − 193 fmt++;
+ − 194 continue;
+ − 195 }
+ − 196
+ − 197 /* Is there a field number specifier? */
+ − 198 {
442
+ − 199 const Bufbyte *ptr;
428
+ − 200 int fieldspec;
+ − 201
+ − 202 ptr = parse_off_posnum (fmt, fmt_end, &fieldspec);
+ − 203 if (fieldspec > 0 && ptr != fmt_end && *ptr == '$')
+ − 204 {
+ − 205 /* There is a format specifier */
+ − 206 prev_argnum = fieldspec;
+ − 207 fmt = ptr + 1;
+ − 208 }
+ − 209 else
+ − 210 prev_argnum++;
+ − 211 spec.argnum = prev_argnum;
+ − 212 }
+ − 213
+ − 214 /* Parse off any flags */
+ − 215 NEXT_ASCII_BYTE (ch);
+ − 216 while (strchr (valid_flags, ch))
+ − 217 {
+ − 218 switch (ch)
+ − 219 {
446
+ − 220 case '-': spec.minus_flag = 1; break;
+ − 221 case '+': spec.plus_flag = 1; break;
+ − 222 case ' ': spec.space_flag = 1; break;
428
+ − 223 case '#': spec.number_flag = 1; break;
446
+ − 224 case '0': spec.zero_flag = 1; break;
428
+ − 225 default: abort ();
+ − 226 }
+ − 227 NEXT_ASCII_BYTE (ch);
+ − 228 }
+ − 229
+ − 230 /* Parse off the minimum field width */
+ − 231 fmt--; /* back up */
+ − 232
+ − 233 /*
+ − 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.
+ − 238 */
+ − 239 if (fmt != fmt_end && *fmt == '*')
+ − 240 {
+ − 241 spec.converter = '*';
+ − 242 RESOLVE_FLAG_CONFLICTS(spec);
+ − 243 Dynarr_add (specs, spec);
+ − 244 xzero (spec);
+ − 245 spec.argnum = ++prev_argnum;
+ − 246 fmt++;
+ − 247 }
+ − 248 else
+ − 249 {
+ − 250 fmt = parse_off_posnum (fmt, fmt_end, &spec.minwidth);
+ − 251 if (spec.minwidth == -1)
+ − 252 spec.minwidth = 0;
+ − 253 }
+ − 254
+ − 255 /* Parse off any precision specified */
+ − 256 NEXT_ASCII_BYTE (ch);
+ − 257 if (ch == '.')
+ − 258 {
+ − 259 /*
+ − 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
+ − 264 * with the parse.
+ − 265 */
+ − 266 if (fmt != fmt_end && *fmt == '*')
+ − 267 {
+ − 268 spec.converter = '*';
+ − 269 spec.forwarding_precision = 1;
+ − 270 RESOLVE_FLAG_CONFLICTS(spec);
+ − 271 Dynarr_add (specs, spec);
+ − 272 xzero (spec);
+ − 273 spec.argnum = ++prev_argnum;
+ − 274 fmt++;
+ − 275 }
+ − 276 else
+ − 277 {
+ − 278 fmt = parse_off_posnum (fmt, fmt_end, &spec.precision);
+ − 279 if (spec.precision == -1)
+ − 280 spec.precision = 0;
+ − 281 }
+ − 282 NEXT_ASCII_BYTE (ch);
+ − 283 }
+ − 284 else
+ − 285 /* No precision specified */
+ − 286 spec.precision = -1;
+ − 287
+ − 288 /* Parse off h or l flag */
+ − 289 if (ch == 'h' || ch == 'l')
+ − 290 {
+ − 291 if (ch == 'h')
+ − 292 spec.h_flag = 1;
+ − 293 else
+ − 294 spec.l_flag = 1;
+ − 295 NEXT_ASCII_BYTE (ch);
+ − 296 }
+ − 297
+ − 298 if (!strchr (valid_converters, ch))
563
+ − 299 syntax_error ("Invalid converter character", make_char (ch));
428
+ − 300 spec.converter = ch;
+ − 301 }
+ − 302
+ − 303 RESOLVE_FLAG_CONFLICTS(spec);
+ − 304 Dynarr_add (specs, spec);
+ − 305 }
+ − 306
+ − 307 RETURN_NOT_REACHED(specs) /* suppress compiler warning */
+ − 308 }
+ − 309
+ − 310 static int
+ − 311 get_args_needed (printf_spec_dynarr *specs)
+ − 312 {
+ − 313 int args_needed = 0;
+ − 314 REGISTER int i;
+ − 315
+ − 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. */
+ − 321
+ − 322 for (i = 0; i < Dynarr_length (specs); i++)
+ − 323 {
+ − 324 char ch = Dynarr_at (specs, i).converter;
+ − 325 if (ch && ch != '%')
+ − 326 {
+ − 327 int argnum = Dynarr_at (specs, i).argnum;
+ − 328 if (argnum > args_needed)
+ − 329 args_needed = argnum;
+ − 330 }
+ − 331 }
+ − 332
+ − 333 return args_needed;
+ − 334 }
+ − 335
+ − 336 static printf_arg_dynarr *
+ − 337 get_doprnt_args (printf_spec_dynarr *specs, va_list vargs)
+ − 338 {
+ − 339 printf_arg_dynarr *args = Dynarr_new (printf_arg);
+ − 340 union printf_arg arg;
+ − 341 REGISTER int i;
+ − 342 int args_needed = get_args_needed (specs);
+ − 343
+ − 344 xzero (arg);
+ − 345 for (i = 1; i <= args_needed; i++)
+ − 346 {
+ − 347 int j;
+ − 348 char ch;
+ − 349 struct printf_spec *spec = 0;
+ − 350
+ − 351 for (j = 0; j < Dynarr_length (specs); j++)
+ − 352 {
+ − 353 spec = Dynarr_atp (specs, j);
+ − 354 if (spec->argnum == i)
+ − 355 break;
+ − 356 }
+ − 357
+ − 358 if (j == Dynarr_length (specs))
563
+ − 359 syntax_error ("No conversion spec for argument", make_int (i));
428
+ − 360
+ − 361 ch = spec->converter;
+ − 362
+ − 363 if (strchr (int_converters, ch))
+ − 364 {
446
+ − 365 if (spec->l_flag)
428
+ − 366 arg.l = va_arg (vargs, long);
+ − 367 else
446
+ − 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);
428
+ − 373 }
+ − 374 else if (strchr (unsigned_int_converters, ch))
+ − 375 {
446
+ − 376 if (spec->l_flag)
428
+ − 377 arg.ul = va_arg (vargs, unsigned long);
+ − 378 else
446
+ − 379 /* unsigned int even if ch == 'c' or spec->h_flag */
+ − 380 arg.ul = (unsigned long) va_arg (vargs, unsigned int);
428
+ − 381 }
+ − 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 *);
+ − 386 else abort ();
+ − 387
+ − 388 Dynarr_add (args, arg);
+ − 389 }
+ − 390
+ − 391 return args;
+ − 392 }
+ − 393
+ − 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
+ − 401 to the arguments. */
+ − 402
+ − 403 static Bytecount
442
+ − 404 emacs_doprnt_1 (Lisp_Object stream, const Bufbyte *format_nonreloc,
428
+ − 405 Lisp_Object format_reloc, Bytecount format_length,
+ − 406 int nargs,
+ − 407 /* #### Gag me, gag me, gag me */
442
+ − 408 const Lisp_Object *largs, va_list vargs)
428
+ − 409 {
+ − 410 printf_spec_dynarr *specs = 0;
+ − 411 printf_arg_dynarr *args = 0;
+ − 412 REGISTER int i;
+ − 413 int init_byte_count = Lstream_byte_count (XLSTREAM (stream));
+ − 414
+ − 415 if (!NILP (format_reloc))
+ − 416 {
+ − 417 format_nonreloc = XSTRING_DATA (format_reloc);
+ − 418 format_length = XSTRING_LENGTH (format_reloc);
+ − 419 }
+ − 420 if (format_length < 0)
442
+ − 421 format_length = (Bytecount) strlen ((const char *) format_nonreloc);
428
+ − 422
+ − 423 specs = parse_doprnt_spec (format_nonreloc, format_length);
+ − 424 if (largs)
+ − 425 {
446
+ − 426 /* allow too many args for string, but not too few */
428
+ − 427 if (nargs < get_args_needed (specs))
563
+ − 428 signal_error_1 (Qwrong_number_of_arguments,
428
+ − 429 list3 (Qformat,
+ − 430 make_int (nargs),
+ − 431 !NILP (format_reloc) ? format_reloc :
+ − 432 make_string (format_nonreloc, format_length)));
+ − 433 }
+ − 434 else
+ − 435 {
+ − 436 args = get_doprnt_args (specs, vargs);
+ − 437 }
+ − 438
+ − 439 for (i = 0; i < Dynarr_length (specs); i++)
+ − 440 {
+ − 441 struct printf_spec *spec = Dynarr_atp (specs, i);
+ − 442 char ch;
+ − 443
+ − 444 /* Copy the text before */
+ − 445 if (!NILP (format_reloc)) /* refetch in case of GC below */
+ − 446 format_nonreloc = XSTRING_DATA (format_reloc);
446
+ − 447
+ − 448 doprnt_1 (stream, format_nonreloc + spec->text_before,
+ − 449 spec->text_before_len, 0, -1, 0, 0);
428
+ − 450
+ − 451 ch = spec->converter;
+ − 452
+ − 453 if (!ch)
+ − 454 continue;
+ − 455
+ − 456 if (ch == '%')
+ − 457 {
+ − 458 doprnt_1 (stream, (Bufbyte *) &ch, 1, 0, -1, 0, 0);
+ − 459 continue;
+ − 460 }
+ − 461
+ − 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. */
+ − 465 if (ch == '*')
+ − 466 {
+ − 467 struct printf_spec *nextspec = Dynarr_atp (specs, i + 1);
+ − 468 Lisp_Object obj = largs[spec->argnum - 1];
+ − 469
+ − 470 if (INTP (obj))
+ − 471 {
+ − 472 if (spec->forwarding_precision)
+ − 473 {
+ − 474 nextspec->precision = XINT (obj);
+ − 475 nextspec->minwidth = spec->minwidth;
+ − 476 }
+ − 477 else
+ − 478 {
+ − 479 nextspec->minwidth = XINT (obj);
446
+ − 480 if (XINT (obj) < 0)
428
+ − 481 {
+ − 482 spec->minus_flag = 1;
+ − 483 nextspec->minwidth = - nextspec->minwidth;
+ − 484 }
+ − 485 }
446
+ − 486 nextspec->minus_flag = spec->minus_flag;
+ − 487 nextspec->plus_flag = spec->plus_flag;
+ − 488 nextspec->space_flag = spec->space_flag;
428
+ − 489 nextspec->number_flag = spec->number_flag;
446
+ − 490 nextspec->zero_flag = spec->zero_flag;
428
+ − 491 }
+ − 492 continue;
+ − 493 }
+ − 494
+ − 495 if (largs && (spec->argnum < 1 || spec->argnum > nargs))
563
+ − 496 syntax_error ("Invalid repositioning argument", make_int (spec->argnum));
428
+ − 497
+ − 498 else if (ch == 'S' || ch == 's')
+ − 499 {
+ − 500 Bufbyte *string;
+ − 501 Bytecount string_len;
+ − 502
+ − 503 if (!largs)
+ − 504 {
+ − 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
+ − 512 */
+ − 513 if (!string)
+ − 514 string = (Bufbyte *) "(null)";
+ − 515 string_len = strlen ((char *) string);
+ − 516 }
+ − 517 else
+ − 518 {
+ − 519 Lisp_Object obj = largs[spec->argnum - 1];
440
+ − 520 Lisp_String *ls;
428
+ − 521
+ − 522 if (ch == 'S')
+ − 523 {
+ − 524 /* For `S', prin1 the argument and then treat like
+ − 525 a string. */
+ − 526 ls = XSTRING (Fprin1_to_string (obj, Qnil));
+ − 527 }
+ − 528 else if (STRINGP (obj))
+ − 529 ls = XSTRING (obj);
+ − 530 else if (SYMBOLP (obj))
+ − 531 ls = XSYMBOL (obj)->name;
+ − 532 else
+ − 533 {
+ − 534 /* convert to string using princ. */
+ − 535 ls = XSTRING (Fprin1_to_string (obj, Qt));
+ − 536 }
+ − 537 string = string_data (ls);
+ − 538 string_len = string_length (ls);
+ − 539 }
+ − 540
+ − 541 doprnt_1 (stream, string, string_len, spec->minwidth,
+ − 542 spec->precision, spec->minus_flag, spec->zero_flag);
+ − 543 }
+ − 544
+ − 545 else
+ − 546 {
+ − 547 /* Must be a number. */
+ − 548 union printf_arg arg;
+ − 549
+ − 550 if (!largs)
+ − 551 {
+ − 552 arg = Dynarr_at (args, spec->argnum - 1);
+ − 553 }
+ − 554 else
+ − 555 {
+ − 556 Lisp_Object obj = largs[spec->argnum - 1];
+ − 557 if (CHARP (obj))
+ − 558 obj = make_int (XCHAR (obj));
+ − 559 if (!INT_OR_FLOATP (obj))
+ − 560 {
563
+ − 561 syntax_error ("format specifier %%%c doesn't match argument type",
568
+ − 562 make_char (ch));
428
+ − 563 }
+ − 564 else if (strchr (double_converters, ch))
+ − 565 arg.d = XFLOATINT (obj);
+ − 566 else
+ − 567 {
446
+ − 568 if (FLOATP (obj))
+ − 569 obj = Ftruncate (obj);
428
+ − 570
+ − 571 if (strchr (unsigned_int_converters, ch))
446
+ − 572 arg.ul = (unsigned long) XINT (obj);
428
+ − 573 else
446
+ − 574 arg.l = XINT (obj);
428
+ − 575 }
+ − 576 }
+ − 577
+ − 578
+ − 579 if (ch == 'c')
+ − 580 {
+ − 581 Emchar a;
+ − 582 Bytecount charlen;
+ − 583 Bufbyte charbuf[MAX_EMCHAR_LEN];
+ − 584
446
+ − 585 a = (Emchar) arg.l;
428
+ − 586
+ − 587 if (!valid_char_p (a))
568
+ − 588 syntax_error ("invalid character value %d to %%c spec", make_char (a));
428
+ − 589
+ − 590 charlen = set_charptr_emchar (charbuf, a);
+ − 591 doprnt_1 (stream, charbuf, charlen, spec->minwidth,
+ − 592 -1, spec->minus_flag, spec->zero_flag);
+ − 593 }
+ − 594 else
+ − 595 {
448
+ − 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 +
+ − 600 max (spec->minwidth,
+ − 601 max (sizeof (double), sizeof (long)) * 3 +
+ − 602 max (spec->precision, 0)));
428
+ − 603 char constructed_spec[100];
446
+ − 604 char *p = constructed_spec;
428
+ − 605
448
+ − 606 /* Mostly reconstruct the spec and use sprintf() to
428
+ − 607 format the string. */
+ − 608
446
+ − 609 *p++ = '%';
+ − 610 if (spec->plus_flag) *p++ = '+';
+ − 611 if (spec->space_flag) *p++ = ' ';
+ − 612 if (spec->number_flag) *p++ = '#';
448
+ − 613 if (spec->minus_flag) *p++ = '-';
+ − 614 if (spec->zero_flag) *p++ = '0';
446
+ − 615
448
+ − 616 if (spec->minwidth >= 0)
+ − 617 p = long_to_string (p, spec->minwidth);
+ − 618 if (spec->precision >= 0)
428
+ − 619 {
446
+ − 620 *p++ = '.';
+ − 621 p = long_to_string (p, spec->precision);
428
+ − 622 }
448
+ − 623
428
+ − 624 if (strchr (double_converters, ch))
442
+ − 625 {
446
+ − 626 *p++ = ch;
+ − 627 *p++ = '\0';
442
+ − 628 sprintf (text_to_print, constructed_spec, arg.d);
+ − 629 }
428
+ − 630 else
+ − 631 {
448
+ − 632 *p++ = 'l'; /* Always use longs with sprintf() */
+ − 633 *p++ = ch;
+ − 634 *p++ = '\0';
446
+ − 635
+ − 636 if (strchr (unsigned_int_converters, ch))
+ − 637 sprintf (text_to_print, constructed_spec, arg.ul);
+ − 638 else
428
+ − 639 sprintf (text_to_print, constructed_spec, arg.l);
+ − 640 }
+ − 641
+ − 642 doprnt_1 (stream, (Bufbyte *) text_to_print,
448
+ − 643 strlen (text_to_print), 0, -1, 0, 0);
428
+ − 644 }
+ − 645 }
+ − 646 }
+ − 647
+ − 648 /* #### will not get freed if error */
+ − 649 if (specs)
+ − 650 Dynarr_free (specs);
+ − 651 if (args)
+ − 652 Dynarr_free (args);
+ − 653 return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count;
+ − 654 }
+ − 655
+ − 656 /* You really don't want to know why this is necessary... */
+ − 657 static Bytecount
442
+ − 658 emacs_doprnt_2 (Lisp_Object stream, const Bufbyte *format_nonreloc,
428
+ − 659 Lisp_Object format_reloc, Bytecount format_length, int nargs,
442
+ − 660 const Lisp_Object *largs, ...)
428
+ − 661 {
+ − 662 va_list vargs;
+ − 663 Bytecount val;
+ − 664 va_start (vargs, largs);
+ − 665 val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
+ − 666 format_length, nargs, largs, vargs);
+ − 667 va_end (vargs);
+ − 668 return val;
+ − 669 }
+ − 670
+ − 671 /*********************** external entry points ***********************/
+ − 672
+ − 673 #ifdef I18N3
+ − 674 /* A note about I18N3 translating: the format string should get
+ − 675 translated, but not under all circumstances. When the format
+ − 676 string is a Lisp string, what should happen is that Fformat()
+ − 677 should format the untranslated args[0] and return that, and also
+ − 678 call Fgettext() on args[0] and, if that is different, format it
+ − 679 and store it in the `string-translatable' property of
+ − 680 the returned string. See Fgettext(). */
+ − 681 #endif
+ − 682
+ − 683 /* Send formatted output to STREAM. The format string comes from
+ − 684 either FORMAT_NONRELOC (of length FORMAT_LENGTH; -1 means use
+ − 685 strlen() to determine the length) or from FORMAT_RELOC, which
+ − 686 should be a Lisp string. Return the number of bytes written
+ − 687 to the stream.
+ − 688
+ − 689 DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC
+ − 690 parameter, because this function can cause GC. */
+ − 691
+ − 692 Bytecount
442
+ − 693 emacs_doprnt_c (Lisp_Object stream, const Bufbyte *format_nonreloc,
428
+ − 694 Lisp_Object format_reloc, Bytecount format_length,
+ − 695 ...)
+ − 696 {
+ − 697 int val;
+ − 698 va_list vargs;
+ − 699
+ − 700 va_start (vargs, format_length);
+ − 701 val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
+ − 702 format_length, 0, 0, vargs);
+ − 703 va_end (vargs);
+ − 704 return val;
+ − 705 }
+ − 706
+ − 707 /* Like emacs_doprnt_c but the args come in va_list format. */
+ − 708
+ − 709 Bytecount
442
+ − 710 emacs_doprnt_va (Lisp_Object stream, const Bufbyte *format_nonreloc,
428
+ − 711 Lisp_Object format_reloc, Bytecount format_length,
+ − 712 va_list vargs)
+ − 713 {
+ − 714 return emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
+ − 715 format_length, 0, 0, vargs);
+ − 716 }
+ − 717
+ − 718 /* Like emacs_doprnt_c but the args are Lisp objects instead of
+ − 719 C arguments. This causes somewhat different behavior from
+ − 720 the above two functions (which should act like printf).
+ − 721 See `format' for a description of this behavior. */
+ − 722
+ − 723 Bytecount
442
+ − 724 emacs_doprnt_lisp (Lisp_Object stream, const Bufbyte *format_nonreloc,
428
+ − 725 Lisp_Object format_reloc, Bytecount format_length,
442
+ − 726 int nargs, const Lisp_Object *largs)
428
+ − 727 {
+ − 728 return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
+ − 729 format_length, nargs, largs);
+ − 730 }
+ − 731
+ − 732 /* Like the previous function but takes a variable number of arguments. */
+ − 733
+ − 734 Bytecount
442
+ − 735 emacs_doprnt_lisp_2 (Lisp_Object stream, const Bufbyte *format_nonreloc,
428
+ − 736 Lisp_Object format_reloc, Bytecount format_length,
+ − 737 int nargs, ...)
+ − 738 {
+ − 739 va_list vargs;
+ − 740 int i;
+ − 741 Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
+ − 742
+ − 743 va_start (vargs, nargs);
+ − 744 for (i = 0; i < nargs; i++)
+ − 745 foo[i] = va_arg (vargs, Lisp_Object);
+ − 746 va_end (vargs);
+ − 747
+ − 748 return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
+ − 749 format_length, nargs, foo);
+ − 750 }
+ − 751
+ − 752 /* The following four functions work like the above three but
+ − 753 return their output as a Lisp string instead of sending it
+ − 754 to a stream. */
+ − 755
+ − 756 Lisp_Object
442
+ − 757 emacs_doprnt_string_c (const Bufbyte *format_nonreloc,
428
+ − 758 Lisp_Object format_reloc, Bytecount format_length,
+ − 759 ...)
+ − 760 {
+ − 761 va_list vargs;
+ − 762 Lisp_Object obj;
+ − 763 Lisp_Object stream = make_resizing_buffer_output_stream ();
+ − 764 struct gcpro gcpro1;
+ − 765
+ − 766 GCPRO1 (stream);
+ − 767 va_start (vargs, format_length);
+ − 768 emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
+ − 769 format_length, 0, 0, vargs);
+ − 770 va_end (vargs);
+ − 771 Lstream_flush (XLSTREAM (stream));
+ − 772 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
+ − 773 Lstream_byte_count (XLSTREAM (stream)));
+ − 774 UNGCPRO;
+ − 775 Lstream_delete (XLSTREAM (stream));
+ − 776 return obj;
+ − 777 }
+ − 778
+ − 779 Lisp_Object
442
+ − 780 emacs_doprnt_string_va (const Bufbyte *format_nonreloc,
428
+ − 781 Lisp_Object format_reloc, Bytecount format_length,
+ − 782 va_list vargs)
+ − 783 {
+ − 784 /* I'm fairly sure that this function cannot actually GC.
+ − 785 That can only happen when the arguments to emacs_doprnt_1() are
+ − 786 Lisp objects rather than C args. */
+ − 787 Lisp_Object obj;
+ − 788 Lisp_Object stream = make_resizing_buffer_output_stream ();
+ − 789 struct gcpro gcpro1;
+ − 790
+ − 791 GCPRO1 (stream);
+ − 792 emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
+ − 793 format_length, 0, 0, vargs);
+ − 794 Lstream_flush (XLSTREAM (stream));
+ − 795 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
+ − 796 Lstream_byte_count (XLSTREAM (stream)));
+ − 797 UNGCPRO;
+ − 798 Lstream_delete (XLSTREAM (stream));
+ − 799 return obj;
+ − 800 }
+ − 801
+ − 802 Lisp_Object
442
+ − 803 emacs_doprnt_string_lisp (const Bufbyte *format_nonreloc,
428
+ − 804 Lisp_Object format_reloc, Bytecount format_length,
442
+ − 805 int nargs, const Lisp_Object *largs)
428
+ − 806 {
+ − 807 Lisp_Object obj;
+ − 808 Lisp_Object stream = make_resizing_buffer_output_stream ();
+ − 809 struct gcpro gcpro1;
+ − 810
+ − 811 GCPRO1 (stream);
+ − 812 emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
+ − 813 format_length, nargs, largs);
+ − 814 Lstream_flush (XLSTREAM (stream));
+ − 815 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
+ − 816 Lstream_byte_count (XLSTREAM (stream)));
+ − 817 UNGCPRO;
+ − 818 Lstream_delete (XLSTREAM (stream));
+ − 819 return obj;
+ − 820 }
+ − 821
+ − 822 Lisp_Object
442
+ − 823 emacs_doprnt_string_lisp_2 (const Bufbyte *format_nonreloc,
428
+ − 824 Lisp_Object format_reloc, Bytecount format_length,
+ − 825 int nargs, ...)
+ − 826 {
+ − 827 Lisp_Object obj;
+ − 828 Lisp_Object stream = make_resizing_buffer_output_stream ();
+ − 829 struct gcpro gcpro1;
+ − 830 va_list vargs;
+ − 831 int i;
+ − 832 Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
+ − 833
+ − 834 va_start (vargs, nargs);
+ − 835 for (i = 0; i < nargs; i++)
+ − 836 foo[i] = va_arg (vargs, Lisp_Object);
+ − 837 va_end (vargs);
+ − 838
+ − 839 GCPRO1 (stream);
+ − 840 emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
+ − 841 format_length, nargs, foo);
+ − 842 Lstream_flush (XLSTREAM (stream));
+ − 843 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
+ − 844 Lstream_byte_count (XLSTREAM (stream)));
+ − 845 UNGCPRO;
+ − 846 Lstream_delete (XLSTREAM (stream));
+ − 847 return obj;
+ − 848 }
