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 *valid_flags = "-+ #0";
  35
  36 static const char *valid_converters = "diouxXfeEgGcsS";
  37 static const char *int_converters = "dic";
  38 static const char *unsigned_int_converters = "ouxX";
  39 static const char *double_converters = "feEgG";
  40 static const char *string_converters = "sS";
  41
  42 typedef struct printf_spec printf_spec;
  43 struct printf_spec
  44 {
  45   int argnum; /* which argument does this spec want?  This is one-based:
  46                  The first argument given is numbered 1, the second
  47                  is 2, etc.  This is to handle %##$x-type specs. */
  48   int minwidth;
  49   int precision;
  50   unsigned int minus_flag:1;
  51   unsigned int plus_flag:1;
  52   unsigned int space_flag:1;
  53   unsigned int number_flag:1;
  54   unsigned int zero_flag:1;
  55   unsigned int h_flag:1;
  56   unsigned int l_flag:1;
  57   unsigned int forwarding_precision:1;
  58   char converter; /* converter character or 0 for dummy marker
  59                      indicating literal text at the end of the
  60                      specification */
  61   Bytecount text_before; /* position of the first character of the
  62                             block of literal text before this spec */
  63   Bytecount text_before_len; /* length of that text */
  64 };
  65
  66 typedef union printf_arg printf_arg;
  67 union printf_arg
  68 {
  69   int i;
  70   unsigned int ui;
  71   long l;
  72   unsigned long ul;
  73   double d;
  74   Bufbyte *bp;
  75 };
  76
  77 /* We maintain a list of all the % specs in the specification,
  78    along with the offset and length of the block of literal text
  79    before each spec.  In addition, we have a "dummy" spec that
  80    represents all the literal text at the end of the specification.
  81    Its converter is 0. */
  82
  83 typedef struct
  84 {
  85   Dynarr_declare (struct printf_spec);
  86 } printf_spec_dynarr;
  87
  88 typedef struct
  89 {
  90   Dynarr_declare (union printf_arg);
  91 } printf_arg_dynarr;
  92
  93 /* Append STRING (of length LEN) to STREAM.  MINLEN is the minimum field
  94    width.  If MINUS_FLAG is set, left-justify the string in its field;
  95    otherwise, right-justify.  If ZERO_FLAG is set, pad with 0's; otherwise
  96    pad with spaces.  If MAXLEN is non-negative, the string is first
  97    truncated to that many character.
  98
  99    Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */
 100
 101 static void
 102 doprnt_1 (Lisp_Object stream, const Bufbyte *string, Bytecount len,
 103           Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag)
 104 {
 105   Charcount cclen;
 106   Bufbyte pad;
 107   Lstream *lstr = XLSTREAM (stream);
 108
 109   cclen = bytecount_to_charcount (string, len);
 110
 111   if (zero_flag)
 112     pad = '0';
 113   else
 114     pad = ' ';
 115
 116   /* Padding at beginning to right-justify ... */
 117   if (minlen > cclen && !minus_flag)
 118     {
 119       int to_add = minlen - cclen;
 120       while (to_add > 0)
 121         {
 122           Lstream_putc (lstr, pad);
 123           to_add--;
 124         }
 125     }
 126
 127   if (maxlen >= 0)
 128     len = charcount_to_bytecount (string, min (maxlen, cclen));
 129   Lstream_write (lstr, string, len);
 130
 131   /* Padding at end to left-justify ... */
 132   if (minlen > cclen && minus_flag)
 133     {
 134       int to_add = minlen - cclen;
 135       while (to_add > 0)
 136         {
 137           Lstream_putc (lstr, pad);
 138           to_add--;
 139         }
 140     }
 141 }
 142
 143 static const Bufbyte *
 144 parse_off_posnum (const Bufbyte *start, const Bufbyte *end, int *returned_num)
 145 {
 146   Bufbyte arg_convert[100];
 147   REGISTER Bufbyte *arg_ptr = arg_convert;
 148
 149   *returned_num = -1;
 150   while (start != end && isdigit (*start))
 151     {
 152       if ((size_t) (arg_ptr - arg_convert) >= sizeof (arg_convert) - 1)
 153         error ("Format converter number too large");
 154       *arg_ptr++ = *start++;
 155     }
 156   *arg_ptr = '\0';
 157   if (arg_convert != arg_ptr)
 158     *returned_num = atoi ((char *) arg_convert);
 159   return start;
 160 }
 161
 162 #define NEXT_ASCII_BYTE(ch)                                     \
 163   do {                                                          \
 164     if (fmt == fmt_end)                                         \
 165       error ("Premature end of format string");                 \
 166     ch = *fmt;                                                  \
 167     if (ch >= 0200)                                             \
 168       error ("Non-ASCII character in format converter spec");   \
 169     fmt++;                                                      \
 170   } while (0)
 171
 172 #define RESOLVE_FLAG_CONFLICTS(spec)                            \
 173   do {                                                          \
 174     if (spec.space_flag && spec.plus_flag)                      \
 175       spec.space_flag = 0;                                      \
 176     if (spec.zero_flag && spec.space_flag)                      \
 177       spec.zero_flag = 0;                                       \
 178   } while (0)
 179
 180 static printf_spec_dynarr *
 181 parse_doprnt_spec (const Bufbyte *format, Bytecount format_length)
 182 {
 183   const Bufbyte *fmt = format;
 184   const Bufbyte *fmt_end = format + format_length;
 185   printf_spec_dynarr *specs = Dynarr_new (printf_spec);
 186   int prev_argnum = 0;
 187
 188   while (1)
 189     {
 190       struct printf_spec spec;
 191       const Bufbyte *text_end;
 192       Bufbyte ch;
 193
 194       xzero (spec);
 195       if (fmt == fmt_end)
 196         return specs;
 197       text_end = (Bufbyte *) memchr (fmt, '%', fmt_end - fmt);
 198       if (!text_end)
 199         text_end = fmt_end;
 200       spec.text_before = fmt - format;
 201       spec.text_before_len = text_end - fmt;
 202       fmt = text_end;
 203       if (fmt != fmt_end)
 204         {
 205           fmt++; /* skip over % */
 206
 207           /* A % is special -- no arg number.  According to ANSI specs,
 208              field width does not apply to %% conversion. */
 209           if (fmt != fmt_end && *fmt == '%')
 210             {
 211               spec.converter = '%';
 212               Dynarr_add (specs, spec);
 213               fmt++;
 214               continue;
 215             }
 216
 217           /* Is there a field number specifier? */
 218           {
 219             const Bufbyte *ptr;
 220             int fieldspec;
 221
 222             ptr = parse_off_posnum (fmt, fmt_end, &fieldspec);
 223             if (fieldspec > 0 && ptr != fmt_end && *ptr == '$')
 224               {
 225                 /* There is a format specifier */
 226                 prev_argnum = fieldspec;
 227                 fmt = ptr + 1;
 228               }
 229             else
 230               prev_argnum++;
 231             spec.argnum = prev_argnum;
 232           }
 233
 234           /* Parse off any flags */
 235           NEXT_ASCII_BYTE (ch);
 236           while (strchr (valid_flags, ch))
 237             {
 238               switch (ch)
 239                 {
 240                 case '-': spec.minus_flag = 1; break;
 241                 case '+': spec.plus_flag = 1; break;
 242                 case ' ': spec.space_flag = 1; break;
 243                 case '#': spec.number_flag = 1; break;
 244                 case '0': spec.zero_flag = 1; break;
 245                 default: abort ();
 246                 }
 247               NEXT_ASCII_BYTE (ch);
 248             }
 249
 250           /* Parse off the minimum field width */
 251           fmt--; /* back up */
 252
 253           /*
 254            * * means the field width was passed as an argument.
 255            * Mark the current spec as one that forwards its
 256            * field width and flags to the next spec in the array.
 257            * Then create a new spec and continue with the parsing.
 258            */
 259           if (fmt != fmt_end && *fmt == '*')
 260             {
 261               spec.converter = '*';
 262               RESOLVE_FLAG_CONFLICTS(spec);
 263               Dynarr_add (specs, spec);
 264               xzero (spec);
 265               spec.argnum = ++prev_argnum;
 266               fmt++;
 267             }
 268           else
 269             {
 270               fmt = parse_off_posnum (fmt, fmt_end, &spec.minwidth);
 271               if (spec.minwidth == -1)
 272                 spec.minwidth = 0;
 273             }
 274
 275           /* Parse off any precision specified */
 276           NEXT_ASCII_BYTE (ch);
 277           if (ch == '.')
 278             {
 279               /*
 280                * * means the precision was passed as an argument.
 281                * Mark the current spec as one that forwards its
 282                * fieldwidth, flags and precision to the next spec in
 283                * the array.  Then create a new spec and continue
 284                * with the parse.
 285                */
 286               if (fmt != fmt_end && *fmt == '*')
 287                 {
 288                   spec.converter = '*';
 289                   spec.forwarding_precision = 1;
 290                   RESOLVE_FLAG_CONFLICTS(spec);
 291                   Dynarr_add (specs, spec);
 292                   xzero (spec);
 293                   spec.argnum = ++prev_argnum;
 294                   fmt++;
 295                 }
 296               else
 297                 {
 298                   fmt = parse_off_posnum (fmt, fmt_end, &spec.precision);
 299                   if (spec.precision == -1)
 300                     spec.precision = 0;
 301                 }
 302               NEXT_ASCII_BYTE (ch);
 303             }
 304           else
 305             /* No precision specified */
 306             spec.precision = -1;
 307
 308           /* Parse off h or l flag */
 309           if (ch == 'h' || ch == 'l')
 310             {
 311               if (ch == 'h')
 312                 spec.h_flag = 1;
 313               else
 314                 spec.l_flag = 1;
 315               NEXT_ASCII_BYTE (ch);
 316             }
 317
 318           if (!strchr (valid_converters, ch))
 319             error ("Invalid converter character %c", ch);
 320           spec.converter = ch;
 321         }
 322
 323       RESOLVE_FLAG_CONFLICTS(spec);
 324       Dynarr_add (specs, spec);
 325     }
 326
 327   RETURN_NOT_REACHED(specs) /* suppress compiler warning */
 328 }
 329
 330 static int
 331 get_args_needed (printf_spec_dynarr *specs)
 332 {
 333   int args_needed = 0;
 334   REGISTER int i;
 335
 336   /* Figure out how many args are needed.  This may be less than
 337      the number of specs because a spec could be %% or could be
 338      missing (literal text at end of format string) or there
 339      could be specs where the field number is explicitly given.
 340      We just look for the maximum argument number that's referenced. */
 341
 342   for (i = 0; i < Dynarr_length (specs); i++)
 343     {
 344       char ch = Dynarr_at (specs, i).converter;
 345       if (ch && ch != '%')
 346         {
 347           int argnum = Dynarr_at (specs, i).argnum;
 348           if (argnum > args_needed)
 349             args_needed = argnum;
 350         }
 351     }
 352
 353   return args_needed;
 354 }
 355
 356 static printf_arg_dynarr *
 357 get_doprnt_args (printf_spec_dynarr *specs, va_list vargs)
 358 {
 359   printf_arg_dynarr *args = Dynarr_new (printf_arg);
 360   union printf_arg arg;
 361   REGISTER int i;
 362   int args_needed = get_args_needed (specs);
 363
 364   xzero (arg);
 365   for (i = 1; i <= args_needed; i++)
 366     {
 367       int j;
 368       char ch;
 369       struct printf_spec *spec = 0;
 370
 371       for (j = 0; j < Dynarr_length (specs); j++)
 372         {
 373           spec = Dynarr_atp (specs, j);
 374           if (spec->argnum == i)
 375             break;
 376         }
 377
 378       if (j == Dynarr_length (specs))
 379         error ("No conversion spec for argument %d", i);
 380
 381       ch = spec->converter;
 382
 383       /* int even if ch == 'c': "the type used in va_arg is supposed to
 384          match the actual type **after default promotions**." */
 385
 386       if (strchr (int_converters, ch))
 387         {
 388           if (spec->h_flag)
 389             arg.i = va_arg (vargs, int /* short */);
 390           else if (spec->l_flag)
 391             arg.l = va_arg (vargs, long);
 392           else
 393             arg.i = va_arg (vargs, int);
 394         }
 395       else if (strchr (unsigned_int_converters, ch))
 396         {
 397           if (spec->h_flag)
 398             arg.ui = va_arg (vargs, unsigned int /* unsigned short */);
 399           else if (spec->l_flag)
 400             arg.ul = va_arg (vargs, unsigned long);
 401           else
 402             arg.ui = va_arg (vargs, unsigned int);
 403         }
 404       else if (strchr (double_converters, ch))
 405         arg.d = va_arg (vargs, double);
 406       else if (strchr (string_converters, ch))
 407         arg.bp = va_arg (vargs, Bufbyte *);
 408       else abort ();
 409
 410       Dynarr_add (args, arg);
 411     }
 412
 413   return args;
 414 }
 415
 416 /* Generate output from a format-spec FORMAT, of length FORMAT_LENGTH.
 417    Output goes in BUFFER, which has room for BUFSIZE bytes.
 418    If the output does not fit, truncate it to fit.
 419    Returns the number of bytes stored into BUFFER.
 420    LARGS or VARGS points to the arguments, and NARGS says how many.
 421    if LARGS is non-zero, it should be a pointer to NARGS worth of
 422    Lisp arguments.  Otherwise, VARGS should be a va_list referring
 423    to the arguments. */
 424
 425 static Bytecount
 426 emacs_doprnt_1 (Lisp_Object stream, const Bufbyte *format_nonreloc,
 427                 Lisp_Object format_reloc, Bytecount format_length,
 428                 int nargs,
 429                 /* #### Gag me, gag me, gag me */
 430                 const Lisp_Object *largs, va_list vargs)
 431 {
 432   printf_spec_dynarr *specs = 0;
 433   printf_arg_dynarr *args = 0;
 434   REGISTER int i;
 435   int init_byte_count = Lstream_byte_count (XLSTREAM (stream));
 436
 437   if (!NILP (format_reloc))
 438     {
 439       format_nonreloc = XSTRING_DATA (format_reloc);
 440       format_length = XSTRING_LENGTH (format_reloc);
 441     }
 442   if (format_length < 0)
 443     format_length = (Bytecount) strlen ((const char *) format_nonreloc);
 444
 445   specs = parse_doprnt_spec (format_nonreloc, format_length);
 446   if (largs)
 447     {
 448         /* allow too many args for string, but not too few */
 449       if (nargs < get_args_needed (specs))
 450         signal_error (Qwrong_number_of_arguments,
 451                       list3 (Qformat,
 452                              make_int (nargs),
 453                              !NILP (format_reloc) ? format_reloc :
 454                              make_string (format_nonreloc, format_length)));
 455     }
 456   else
 457     {
 458       args = get_doprnt_args (specs, vargs);
 459     }
 460
 461   for (i = 0; i < Dynarr_length (specs); i++)
 462     {
 463       struct printf_spec *spec = Dynarr_atp (specs, i);
 464       char ch;
 465
 466       /* Copy the text before */
 467       if (!NILP (format_reloc)) /* refetch in case of GC below */
 468         format_nonreloc = XSTRING_DATA (format_reloc);
 469        doprnt_1 (stream, format_nonreloc + spec->text_before,
 470                  spec->text_before_len, 0, -1, 0, 0);
 471
 472       ch = spec->converter;
 473
 474       if (!ch)
 475         continue;
 476
 477       if (ch == '%')
 478         {
 479           doprnt_1 (stream, (Bufbyte *) &ch, 1, 0, -1, 0, 0);
 480           continue;
 481         }
 482
 483       /* The char '*' as converter means the field width, precision
 484          was specified as an argument.  Extract the data and forward
 485          it to the next spec, to which it will apply.  */
 486       if (ch == '*')
 487         {
 488           struct printf_spec *nextspec = Dynarr_atp (specs, i + 1);
 489           Lisp_Object obj = largs[spec->argnum - 1];
 490
 491           if (INTP (obj))
 492             {
 493               if (spec->forwarding_precision)
 494                 {
 495                   nextspec->precision = XINT (obj);
 496                   nextspec->minwidth = spec->minwidth;
 497                 }
 498               else
 499                 {
 500                   nextspec->minwidth = XINT (obj);
 501                   if (XINT(obj) < 0)
 502                     {
 503                       spec->minus_flag = 1;
 504                       nextspec->minwidth = - nextspec->minwidth;
 505                     }
 506                 }
 507               nextspec->minus_flag = spec->minus_flag;
 508               nextspec->plus_flag = spec->plus_flag;
 509               nextspec->space_flag = spec->space_flag;
 510               nextspec->number_flag = spec->number_flag;
 511               nextspec->zero_flag = spec->zero_flag;
 512             }
 513           continue;
 514         }
 515
 516       if (largs && (spec->argnum < 1 || spec->argnum > nargs))
 517         error ("Invalid repositioning argument %d", spec->argnum);
 518
 519       else if (ch == 'S' || ch == 's')
 520         {
 521           Bufbyte *string;
 522           Bytecount string_len;
 523
 524           if (!largs)
 525             {
 526               string = Dynarr_at (args, spec->argnum - 1).bp;
 527               /* error() can be called with null string arguments.
 528                  E.g., in fileio.c, the return value of strerror()
 529                  is never checked.  We'll print (null), like some
 530                  printf implementations do.  Would it be better (and safe)
 531                  to signal an error instead?  Or should we just use the
 532                  empty string?  -dkindred@cs.cmu.edu 8/1997
 533               */
 534               if (!string)
 535                 string = (Bufbyte *) "(null)";
 536               string_len = strlen ((char *) string);
 537             }
 538           else
 539             {
 540               Lisp_Object obj = largs[spec->argnum - 1];
 541               Lisp_String *ls;
 542
 543               if (ch == 'S')
 544                 {
 545                   /* For `S', prin1 the argument and then treat like
 546                      a string.  */
 547                   ls = XSTRING (Fprin1_to_string (obj, Qnil));
 548                 }
 549               else if (STRINGP (obj))
 550                 ls = XSTRING (obj);
 551               else if (SYMBOLP (obj))
 552                 ls = XSYMBOL (obj)->name;
 553               else
 554                 {
 555                   /* convert to string using princ. */
 556                   ls = XSTRING (Fprin1_to_string (obj, Qt));
 557                 }
 558               string = string_data (ls);
 559               string_len = string_length (ls);
 560             }
 561
 562           doprnt_1 (stream, string, string_len, spec->minwidth,
 563                     spec->precision, spec->minus_flag, spec->zero_flag);
 564         }
 565
 566       else
 567         {
 568           /* Must be a number. */
 569           union printf_arg arg;
 570
 571           if (!largs)
 572             {
 573               arg = Dynarr_at (args, spec->argnum - 1);
 574             }
 575           else
 576             {
 577               Lisp_Object obj = largs[spec->argnum - 1];
 578               if (CHARP (obj))
 579                 obj = make_int (XCHAR (obj));
 580               if (!INT_OR_FLOATP (obj))
 581                 {
 582                   error ("format specifier %%%c doesn't match argument type",
 583                          ch);
 584                 }
 585               else if (strchr (double_converters, ch))
 586                 arg.d = XFLOATINT (obj);
 587               else
 588                 {
 589                   int val;
 590
 591                   if (FLOATP (obj))
 592                     val = XINT (Ftruncate (obj));
 593                   else
 594                     val = XINT (obj);
 595                   if (strchr (unsigned_int_converters, ch))
 596                     {
 597                       if (spec->l_flag)
 598                         arg.ul = (unsigned long) val;
 599                       else
 600                         arg.ui = (unsigned int) val;
 601                     }
 602                   else
 603                     {
 604                       if (spec->l_flag)
 605                         arg.l = (long) val;
 606                       else
 607                         arg.i = val;
 608                     }
 609                 }
 610             }
 611
 612
 613           if (ch == 'c')
 614             {
 615               Emchar a;
 616               Bytecount charlen;
 617               Bufbyte charbuf[MAX_EMCHAR_LEN];
 618
 619               if (spec->l_flag)
 620                 a = (Emchar) arg.l;
 621               else
 622                 a = (Emchar) arg.i;
 623
 624               if (!valid_char_p (a))
 625                 error ("invalid character value %d to %%c spec", a);
 626
 627               charlen = set_charptr_emchar (charbuf, a);
 628               doprnt_1 (stream, charbuf, charlen, spec->minwidth,
 629                         -1, spec->minus_flag, spec->zero_flag);
 630             }
 631
 632           else
 633             {
 634               char text_to_print[500];
 635               char constructed_spec[100];
 636
 637               /* Partially reconstruct the spec and use sprintf() to
 638                  format the string. */
 639
 640               /* Make sure nothing stupid happens */
 641               /* DO NOT REMOVE THE (int) CAST!  Incorrect results will
 642                  follow! */
 643               spec->precision = min (spec->precision,
 644                                      (int) (sizeof (text_to_print) - 50));
 645
 646               constructed_spec[0] = 0;
 647               strcat (constructed_spec, "%");
 648               if (spec->plus_flag)
 649                 strcat (constructed_spec, "+");
 650               if (spec->space_flag)
 651                 strcat (constructed_spec, " ");
 652               if (spec->number_flag)
 653                 strcat (constructed_spec, "#");
 654               if (spec->precision >= 0)
 655                 {
 656                   strcat (constructed_spec, ".");
 657                   long_to_string (constructed_spec + strlen (constructed_spec),
 658                                   spec->precision);
 659                 }
 660
 661               /* sprintf the mofo */
 662               /* we have to use separate calls to sprintf(), rather than
 663                  a single big conditional, because of the different types
 664                  of the arguments */
 665               if (strchr (double_converters, ch))
 666                 {
 667                   sprintf (constructed_spec + strlen (constructed_spec),
 668                            "%c", ch);
 669                   sprintf (text_to_print, constructed_spec, arg.d);
 670                 }
 671               else if (strchr (unsigned_int_converters, ch))
 672                 {
 673                   sprintf (constructed_spec + strlen (constructed_spec),
 674                            "%c", ch);
 675                   if (spec->l_flag)
 676                     sprintf (text_to_print, constructed_spec, arg.ul);
 677                   else
 678                     sprintf (text_to_print, constructed_spec, arg.ui);
 679                 }
 680               else
 681                 {
 682                   if (spec->zero_flag && spec->minwidth)
 683                     sprintf (constructed_spec + strlen (constructed_spec),
 684                              "0%d%c", spec->minwidth, ch);
 685                   else
 686                     sprintf (constructed_spec + strlen (constructed_spec),
 687                              "%c", ch);
 688                   if (spec->l_flag)
 689                     sprintf (text_to_print, constructed_spec, arg.l);
 690                   else
 691                     sprintf (text_to_print, constructed_spec, arg.i);
 692                 }
 693
 694               doprnt_1 (stream, (Bufbyte *) text_to_print,
 695                         strlen (text_to_print),
 696                         spec->minwidth, -1, spec->minus_flag, spec->zero_flag);
 697             }
 698         }
 699     }
 700
 701   /* #### will not get freed if error */
 702   if (specs)
 703     Dynarr_free (specs);
 704   if (args)
 705     Dynarr_free (args);
 706   return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count;
 707 }
 708
 709 /* You really don't want to know why this is necessary... */
 710 static Bytecount
 711 emacs_doprnt_2 (Lisp_Object stream, const Bufbyte *format_nonreloc,
 712                 Lisp_Object format_reloc, Bytecount format_length, int nargs,
 713                 const Lisp_Object *largs, ...)
 714 {
 715   va_list vargs;
 716   Bytecount val;
 717   va_start (vargs, largs);
 718   val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
 719                         format_length, nargs, largs, vargs);
 720   va_end (vargs);
 721   return val;
 722 }
 723
 724 /*********************** external entry points ***********************/
 725
 726 #ifdef I18N3
 727   /* A note about I18N3 translating: the format string should get
 728      translated, but not under all circumstances.  When the format
 729      string is a Lisp string, what should happen is that Fformat()
 730      should format the untranslated args[0] and return that, and also
 731      call Fgettext() on args[0] and, if that is different, format it
 732      and store it in the `string-translatable' property of
 733      the returned string.  See Fgettext(). */
 734 #endif
 735
 736 /* Send formatted output to STREAM.  The format string comes from
 737    either FORMAT_NONRELOC (of length FORMAT_LENGTH; -1 means use
 738    strlen() to determine the length) or from FORMAT_RELOC, which
 739    should be a Lisp string.  Return the number of bytes written
 740    to the stream.
 741
 742    DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC
 743    parameter, because this function can cause GC. */
 744
 745 Bytecount
 746 emacs_doprnt_c (Lisp_Object stream, const Bufbyte *format_nonreloc,
 747                 Lisp_Object format_reloc, Bytecount format_length,
 748                 ...)
 749 {
 750   int val;
 751   va_list vargs;
 752
 753   va_start (vargs, format_length);
 754   val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
 755                         format_length, 0, 0, vargs);
 756   va_end (vargs);
 757   return val;
 758 }
 759
 760 /* Like emacs_doprnt_c but the args come in va_list format. */
 761
 762 Bytecount
 763 emacs_doprnt_va (Lisp_Object stream, const Bufbyte *format_nonreloc,
 764                  Lisp_Object format_reloc, Bytecount format_length,
 765                  va_list vargs)
 766 {
 767   return emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
 768                          format_length, 0, 0, vargs);
 769 }
 770
 771 /* Like emacs_doprnt_c but the args are Lisp objects instead of
 772    C arguments.  This causes somewhat different behavior from
 773    the above two functions (which should act like printf).
 774    See `format' for a description of this behavior. */
 775
 776 Bytecount
 777 emacs_doprnt_lisp (Lisp_Object stream, const Bufbyte *format_nonreloc,
 778                    Lisp_Object format_reloc, Bytecount format_length,
 779                    int nargs, const Lisp_Object *largs)
 780 {
 781   return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
 782                          format_length, nargs, largs);
 783 }
 784
 785 /* Like the previous function but takes a variable number of arguments. */
 786
 787 Bytecount
 788 emacs_doprnt_lisp_2 (Lisp_Object stream, const Bufbyte *format_nonreloc,
 789                      Lisp_Object format_reloc, Bytecount format_length,
 790                      int nargs, ...)
 791 {
 792   va_list vargs;
 793   int i;
 794   Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
 795
 796   va_start (vargs, nargs);
 797   for (i = 0; i < nargs; i++)
 798     foo[i] = va_arg (vargs, Lisp_Object);
 799   va_end (vargs);
 800
 801   return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
 802                          format_length, nargs, foo);
 803 }
 804
 805 /* The following four functions work like the above three but
 806    return their output as a Lisp string instead of sending it
 807    to a stream. */
 808
 809 Lisp_Object
 810 emacs_doprnt_string_c (const Bufbyte *format_nonreloc,
 811                        Lisp_Object format_reloc, Bytecount format_length,
 812                        ...)
 813 {
 814   va_list vargs;
 815   Lisp_Object obj;
 816   Lisp_Object stream = make_resizing_buffer_output_stream ();
 817   struct gcpro gcpro1;
 818
 819   GCPRO1 (stream);
 820   va_start (vargs, format_length);
 821   emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
 822                   format_length, 0, 0, vargs);
 823   va_end (vargs);
 824   Lstream_flush (XLSTREAM (stream));
 825   obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
 826                      Lstream_byte_count (XLSTREAM (stream)));
 827   UNGCPRO;
 828   Lstream_delete (XLSTREAM (stream));
 829   return obj;
 830 }
 831
 832 Lisp_Object
 833 emacs_doprnt_string_va (const Bufbyte *format_nonreloc,
 834                         Lisp_Object format_reloc, Bytecount format_length,
 835                         va_list vargs)
 836 {
 837   /* I'm fairly sure that this function cannot actually GC.
 838      That can only happen when the arguments to emacs_doprnt_1() are
 839      Lisp objects rather than C args. */
 840   Lisp_Object obj;
 841   Lisp_Object stream = make_resizing_buffer_output_stream ();
 842   struct gcpro gcpro1;
 843
 844   GCPRO1 (stream);
 845   emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
 846                   format_length, 0, 0, vargs);
 847   Lstream_flush (XLSTREAM (stream));
 848   obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
 849                      Lstream_byte_count (XLSTREAM (stream)));
 850   UNGCPRO;
 851   Lstream_delete (XLSTREAM (stream));
 852   return obj;
 853 }
 854
 855 Lisp_Object
 856 emacs_doprnt_string_lisp (const Bufbyte *format_nonreloc,
 857                           Lisp_Object format_reloc, Bytecount format_length,
 858                           int nargs, const Lisp_Object *largs)
 859 {
 860   Lisp_Object obj;
 861   Lisp_Object stream = make_resizing_buffer_output_stream ();
 862   struct gcpro gcpro1;
 863
 864   GCPRO1 (stream);
 865   emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
 866                   format_length, nargs, largs);
 867   Lstream_flush (XLSTREAM (stream));
 868   obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
 869                      Lstream_byte_count (XLSTREAM (stream)));
 870   UNGCPRO;
 871   Lstream_delete (XLSTREAM (stream));
 872   return obj;
 873 }
 874
 875 Lisp_Object
 876 emacs_doprnt_string_lisp_2 (const Bufbyte *format_nonreloc,
 877                             Lisp_Object format_reloc, Bytecount format_length,
 878                             int nargs, ...)
 879 {
 880   Lisp_Object obj;
 881   Lisp_Object stream = make_resizing_buffer_output_stream ();
 882   struct gcpro gcpro1;
 883   va_list vargs;
 884   int i;
 885   Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
 886
 887   va_start (vargs, nargs);
 888   for (i = 0; i < nargs; i++)
 889     foo[i] = va_arg (vargs, Lisp_Object);
 890   va_end (vargs);
 891
 892   GCPRO1 (stream);
 893   emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
 894                   format_length, nargs, foo);
 895   Lstream_flush (XLSTREAM (stream));
 896   obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
 897                      Lstream_byte_count (XLSTREAM (stream)));
 898   UNGCPRO;
 899   Lstream_delete (XLSTREAM (stream));
 900   return obj;
 901 }