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