git.chise.org Git - chise/xemacs-chise.git.1/blob - src/doprnt.c

   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 * 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";
  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
  90 /* Append STRING (of length LEN) to STREAM.  MINLEN is the minimum field
  91    width.  If MINUS_FLAG is set, left-justify the string in its field;
  92    otherwise, right-justify.  If ZERO_FLAG is set, pad with 0's; otherwise
  93    pad with spaces.  If MAXLEN is non-negative, the string is first
  94    truncated to that many character.
  95
  96    Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */
  97
  98 static void
  99 doprnt_1 (Lisp_Object stream, const Bufbyte *string, Bytecount len,
 100           Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag)
 101 {
 102   Charcount cclen;
 103   Bufbyte pad;
 104   Lstream *lstr = XLSTREAM (stream);
 105
 106   cclen = bytecount_to_charcount (string, len);
 107
 108   if (zero_flag)
 109     pad = '0';
 110   else
 111     pad = ' ';
 112
 113   /* Padding at beginning to right-justify ... */
 114   if (minlen > cclen && !minus_flag)
 115     {
 116       int to_add = minlen - cclen;
 117       while (to_add > 0)
 118         {
 119           Lstream_putc (lstr, pad);
 120           to_add--;
 121         }
 122     }
 123
 124   if (maxlen >= 0)
 125     len = charcount_to_bytecount (string, min (maxlen, cclen));
 126   Lstream_write (lstr, string, len);
 127
 128   /* Padding at end to left-justify ... */
 129   if (minlen > cclen && minus_flag)
 130     {
 131       int to_add = minlen - cclen;
 132       while (to_add > 0)
 133         {
 134           Lstream_putc (lstr, pad);
 135           to_add--;
 136         }
 137     }
 138 }
 139
 140 static const Bufbyte *
 141 parse_off_posnum (const Bufbyte *start, const Bufbyte *end, int *returned_num)
 142 {
 143   Bufbyte arg_convert[100];
 144   REGISTER Bufbyte *arg_ptr = arg_convert;
 145
 146   *returned_num = -1;
 147   while (start != end && isdigit (*start))
 148     {
 149       if ((size_t) (arg_ptr - arg_convert) >= sizeof (arg_convert) - 1)
 150         error ("Format converter number too large");
 151       *arg_ptr++ = *start++;
 152     }
 153   *arg_ptr = '\0';
 154   if (arg_convert != arg_ptr)
 155     *returned_num = atoi ((char *) arg_convert);
 156   return start;
 157 }
 158
 159 #define NEXT_ASCII_BYTE(ch)                                     \
 160   do {                                                          \
 161     if (fmt == fmt_end)                                         \
 162       error ("Premature end of format string");                 \
 163     ch = *fmt;                                                  \
 164     if (ch >= 0200)                                             \
 165       error ("Non-ASCII character in format converter spec");   \
 166     fmt++;                                                      \
 167   } while (0)
 168
 169 #define RESOLVE_FLAG_CONFLICTS(spec)                            \
 170   do {                                                          \
 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;                                       \
 175   } while (0)
 176
 177 static printf_spec_dynarr *
 178 parse_doprnt_spec (const Bufbyte *format, Bytecount format_length)
 179 {
 180   const Bufbyte *fmt = format;
 181   const Bufbyte *fmt_end = format + format_length;
 182   printf_spec_dynarr *specs = Dynarr_new (printf_spec);
 183   int prev_argnum = 0;
 184
 185   while (1)
 186     {
 187       struct printf_spec spec;
 188       const Bufbyte *text_end;
 189       Bufbyte ch;
 190
 191       xzero (spec);
 192       if (fmt == fmt_end)
 193         return specs;
 194       text_end = (Bufbyte *) memchr (fmt, '%', fmt_end - fmt);
 195       if (!text_end)
 196         text_end = fmt_end;
 197       spec.text_before = fmt - format;
 198       spec.text_before_len = text_end - fmt;
 199       fmt = text_end;
 200       if (fmt != fmt_end)
 201         {
 202           fmt++; /* skip over % */
 203
 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 == '%')
 207             {
 208               spec.converter = '%';
 209               Dynarr_add (specs, spec);
 210               fmt++;
 211               continue;
 212             }
 213
 214           /* Is there a field number specifier? */
 215           {
 216             const Bufbyte *ptr;
 217             int fieldspec;
 218
 219             ptr = parse_off_posnum (fmt, fmt_end, &fieldspec);
 220             if (fieldspec > 0 && ptr != fmt_end && *ptr == '$')
 221               {
 222                 /* There is a format specifier */
 223                 prev_argnum = fieldspec;
 224                 fmt = ptr + 1;
 225               }
 226             else
 227               prev_argnum++;
 228             spec.argnum = prev_argnum;
 229           }
 230
 231           /* Parse off any flags */
 232           NEXT_ASCII_BYTE (ch);
 233           while (strchr (valid_flags, ch))
 234             {
 235               switch (ch)
 236                 {
 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;
 242                 default: abort ();
 243                 }
 244               NEXT_ASCII_BYTE (ch);
 245             }
 246
 247           /* Parse off the minimum field width */
 248           fmt--; /* back up */
 249
 250           /*
 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.
 255            */
 256           if (fmt != fmt_end && *fmt == '*')
 257             {
 258               spec.converter = '*';
 259               RESOLVE_FLAG_CONFLICTS(spec);
 260               Dynarr_add (specs, spec);
 261               xzero (spec);
 262               spec.argnum = ++prev_argnum;
 263               fmt++;
 264             }
 265           else
 266             {
 267               fmt = parse_off_posnum (fmt, fmt_end, &spec.minwidth);
 268               if (spec.minwidth == -1)
 269                 spec.minwidth = 0;
 270             }
 271
 272           /* Parse off any precision specified */
 273           NEXT_ASCII_BYTE (ch);
 274           if (ch == '.')
 275             {
 276               /*
 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
 281                * with the parse.
 282                */
 283               if (fmt != fmt_end && *fmt == '*')
 284                 {
 285                   spec.converter = '*';
 286                   spec.forwarding_precision = 1;
 287                   RESOLVE_FLAG_CONFLICTS(spec);
 288                   Dynarr_add (specs, spec);
 289                   xzero (spec);
 290                   spec.argnum = ++prev_argnum;
 291                   fmt++;
 292                 }
 293               else
 294                 {
 295                   fmt = parse_off_posnum (fmt, fmt_end, &spec.precision);
 296                   if (spec.precision == -1)
 297                     spec.precision = 0;
 298                 }
 299               NEXT_ASCII_BYTE (ch);
 300             }
 301           else
 302             /* No precision specified */
 303             spec.precision = -1;
 304
 305           /* Parse off h or l flag */
 306           if (ch == 'h' || ch == 'l')
 307             {
 308               if (ch == 'h')
 309                 spec.h_flag = 1;
 310               else
 311                 spec.l_flag = 1;
 312               NEXT_ASCII_BYTE (ch);
 313             }
 314
 315           if (!strchr (valid_converters, ch))
 316             error ("Invalid converter character %c", ch);
 317           spec.converter = ch;
 318         }
 319
 320       RESOLVE_FLAG_CONFLICTS(spec);
 321       Dynarr_add (specs, spec);
 322     }
 323
 324   RETURN_NOT_REACHED(specs) /* suppress compiler warning */
 325 }
 326
 327 static int
 328 get_args_needed (printf_spec_dynarr *specs)
 329 {
 330   int args_needed = 0;
 331   REGISTER int i;
 332
 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. */
 338
 339   for (i = 0; i < Dynarr_length (specs); i++)
 340     {
 341       char ch = Dynarr_at (specs, i).converter;
 342       if (ch && ch != '%')
 343         {
 344           int argnum = Dynarr_at (specs, i).argnum;
 345           if (argnum > args_needed)
 346             args_needed = argnum;
 347         }
 348     }
 349
 350   return args_needed;
 351 }
 352
 353 static printf_arg_dynarr *
 354 get_doprnt_args (printf_spec_dynarr *specs, va_list vargs)
 355 {
 356   printf_arg_dynarr *args = Dynarr_new (printf_arg);
 357   union printf_arg arg;
 358   REGISTER int i;
 359   int args_needed = get_args_needed (specs);
 360
 361   xzero (arg);
 362   for (i = 1; i <= args_needed; i++)
 363     {
 364       int j;
 365       char ch;
 366       struct printf_spec *spec = 0;
 367
 368       for (j = 0; j < Dynarr_length (specs); j++)
 369         {
 370           spec = Dynarr_atp (specs, j);
 371           if (spec->argnum == i)
 372             break;
 373         }
 374
 375       if (j == Dynarr_length (specs))
 376         error ("No conversion spec for argument %d", i);
 377
 378       ch = spec->converter;
 379
 380       if (strchr (int_converters, ch))
 381         {
 382           if (spec->l_flag)
 383             arg.l = va_arg (vargs, long);
 384           else
 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);
 390         }
 391       else if (strchr (unsigned_int_converters, ch))
 392         {
 393           if (spec->l_flag)
 394             arg.ul = va_arg (vargs, unsigned long);
 395           else
 396             /* unsigned int even if ch == 'c' or spec->h_flag */
 397             arg.ul = (unsigned long) va_arg (vargs, unsigned int);
 398         }
 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 *);
 403       else abort ();
 404
 405       Dynarr_add (args, arg);
 406     }
 407
 408   return args;
 409 }
 410
 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
 418    to the arguments. */
 419
 420 static Bytecount
 421 emacs_doprnt_1 (Lisp_Object stream, const Bufbyte *format_nonreloc,
 422                 Lisp_Object format_reloc, Bytecount format_length,
 423                 int nargs,
 424                 /* #### Gag me, gag me, gag me */
 425                 const Lisp_Object *largs, va_list vargs)
 426 {
 427   printf_spec_dynarr *specs = 0;
 428   printf_arg_dynarr *args = 0;
 429   REGISTER int i;
 430   int init_byte_count = Lstream_byte_count (XLSTREAM (stream));
 431
 432   if (!NILP (format_reloc))
 433     {
 434       format_nonreloc = XSTRING_DATA (format_reloc);
 435       format_length = XSTRING_LENGTH (format_reloc);
 436     }
 437   if (format_length < 0)
 438     format_length = (Bytecount) strlen ((const char *) format_nonreloc);
 439
 440   specs = parse_doprnt_spec (format_nonreloc, format_length);
 441   if (largs)
 442     {
 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,
 446                       list3 (Qformat,
 447                              make_int (nargs),
 448                              !NILP (format_reloc) ? format_reloc :
 449                              make_string (format_nonreloc, format_length)));
 450     }
 451   else
 452     {
 453       args = get_doprnt_args (specs, vargs);
 454     }
 455
 456   for (i = 0; i < Dynarr_length (specs); i++)
 457     {
 458       struct printf_spec *spec = Dynarr_atp (specs, i);
 459       char ch;
 460
 461       /* Copy the text before */
 462       if (!NILP (format_reloc)) /* refetch in case of GC below */
 463         format_nonreloc = XSTRING_DATA (format_reloc);
 464
 465       doprnt_1 (stream, format_nonreloc + spec->text_before,
 466                 spec->text_before_len, 0, -1, 0, 0);
 467
 468       ch = spec->converter;
 469
 470       if (!ch)
 471         continue;
 472
 473       if (ch == '%')
 474         {
 475           doprnt_1 (stream, (Bufbyte *) &ch, 1, 0, -1, 0, 0);
 476           continue;
 477         }
 478
 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.  */
 482       if (ch == '*')
 483         {
 484           struct printf_spec *nextspec = Dynarr_atp (specs, i + 1);
 485           Lisp_Object obj = largs[spec->argnum - 1];
 486
 487           if (INTP (obj))
 488             {
 489               if (spec->forwarding_precision)
 490                 {
 491                   nextspec->precision = XINT (obj);
 492                   nextspec->minwidth = spec->minwidth;
 493                 }
 494               else
 495                 {
 496                   nextspec->minwidth = XINT (obj);
 497                   if (XINT (obj) < 0)
 498                     {
 499                       spec->minus_flag = 1;
 500                       nextspec->minwidth = - nextspec->minwidth;
 501                     }
 502                 }
 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;
 508             }
 509           continue;
 510         }
 511
 512       if (largs && (spec->argnum < 1 || spec->argnum > nargs))
 513         error ("Invalid repositioning argument %d", spec->argnum);
 514
 515       else if (ch == 'S' || ch == 's')
 516         {
 517           Bufbyte *string;
 518           Bytecount string_len;
 519
 520           if (!largs)
 521             {
 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
 529               */
 530               if (!string)
 531                 string = (Bufbyte *) "(null)";
 532               string_len = strlen ((char *) string);
 533             }
 534           else
 535             {
 536               Lisp_Object obj = largs[spec->argnum - 1];
 537               Lisp_String *ls;
 538
 539               if (ch == 'S')
 540                 {
 541                   /* For `S', prin1 the argument and then treat like
 542                      a string.  */
 543                   ls = XSTRING (Fprin1_to_string (obj, Qnil));
 544                 }
 545               else if (STRINGP (obj))
 546                 ls = XSTRING (obj);
 547               else if (SYMBOLP (obj))
 548                 ls = XSYMBOL (obj)->name;
 549               else
 550                 {
 551                   /* convert to string using princ. */
 552                   ls = XSTRING (Fprin1_to_string (obj, Qt));
 553                 }
 554               string = string_data (ls);
 555               string_len = string_length (ls);
 556             }
 557
 558           doprnt_1 (stream, string, string_len, spec->minwidth,
 559                     spec->precision, spec->minus_flag, spec->zero_flag);
 560         }
 561
 562       else
 563         {
 564           /* Must be a number. */
 565           union printf_arg arg;
 566
 567           if (!largs)
 568             {
 569               arg = Dynarr_at (args, spec->argnum - 1);
 570             }
 571           else
 572             {
 573               Lisp_Object obj = largs[spec->argnum - 1];
 574               if (CHARP (obj))
 575                 obj = make_int (XCHAR (obj));
 576               if (!INT_OR_FLOATP (obj))
 577                 {
 578                   error ("format specifier %%%c doesn't match argument type",
 579                          ch);
 580                 }
 581               else if (strchr (double_converters, ch))
 582                 arg.d = XFLOATINT (obj);
 583               else
 584                 {
 585                   if (FLOATP (obj))
 586                     obj = Ftruncate (obj);
 587
 588                   if (strchr (unsigned_int_converters, ch))
 589                     arg.ul = (unsigned long) XINT (obj);
 590                   else
 591                     arg.l = XINT (obj);
 592                 }
 593             }
 594
 595
 596           if (ch == 'c')
 597             {
 598               Emchar a;
 599               Bytecount charlen;
 600               Bufbyte charbuf[MAX_EMCHAR_LEN];
 601
 602               a = (Emchar) arg.l;
 603
 604               if (!valid_char_p (a))
 605                 error ("invalid character value %d to %%c spec", a);
 606
 607               charlen = set_charptr_emchar (charbuf, a);
 608               doprnt_1 (stream, charbuf, charlen, spec->minwidth,
 609                         -1, spec->minus_flag, spec->zero_flag);
 610             }
 611           else
 612             {
 613               char text_to_print[500];
 614               char constructed_spec[100];
 615               char *p = constructed_spec;
 616
 617               /* Partially reconstruct the spec and use sprintf() to
 618                  format the string. */
 619
 620               /* Make sure nothing stupid happens */
 621               /* DO NOT REMOVE THE (int) CAST!  Incorrect results will
 622                  follow! */
 623               spec->precision = min (spec->precision,
 624                                      (int) (sizeof (text_to_print) - 50));
 625
 626               *p++ = '%';
 627               if (spec->plus_flag)   *p++ = '+';
 628               if (spec->space_flag)  *p++ = ' ';
 629               if (spec->number_flag) *p++ = '#';
 630
 631               if (spec->precision >= 0 && !spec->minwidth)
 632                 {
 633                   *p++ = '.';
 634                   p = long_to_string (p, spec->precision);
 635                 }
 636
 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
 640                  of the arguments */
 641               if (strchr (double_converters, ch))
 642                 {
 643                   *p++ = ch;
 644                   *p++ = '\0';
 645                   sprintf (text_to_print, constructed_spec, arg.d);
 646                 }
 647               else
 648                 {
 649                   if (spec->zero_flag && spec->minwidth)
 650                     sprintf (p, "0%dl%c", spec->minwidth, ch);
 651                   else
 652                     sprintf (p, "l%c", ch);
 653
 654                   if (strchr (unsigned_int_converters, ch))
 655                     sprintf (text_to_print, constructed_spec, arg.ul);
 656                   else
 657                     sprintf (text_to_print, constructed_spec, arg.l);
 658                 }
 659
 660               doprnt_1 (stream, (Bufbyte *) text_to_print,
 661                         strlen (text_to_print),
 662                         spec->minwidth, -1, spec->minus_flag, spec->zero_flag);
 663             }
 664         }
 665     }
 666
 667   /* #### will not get freed if error */
 668   if (specs)
 669     Dynarr_free (specs);
 670   if (args)
 671     Dynarr_free (args);
 672   return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count;
 673 }
 674
 675 /* You really don't want to know why this is necessary... */
 676 static Bytecount
 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, ...)
 680 {
 681   va_list vargs;
 682   Bytecount val;
 683   va_start (vargs, largs);
 684   val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
 685                         format_length, nargs, largs, vargs);
 686   va_end (vargs);
 687   return val;
 688 }
 689
 690 /*********************** external entry points ***********************/
 691
 692 #ifdef I18N3
 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(). */
 700 #endif
 701
 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
 706    to the stream.
 707
 708    DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC
 709    parameter, because this function can cause GC. */
 710
 711 Bytecount
 712 emacs_doprnt_c (Lisp_Object stream, const Bufbyte *format_nonreloc,
 713                 Lisp_Object format_reloc, Bytecount format_length,
 714                 ...)
 715 {
 716   int val;
 717   va_list vargs;
 718
 719   va_start (vargs, format_length);
 720   val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
 721                         format_length, 0, 0, vargs);
 722   va_end (vargs);
 723   return val;
 724 }
 725
 726 /* Like emacs_doprnt_c but the args come in va_list format. */
 727
 728 Bytecount
 729 emacs_doprnt_va (Lisp_Object stream, const Bufbyte *format_nonreloc,
 730                  Lisp_Object format_reloc, Bytecount format_length,
 731                  va_list vargs)
 732 {
 733   return emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
 734                          format_length, 0, 0, vargs);
 735 }
 736
 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. */
 741
 742 Bytecount
 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)
 746 {
 747   return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
 748                          format_length, nargs, largs);
 749 }
 750
 751 /* Like the previous function but takes a variable number of arguments. */
 752
 753 Bytecount
 754 emacs_doprnt_lisp_2 (Lisp_Object stream, const Bufbyte *format_nonreloc,
 755                      Lisp_Object format_reloc, Bytecount format_length,
 756                      int nargs, ...)
 757 {
 758   va_list vargs;
 759   int i;
 760   Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
 761
 762   va_start (vargs, nargs);
 763   for (i = 0; i < nargs; i++)
 764     foo[i] = va_arg (vargs, Lisp_Object);
 765   va_end (vargs);
 766
 767   return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
 768                          format_length, nargs, foo);
 769 }
 770
 771 /* The following four functions work like the above three but
 772    return their output as a Lisp string instead of sending it
 773    to a stream. */
 774
 775 Lisp_Object
 776 emacs_doprnt_string_c (const Bufbyte *format_nonreloc,
 777                        Lisp_Object format_reloc, Bytecount format_length,
 778                        ...)
 779 {
 780   va_list vargs;
 781   Lisp_Object obj;
 782   Lisp_Object stream = make_resizing_buffer_output_stream ();
 783   struct gcpro gcpro1;
 784
 785   GCPRO1 (stream);
 786   va_start (vargs, format_length);
 787   emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
 788                   format_length, 0, 0, vargs);
 789   va_end (vargs);
 790   Lstream_flush (XLSTREAM (stream));
 791   obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
 792                      Lstream_byte_count (XLSTREAM (stream)));
 793   UNGCPRO;
 794   Lstream_delete (XLSTREAM (stream));
 795   return obj;
 796 }
 797
 798 Lisp_Object
 799 emacs_doprnt_string_va (const Bufbyte *format_nonreloc,
 800                         Lisp_Object format_reloc, Bytecount format_length,
 801                         va_list vargs)
 802 {
 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. */
 806   Lisp_Object obj;
 807   Lisp_Object stream = make_resizing_buffer_output_stream ();
 808   struct gcpro gcpro1;
 809
 810   GCPRO1 (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)));
 816   UNGCPRO;
 817   Lstream_delete (XLSTREAM (stream));
 818   return obj;
 819 }
 820
 821 Lisp_Object
 822 emacs_doprnt_string_lisp (const Bufbyte *format_nonreloc,
 823                           Lisp_Object format_reloc, Bytecount format_length,
 824                           int nargs, const Lisp_Object *largs)
 825 {
 826   Lisp_Object obj;
 827   Lisp_Object stream = make_resizing_buffer_output_stream ();
 828   struct gcpro gcpro1;
 829
 830   GCPRO1 (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)));
 836   UNGCPRO;
 837   Lstream_delete (XLSTREAM (stream));
 838   return obj;
 839 }
 840
 841 Lisp_Object
 842 emacs_doprnt_string_lisp_2 (const Bufbyte *format_nonreloc,
 843                             Lisp_Object format_reloc, Bytecount format_length,
 844                             int nargs, ...)
 845 {
 846   Lisp_Object obj;
 847   Lisp_Object stream = make_resizing_buffer_output_stream ();
 848   struct gcpro gcpro1;
 849   va_list vargs;
 850   int i;
 851   Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
 852
 853   va_start (vargs, nargs);
 854   for (i = 0; i < nargs; i++)
 855     foo[i] = va_arg (vargs, Lisp_Object);
 856   va_end (vargs);
 857
 858   GCPRO1 (stream);
 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)));
 864   UNGCPRO;
 865   Lstream_delete (XLSTREAM (stream));
 866   return obj;
 867 }