|
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";
|
|
1983
|
37 static const char * const valid_converters = "dic" "ouxX" "feEgG" "sS"
|
|
|
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";
|
|
|
46 static const char * const unsigned_int_converters = "ouxX";
|
|
|
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)
|
|
|
50 static const char * const bignum_converters = "npyY";
|
|
|
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. */
|
|
793
|
561 ls = Fprin1_to_string (obj, Qnil);
|
|
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. */
|
|
793
|
570 ls = Fprin1_to_string (obj, Qt);
|
|
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);
|
|
2272
|
605 syntax_error (msg, Qnil);
|
|
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))
|
|
|
641 obj = Ftruncate (obj);
|
|
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;
|
|
|
668 default: /* ch == 'u' */
|
|
|
669 if (strchr (unsigned_int_converters, ch) &&
|
|
|
670 ratio_sign (XRATIO_DATA (obj)) < 0)
|
|
|
671 dead_wrong_type_argument (Qnonnegativep, obj);
|
|
|
672 else
|
|
|
673 ch = 'n';
|
|
|
674 }
|
|
|
675 }
|
|
|
676 #endif
|
|
|
677 #ifdef HAVE_BIGNUM
|
|
|
678 if (BIGNUMP (obj))
|
|
|
679 {
|
|
|
680 arg.obj = obj;
|
|
|
681 switch (ch)
|
|
|
682 {
|
|
|
683 case 'i': case 'd': ch = 'n'; break;
|
|
|
684 case 'o': ch = 'p'; break;
|
|
|
685 case 'x': ch = 'y'; break;
|
|
|
686 case 'X': ch = 'Y'; break;
|
|
|
687 default: /* ch == 'u' */
|
|
|
688 if (strchr (unsigned_int_converters, ch) &&
|
|
|
689 bignum_sign (XBIGNUM_DATA (obj)) < 0)
|
|
|
690 dead_wrong_type_argument (Qnatnump, obj);
|
|
|
691 else
|
|
|
692 ch = 'n';
|
|
|
693 }
|
|
|
694 }
|
|
|
695 #endif
|
|
|
696 if (INTP (obj))
|
|
|
697 {
|
|
|
698 if (strchr (unsigned_int_converters, ch))
|
|
|
699 {
|
|
|
700 #ifdef HAVE_BIGNUM
|
|
|
701 if (XINT (obj) < 0)
|
|
|
702 dead_wrong_type_argument (Qnatnump, obj);
|
|
|
703 #endif
|
|
|
704 arg.ul = (unsigned long) XUINT (obj);
|
|
|
705 }
|
|
|
706 else
|
|
|
707 arg.l = XINT (obj);
|
|
|
708 }
|
|
428
|
709 }
|
|
|
710 }
|
|
|
711
|
|
|
712 if (ch == 'c')
|
|
|
713 {
|
|
867
|
714 Ichar a;
|
|
428
|
715 Bytecount charlen;
|
|
867
|
716 Ibyte charbuf[MAX_ICHAR_LEN];
|
|
428
|
717
|
|
867
|
718 a = (Ichar) arg.l;
|
|
428
|
719
|
|
867
|
720 if (!valid_ichar_p (a))
|
|
2267
|
721 {
|
|
|
722 /* WARNING! This MUST be big enough for the sprintf below */
|
|
2272
|
723 CIbyte msg[60];
|
|
|
724 sprintf (msg, "invalid character value %d to %%c spec",
|
|
2267
|
725 a);
|
|
2272
|
726 syntax_error (msg, Qnil);
|
|
2267
|
727 }
|
|
428
|
728
|
|
867
|
729 charlen = set_itext_ichar (charbuf, a);
|
|
771
|
730 doprnt_2 (stream, charbuf, charlen, spec->minwidth,
|
|
428
|
731 -1, spec->minus_flag, spec->zero_flag);
|
|
|
732 }
|
|
1983
|
733 #if defined(HAVE_BIGNUM) || defined(HAVE_RATIO)
|
|
|
734 else if (strchr (bignum_converters, ch))
|
|
|
735 {
|
|
|
736 #ifdef HAVE_BIGNUM
|
|
|
737 if (BIGNUMP (arg.obj))
|
|
|
738 {
|
|
1995
|
739 Ibyte *text_to_print =
|
|
|
740 (Ibyte *) bignum_to_string (XBIGNUM_DATA (arg.obj),
|
|
|
741 ch == 'n' ? 10 :
|
|
|
742 (ch == 'p' ? 8 : 16));
|
|
|
743 doprnt_2 (stream, text_to_print,
|
|
|
744 strlen ((const char *) text_to_print),
|
|
1983
|
745 spec->minwidth, -1, spec->minus_flag,
|
|
|
746 spec->zero_flag);
|
|
1995
|
747 xfree (text_to_print, Ibyte *);
|
|
1983
|
748 }
|
|
|
749 #endif
|
|
|
750 #ifdef HAVE_RATIO
|
|
|
751 if (RATIOP (arg.obj))
|
|
|
752 {
|
|
1995
|
753 Ibyte *text_to_print =
|
|
|
754 (Ibyte *) ratio_to_string (XRATIO_DATA (arg.obj),
|
|
|
755 ch == 'n' ? 10 :
|
|
|
756 (ch == 'p' ? 8 : 16));
|
|
|
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);
|
|
1995
|
761 xfree (text_to_print, Ibyte *);
|
|
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);
|
|
1995
|
774 xfree (text_to_print, Ibyte *);
|
|
1983
|
775 }
|
|
|
776 #endif /* HAVE_BIGFLOAT */
|
|
428
|
777 else
|
|
|
778 {
|
|
448
|
779 /* ASCII Decimal representation uses 2.4 times as many
|
|
|
780 bits as machine binary. */
|
|
|
781 char *text_to_print =
|
|
|
782 alloca_array (char, 32 +
|
|
|
783 max (spec->minwidth,
|
|
647
|
784 (int) max (sizeof (double),
|
|
|
785 sizeof (long)) * 3 +
|
|
448
|
786 max (spec->precision, 0)));
|
|
428
|
787 char constructed_spec[100];
|
|
446
|
788 char *p = constructed_spec;
|
|
428
|
789
|
|
448
|
790 /* Mostly reconstruct the spec and use sprintf() to
|
|
428
|
791 format the string. */
|
|
|
792
|
|
446
|
793 *p++ = '%';
|
|
|
794 if (spec->plus_flag) *p++ = '+';
|
|
|
795 if (spec->space_flag) *p++ = ' ';
|
|
|
796 if (spec->number_flag) *p++ = '#';
|
|
448
|
797 if (spec->minus_flag) *p++ = '-';
|
|
|
798 if (spec->zero_flag) *p++ = '0';
|
|
446
|
799
|
|
448
|
800 if (spec->minwidth >= 0)
|
|
577
|
801 {
|
|
|
802 long_to_string (p, spec->minwidth);
|
|
|
803 p += strlen (p);
|
|
|
804 }
|
|
448
|
805 if (spec->precision >= 0)
|
|
428
|
806 {
|
|
446
|
807 *p++ = '.';
|
|
577
|
808 long_to_string (p, spec->precision);
|
|
|
809 p += strlen (p);
|
|
428
|
810 }
|
|
448
|
811
|
|
428
|
812 if (strchr (double_converters, ch))
|
|
442
|
813 {
|
|
446
|
814 *p++ = ch;
|
|
|
815 *p++ = '\0';
|
|
442
|
816 sprintf (text_to_print, constructed_spec, arg.d);
|
|
|
817 }
|
|
428
|
818 else
|
|
|
819 {
|
|
448
|
820 *p++ = 'l'; /* Always use longs with sprintf() */
|
|
|
821 *p++ = ch;
|
|
|
822 *p++ = '\0';
|
|
446
|
823
|
|
|
824 if (strchr (unsigned_int_converters, ch))
|
|
|
825 sprintf (text_to_print, constructed_spec, arg.ul);
|
|
|
826 else
|
|
428
|
827 sprintf (text_to_print, constructed_spec, arg.l);
|
|
|
828 }
|
|
|
829
|
|
867
|
830 doprnt_2 (stream, (Ibyte *) text_to_print,
|
|
448
|
831 strlen (text_to_print), 0, -1, 0, 0);
|
|
428
|
832 }
|
|
|
833 }
|
|
|
834 }
|
|
|
835
|
|
771
|
836 unbind_to (count);
|
|
428
|
837 return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count;
|
|
|
838 }
|
|
|
839
|
|
771
|
840 /* Basic external entry point into string formatting. See
|
|
|
841 emacs_doprnt_1().
|
|
|
842 */
|
|
|
843
|
|
|
844 Bytecount
|
|
867
|
845 emacs_doprnt_va (Lisp_Object stream, const Ibyte *format_nonreloc,
|
|
771
|
846 Bytecount format_length, Lisp_Object format_reloc,
|
|
|
847 va_list vargs)
|
|
|
848 {
|
|
|
849 return emacs_doprnt_1 (stream, format_nonreloc, format_length,
|
|
|
850 format_reloc, 0, 0, vargs);
|
|
|
851 }
|
|
|
852
|
|
|
853 /* Basic external entry point into string formatting. See
|
|
|
854 emacs_doprnt_1().
|
|
|
855 */
|
|
|
856
|
|
|
857 Bytecount
|
|
867
|
858 emacs_doprnt (Lisp_Object stream, const Ibyte *format_nonreloc,
|
|
771
|
859 Bytecount format_length, Lisp_Object format_reloc,
|
|
|
860 int nargs, const Lisp_Object *largs, ...)
|
|
428
|
861 {
|
|
|
862 va_list vargs;
|
|
|
863 Bytecount val;
|
|
|
864 va_start (vargs, largs);
|
|
771
|
865 val = emacs_doprnt_1 (stream, format_nonreloc, format_length,
|
|
|
866 format_reloc, nargs, largs, vargs);
|
|
428
|
867 va_end (vargs);
|
|
|
868 return val;
|
|
|
869 }
|
|
|
870
|
|
771
|
871 /* Similar to `format' in that its arguments are Lisp objects rather than C
|
|
|
872 objects. (For the versions that take C objects, see the
|
|
|
873 emacs_[v]sprintf... functions below.) Accepts the format string as
|
|
|
874 either a C string (FORMAT_NONRELOC, which *MUST NOT* come from Lisp
|
|
|
875 string data, unless GC is inhibited) or a Lisp string (FORMAT_RELOC).
|
|
|
876 Return resulting formatted string as a Lisp string.
|
|
428
|
877
|
|
771
|
878 All arguments are GCPRO'd, including FORMAT_RELOC; this makes it OK to
|
|
|
879 pass newly created objects into this function (as often happens).
|
|
428
|
880
|
|
771
|
881 #### It shouldn't be necessary to specify the number of arguments.
|
|
|
882 This would require some rewriting of the doprnt() functions, though.
|
|
|
883 */
|
|
428
|
884
|
|
|
885 Lisp_Object
|
|
867
|
886 emacs_vsprintf_string_lisp (const CIbyte *format_nonreloc,
|
|
771
|
887 Lisp_Object format_reloc, int nargs,
|
|
|
888 const Lisp_Object *largs)
|
|
428
|
889 {
|
|
771
|
890 Lisp_Object stream;
|
|
428
|
891 Lisp_Object obj;
|
|
771
|
892 struct gcpro gcpro1, gcpro2;
|
|
|
893 GCPRO2 (largs[0], format_reloc);
|
|
|
894 gcpro1.nvars = nargs;
|
|
428
|
895
|
|
771
|
896 stream = make_resizing_buffer_output_stream ();
|
|
867
|
897 emacs_doprnt (stream, (Ibyte *) format_nonreloc, format_nonreloc ?
|
|
771
|
898 strlen (format_nonreloc) : 0,
|
|
|
899 format_reloc, nargs, largs);
|
|
428
|
900 Lstream_flush (XLSTREAM (stream));
|
|
|
901 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
|
|
|
902 Lstream_byte_count (XLSTREAM (stream)));
|
|
771
|
903 Lstream_delete (XLSTREAM (stream));
|
|
428
|
904 UNGCPRO;
|
|
|
905 return obj;
|
|
|
906 }
|
|
|
907
|
|
771
|
908 /* Like emacs_vsprintf_string_lisp() but accepts its extra args directly
|
|
|
909 (using variable arguments), rather than as an array. */
|
|
|
910
|
|
428
|
911 Lisp_Object
|
|
867
|
912 emacs_sprintf_string_lisp (const CIbyte *format_nonreloc,
|
|
771
|
913 Lisp_Object format_reloc, int nargs, ...)
|
|
428
|
914 {
|
|
771
|
915 Lisp_Object *args = alloca_array (Lisp_Object, nargs);
|
|
|
916 va_list va;
|
|
|
917 int i;
|
|
428
|
918 Lisp_Object obj;
|
|
|
919
|
|
771
|
920 va_start (va, nargs);
|
|
|
921 for (i = 0; i < nargs; i++)
|
|
|
922 args[i] = va_arg (va, Lisp_Object);
|
|
|
923 va_end (va);
|
|
|
924 obj = emacs_vsprintf_string_lisp (format_nonreloc, format_reloc, nargs,
|
|
|
925 args);
|
|
428
|
926 return obj;
|
|
|
927 }
|
|
|
928
|
|
771
|
929 /* Like emacs_vsprintf_string_lisp() but returns a malloc()ed memory block.
|
|
|
930 Return length out through LEN_OUT, if not null. */
|
|
|
931
|
|
867
|
932 Ibyte *
|
|
|
933 emacs_vsprintf_malloc_lisp (const CIbyte *format_nonreloc,
|
|
771
|
934 Lisp_Object format_reloc, int nargs,
|
|
|
935 const Lisp_Object *largs, Bytecount *len_out)
|
|
|
936 {
|
|
|
937 Lisp_Object stream;
|
|
867
|
938 Ibyte *retval;
|
|
771
|
939 Bytecount len;
|
|
|
940 struct gcpro gcpro1, gcpro2;
|
|
|
941
|
|
|
942 GCPRO2 (largs[0], format_reloc);
|
|
|
943 gcpro1.nvars = nargs;
|
|
|
944
|
|
|
945 stream = make_resizing_buffer_output_stream ();
|
|
867
|
946 emacs_doprnt (stream, (Ibyte *) format_nonreloc, format_nonreloc ?
|
|
771
|
947 strlen (format_nonreloc) : 0,
|
|
|
948 format_reloc, nargs, largs);
|
|
|
949 Lstream_flush (XLSTREAM (stream));
|
|
|
950 len = Lstream_byte_count (XLSTREAM (stream));
|
|
2367
|
951 retval = xnew_ibytes (len + 1);
|
|
771
|
952 memcpy (retval, resizing_buffer_stream_ptr (XLSTREAM (stream)), len);
|
|
|
953 retval[len] = '\0';
|
|
|
954 Lstream_delete (XLSTREAM (stream));
|
|
|
955
|
|
|
956 if (len_out)
|
|
|
957 *len_out = len;
|
|
|
958 UNGCPRO;
|
|
|
959 return retval;
|
|
|
960 }
|
|
|
961
|
|
|
962 /* Like emacs_sprintf_string_lisp() but returns a malloc()ed memory block.
|
|
|
963 Return length out through LEN_OUT, if not null. */
|
|
|
964
|
|
867
|
965 Ibyte *
|
|
|
966 emacs_sprintf_malloc_lisp (Bytecount *len_out, const CIbyte *format_nonreloc,
|
|
771
|
967 Lisp_Object format_reloc, int nargs, ...)
|
|
|
968 {
|
|
|
969 Lisp_Object *args = alloca_array (Lisp_Object, nargs);
|
|
|
970 va_list va;
|
|
|
971 int i;
|
|
867
|
972 Ibyte *retval;
|
|
771
|
973
|
|
|
974 va_start (va, nargs);
|
|
|
975 for (i = 0; i < nargs; i++)
|
|
|
976 args[i] = va_arg (va, Lisp_Object);
|
|
|
977 va_end (va);
|
|
|
978 retval = emacs_vsprintf_malloc_lisp (format_nonreloc, format_reloc, nargs,
|
|
|
979 args, len_out);
|
|
|
980 return retval;
|
|
|
981 }
|
|
|
982
|
|
|
983 /* vsprintf()-like replacement. Returns a Lisp string. Data
|
|
|
984 from Lisp strings is OK because we explicitly inhibit GC. */
|
|
|
985
|
|
428
|
986 Lisp_Object
|
|
867
|
987 emacs_vsprintf_string (const CIbyte *format, va_list vargs)
|
|
428
|
988 {
|
|
771
|
989 Lisp_Object stream = make_resizing_buffer_output_stream ();
|
|
428
|
990 Lisp_Object obj;
|
|
771
|
991 int count = begin_gc_forbidden ();
|
|
428
|
992
|
|
867
|
993 emacs_doprnt_va (stream, (Ibyte *) format, strlen (format), Qnil,
|
|
771
|
994 vargs);
|
|
428
|
995 Lstream_flush (XLSTREAM (stream));
|
|
|
996 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
|
|
|
997 Lstream_byte_count (XLSTREAM (stream)));
|
|
|
998 Lstream_delete (XLSTREAM (stream));
|
|
771
|
999 end_gc_forbidden (count);
|
|
428
|
1000 return obj;
|
|
|
1001 }
|
|
|
1002
|
|
771
|
1003 /* sprintf()-like replacement. Returns a Lisp string. Data
|
|
|
1004 from Lisp strings is OK because we explicitly inhibit GC. */
|
|
|
1005
|
|
428
|
1006 Lisp_Object
|
|
867
|
1007 emacs_sprintf_string (const CIbyte *format, ...)
|
|
771
|
1008 {
|
|
|
1009 va_list vargs;
|
|
|
1010 Lisp_Object retval;
|
|
|
1011
|
|
|
1012 va_start (vargs, format);
|
|
|
1013 retval = emacs_vsprintf_string (format, vargs);
|
|
|
1014 va_end (vargs);
|
|
|
1015 return retval;
|
|
|
1016 }
|
|
|
1017
|
|
|
1018 /* vsprintf()-like replacement. Returns a malloc()ed memory block. Data
|
|
|
1019 from Lisp strings is OK because we explicitly inhibit GC. Return
|
|
|
1020 length out through LEN_OUT, if not null. */
|
|
|
1021
|
|
867
|
1022 Ibyte *
|
|
|
1023 emacs_vsprintf_malloc (const CIbyte *format, va_list vargs,
|
|
771
|
1024 Bytecount *len_out)
|
|
428
|
1025 {
|
|
771
|
1026 int count = begin_gc_forbidden ();
|
|
428
|
1027 Lisp_Object stream = make_resizing_buffer_output_stream ();
|
|
867
|
1028 Ibyte *retval;
|
|
771
|
1029 Bytecount len;
|
|
|
1030
|
|
867
|
1031 emacs_doprnt_va (stream, (Ibyte *) format, strlen (format), Qnil,
|
|
771
|
1032 vargs);
|
|
|
1033 Lstream_flush (XLSTREAM (stream));
|
|
|
1034 len = Lstream_byte_count (XLSTREAM (stream));
|
|
2367
|
1035 retval = xnew_ibytes (len + 1);
|
|
771
|
1036 memcpy (retval, resizing_buffer_stream_ptr (XLSTREAM (stream)), len);
|
|
|
1037 retval[len] = '\0';
|
|
|
1038 end_gc_forbidden (count);
|
|
|
1039 Lstream_delete (XLSTREAM (stream));
|
|
|
1040
|
|
|
1041 if (len_out)
|
|
|
1042 *len_out = len;
|
|
|
1043 return retval;
|
|
|
1044 }
|
|
|
1045
|
|
|
1046 /* sprintf()-like replacement. Returns a malloc()ed memory block. Data
|
|
|
1047 from Lisp strings is OK because we explicitly inhibit GC. Return length
|
|
|
1048 out through LEN_OUT, if not null. */
|
|
428
|
1049
|
|
867
|
1050 Ibyte *
|
|
|
1051 emacs_sprintf_malloc (Bytecount *len_out, const CIbyte *format, ...)
|
|
771
|
1052 {
|
|
|
1053 va_list vargs;
|
|
867
|
1054 Ibyte *retval;
|
|
771
|
1055
|
|
|
1056 va_start (vargs, format);
|
|
|
1057 retval = emacs_vsprintf_malloc (format, vargs, len_out);
|
|
428
|
1058 va_end (vargs);
|
|
771
|
1059 return retval;
|
|
|
1060 }
|
|
|
1061
|
|
|
1062 /* vsprintf() replacement. Writes output into OUTPUT, which better
|
|
|
1063 have enough space for the output. Data from Lisp strings is OK
|
|
|
1064 because we explicitly inhibit GC. */
|
|
|
1065
|
|
|
1066 Bytecount
|
|
867
|
1067 emacs_vsprintf (Ibyte *output, const CIbyte *format, va_list vargs)
|
|
771
|
1068 {
|
|
|
1069 Bytecount retval;
|
|
|
1070 int count = begin_gc_forbidden ();
|
|
|
1071 Lisp_Object stream = make_resizing_buffer_output_stream ();
|
|
|
1072 Bytecount len;
|
|
428
|
1073
|
|
867
|
1074 retval = emacs_doprnt_va (stream, (Ibyte *) format, strlen (format), Qnil,
|
|
771
|
1075 vargs);
|
|
428
|
1076 Lstream_flush (XLSTREAM (stream));
|
|
771
|
1077 len = Lstream_byte_count (XLSTREAM (stream));
|
|
|
1078 memcpy (output, resizing_buffer_stream_ptr (XLSTREAM (stream)), len);
|
|
|
1079 output[len] = '\0';
|
|
|
1080 end_gc_forbidden (count);
|
|
428
|
1081 Lstream_delete (XLSTREAM (stream));
|
|
771
|
1082
|
|
|
1083 return retval;
|
|
428
|
1084 }
|
|
771
|
1085
|
|
|
1086 /* sprintf() replacement. Writes output into OUTPUT, which better
|
|
|
1087 have enough space for the output. Data from Lisp strings is OK
|
|
|
1088 because we explicitly inhibit GC. */
|
|
|
1089
|
|
|
1090 Bytecount
|
|
867
|
1091 emacs_sprintf (Ibyte *output, const CIbyte *format, ...)
|
|
771
|
1092 {
|
|
|
1093 va_list vargs;
|
|
|
1094 Bytecount retval;
|
|
|
1095
|
|
|
1096 va_start (vargs, format);
|
|
|
1097 retval = emacs_vsprintf (output, format, vargs);
|
|
|
1098 va_end (vargs);
|
|
|
1099 return retval;
|
|
|
1100 }
|
