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