git.chise.org Git - chise/xemacs-chise.git-/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 && !spec->minwidth)
 655                 {
 656                   strcat (constructed_spec, ".");
 657                   long_to_string (constructed_spec + strlen (constructed_spec),
 658                                   spec->precision);
 659                 }
 660 #if 0
 661               sprintf (constructed_spec + strlen (constructed_spec), "%c", ch);
 662 #endif
 663
 664               /* sprintf the mofo */
 665               /* we have to use separate calls to sprintf(), rather than
 666                  a single big conditional, because of the different types
 667                  of the arguments */
 668               if (strchr (double_converters, ch))
 669                 {
 670                   sprintf (constructed_spec + strlen (constructed_spec),
 671                            "%c", ch);
 672                   sprintf (text_to_print, constructed_spec, arg.d);
 673                 }
 674               else if (strchr (unsigned_int_converters, ch))
 675                 {
 676                   sprintf (constructed_spec + strlen (constructed_spec),
 677                            "%c", ch);
 678                   if (spec->l_flag)
 679                     sprintf (text_to_print, constructed_spec, arg.ul);
 680                   else
 681                     sprintf (text_to_print, constructed_spec, arg.ui);
 682                 }
 683               else
 684                 {
 685                   if (spec->zero_flag && spec->minwidth)
 686                     sprintf (constructed_spec + strlen (constructed_spec),
 687                              "0%d%c", spec->minwidth, ch);
 688                   else
 689                     sprintf (constructed_spec + strlen (constructed_spec),
 690                              "%c", ch);
 691                   if (spec->l_flag)
 692                     sprintf (text_to_print, constructed_spec, arg.l);
 693                   else
 694                     sprintf (text_to_print, constructed_spec, arg.i);
 695                 }
 696
 697               doprnt_1 (stream, (Bufbyte *) text_to_print,
 698                         strlen (text_to_print),
 699                         spec->minwidth, -1, spec->minus_flag, spec->zero_flag);
 700             }
 701         }
 702     }
 703
 704   /* #### will not get freed if error */
 705   if (specs)
 706     Dynarr_free (specs);
 707   if (args)
 708     Dynarr_free (args);
 709   return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count;
 710 }
 711
 712 /* You really don't want to know why this is necessary... */
 713 static Bytecount
 714 emacs_doprnt_2 (Lisp_Object stream, const Bufbyte *format_nonreloc,
 715                 Lisp_Object format_reloc, Bytecount format_length, int nargs,
 716                 const Lisp_Object *largs, ...)
 717 {
 718   va_list vargs;
 719   Bytecount val;
 720   va_start (vargs, largs);
 721   val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
 722                         format_length, nargs, largs, vargs);
 723   va_end (vargs);
 724   return val;
 725 }
 726
 727 /*********************** external entry points ***********************/
 728
 729 #ifdef I18N3
 730   /* A note about I18N3 translating: the format string should get
 731      translated, but not under all circumstances.  When the format
 732      string is a Lisp string, what should happen is that Fformat()
 733      should format the untranslated args[0] and return that, and also
 734      call Fgettext() on args[0] and, if that is different, format it
 735      and store it in the `string-translatable' property of
 736      the returned string.  See Fgettext(). */
 737 #endif
 738
 739 /* Send formatted output to STREAM.  The format string comes from
 740    either FORMAT_NONRELOC (of length FORMAT_LENGTH; -1 means use
 741    strlen() to determine the length) or from FORMAT_RELOC, which
 742    should be a Lisp string.  Return the number of bytes written
 743    to the stream.
 744
 745    DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC
 746    parameter, because this function can cause GC. */
 747
 748 Bytecount
 749 emacs_doprnt_c (Lisp_Object stream, const Bufbyte *format_nonreloc,
 750                 Lisp_Object format_reloc, Bytecount format_length,
 751                 ...)
 752 {
 753   int val;
 754   va_list vargs;
 755
 756   va_start (vargs, format_length);
 757   val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
 758                         format_length, 0, 0, vargs);
 759   va_end (vargs);
 760   return val;
 761 }
 762
 763 /* Like emacs_doprnt_c but the args come in va_list format. */
 764
 765 Bytecount
 766 emacs_doprnt_va (Lisp_Object stream, const Bufbyte *format_nonreloc,
 767                  Lisp_Object format_reloc, Bytecount format_length,
 768                  va_list vargs)
 769 {
 770   return emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
 771                          format_length, 0, 0, vargs);
 772 }
 773
 774 /* Like emacs_doprnt_c but the args are Lisp objects instead of
 775    C arguments.  This causes somewhat different behavior from
 776    the above two functions (which should act like printf).
 777    See `format' for a description of this behavior. */
 778
 779 Bytecount
 780 emacs_doprnt_lisp (Lisp_Object stream, const Bufbyte *format_nonreloc,
 781                    Lisp_Object format_reloc, Bytecount format_length,
 782                    int nargs, const Lisp_Object *largs)
 783 {
 784   return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
 785                          format_length, nargs, largs);
 786 }
 787
 788 /* Like the previous function but takes a variable number of arguments. */
 789
 790 Bytecount
 791 emacs_doprnt_lisp_2 (Lisp_Object stream, const Bufbyte *format_nonreloc,
 792                      Lisp_Object format_reloc, Bytecount format_length,
 793                      int nargs, ...)
 794 {
 795   va_list vargs;
 796   int i;
 797   Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
 798
 799   va_start (vargs, nargs);
 800   for (i = 0; i < nargs; i++)
 801     foo[i] = va_arg (vargs, Lisp_Object);
 802   va_end (vargs);
 803
 804   return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
 805                          format_length, nargs, foo);
 806 }
 807
 808 /* The following four functions work like the above three but
 809    return their output as a Lisp string instead of sending it
 810    to a stream. */
 811
 812 Lisp_Object
 813 emacs_doprnt_string_c (const Bufbyte *format_nonreloc,
 814                        Lisp_Object format_reloc, Bytecount format_length,
 815                        ...)
 816 {
 817   va_list vargs;
 818   Lisp_Object obj;
 819   Lisp_Object stream = make_resizing_buffer_output_stream ();
 820   struct gcpro gcpro1;
 821
 822   GCPRO1 (stream);
 823   va_start (vargs, format_length);
 824   emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
 825                   format_length, 0, 0, vargs);
 826   va_end (vargs);
 827   Lstream_flush (XLSTREAM (stream));
 828   obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
 829                      Lstream_byte_count (XLSTREAM (stream)));
 830   UNGCPRO;
 831   Lstream_delete (XLSTREAM (stream));
 832   return obj;
 833 }
 834
 835 Lisp_Object
 836 emacs_doprnt_string_va (const Bufbyte *format_nonreloc,
 837                         Lisp_Object format_reloc, Bytecount format_length,
 838                         va_list vargs)
 839 {
 840   /* I'm fairly sure that this function cannot actually GC.
 841      That can only happen when the arguments to emacs_doprnt_1() are
 842      Lisp objects rather than C args. */
 843   Lisp_Object obj;
 844   Lisp_Object stream = make_resizing_buffer_output_stream ();
 845   struct gcpro gcpro1;
 846
 847   GCPRO1 (stream);
 848   emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
 849                   format_length, 0, 0, vargs);
 850   Lstream_flush (XLSTREAM (stream));
 851   obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
 852                      Lstream_byte_count (XLSTREAM (stream)));
 853   UNGCPRO;
 854   Lstream_delete (XLSTREAM (stream));
 855   return obj;
 856 }
 857
 858 Lisp_Object
 859 emacs_doprnt_string_lisp (const Bufbyte *format_nonreloc,
 860                           Lisp_Object format_reloc, Bytecount format_length,
 861                           int nargs, const Lisp_Object *largs)
 862 {
 863   Lisp_Object obj;
 864   Lisp_Object stream = make_resizing_buffer_output_stream ();
 865   struct gcpro gcpro1;
 866
 867   GCPRO1 (stream);
 868   emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
 869                   format_length, nargs, largs);
 870   Lstream_flush (XLSTREAM (stream));
 871   obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
 872                      Lstream_byte_count (XLSTREAM (stream)));
 873   UNGCPRO;
 874   Lstream_delete (XLSTREAM (stream));
 875   return obj;
 876 }
 877
 878 Lisp_Object
 879 emacs_doprnt_string_lisp_2 (const Bufbyte *format_nonreloc,
 880                             Lisp_Object format_reloc, Bytecount format_length,
 881                             int nargs, ...)
 882 {
 883   Lisp_Object obj;
 884   Lisp_Object stream = make_resizing_buffer_output_stream ();
 885   struct gcpro gcpro1;
 886   va_list vargs;
 887   int i;
 888   Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
 889
 890   va_start (vargs, nargs);
 891   for (i = 0; i < nargs; i++)
 892     foo[i] = va_arg (vargs, Lisp_Object);
 893   va_end (vargs);
 894
 895   GCPRO1 (stream);
 896   emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
 897                   format_length, nargs, foo);
 898   Lstream_flush (XLSTREAM (stream));
 899   obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
 900                      Lstream_byte_count (XLSTREAM (stream)));
 901   UNGCPRO;
 902   Lstream_delete (XLSTREAM (stream));
 903   return obj;
 904 }