Mercurial > hg > xemacs-beta
annotate src/doprnt.c @ 5518:3cc7470ea71c
gnuclient: if TMPDIR was set and connect failed, try again with /tmp
2011-06-03 Aidan Kehoe <kehoea@parhasard.net>
* gnuslib.c (connect_to_unix_server):
Retry with /tmp as a directory in which to search for Unix sockets
if an attempt to connect with some other directory failed (which
may be because gnuclient and gnuserv don't share an environment
value for TMPDIR, or because gnuserv was compiled with USE_TMPDIR
turned off).
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Fri, 03 Jun 2011 18:40:57 +0100 |
| parents | 308d34e9f07d |
| children | 56144c8593a8 |
| rev | line source |
|---|---|
| 428 | 1 /* Output like sprintf to a buffer of specified size. |
| 2 Also takes args differently: pass one pointer to an array of strings | |
| 3 in addition to the format string which is separate. | |
| 4 Copyright (C) 1995 Free Software Foundation, Inc. | |
| 793 | 5 Copyright (C) 2001, 2002 Ben Wing. |
| 428 | 6 Rewritten by mly to use varargs.h. |
| 7 Rewritten from scratch by Ben Wing (February 1995) for Mule; expanded | |
| 8 to full printf spec. | |
| 1983 | 9 Support for bignums, ratios, and bigfloats added April 2004 by Jerry James. |
| 428 | 10 |
| 11 This file is part of XEmacs. | |
| 12 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5252
diff
changeset
|
13 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 14 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5252
diff
changeset
|
15 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5252
diff
changeset
|
16 option) any later version. |
| 428 | 17 |
| 18 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 19 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 20 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 21 for more details. | |
| 22 | |
| 23 You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5252
diff
changeset
|
24 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 25 |
| 793 | 26 /* Synched up with: Rewritten by Ben Wing. Not in FSF. */ |
| 428 | 27 |
| 28 #include <config.h> | |
| 29 #include "lisp.h" | |
| 30 | |
| 31 #include "buffer.h" | |
| 32 #include "lstream.h" | |
| 33 | |
| 446 | 34 static const char * const valid_flags = "-+ #0"; |
|
4329
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
35 static const char * const valid_converters = "dic" "ouxX" "feEgG" "sS" "b" |
| 1983 | 36 #if defined(HAVE_BIGNUM) || defined(HAVE_RATIO) |
| 37 "npyY" | |
| 38 #endif | |
| 39 #ifdef HAVE_BIGFLOAT | |
| 40 "FhHkK" | |
| 41 #endif | |
| 42 ; | |
| 446 | 43 static const char * const int_converters = "dic"; |
|
4329
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
44 static const char * const unsigned_int_converters = "ouxXb"; |
| 446 | 45 static const char * const double_converters = "feEgG"; |
| 46 static const char * const string_converters = "sS"; | |
| 1983 | 47 #if defined(HAVE_BIGNUM) || defined(HAVE_RATIO) |
|
4329
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
48 static const char * const bignum_converters = "npyY\337"; |
| 1983 | 49 #endif |
| 50 #ifdef HAVE_BIGFLOAT | |
| 51 static const char * const bigfloat_converters = "FhHkK"; | |
| 52 #endif | |
| 428 | 53 |
| 54 typedef struct printf_spec printf_spec; | |
| 55 struct printf_spec | |
| 56 { | |
| 57 int argnum; /* which argument does this spec want? This is one-based: | |
| 58 The first argument given is numbered 1, the second | |
| 59 is 2, etc. This is to handle %##$x-type specs. */ | |
| 60 int minwidth; | |
| 61 int precision; | |
| 62 unsigned int minus_flag:1; | |
| 63 unsigned int plus_flag:1; | |
| 64 unsigned int space_flag:1; | |
| 65 unsigned int number_flag:1; | |
| 66 unsigned int zero_flag:1; | |
| 67 unsigned int h_flag:1; | |
| 68 unsigned int l_flag:1; | |
| 69 unsigned int forwarding_precision:1; | |
| 70 char converter; /* converter character or 0 for dummy marker | |
| 71 indicating literal text at the end of the | |
| 72 specification */ | |
| 73 Bytecount text_before; /* position of the first character of the | |
| 74 block of literal text before this spec */ | |
| 75 Bytecount text_before_len; /* length of that text */ | |
| 76 }; | |
| 77 | |
| 78 typedef union printf_arg printf_arg; | |
| 79 union printf_arg | |
| 80 { | |
| 81 long l; | |
| 82 unsigned long ul; | |
| 83 double d; | |
| 867 | 84 Ibyte *bp; |
| 1983 | 85 Lisp_Object obj; |
| 428 | 86 }; |
| 87 | |
| 88 /* We maintain a list of all the % specs in the specification, | |
| 89 along with the offset and length of the block of literal text | |
| 90 before each spec. In addition, we have a "dummy" spec that | |
| 91 represents all the literal text at the end of the specification. | |
| 92 Its converter is 0. */ | |
| 93 | |
| 94 typedef struct | |
| 95 { | |
| 96 Dynarr_declare (struct printf_spec); | |
| 97 } printf_spec_dynarr; | |
| 98 | |
| 99 typedef struct | |
| 100 { | |
| 101 Dynarr_declare (union printf_arg); | |
| 102 } printf_arg_dynarr; | |
| 103 | |
| 448 | 104 /* Append STRING (of length LEN bytes) to STREAM. |
| 105 MINLEN is the minimum field width. | |
| 106 If MINUS_FLAG is set, left-justify the string in its field; | |
| 107 otherwise, right-justify. | |
| 108 If ZERO_FLAG is set, pad with 0's; otherwise pad with spaces. | |
| 109 If MAXLEN is non-negative, the string is first truncated on the | |
| 110 right to that many characters. | |
| 428 | 111 |
| 112 Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */ | |
| 113 | |
| 114 static void | |
| 867 | 115 doprnt_2 (Lisp_Object stream, const Ibyte *string, Bytecount len, |
| 428 | 116 Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag) |
| 117 { | |
| 118 Lstream *lstr = XLSTREAM (stream); | |
| 448 | 119 Charcount cclen = bytecount_to_charcount (string, len); |
| 120 int to_add = minlen - cclen; | |
| 428 | 121 |
| 122 /* Padding at beginning to right-justify ... */ | |
| 448 | 123 if (!minus_flag) |
| 124 while (to_add-- > 0) | |
| 125 Lstream_putc (lstr, zero_flag ? '0' : ' '); | |
| 428 | 126 |
| 448 | 127 if (0 <= maxlen && maxlen < cclen) |
| 128 len = charcount_to_bytecount (string, maxlen); | |
| 428 | 129 Lstream_write (lstr, string, len); |
| 130 | |
| 131 /* Padding at end to left-justify ... */ | |
| 448 | 132 if (minus_flag) |
| 133 while (to_add-- > 0) | |
| 134 Lstream_putc (lstr, zero_flag ? '0' : ' '); | |
| 428 | 135 } |
| 136 | |
| 867 | 137 static const Ibyte * |
| 138 parse_off_posnum (const Ibyte *start, const Ibyte *end, int *returned_num) | |
| 428 | 139 { |
| 867 | 140 Ibyte arg_convert[100]; |
| 141 REGISTER Ibyte *arg_ptr = arg_convert; | |
| 428 | 142 |
| 143 *returned_num = -1; | |
| 144 while (start != end && isdigit (*start)) | |
| 145 { | |
| 647 | 146 if (arg_ptr - arg_convert >= (int) sizeof (arg_convert) - 1) |
| 147 syntax_error ("Format converter number too large", Qunbound); | |
| 428 | 148 *arg_ptr++ = *start++; |
| 149 } | |
| 150 *arg_ptr = '\0'; | |
| 151 if (arg_convert != arg_ptr) | |
| 152 *returned_num = atoi ((char *) arg_convert); | |
| 153 return start; | |
| 154 } | |
| 155 | |
| 793 | 156 #define NEXT_ASCII_BYTE(ch) \ |
| 157 do { \ | |
| 158 if (fmt == fmt_end) \ | |
| 159 syntax_error ("Premature end of format string", Qunbound); \ | |
| 160 ch = *fmt; \ | |
| 161 if (ch >= 0200) \ | |
| 162 syntax_error ("Non-ASCII character in format converter spec", \ | |
| 163 Qunbound); \ | |
| 164 fmt++; \ | |
| 428 | 165 } while (0) |
| 166 | |
| 167 #define RESOLVE_FLAG_CONFLICTS(spec) \ | |
| 168 do { \ | |
| 169 if (spec.space_flag && spec.plus_flag) \ | |
| 170 spec.space_flag = 0; \ | |
| 171 if (spec.zero_flag && spec.space_flag) \ | |
| 172 spec.zero_flag = 0; \ | |
| 173 } while (0) | |
| 174 | |
| 175 static printf_spec_dynarr * | |
| 867 | 176 parse_doprnt_spec (const Ibyte *format, Bytecount format_length) |
| 428 | 177 { |
| 867 | 178 const Ibyte *fmt = format; |
| 179 const Ibyte *fmt_end = format + format_length; | |
| 428 | 180 printf_spec_dynarr *specs = Dynarr_new (printf_spec); |
| 181 int prev_argnum = 0; | |
| 182 | |
| 183 while (1) | |
| 184 { | |
| 185 struct printf_spec spec; | |
| 867 | 186 const Ibyte *text_end; |
| 187 Ibyte ch; | |
| 428 | 188 |
| 189 xzero (spec); | |
| 190 if (fmt == fmt_end) | |
| 191 return specs; | |
| 867 | 192 text_end = (Ibyte *) memchr (fmt, '%', fmt_end - fmt); |
| 428 | 193 if (!text_end) |
| 194 text_end = fmt_end; | |
| 195 spec.text_before = fmt - format; | |
| 196 spec.text_before_len = text_end - fmt; | |
| 197 fmt = text_end; | |
| 198 if (fmt != fmt_end) | |
| 199 { | |
| 200 fmt++; /* skip over % */ | |
| 201 | |
| 202 /* A % is special -- no arg number. According to ANSI specs, | |
| 203 field width does not apply to %% conversion. */ | |
| 204 if (fmt != fmt_end && *fmt == '%') | |
| 205 { | |
| 206 spec.converter = '%'; | |
| 207 Dynarr_add (specs, spec); | |
| 208 fmt++; | |
| 209 continue; | |
| 210 } | |
| 211 | |
| 212 /* Is there a field number specifier? */ | |
| 213 { | |
| 867 | 214 const Ibyte *ptr; |
| 428 | 215 int fieldspec; |
| 216 | |
| 217 ptr = parse_off_posnum (fmt, fmt_end, &fieldspec); | |
| 218 if (fieldspec > 0 && ptr != fmt_end && *ptr == '$') | |
| 219 { | |
| 220 /* There is a format specifier */ | |
| 221 prev_argnum = fieldspec; | |
| 222 fmt = ptr + 1; | |
| 223 } | |
| 224 else | |
| 225 prev_argnum++; | |
| 226 spec.argnum = prev_argnum; | |
| 227 } | |
| 228 | |
| 229 /* Parse off any flags */ | |
| 230 NEXT_ASCII_BYTE (ch); | |
| 231 while (strchr (valid_flags, ch)) | |
| 232 { | |
| 233 switch (ch) | |
| 234 { | |
| 446 | 235 case '-': spec.minus_flag = 1; break; |
| 236 case '+': spec.plus_flag = 1; break; | |
| 237 case ' ': spec.space_flag = 1; break; | |
| 428 | 238 case '#': spec.number_flag = 1; break; |
| 446 | 239 case '0': spec.zero_flag = 1; break; |
| 2500 | 240 default: ABORT (); |
| 428 | 241 } |
| 242 NEXT_ASCII_BYTE (ch); | |
| 243 } | |
| 244 | |
| 245 /* Parse off the minimum field width */ | |
| 246 fmt--; /* back up */ | |
| 247 | |
| 248 /* | |
| 249 * * means the field width was passed as an argument. | |
| 250 * Mark the current spec as one that forwards its | |
| 251 * field width and flags to the next spec in the array. | |
| 252 * Then create a new spec and continue with the parsing. | |
| 253 */ | |
| 254 if (fmt != fmt_end && *fmt == '*') | |
| 255 { | |
| 256 spec.converter = '*'; | |
| 257 RESOLVE_FLAG_CONFLICTS(spec); | |
| 258 Dynarr_add (specs, spec); | |
| 259 xzero (spec); | |
| 260 spec.argnum = ++prev_argnum; | |
| 261 fmt++; | |
| 262 } | |
| 263 else | |
| 264 { | |
| 265 fmt = parse_off_posnum (fmt, fmt_end, &spec.minwidth); | |
| 266 if (spec.minwidth == -1) | |
| 267 spec.minwidth = 0; | |
| 268 } | |
| 269 | |
| 270 /* Parse off any precision specified */ | |
| 271 NEXT_ASCII_BYTE (ch); | |
| 272 if (ch == '.') | |
| 273 { | |
| 274 /* | |
| 275 * * means the precision was passed as an argument. | |
| 276 * Mark the current spec as one that forwards its | |
| 277 * fieldwidth, flags and precision to the next spec in | |
| 278 * the array. Then create a new spec and continue | |
| 279 * with the parse. | |
| 280 */ | |
| 281 if (fmt != fmt_end && *fmt == '*') | |
| 282 { | |
| 283 spec.converter = '*'; | |
| 284 spec.forwarding_precision = 1; | |
| 285 RESOLVE_FLAG_CONFLICTS(spec); | |
| 286 Dynarr_add (specs, spec); | |
| 287 xzero (spec); | |
| 288 spec.argnum = ++prev_argnum; | |
| 289 fmt++; | |
| 290 } | |
| 291 else | |
| 292 { | |
| 293 fmt = parse_off_posnum (fmt, fmt_end, &spec.precision); | |
| 294 if (spec.precision == -1) | |
| 295 spec.precision = 0; | |
| 296 } | |
| 297 NEXT_ASCII_BYTE (ch); | |
| 298 } | |
| 299 else | |
| 300 /* No precision specified */ | |
| 301 spec.precision = -1; | |
| 302 | |
| 303 /* Parse off h or l flag */ | |
| 304 if (ch == 'h' || ch == 'l') | |
| 305 { | |
| 306 if (ch == 'h') | |
| 307 spec.h_flag = 1; | |
| 308 else | |
| 309 spec.l_flag = 1; | |
| 310 NEXT_ASCII_BYTE (ch); | |
| 311 } | |
| 312 | |
| 313 if (!strchr (valid_converters, ch)) | |
| 563 | 314 syntax_error ("Invalid converter character", make_char (ch)); |
| 428 | 315 spec.converter = ch; |
| 316 } | |
| 317 | |
| 318 RESOLVE_FLAG_CONFLICTS(spec); | |
| 319 Dynarr_add (specs, spec); | |
| 320 } | |
| 321 | |
| 1204 | 322 RETURN_NOT_REACHED(specs); /* suppress compiler warning */ |
| 428 | 323 } |
| 324 | |
| 325 static int | |
| 326 get_args_needed (printf_spec_dynarr *specs) | |
| 327 { | |
| 328 int args_needed = 0; | |
| 329 REGISTER int i; | |
| 330 | |
| 331 /* Figure out how many args are needed. This may be less than | |
| 332 the number of specs because a spec could be %% or could be | |
| 333 missing (literal text at end of format string) or there | |
| 334 could be specs where the field number is explicitly given. | |
| 335 We just look for the maximum argument number that's referenced. */ | |
| 336 | |
| 337 for (i = 0; i < Dynarr_length (specs); i++) | |
| 338 { | |
| 339 char ch = Dynarr_at (specs, i).converter; | |
| 340 if (ch && ch != '%') | |
| 341 { | |
| 342 int argnum = Dynarr_at (specs, i).argnum; | |
| 343 if (argnum > args_needed) | |
| 344 args_needed = argnum; | |
| 345 } | |
| 346 } | |
| 347 | |
| 348 return args_needed; | |
| 349 } | |
| 350 | |
| 351 static printf_arg_dynarr * | |
| 352 get_doprnt_args (printf_spec_dynarr *specs, va_list vargs) | |
| 353 { | |
| 354 printf_arg_dynarr *args = Dynarr_new (printf_arg); | |
| 355 union printf_arg arg; | |
| 356 REGISTER int i; | |
| 357 int args_needed = get_args_needed (specs); | |
| 358 | |
| 359 xzero (arg); | |
| 360 for (i = 1; i <= args_needed; i++) | |
| 361 { | |
| 362 int j; | |
| 363 char ch; | |
| 364 struct printf_spec *spec = 0; | |
| 365 | |
| 366 for (j = 0; j < Dynarr_length (specs); j++) | |
| 367 { | |
| 368 spec = Dynarr_atp (specs, j); | |
| 369 if (spec->argnum == i) | |
| 370 break; | |
| 371 } | |
| 372 | |
| 373 if (j == Dynarr_length (specs)) | |
| 1318 | 374 syntax_error ("No conversion spec for argument", make_int (i)); |
| 428 | 375 |
| 376 ch = spec->converter; | |
| 377 | |
| 378 if (strchr (int_converters, ch)) | |
| 379 { | |
| 446 | 380 if (spec->l_flag) |
| 428 | 381 arg.l = va_arg (vargs, long); |
| 382 else | |
| 446 | 383 /* int even if ch == 'c' or spec->h_flag: |
| 384 "the type used in va_arg is supposed to match the | |
| 385 actual type **after default promotions**." | |
| 386 Hence we read an int, not a short, if spec->h_flag. */ | |
| 387 arg.l = va_arg (vargs, int); | |
| 428 | 388 } |
| 389 else if (strchr (unsigned_int_converters, ch)) | |
| 390 { | |
| 446 | 391 if (spec->l_flag) |
| 428 | 392 arg.ul = va_arg (vargs, unsigned long); |
| 393 else | |
| 446 | 394 /* unsigned int even if ch == 'c' or spec->h_flag */ |
| 395 arg.ul = (unsigned long) va_arg (vargs, unsigned int); | |
| 428 | 396 } |
| 397 else if (strchr (double_converters, ch)) | |
| 398 arg.d = va_arg (vargs, double); | |
| 399 else if (strchr (string_converters, ch)) | |
| 867 | 400 arg.bp = va_arg (vargs, Ibyte *); |
| 1983 | 401 #if defined(HAVE_BIGNUM) || defined(HAVE_RATIO) |
| 402 else if (strchr (bignum_converters, ch)) | |
| 403 arg.obj = va_arg (vargs, Lisp_Object); | |
| 404 #endif | |
| 405 #ifdef HAVE_BIGFLOAT | |
| 406 else if (strchr (bigfloat_converters, ch)) | |
| 407 arg.obj = va_arg (vargs, Lisp_Object); | |
| 408 #endif | |
| 2500 | 409 else ABORT (); |
| 428 | 410 |
| 411 Dynarr_add (args, arg); | |
| 412 } | |
| 413 | |
| 414 return args; | |
| 415 } | |
| 416 | |
| 771 | 417 /* Most basic entry point into string formatting. |
| 418 | |
| 419 Generate output from a format-spec (either a Lisp string | |
| 420 FORMAT_RELOC, or a C string FORMAT_NONRELOC of length FORMAT_LENGTH | |
| 421 -- which *MUST NOT* come from Lisp string data, unless GC is | |
| 422 inhibited). Output goes to STREAM. Returns the number of bytes | |
| 423 stored into STREAM. Arguments are either C-type arguments in | |
| 424 va_list VARGS, or an array of Lisp objects in LARGS of size | |
| 425 NARGS. (Behavior is different in the two cases -- you either get | |
| 426 standard sprintf() behavior or `format' behavior.) */ | |
| 428 | 427 |
| 428 static Bytecount | |
| 867 | 429 emacs_doprnt_1 (Lisp_Object stream, const Ibyte *format_nonreloc, |
| 771 | 430 Bytecount format_length, Lisp_Object format_reloc, |
| 431 int nargs, const Lisp_Object *largs, va_list vargs) | |
| 428 | 432 { |
| 433 printf_spec_dynarr *specs = 0; | |
| 434 printf_arg_dynarr *args = 0; | |
| 435 REGISTER int i; | |
| 436 int init_byte_count = Lstream_byte_count (XLSTREAM (stream)); | |
| 771 | 437 int count; |
| 428 | 438 |
| 439 if (!NILP (format_reloc)) | |
| 440 { | |
| 441 format_nonreloc = XSTRING_DATA (format_reloc); | |
| 442 format_length = XSTRING_LENGTH (format_reloc); | |
| 443 } | |
| 444 if (format_length < 0) | |
| 442 | 445 format_length = (Bytecount) strlen ((const char *) format_nonreloc); |
| 428 | 446 |
| 447 specs = parse_doprnt_spec (format_nonreloc, format_length); | |
| 771 | 448 count = record_unwind_protect_freeing_dynarr (specs); |
| 449 | |
| 428 | 450 if (largs) |
| 451 { | |
| 446 | 452 /* allow too many args for string, but not too few */ |
| 428 | 453 if (nargs < get_args_needed (specs)) |
| 563 | 454 signal_error_1 (Qwrong_number_of_arguments, |
| 1318 | 455 list3 (Qformat, |
| 456 make_int (nargs), | |
| 457 !NILP (format_reloc) ? format_reloc : | |
| 458 make_string (format_nonreloc, format_length))); | |
| 428 | 459 } |
| 460 else | |
| 461 { | |
| 462 args = get_doprnt_args (specs, vargs); | |
| 771 | 463 record_unwind_protect_freeing_dynarr (args); |
| 428 | 464 } |
| 465 | |
| 466 for (i = 0; i < Dynarr_length (specs); i++) | |
| 467 { | |
| 468 struct printf_spec *spec = Dynarr_atp (specs, i); | |
| 469 char ch; | |
| 470 | |
| 471 /* Copy the text before */ | |
| 472 if (!NILP (format_reloc)) /* refetch in case of GC below */ | |
| 473 format_nonreloc = XSTRING_DATA (format_reloc); | |
| 446 | 474 |
| 771 | 475 doprnt_2 (stream, format_nonreloc + spec->text_before, |
| 446 | 476 spec->text_before_len, 0, -1, 0, 0); |
| 428 | 477 |
| 478 ch = spec->converter; | |
| 479 | |
| 480 if (!ch) | |
| 481 continue; | |
| 482 | |
| 483 if (ch == '%') | |
| 484 { | |
| 867 | 485 doprnt_2 (stream, (Ibyte *) &ch, 1, 0, -1, 0, 0); |
| 428 | 486 continue; |
| 487 } | |
| 488 | |
| 489 /* The char '*' as converter means the field width, precision | |
| 490 was specified as an argument. Extract the data and forward | |
| 491 it to the next spec, to which it will apply. */ | |
| 492 if (ch == '*') | |
| 493 { | |
| 494 struct printf_spec *nextspec = Dynarr_atp (specs, i + 1); | |
| 495 Lisp_Object obj = largs[spec->argnum - 1]; | |
| 496 | |
| 497 if (INTP (obj)) | |
| 498 { | |
| 499 if (spec->forwarding_precision) | |
| 500 { | |
| 501 nextspec->precision = XINT (obj); | |
| 502 nextspec->minwidth = spec->minwidth; | |
| 503 } | |
| 504 else | |
| 505 { | |
| 506 nextspec->minwidth = XINT (obj); | |
| 446 | 507 if (XINT (obj) < 0) |
| 428 | 508 { |
| 509 spec->minus_flag = 1; | |
| 510 nextspec->minwidth = - nextspec->minwidth; | |
| 511 } | |
| 512 } | |
| 446 | 513 nextspec->minus_flag = spec->minus_flag; |
| 514 nextspec->plus_flag = spec->plus_flag; | |
| 515 nextspec->space_flag = spec->space_flag; | |
| 428 | 516 nextspec->number_flag = spec->number_flag; |
| 446 | 517 nextspec->zero_flag = spec->zero_flag; |
| 428 | 518 } |
| 519 continue; | |
| 520 } | |
| 521 | |
| 522 if (largs && (spec->argnum < 1 || spec->argnum > nargs)) | |
| 771 | 523 syntax_error ("Invalid repositioning argument", |
| 524 make_int (spec->argnum)); | |
| 428 | 525 |
| 526 else if (ch == 'S' || ch == 's') | |
| 527 { | |
| 867 | 528 Ibyte *string; |
| 428 | 529 Bytecount string_len; |
| 530 | |
| 531 if (!largs) | |
| 532 { | |
| 533 string = Dynarr_at (args, spec->argnum - 1).bp; | |
| 771 | 534 #if 0 |
| 535 /* [[ error() can be called with null string arguments. | |
| 428 | 536 E.g., in fileio.c, the return value of strerror() |
| 537 is never checked. We'll print (null), like some | |
| 538 printf implementations do. Would it be better (and safe) | |
| 539 to signal an error instead? Or should we just use the | |
| 771 | 540 empty string? -dkindred@cs.cmu.edu 8/1997 ]] |
| 541 Do not hide bugs. --ben | |
| 428 | 542 */ |
| 543 if (!string) | |
| 867 | 544 string = (Ibyte *) "(null)"; |
| 771 | 545 #else |
| 546 assert (string); | |
| 547 #endif | |
| 428 | 548 string_len = strlen ((char *) string); |
| 549 } | |
| 550 else | |
| 551 { | |
| 552 Lisp_Object obj = largs[spec->argnum - 1]; | |
| 793 | 553 Lisp_Object ls; |
| 428 | 554 |
| 555 if (ch == 'S') | |
| 556 { | |
| 557 /* For `S', prin1 the argument and then treat like | |
| 558 a string. */ | |
|
4394
cacc942c0d0f
Avoid clearing print-gensym-alist inappropriately when printing hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4333
diff
changeset
|
559 ls = prin1_to_string (obj, 0); |
| 428 | 560 } |
| 561 else if (STRINGP (obj)) | |
| 793 | 562 ls = obj; |
| 428 | 563 else if (SYMBOLP (obj)) |
| 564 ls = XSYMBOL (obj)->name; | |
| 565 else | |
| 566 { | |
| 567 /* convert to string using princ. */ | |
|
4394
cacc942c0d0f
Avoid clearing print-gensym-alist inappropriately when printing hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4333
diff
changeset
|
568 ls = prin1_to_string (obj, 1); |
| 428 | 569 } |
| 793 | 570 string = XSTRING_DATA (ls); |
| 571 string_len = XSTRING_LENGTH (ls); | |
| 428 | 572 } |
| 573 | |
| 771 | 574 doprnt_2 (stream, string, string_len, spec->minwidth, |
| 428 | 575 spec->precision, spec->minus_flag, spec->zero_flag); |
| 576 } | |
| 577 | |
| 578 else | |
| 579 { | |
| 580 /* Must be a number. */ | |
| 581 union printf_arg arg; | |
| 582 | |
| 583 if (!largs) | |
| 584 { | |
| 585 arg = Dynarr_at (args, spec->argnum - 1); | |
| 586 } | |
| 587 else | |
| 588 { | |
| 589 Lisp_Object obj = largs[spec->argnum - 1]; | |
| 590 if (CHARP (obj)) | |
| 591 obj = make_int (XCHAR (obj)); | |
| 1983 | 592 if (!NUMBERP (obj)) |
| 428 | 593 { |
| 2267 | 594 /* WARNING! This MUST be big enough for the sprintf below */ |
| 2272 | 595 CIbyte msg[48]; |
| 596 sprintf (msg, | |
| 2267 | 597 "format specifier %%%c doesn't match argument type", |
| 598 ch); | |
|
4876
437323273039
Cosmetic: Use Qunbound, not Qnil as second arg to call to syntax_error() to get cleaner error message
Ben Wing <ben@xemacs.org>
parents:
4678
diff
changeset
|
599 syntax_error (msg, Qunbound); |
| 428 | 600 } |
| 601 else if (strchr (double_converters, ch)) | |
| 1983 | 602 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
603 if (INTP (obj)) |
|
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
604 arg.d = XINT (obj); |
|
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
605 else if (FLOATP (obj)) |
|
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
606 arg.d = XFLOAT_DATA (obj); |
| 1983 | 607 #ifdef HAVE_BIGNUM |
| 608 else if (BIGNUMP (obj)) | |
| 609 arg.d = bignum_to_double (XBIGNUM_DATA (obj)); | |
| 610 #endif | |
| 611 #ifdef HAVE_RATIO | |
| 612 else if (RATIOP (obj)) | |
| 613 arg.d = ratio_to_double (XRATIO_DATA (obj)); | |
| 614 #endif | |
| 615 #ifdef HAVE_BIGFLOAT | |
| 616 else if (BIGFLOATP (obj)) | |
| 617 { | |
| 618 arg.obj = obj; | |
| 619 switch (ch) | |
| 620 { | |
| 621 case 'f': ch = 'F'; break; | |
| 622 case 'e': ch = 'h'; break; | |
| 623 case 'E': ch = 'H'; break; | |
| 624 case 'g': ch = 'k'; break; | |
| 625 case 'G': ch = 'K'; break; | |
| 626 } | |
| 627 } | |
| 628 #endif | |
| 629 } | |
| 428 | 630 else |
| 631 { | |
| 446 | 632 if (FLOATP (obj)) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4394
diff
changeset
|
633 obj = Ftruncate (obj, Qnil); |
| 1983 | 634 #ifdef HAVE_BIGFLOAT |
| 635 else if (BIGFLOATP (obj)) | |
| 636 { | |
| 637 #ifdef HAVE_BIGNUM | |
| 638 bignum_set_bigfloat (scratch_bignum, | |
| 639 XBIGFLOAT_DATA (obj)); | |
| 640 if (strchr (unsigned_int_converters, ch) && | |
| 641 bignum_sign (scratch_bignum) < 0) | |
| 642 dead_wrong_type_argument (Qnonnegativep, obj); | |
| 643 obj = | |
| 644 Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
| 645 #else /* !HAVE_BIGNUM */ | |
| 646 obj = make_int (bigfloat_to_long (XBIGFLOAT_DATA (obj))); | |
| 647 #endif /* HAVE_BIGNUM */ | |
| 648 } | |
| 649 #endif /* HAVE_BIGFLOAT */ | |
| 650 #ifdef HAVE_RATIO | |
| 651 else if (RATIOP (obj)) | |
| 652 { | |
| 653 arg.obj = obj; | |
| 654 switch (ch) | |
| 655 { | |
| 656 case 'i': case 'd': ch = 'n'; break; | |
| 657 case 'o': ch = 'p'; break; | |
| 658 case 'x': ch = 'y'; break; | |
| 659 case 'X': ch = 'Y'; break; | |
|
4333
3483b381b0a9
Take out some debug code; correct some original code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4329
diff
changeset
|
660 case 'b': ch = '\337'; break; |
| 1983 | 661 default: /* ch == 'u' */ |
| 662 if (strchr (unsigned_int_converters, ch) && | |
| 663 ratio_sign (XRATIO_DATA (obj)) < 0) | |
| 664 dead_wrong_type_argument (Qnonnegativep, obj); | |
| 665 else | |
| 666 ch = 'n'; | |
| 667 } | |
| 668 } | |
| 669 #endif | |
| 670 #ifdef HAVE_BIGNUM | |
| 671 if (BIGNUMP (obj)) | |
| 672 { | |
| 673 arg.obj = obj; | |
| 674 switch (ch) | |
| 675 { | |
| 676 case 'i': case 'd': ch = 'n'; break; | |
| 677 case 'o': ch = 'p'; break; | |
| 678 case 'x': ch = 'y'; break; | |
| 679 case 'X': ch = 'Y'; break; | |
|
4329
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
680 case 'b': ch = '\337'; break; |
| 1983 | 681 default: /* ch == 'u' */ |
| 682 if (strchr (unsigned_int_converters, ch) && | |
| 683 bignum_sign (XBIGNUM_DATA (obj)) < 0) | |
| 684 dead_wrong_type_argument (Qnatnump, obj); | |
| 685 else | |
| 686 ch = 'n'; | |
| 687 } | |
| 688 } | |
| 689 #endif | |
| 690 if (INTP (obj)) | |
| 691 { | |
| 692 if (strchr (unsigned_int_converters, ch)) | |
| 693 { | |
| 694 #ifdef HAVE_BIGNUM | |
| 695 if (XINT (obj) < 0) | |
| 696 dead_wrong_type_argument (Qnatnump, obj); | |
| 697 #endif | |
| 698 arg.ul = (unsigned long) XUINT (obj); | |
| 699 } | |
| 700 else | |
| 701 arg.l = XINT (obj); | |
| 702 } | |
| 428 | 703 } |
| 704 } | |
| 705 | |
| 706 if (ch == 'c') | |
| 707 { | |
| 867 | 708 Ichar a; |
| 428 | 709 Bytecount charlen; |
| 867 | 710 Ibyte charbuf[MAX_ICHAR_LEN]; |
| 428 | 711 |
| 867 | 712 a = (Ichar) arg.l; |
| 428 | 713 |
| 867 | 714 if (!valid_ichar_p (a)) |
| 2267 | 715 { |
| 716 /* WARNING! This MUST be big enough for the sprintf below */ | |
| 2272 | 717 CIbyte msg[60]; |
| 718 sprintf (msg, "invalid character value %d to %%c spec", | |
| 2267 | 719 a); |
|
4876
437323273039
Cosmetic: Use Qunbound, not Qnil as second arg to call to syntax_error() to get cleaner error message
Ben Wing <ben@xemacs.org>
parents:
4678
diff
changeset
|
720 syntax_error (msg, Qunbound); |
| 2267 | 721 } |
| 428 | 722 |
| 867 | 723 charlen = set_itext_ichar (charbuf, a); |
| 771 | 724 doprnt_2 (stream, charbuf, charlen, spec->minwidth, |
| 428 | 725 -1, spec->minus_flag, spec->zero_flag); |
| 726 } | |
| 1983 | 727 #if defined(HAVE_BIGNUM) || defined(HAVE_RATIO) |
| 728 else if (strchr (bignum_converters, ch)) | |
| 729 { | |
|
4329
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
730 int base = 16; |
|
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
731 |
|
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
732 if (ch == 'n') |
|
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
733 base = 10; |
|
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
734 else if (ch == 'p') |
|
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
735 base = 8; |
|
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
736 else if (ch == '\337') |
|
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
737 base = 2; |
|
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
738 |
| 1983 | 739 #ifdef HAVE_BIGNUM |
| 740 if (BIGNUMP (arg.obj)) | |
| 741 { | |
| 1995 | 742 Ibyte *text_to_print = |
| 743 (Ibyte *) bignum_to_string (XBIGNUM_DATA (arg.obj), | |
|
4329
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
744 base); |
| 1995 | 745 doprnt_2 (stream, text_to_print, |
| 746 strlen ((const char *) text_to_print), | |
| 1983 | 747 spec->minwidth, -1, spec->minus_flag, |
| 748 spec->zero_flag); | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4876
diff
changeset
|
749 xfree (text_to_print); |
| 1983 | 750 } |
| 751 #endif | |
| 752 #ifdef HAVE_RATIO | |
| 753 if (RATIOP (arg.obj)) | |
| 754 { | |
| 1995 | 755 Ibyte *text_to_print = |
|
4329
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
756 (Ibyte *) ratio_to_string (XRATIO_DATA (arg.obj), base); |
| 1995 | 757 doprnt_2 (stream, text_to_print, |
| 758 strlen ((const char *) text_to_print), | |
| 1983 | 759 spec->minwidth, -1, spec->minus_flag, |
| 760 spec->zero_flag); | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4876
diff
changeset
|
761 xfree (text_to_print); |
| 1983 | 762 } |
| 763 #endif | |
| 764 } | |
| 765 #endif /* HAVE_BIGNUM || HAVE_RATIO */ | |
| 766 #ifdef HAVE_BIGFLOAT | |
| 767 else if (strchr (bigfloat_converters, ch)) | |
| 768 { | |
| 1995 | 769 Ibyte *text_to_print = |
| 770 (Ibyte *) bigfloat_to_string (XBIGFLOAT_DATA (arg.obj), 10); | |
| 771 doprnt_2 (stream, text_to_print, | |
| 772 strlen ((const char *) text_to_print), | |
| 1983 | 773 spec->minwidth, -1, spec->minus_flag, spec->zero_flag); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4876
diff
changeset
|
774 xfree (text_to_print); |
| 1983 | 775 } |
| 776 #endif /* HAVE_BIGFLOAT */ | |
|
4329
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
777 else if (ch == 'b') |
|
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
778 { |
|
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
779 Ascbyte *text_to_print = alloca_array (char, SIZEOF_LONG * 8 + 1); |
|
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
780 |
|
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
781 ulong_to_bit_string (text_to_print, arg.ul); |
|
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
782 doprnt_2 (stream, (Ibyte *)text_to_print, |
|
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
783 qxestrlen ((Ibyte *)text_to_print), |
|
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
784 spec->minwidth, -1, spec->minus_flag, spec->zero_flag); |
|
d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4287
diff
changeset
|
785 } |
| 428 | 786 else |
| 787 { | |
| 4287 | 788 Ascbyte *text_to_print; |
| 3706 | 789 Ascbyte constructed_spec[100]; |
| 790 Ascbyte *p = constructed_spec; | |
| 4287 | 791 int alloca_sz = 350; |
| 792 int min = spec->minwidth, prec = spec->precision; | |
| 793 | |
| 794 if (prec < 0) | |
| 795 prec = 0; | |
| 796 if (min < 0) | |
| 797 min = 0; | |
| 798 | |
| 799 if (32+min+prec > alloca_sz) | |
| 800 alloca_sz = 32 + min + prec; | |
| 801 | |
| 802 text_to_print = alloca_array(char, alloca_sz); | |
| 428 | 803 |
| 448 | 804 /* Mostly reconstruct the spec and use sprintf() to |
| 428 | 805 format the string. */ |
| 806 | |
| 446 | 807 *p++ = '%'; |
| 808 if (spec->plus_flag) *p++ = '+'; | |
| 809 if (spec->space_flag) *p++ = ' '; | |
| 810 if (spec->number_flag) *p++ = '#'; | |
| 448 | 811 if (spec->minus_flag) *p++ = '-'; |
| 812 if (spec->zero_flag) *p++ = '0'; | |
| 446 | 813 |
| 448 | 814 if (spec->minwidth >= 0) |
| 577 | 815 { |
| 816 long_to_string (p, spec->minwidth); | |
| 817 p += strlen (p); | |
| 818 } | |
| 448 | 819 if (spec->precision >= 0) |
| 428 | 820 { |
| 446 | 821 *p++ = '.'; |
| 577 | 822 long_to_string (p, spec->precision); |
| 823 p += strlen (p); | |
| 428 | 824 } |
| 448 | 825 |
| 428 | 826 if (strchr (double_converters, ch)) |
| 442 | 827 { |
| 446 | 828 *p++ = ch; |
| 829 *p++ = '\0'; | |
| 442 | 830 sprintf (text_to_print, constructed_spec, arg.d); |
| 831 } | |
| 428 | 832 else |
| 833 { | |
| 448 | 834 *p++ = 'l'; /* Always use longs with sprintf() */ |
| 835 *p++ = ch; | |
| 836 *p++ = '\0'; | |
| 446 | 837 |
| 838 if (strchr (unsigned_int_converters, ch)) | |
| 839 sprintf (text_to_print, constructed_spec, arg.ul); | |
| 840 else | |
| 428 | 841 sprintf (text_to_print, constructed_spec, arg.l); |
| 842 } | |
| 843 | |
| 867 | 844 doprnt_2 (stream, (Ibyte *) text_to_print, |
| 448 | 845 strlen (text_to_print), 0, -1, 0, 0); |
| 428 | 846 } |
| 847 } | |
| 848 } | |
| 849 | |
| 771 | 850 unbind_to (count); |
| 428 | 851 return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count; |
| 852 } | |
| 853 | |
| 771 | 854 /* Basic external entry point into string formatting. See |
| 855 emacs_doprnt_1(). | |
| 856 */ | |
| 857 | |
| 858 Bytecount | |
| 867 | 859 emacs_doprnt_va (Lisp_Object stream, const Ibyte *format_nonreloc, |
| 771 | 860 Bytecount format_length, Lisp_Object format_reloc, |
| 861 va_list vargs) | |
| 862 { | |
| 863 return emacs_doprnt_1 (stream, format_nonreloc, format_length, | |
| 864 format_reloc, 0, 0, vargs); | |
| 865 } | |
| 866 | |
| 867 /* Basic external entry point into string formatting. See | |
| 868 emacs_doprnt_1(). | |
| 869 */ | |
| 870 | |
| 871 Bytecount | |
| 867 | 872 emacs_doprnt (Lisp_Object stream, const Ibyte *format_nonreloc, |
| 771 | 873 Bytecount format_length, Lisp_Object format_reloc, |
| 874 int nargs, const Lisp_Object *largs, ...) | |
| 428 | 875 { |
| 876 va_list vargs; | |
| 877 Bytecount val; | |
| 878 va_start (vargs, largs); | |
| 771 | 879 val = emacs_doprnt_1 (stream, format_nonreloc, format_length, |
| 880 format_reloc, nargs, largs, vargs); | |
| 428 | 881 va_end (vargs); |
| 882 return val; | |
| 883 } | |
| 884 | |
| 771 | 885 /* Similar to `format' in that its arguments are Lisp objects rather than C |
| 886 objects. (For the versions that take C objects, see the | |
| 887 emacs_[v]sprintf... functions below.) Accepts the format string as | |
| 888 either a C string (FORMAT_NONRELOC, which *MUST NOT* come from Lisp | |
| 889 string data, unless GC is inhibited) or a Lisp string (FORMAT_RELOC). | |
| 890 Return resulting formatted string as a Lisp string. | |
| 428 | 891 |
| 771 | 892 All arguments are GCPRO'd, including FORMAT_RELOC; this makes it OK to |
| 893 pass newly created objects into this function (as often happens). | |
| 428 | 894 |
| 771 | 895 #### It shouldn't be necessary to specify the number of arguments. |
| 896 This would require some rewriting of the doprnt() functions, though. | |
| 897 */ | |
| 428 | 898 |
| 899 Lisp_Object | |
| 867 | 900 emacs_vsprintf_string_lisp (const CIbyte *format_nonreloc, |
| 771 | 901 Lisp_Object format_reloc, int nargs, |
| 902 const Lisp_Object *largs) | |
| 428 | 903 { |
| 771 | 904 Lisp_Object stream; |
| 428 | 905 Lisp_Object obj; |
| 771 | 906 struct gcpro gcpro1, gcpro2; |
| 907 GCPRO2 (largs[0], format_reloc); | |
| 908 gcpro1.nvars = nargs; | |
| 428 | 909 |
| 771 | 910 stream = make_resizing_buffer_output_stream (); |
| 867 | 911 emacs_doprnt (stream, (Ibyte *) format_nonreloc, format_nonreloc ? |
| 771 | 912 strlen (format_nonreloc) : 0, |
| 913 format_reloc, nargs, largs); | |
| 428 | 914 Lstream_flush (XLSTREAM (stream)); |
| 915 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)), | |
| 916 Lstream_byte_count (XLSTREAM (stream))); | |
| 771 | 917 Lstream_delete (XLSTREAM (stream)); |
| 428 | 918 UNGCPRO; |
| 919 return obj; | |
| 920 } | |
| 921 | |
| 771 | 922 /* Like emacs_vsprintf_string_lisp() but accepts its extra args directly |
| 923 (using variable arguments), rather than as an array. */ | |
| 924 | |
| 428 | 925 Lisp_Object |
| 867 | 926 emacs_sprintf_string_lisp (const CIbyte *format_nonreloc, |
| 771 | 927 Lisp_Object format_reloc, int nargs, ...) |
| 428 | 928 { |
| 771 | 929 Lisp_Object *args = alloca_array (Lisp_Object, nargs); |
| 930 va_list va; | |
| 931 int i; | |
| 428 | 932 Lisp_Object obj; |
| 933 | |
| 771 | 934 va_start (va, nargs); |
| 935 for (i = 0; i < nargs; i++) | |
| 936 args[i] = va_arg (va, Lisp_Object); | |
| 937 va_end (va); | |
| 938 obj = emacs_vsprintf_string_lisp (format_nonreloc, format_reloc, nargs, | |
| 939 args); | |
| 428 | 940 return obj; |
| 941 } | |
| 942 | |
| 771 | 943 /* Like emacs_vsprintf_string_lisp() but returns a malloc()ed memory block. |
| 944 Return length out through LEN_OUT, if not null. */ | |
| 945 | |
| 867 | 946 Ibyte * |
| 947 emacs_vsprintf_malloc_lisp (const CIbyte *format_nonreloc, | |
| 771 | 948 Lisp_Object format_reloc, int nargs, |
| 949 const Lisp_Object *largs, Bytecount *len_out) | |
| 950 { | |
| 951 Lisp_Object stream; | |
| 867 | 952 Ibyte *retval; |
| 771 | 953 Bytecount len; |
| 954 struct gcpro gcpro1, gcpro2; | |
| 955 | |
| 956 GCPRO2 (largs[0], format_reloc); | |
| 957 gcpro1.nvars = nargs; | |
| 958 | |
| 959 stream = make_resizing_buffer_output_stream (); | |
| 867 | 960 emacs_doprnt (stream, (Ibyte *) format_nonreloc, format_nonreloc ? |
| 771 | 961 strlen (format_nonreloc) : 0, |
| 962 format_reloc, nargs, largs); | |
| 963 Lstream_flush (XLSTREAM (stream)); | |
| 964 len = Lstream_byte_count (XLSTREAM (stream)); | |
| 2367 | 965 retval = xnew_ibytes (len + 1); |
| 771 | 966 memcpy (retval, resizing_buffer_stream_ptr (XLSTREAM (stream)), len); |
| 967 retval[len] = '\0'; | |
| 968 Lstream_delete (XLSTREAM (stream)); | |
| 969 | |
| 970 if (len_out) | |
| 971 *len_out = len; | |
| 972 UNGCPRO; | |
| 973 return retval; | |
| 974 } | |
| 975 | |
| 976 /* Like emacs_sprintf_string_lisp() but returns a malloc()ed memory block. | |
| 977 Return length out through LEN_OUT, if not null. */ | |
| 978 | |
| 867 | 979 Ibyte * |
| 980 emacs_sprintf_malloc_lisp (Bytecount *len_out, const CIbyte *format_nonreloc, | |
| 771 | 981 Lisp_Object format_reloc, int nargs, ...) |
| 982 { | |
| 983 Lisp_Object *args = alloca_array (Lisp_Object, nargs); | |
| 984 va_list va; | |
| 985 int i; | |
| 867 | 986 Ibyte *retval; |
| 771 | 987 |
| 988 va_start (va, nargs); | |
| 989 for (i = 0; i < nargs; i++) | |
| 990 args[i] = va_arg (va, Lisp_Object); | |
| 991 va_end (va); | |
| 992 retval = emacs_vsprintf_malloc_lisp (format_nonreloc, format_reloc, nargs, | |
| 993 args, len_out); | |
| 994 return retval; | |
| 995 } | |
| 996 | |
| 997 /* vsprintf()-like replacement. Returns a Lisp string. Data | |
| 998 from Lisp strings is OK because we explicitly inhibit GC. */ | |
| 999 | |
| 428 | 1000 Lisp_Object |
| 867 | 1001 emacs_vsprintf_string (const CIbyte *format, va_list vargs) |
| 428 | 1002 { |
| 771 | 1003 Lisp_Object stream = make_resizing_buffer_output_stream (); |
| 428 | 1004 Lisp_Object obj; |
| 771 | 1005 int count = begin_gc_forbidden (); |
| 428 | 1006 |
| 867 | 1007 emacs_doprnt_va (stream, (Ibyte *) format, strlen (format), Qnil, |
| 771 | 1008 vargs); |
| 428 | 1009 Lstream_flush (XLSTREAM (stream)); |
| 1010 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)), | |
| 1011 Lstream_byte_count (XLSTREAM (stream))); | |
| 1012 Lstream_delete (XLSTREAM (stream)); | |
| 771 | 1013 end_gc_forbidden (count); |
| 428 | 1014 return obj; |
| 1015 } | |
| 1016 | |
| 771 | 1017 /* sprintf()-like replacement. Returns a Lisp string. Data |
| 1018 from Lisp strings is OK because we explicitly inhibit GC. */ | |
| 1019 | |
| 428 | 1020 Lisp_Object |
| 867 | 1021 emacs_sprintf_string (const CIbyte *format, ...) |
| 771 | 1022 { |
| 1023 va_list vargs; | |
| 1024 Lisp_Object retval; | |
| 1025 | |
| 1026 va_start (vargs, format); | |
| 1027 retval = emacs_vsprintf_string (format, vargs); | |
| 1028 va_end (vargs); | |
| 1029 return retval; | |
| 1030 } | |
| 1031 | |
| 1032 /* vsprintf()-like replacement. Returns a malloc()ed memory block. Data | |
| 1033 from Lisp strings is OK because we explicitly inhibit GC. Return | |
| 1034 length out through LEN_OUT, if not null. */ | |
| 1035 | |
| 867 | 1036 Ibyte * |
| 1037 emacs_vsprintf_malloc (const CIbyte *format, va_list vargs, | |
| 771 | 1038 Bytecount *len_out) |
| 428 | 1039 { |
| 771 | 1040 int count = begin_gc_forbidden (); |
| 428 | 1041 Lisp_Object stream = make_resizing_buffer_output_stream (); |
| 867 | 1042 Ibyte *retval; |
| 771 | 1043 Bytecount len; |
| 1044 | |
| 867 | 1045 emacs_doprnt_va (stream, (Ibyte *) format, strlen (format), Qnil, |
| 771 | 1046 vargs); |
| 1047 Lstream_flush (XLSTREAM (stream)); | |
| 1048 len = Lstream_byte_count (XLSTREAM (stream)); | |
| 2367 | 1049 retval = xnew_ibytes (len + 1); |
| 771 | 1050 memcpy (retval, resizing_buffer_stream_ptr (XLSTREAM (stream)), len); |
| 1051 retval[len] = '\0'; | |
| 1052 end_gc_forbidden (count); | |
| 1053 Lstream_delete (XLSTREAM (stream)); | |
| 1054 | |
| 1055 if (len_out) | |
| 1056 *len_out = len; | |
| 1057 return retval; | |
| 1058 } | |
| 1059 | |
| 1060 /* sprintf()-like replacement. Returns a malloc()ed memory block. Data | |
| 1061 from Lisp strings is OK because we explicitly inhibit GC. Return length | |
| 1062 out through LEN_OUT, if not null. */ | |
| 428 | 1063 |
| 867 | 1064 Ibyte * |
| 1065 emacs_sprintf_malloc (Bytecount *len_out, const CIbyte *format, ...) | |
| 771 | 1066 { |
| 1067 va_list vargs; | |
| 867 | 1068 Ibyte *retval; |
| 771 | 1069 |
| 1070 va_start (vargs, format); | |
| 1071 retval = emacs_vsprintf_malloc (format, vargs, len_out); | |
| 428 | 1072 va_end (vargs); |
| 771 | 1073 return retval; |
| 1074 } | |
| 1075 | |
| 1076 /* vsprintf() replacement. Writes output into OUTPUT, which better | |
| 1077 have enough space for the output. Data from Lisp strings is OK | |
| 1078 because we explicitly inhibit GC. */ | |
| 1079 | |
| 1080 Bytecount | |
| 867 | 1081 emacs_vsprintf (Ibyte *output, const CIbyte *format, va_list vargs) |
| 771 | 1082 { |
| 1083 Bytecount retval; | |
| 1084 int count = begin_gc_forbidden (); | |
| 1085 Lisp_Object stream = make_resizing_buffer_output_stream (); | |
| 1086 Bytecount len; | |
| 428 | 1087 |
| 867 | 1088 retval = emacs_doprnt_va (stream, (Ibyte *) format, strlen (format), Qnil, |
| 771 | 1089 vargs); |
| 428 | 1090 Lstream_flush (XLSTREAM (stream)); |
| 771 | 1091 len = Lstream_byte_count (XLSTREAM (stream)); |
| 1092 memcpy (output, resizing_buffer_stream_ptr (XLSTREAM (stream)), len); | |
| 1093 output[len] = '\0'; | |
| 1094 end_gc_forbidden (count); | |
| 428 | 1095 Lstream_delete (XLSTREAM (stream)); |
| 771 | 1096 |
| 1097 return retval; | |
| 428 | 1098 } |
| 771 | 1099 |
| 1100 /* sprintf() replacement. Writes output into OUTPUT, which better | |
| 1101 have enough space for the output. Data from Lisp strings is OK | |
| 1102 because we explicitly inhibit GC. */ | |
| 1103 | |
| 1104 Bytecount | |
| 867 | 1105 emacs_sprintf (Ibyte *output, const CIbyte *format, ...) |
| 771 | 1106 { |
| 1107 va_list vargs; | |
| 1108 Bytecount retval; | |
| 1109 | |
| 1110 va_start (vargs, format); | |
| 1111 retval = emacs_vsprintf (output, format, vargs); | |
| 1112 va_end (vargs); | |
| 1113 return retval; | |
| 1114 } |