|
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.
|
|
771
|
5 Copyright (C) 2001 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.
|
|
|
9
|
|
|
10 This file is part of XEmacs.
|
|
|
11
|
|
|
12 XEmacs is free software; you can redistribute it and/or modify it
|
|
|
13 under the terms of the GNU General Public License as published by the
|
|
|
14 Free Software Foundation; either version 2, or (at your option) any
|
|
|
15 later version.
|
|
|
16
|
|
|
17 XEmacs is distributed in the hope that it will be useful, but WITHOUT
|
|
|
18 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
19 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
20 for more details.
|
|
|
21
|
|
|
22 You should have received a copy of the GNU General Public License
|
|
|
23 along with XEmacs; see the file COPYING. If not, write to
|
|
|
24 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
25 Boston, MA 02111-1307, USA. */
|
|
|
26
|
|
|
27 /* Synched up with: Rewritten. Not in FSF. */
|
|
|
28
|
|
|
29 #include <config.h>
|
|
|
30 #include "lisp.h"
|
|
|
31
|
|
|
32 #include "buffer.h"
|
|
|
33 #include "lstream.h"
|
|
|
34
|
|
446
|
35 static const char * const valid_flags = "-+ #0";
|
|
|
36 static const char * const valid_converters = "dic" "ouxX" "feEgG" "sS";
|
|
|
37 static const char * const int_converters = "dic";
|
|
|
38 static const char * const unsigned_int_converters = "ouxX";
|
|
|
39 static const char * const double_converters = "feEgG";
|
|
|
40 static const char * const string_converters = "sS";
|
|
428
|
41
|
|
|
42 typedef struct printf_spec printf_spec;
|
|
|
43 struct printf_spec
|
|
|
44 {
|
|
|
45 int argnum; /* which argument does this spec want? This is one-based:
|
|
|
46 The first argument given is numbered 1, the second
|
|
|
47 is 2, etc. This is to handle %##$x-type specs. */
|
|
|
48 int minwidth;
|
|
|
49 int precision;
|
|
|
50 unsigned int minus_flag:1;
|
|
|
51 unsigned int plus_flag:1;
|
|
|
52 unsigned int space_flag:1;
|
|
|
53 unsigned int number_flag:1;
|
|
|
54 unsigned int zero_flag:1;
|
|
|
55 unsigned int h_flag:1;
|
|
|
56 unsigned int l_flag:1;
|
|
|
57 unsigned int forwarding_precision:1;
|
|
|
58 char converter; /* converter character or 0 for dummy marker
|
|
|
59 indicating literal text at the end of the
|
|
|
60 specification */
|
|
|
61 Bytecount text_before; /* position of the first character of the
|
|
|
62 block of literal text before this spec */
|
|
|
63 Bytecount text_before_len; /* length of that text */
|
|
|
64 };
|
|
|
65
|
|
|
66 typedef union printf_arg printf_arg;
|
|
|
67 union printf_arg
|
|
|
68 {
|
|
|
69 long l;
|
|
|
70 unsigned long ul;
|
|
|
71 double d;
|
|
665
|
72 Intbyte *bp;
|
|
428
|
73 };
|
|
|
74
|
|
|
75 /* We maintain a list of all the % specs in the specification,
|
|
|
76 along with the offset and length of the block of literal text
|
|
|
77 before each spec. In addition, we have a "dummy" spec that
|
|
|
78 represents all the literal text at the end of the specification.
|
|
|
79 Its converter is 0. */
|
|
|
80
|
|
|
81 typedef struct
|
|
|
82 {
|
|
|
83 Dynarr_declare (struct printf_spec);
|
|
|
84 } printf_spec_dynarr;
|
|
|
85
|
|
|
86 typedef struct
|
|
|
87 {
|
|
|
88 Dynarr_declare (union printf_arg);
|
|
|
89 } printf_arg_dynarr;
|
|
|
90
|
|
448
|
91 /* Append STRING (of length LEN bytes) to STREAM.
|
|
|
92 MINLEN is the minimum field width.
|
|
|
93 If MINUS_FLAG is set, left-justify the string in its field;
|
|
|
94 otherwise, right-justify.
|
|
|
95 If ZERO_FLAG is set, pad with 0's; otherwise pad with spaces.
|
|
|
96 If MAXLEN is non-negative, the string is first truncated on the
|
|
|
97 right to that many characters.
|
|
428
|
98
|
|
|
99 Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */
|
|
|
100
|
|
|
101 static void
|
|
771
|
102 doprnt_2 (Lisp_Object stream, const Intbyte *string, Bytecount len,
|
|
428
|
103 Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag)
|
|
|
104 {
|
|
|
105 Lstream *lstr = XLSTREAM (stream);
|
|
448
|
106 Charcount cclen = bytecount_to_charcount (string, len);
|
|
|
107 int to_add = minlen - cclen;
|
|
428
|
108
|
|
|
109 /* Padding at beginning to right-justify ... */
|
|
448
|
110 if (!minus_flag)
|
|
|
111 while (to_add-- > 0)
|
|
|
112 Lstream_putc (lstr, zero_flag ? '0' : ' ');
|
|
428
|
113
|
|
448
|
114 if (0 <= maxlen && maxlen < cclen)
|
|
|
115 len = charcount_to_bytecount (string, maxlen);
|
|
428
|
116 Lstream_write (lstr, string, len);
|
|
|
117
|
|
|
118 /* Padding at end to left-justify ... */
|
|
448
|
119 if (minus_flag)
|
|
|
120 while (to_add-- > 0)
|
|
|
121 Lstream_putc (lstr, zero_flag ? '0' : ' ');
|
|
428
|
122 }
|
|
|
123
|
|
665
|
124 static const Intbyte *
|
|
|
125 parse_off_posnum (const Intbyte *start, const Intbyte *end, int *returned_num)
|
|
428
|
126 {
|
|
665
|
127 Intbyte arg_convert[100];
|
|
|
128 REGISTER Intbyte *arg_ptr = arg_convert;
|
|
428
|
129
|
|
|
130 *returned_num = -1;
|
|
|
131 while (start != end && isdigit (*start))
|
|
|
132 {
|
|
647
|
133 if (arg_ptr - arg_convert >= (int) sizeof (arg_convert) - 1)
|
|
|
134 syntax_error ("Format converter number too large", Qunbound);
|
|
428
|
135 *arg_ptr++ = *start++;
|
|
|
136 }
|
|
|
137 *arg_ptr = '\0';
|
|
|
138 if (arg_convert != arg_ptr)
|
|
|
139 *returned_num = atoi ((char *) arg_convert);
|
|
|
140 return start;
|
|
|
141 }
|
|
|
142
|
|
|
143 #define NEXT_ASCII_BYTE(ch) \
|
|
|
144 do { \
|
|
|
145 if (fmt == fmt_end) \
|
|
563
|
146 syntax_error ("Premature end of format string", Qunbound); \
|
|
428
|
147 ch = *fmt; \
|
|
|
148 if (ch >= 0200) \
|
|
563
|
149 syntax_error ("Non-ASCII character in format converter spec", Qunbound); \
|
|
428
|
150 fmt++; \
|
|
|
151 } while (0)
|
|
|
152
|
|
|
153 #define RESOLVE_FLAG_CONFLICTS(spec) \
|
|
|
154 do { \
|
|
|
155 if (spec.space_flag && spec.plus_flag) \
|
|
|
156 spec.space_flag = 0; \
|
|
|
157 if (spec.zero_flag && spec.space_flag) \
|
|
|
158 spec.zero_flag = 0; \
|
|
|
159 } while (0)
|
|
|
160
|
|
|
161 static printf_spec_dynarr *
|
|
665
|
162 parse_doprnt_spec (const Intbyte *format, Bytecount format_length)
|
|
428
|
163 {
|
|
665
|
164 const Intbyte *fmt = format;
|
|
|
165 const Intbyte *fmt_end = format + format_length;
|
|
428
|
166 printf_spec_dynarr *specs = Dynarr_new (printf_spec);
|
|
|
167 int prev_argnum = 0;
|
|
|
168
|
|
|
169 while (1)
|
|
|
170 {
|
|
|
171 struct printf_spec spec;
|
|
665
|
172 const Intbyte *text_end;
|
|
|
173 Intbyte ch;
|
|
428
|
174
|
|
|
175 xzero (spec);
|
|
|
176 if (fmt == fmt_end)
|
|
|
177 return specs;
|
|
665
|
178 text_end = (Intbyte *) memchr (fmt, '%', fmt_end - fmt);
|
|
428
|
179 if (!text_end)
|
|
|
180 text_end = fmt_end;
|
|
|
181 spec.text_before = fmt - format;
|
|
|
182 spec.text_before_len = text_end - fmt;
|
|
|
183 fmt = text_end;
|
|
|
184 if (fmt != fmt_end)
|
|
|
185 {
|
|
|
186 fmt++; /* skip over % */
|
|
|
187
|
|
|
188 /* A % is special -- no arg number. According to ANSI specs,
|
|
|
189 field width does not apply to %% conversion. */
|
|
|
190 if (fmt != fmt_end && *fmt == '%')
|
|
|
191 {
|
|
|
192 spec.converter = '%';
|
|
|
193 Dynarr_add (specs, spec);
|
|
|
194 fmt++;
|
|
|
195 continue;
|
|
|
196 }
|
|
|
197
|
|
|
198 /* Is there a field number specifier? */
|
|
|
199 {
|
|
665
|
200 const Intbyte *ptr;
|
|
428
|
201 int fieldspec;
|
|
|
202
|
|
|
203 ptr = parse_off_posnum (fmt, fmt_end, &fieldspec);
|
|
|
204 if (fieldspec > 0 && ptr != fmt_end && *ptr == '$')
|
|
|
205 {
|
|
|
206 /* There is a format specifier */
|
|
|
207 prev_argnum = fieldspec;
|
|
|
208 fmt = ptr + 1;
|
|
|
209 }
|
|
|
210 else
|
|
|
211 prev_argnum++;
|
|
|
212 spec.argnum = prev_argnum;
|
|
|
213 }
|
|
|
214
|
|
|
215 /* Parse off any flags */
|
|
|
216 NEXT_ASCII_BYTE (ch);
|
|
|
217 while (strchr (valid_flags, ch))
|
|
|
218 {
|
|
|
219 switch (ch)
|
|
|
220 {
|
|
446
|
221 case '-': spec.minus_flag = 1; break;
|
|
|
222 case '+': spec.plus_flag = 1; break;
|
|
|
223 case ' ': spec.space_flag = 1; break;
|
|
428
|
224 case '#': spec.number_flag = 1; break;
|
|
446
|
225 case '0': spec.zero_flag = 1; break;
|
|
428
|
226 default: abort ();
|
|
|
227 }
|
|
|
228 NEXT_ASCII_BYTE (ch);
|
|
|
229 }
|
|
|
230
|
|
|
231 /* Parse off the minimum field width */
|
|
|
232 fmt--; /* back up */
|
|
|
233
|
|
|
234 /*
|
|
|
235 * * means the field width was passed as an argument.
|
|
|
236 * Mark the current spec as one that forwards its
|
|
|
237 * field width and flags to the next spec in the array.
|
|
|
238 * Then create a new spec and continue with the parsing.
|
|
|
239 */
|
|
|
240 if (fmt != fmt_end && *fmt == '*')
|
|
|
241 {
|
|
|
242 spec.converter = '*';
|
|
|
243 RESOLVE_FLAG_CONFLICTS(spec);
|
|
|
244 Dynarr_add (specs, spec);
|
|
|
245 xzero (spec);
|
|
|
246 spec.argnum = ++prev_argnum;
|
|
|
247 fmt++;
|
|
|
248 }
|
|
|
249 else
|
|
|
250 {
|
|
|
251 fmt = parse_off_posnum (fmt, fmt_end, &spec.minwidth);
|
|
|
252 if (spec.minwidth == -1)
|
|
|
253 spec.minwidth = 0;
|
|
|
254 }
|
|
|
255
|
|
|
256 /* Parse off any precision specified */
|
|
|
257 NEXT_ASCII_BYTE (ch);
|
|
|
258 if (ch == '.')
|
|
|
259 {
|
|
|
260 /*
|
|
|
261 * * means the precision was passed as an argument.
|
|
|
262 * Mark the current spec as one that forwards its
|
|
|
263 * fieldwidth, flags and precision to the next spec in
|
|
|
264 * the array. Then create a new spec and continue
|
|
|
265 * with the parse.
|
|
|
266 */
|
|
|
267 if (fmt != fmt_end && *fmt == '*')
|
|
|
268 {
|
|
|
269 spec.converter = '*';
|
|
|
270 spec.forwarding_precision = 1;
|
|
|
271 RESOLVE_FLAG_CONFLICTS(spec);
|
|
|
272 Dynarr_add (specs, spec);
|
|
|
273 xzero (spec);
|
|
|
274 spec.argnum = ++prev_argnum;
|
|
|
275 fmt++;
|
|
|
276 }
|
|
|
277 else
|
|
|
278 {
|
|
|
279 fmt = parse_off_posnum (fmt, fmt_end, &spec.precision);
|
|
|
280 if (spec.precision == -1)
|
|
|
281 spec.precision = 0;
|
|
|
282 }
|
|
|
283 NEXT_ASCII_BYTE (ch);
|
|
|
284 }
|
|
|
285 else
|
|
|
286 /* No precision specified */
|
|
|
287 spec.precision = -1;
|
|
|
288
|
|
|
289 /* Parse off h or l flag */
|
|
|
290 if (ch == 'h' || ch == 'l')
|
|
|
291 {
|
|
|
292 if (ch == 'h')
|
|
|
293 spec.h_flag = 1;
|
|
|
294 else
|
|
|
295 spec.l_flag = 1;
|
|
|
296 NEXT_ASCII_BYTE (ch);
|
|
|
297 }
|
|
|
298
|
|
|
299 if (!strchr (valid_converters, ch))
|
|
563
|
300 syntax_error ("Invalid converter character", make_char (ch));
|
|
428
|
301 spec.converter = ch;
|
|
|
302 }
|
|
|
303
|
|
|
304 RESOLVE_FLAG_CONFLICTS(spec);
|
|
|
305 Dynarr_add (specs, spec);
|
|
|
306 }
|
|
|
307
|
|
|
308 RETURN_NOT_REACHED(specs) /* suppress compiler warning */
|
|
|
309 }
|
|
|
310
|
|
|
311 static int
|
|
|
312 get_args_needed (printf_spec_dynarr *specs)
|
|
|
313 {
|
|
|
314 int args_needed = 0;
|
|
|
315 REGISTER int i;
|
|
|
316
|
|
|
317 /* Figure out how many args are needed. This may be less than
|
|
|
318 the number of specs because a spec could be %% or could be
|
|
|
319 missing (literal text at end of format string) or there
|
|
|
320 could be specs where the field number is explicitly given.
|
|
|
321 We just look for the maximum argument number that's referenced. */
|
|
|
322
|
|
|
323 for (i = 0; i < Dynarr_length (specs); i++)
|
|
|
324 {
|
|
|
325 char ch = Dynarr_at (specs, i).converter;
|
|
|
326 if (ch && ch != '%')
|
|
|
327 {
|
|
|
328 int argnum = Dynarr_at (specs, i).argnum;
|
|
|
329 if (argnum > args_needed)
|
|
|
330 args_needed = argnum;
|
|
|
331 }
|
|
|
332 }
|
|
|
333
|
|
|
334 return args_needed;
|
|
|
335 }
|
|
|
336
|
|
|
337 static printf_arg_dynarr *
|
|
|
338 get_doprnt_args (printf_spec_dynarr *specs, va_list vargs)
|
|
|
339 {
|
|
|
340 printf_arg_dynarr *args = Dynarr_new (printf_arg);
|
|
|
341 union printf_arg arg;
|
|
|
342 REGISTER int i;
|
|
|
343 int args_needed = get_args_needed (specs);
|
|
|
344
|
|
|
345 xzero (arg);
|
|
|
346 for (i = 1; i <= args_needed; i++)
|
|
|
347 {
|
|
|
348 int j;
|
|
|
349 char ch;
|
|
|
350 struct printf_spec *spec = 0;
|
|
|
351
|
|
|
352 for (j = 0; j < Dynarr_length (specs); j++)
|
|
|
353 {
|
|
|
354 spec = Dynarr_atp (specs, j);
|
|
|
355 if (spec->argnum == i)
|
|
|
356 break;
|
|
|
357 }
|
|
|
358
|
|
|
359 if (j == Dynarr_length (specs))
|
|
563
|
360 syntax_error ("No conversion spec for argument", make_int (i));
|
|
428
|
361
|
|
|
362 ch = spec->converter;
|
|
|
363
|
|
|
364 if (strchr (int_converters, ch))
|
|
|
365 {
|
|
446
|
366 if (spec->l_flag)
|
|
428
|
367 arg.l = va_arg (vargs, long);
|
|
|
368 else
|
|
446
|
369 /* int even if ch == 'c' or spec->h_flag:
|
|
|
370 "the type used in va_arg is supposed to match the
|
|
|
371 actual type **after default promotions**."
|
|
|
372 Hence we read an int, not a short, if spec->h_flag. */
|
|
|
373 arg.l = va_arg (vargs, int);
|
|
428
|
374 }
|
|
|
375 else if (strchr (unsigned_int_converters, ch))
|
|
|
376 {
|
|
446
|
377 if (spec->l_flag)
|
|
428
|
378 arg.ul = va_arg (vargs, unsigned long);
|
|
|
379 else
|
|
446
|
380 /* unsigned int even if ch == 'c' or spec->h_flag */
|
|
|
381 arg.ul = (unsigned long) va_arg (vargs, unsigned int);
|
|
428
|
382 }
|
|
|
383 else if (strchr (double_converters, ch))
|
|
|
384 arg.d = va_arg (vargs, double);
|
|
|
385 else if (strchr (string_converters, ch))
|
|
665
|
386 arg.bp = va_arg (vargs, Intbyte *);
|
|
428
|
387 else abort ();
|
|
|
388
|
|
|
389 Dynarr_add (args, arg);
|
|
|
390 }
|
|
|
391
|
|
|
392 return args;
|
|
|
393 }
|
|
|
394
|
|
771
|
395 /* Most basic entry point into string formatting.
|
|
|
396
|
|
|
397 Generate output from a format-spec (either a Lisp string
|
|
|
398 FORMAT_RELOC, or a C string FORMAT_NONRELOC of length FORMAT_LENGTH
|
|
|
399 -- which *MUST NOT* come from Lisp string data, unless GC is
|
|
|
400 inhibited). Output goes to STREAM. Returns the number of bytes
|
|
|
401 stored into STREAM. Arguments are either C-type arguments in
|
|
|
402 va_list VARGS, or an array of Lisp objects in LARGS of size
|
|
|
403 NARGS. (Behavior is different in the two cases -- you either get
|
|
|
404 standard sprintf() behavior or `format' behavior.) */
|
|
428
|
405
|
|
|
406 static Bytecount
|
|
665
|
407 emacs_doprnt_1 (Lisp_Object stream, const Intbyte *format_nonreloc,
|
|
771
|
408 Bytecount format_length, Lisp_Object format_reloc,
|
|
|
409 int nargs, const Lisp_Object *largs, va_list vargs)
|
|
428
|
410 {
|
|
|
411 printf_spec_dynarr *specs = 0;
|
|
|
412 printf_arg_dynarr *args = 0;
|
|
|
413 REGISTER int i;
|
|
|
414 int init_byte_count = Lstream_byte_count (XLSTREAM (stream));
|
|
771
|
415 int count;
|
|
428
|
416
|
|
|
417 if (!NILP (format_reloc))
|
|
|
418 {
|
|
|
419 format_nonreloc = XSTRING_DATA (format_reloc);
|
|
|
420 format_length = XSTRING_LENGTH (format_reloc);
|
|
|
421 }
|
|
|
422 if (format_length < 0)
|
|
442
|
423 format_length = (Bytecount) strlen ((const char *) format_nonreloc);
|
|
428
|
424
|
|
|
425 specs = parse_doprnt_spec (format_nonreloc, format_length);
|
|
771
|
426 count = record_unwind_protect_freeing_dynarr (specs);
|
|
|
427
|
|
428
|
428 if (largs)
|
|
|
429 {
|
|
446
|
430 /* allow too many args for string, but not too few */
|
|
428
|
431 if (nargs < get_args_needed (specs))
|
|
563
|
432 signal_error_1 (Qwrong_number_of_arguments,
|
|
428
|
433 list3 (Qformat,
|
|
|
434 make_int (nargs),
|
|
|
435 !NILP (format_reloc) ? format_reloc :
|
|
|
436 make_string (format_nonreloc, format_length)));
|
|
|
437 }
|
|
|
438 else
|
|
|
439 {
|
|
|
440 args = get_doprnt_args (specs, vargs);
|
|
771
|
441 record_unwind_protect_freeing_dynarr (args);
|
|
428
|
442 }
|
|
|
443
|
|
|
444 for (i = 0; i < Dynarr_length (specs); i++)
|
|
|
445 {
|
|
|
446 struct printf_spec *spec = Dynarr_atp (specs, i);
|
|
|
447 char ch;
|
|
|
448
|
|
|
449 /* Copy the text before */
|
|
|
450 if (!NILP (format_reloc)) /* refetch in case of GC below */
|
|
|
451 format_nonreloc = XSTRING_DATA (format_reloc);
|
|
446
|
452
|
|
771
|
453 doprnt_2 (stream, format_nonreloc + spec->text_before,
|
|
446
|
454 spec->text_before_len, 0, -1, 0, 0);
|
|
428
|
455
|
|
|
456 ch = spec->converter;
|
|
|
457
|
|
|
458 if (!ch)
|
|
|
459 continue;
|
|
|
460
|
|
|
461 if (ch == '%')
|
|
|
462 {
|
|
771
|
463 doprnt_2 (stream, (Intbyte *) &ch, 1, 0, -1, 0, 0);
|
|
428
|
464 continue;
|
|
|
465 }
|
|
|
466
|
|
|
467 /* The char '*' as converter means the field width, precision
|
|
|
468 was specified as an argument. Extract the data and forward
|
|
|
469 it to the next spec, to which it will apply. */
|
|
|
470 if (ch == '*')
|
|
|
471 {
|
|
|
472 struct printf_spec *nextspec = Dynarr_atp (specs, i + 1);
|
|
|
473 Lisp_Object obj = largs[spec->argnum - 1];
|
|
|
474
|
|
|
475 if (INTP (obj))
|
|
|
476 {
|
|
|
477 if (spec->forwarding_precision)
|
|
|
478 {
|
|
|
479 nextspec->precision = XINT (obj);
|
|
|
480 nextspec->minwidth = spec->minwidth;
|
|
|
481 }
|
|
|
482 else
|
|
|
483 {
|
|
|
484 nextspec->minwidth = XINT (obj);
|
|
446
|
485 if (XINT (obj) < 0)
|
|
428
|
486 {
|
|
|
487 spec->minus_flag = 1;
|
|
|
488 nextspec->minwidth = - nextspec->minwidth;
|
|
|
489 }
|
|
|
490 }
|
|
446
|
491 nextspec->minus_flag = spec->minus_flag;
|
|
|
492 nextspec->plus_flag = spec->plus_flag;
|
|
|
493 nextspec->space_flag = spec->space_flag;
|
|
428
|
494 nextspec->number_flag = spec->number_flag;
|
|
446
|
495 nextspec->zero_flag = spec->zero_flag;
|
|
428
|
496 }
|
|
|
497 continue;
|
|
|
498 }
|
|
|
499
|
|
|
500 if (largs && (spec->argnum < 1 || spec->argnum > nargs))
|
|
771
|
501 syntax_error ("Invalid repositioning argument",
|
|
|
502 make_int (spec->argnum));
|
|
428
|
503
|
|
|
504 else if (ch == 'S' || ch == 's')
|
|
|
505 {
|
|
665
|
506 Intbyte *string;
|
|
428
|
507 Bytecount string_len;
|
|
|
508
|
|
|
509 if (!largs)
|
|
|
510 {
|
|
|
511 string = Dynarr_at (args, spec->argnum - 1).bp;
|
|
771
|
512 #if 0
|
|
|
513 /* [[ error() can be called with null string arguments.
|
|
428
|
514 E.g., in fileio.c, the return value of strerror()
|
|
|
515 is never checked. We'll print (null), like some
|
|
|
516 printf implementations do. Would it be better (and safe)
|
|
|
517 to signal an error instead? Or should we just use the
|
|
771
|
518 empty string? -dkindred@cs.cmu.edu 8/1997 ]]
|
|
|
519 Do not hide bugs. --ben
|
|
428
|
520 */
|
|
|
521 if (!string)
|
|
665
|
522 string = (Intbyte *) "(null)";
|
|
771
|
523 #else
|
|
|
524 assert (string);
|
|
|
525 #endif
|
|
428
|
526 string_len = strlen ((char *) string);
|
|
|
527 }
|
|
|
528 else
|
|
|
529 {
|
|
|
530 Lisp_Object obj = largs[spec->argnum - 1];
|
|
440
|
531 Lisp_String *ls;
|
|
428
|
532
|
|
|
533 if (ch == 'S')
|
|
|
534 {
|
|
|
535 /* For `S', prin1 the argument and then treat like
|
|
|
536 a string. */
|
|
|
537 ls = XSTRING (Fprin1_to_string (obj, Qnil));
|
|
|
538 }
|
|
|
539 else if (STRINGP (obj))
|
|
|
540 ls = XSTRING (obj);
|
|
|
541 else if (SYMBOLP (obj))
|
|
|
542 ls = XSYMBOL (obj)->name;
|
|
|
543 else
|
|
|
544 {
|
|
|
545 /* convert to string using princ. */
|
|
|
546 ls = XSTRING (Fprin1_to_string (obj, Qt));
|
|
|
547 }
|
|
|
548 string = string_data (ls);
|
|
|
549 string_len = string_length (ls);
|
|
|
550 }
|
|
|
551
|
|
771
|
552 doprnt_2 (stream, string, string_len, spec->minwidth,
|
|
428
|
553 spec->precision, spec->minus_flag, spec->zero_flag);
|
|
|
554 }
|
|
|
555
|
|
|
556 else
|
|
|
557 {
|
|
|
558 /* Must be a number. */
|
|
|
559 union printf_arg arg;
|
|
|
560
|
|
|
561 if (!largs)
|
|
|
562 {
|
|
|
563 arg = Dynarr_at (args, spec->argnum - 1);
|
|
|
564 }
|
|
|
565 else
|
|
|
566 {
|
|
|
567 Lisp_Object obj = largs[spec->argnum - 1];
|
|
|
568 if (CHARP (obj))
|
|
|
569 obj = make_int (XCHAR (obj));
|
|
|
570 if (!INT_OR_FLOATP (obj))
|
|
|
571 {
|
|
563
|
572 syntax_error ("format specifier %%%c doesn't match argument type",
|
|
568
|
573 make_char (ch));
|
|
428
|
574 }
|
|
|
575 else if (strchr (double_converters, ch))
|
|
|
576 arg.d = XFLOATINT (obj);
|
|
|
577 else
|
|
|
578 {
|
|
446
|
579 if (FLOATP (obj))
|
|
|
580 obj = Ftruncate (obj);
|
|
428
|
581
|
|
|
582 if (strchr (unsigned_int_converters, ch))
|
|
446
|
583 arg.ul = (unsigned long) XINT (obj);
|
|
428
|
584 else
|
|
446
|
585 arg.l = XINT (obj);
|
|
428
|
586 }
|
|
|
587 }
|
|
|
588
|
|
|
589
|
|
|
590 if (ch == 'c')
|
|
|
591 {
|
|
|
592 Emchar a;
|
|
|
593 Bytecount charlen;
|
|
665
|
594 Intbyte charbuf[MAX_EMCHAR_LEN];
|
|
428
|
595
|
|
446
|
596 a = (Emchar) arg.l;
|
|
428
|
597
|
|
|
598 if (!valid_char_p (a))
|
|
568
|
599 syntax_error ("invalid character value %d to %%c spec", make_char (a));
|
|
428
|
600
|
|
|
601 charlen = set_charptr_emchar (charbuf, a);
|
|
771
|
602 doprnt_2 (stream, charbuf, charlen, spec->minwidth,
|
|
428
|
603 -1, spec->minus_flag, spec->zero_flag);
|
|
|
604 }
|
|
|
605 else
|
|
|
606 {
|
|
448
|
607 /* ASCII Decimal representation uses 2.4 times as many
|
|
|
608 bits as machine binary. */
|
|
|
609 char *text_to_print =
|
|
|
610 alloca_array (char, 32 +
|
|
|
611 max (spec->minwidth,
|
|
647
|
612 (int) max (sizeof (double),
|
|
|
613 sizeof (long)) * 3 +
|
|
448
|
614 max (spec->precision, 0)));
|
|
428
|
615 char constructed_spec[100];
|
|
446
|
616 char *p = constructed_spec;
|
|
428
|
617
|
|
448
|
618 /* Mostly reconstruct the spec and use sprintf() to
|
|
428
|
619 format the string. */
|
|
|
620
|
|
446
|
621 *p++ = '%';
|
|
|
622 if (spec->plus_flag) *p++ = '+';
|
|
|
623 if (spec->space_flag) *p++ = ' ';
|
|
|
624 if (spec->number_flag) *p++ = '#';
|
|
448
|
625 if (spec->minus_flag) *p++ = '-';
|
|
|
626 if (spec->zero_flag) *p++ = '0';
|
|
446
|
627
|
|
448
|
628 if (spec->minwidth >= 0)
|
|
577
|
629 {
|
|
|
630 long_to_string (p, spec->minwidth);
|
|
|
631 p += strlen (p);
|
|
|
632 }
|
|
448
|
633 if (spec->precision >= 0)
|
|
428
|
634 {
|
|
446
|
635 *p++ = '.';
|
|
577
|
636 long_to_string (p, spec->precision);
|
|
|
637 p += strlen (p);
|
|
428
|
638 }
|
|
448
|
639
|
|
428
|
640 if (strchr (double_converters, ch))
|
|
442
|
641 {
|
|
446
|
642 *p++ = ch;
|
|
|
643 *p++ = '\0';
|
|
442
|
644 sprintf (text_to_print, constructed_spec, arg.d);
|
|
|
645 }
|
|
428
|
646 else
|
|
|
647 {
|
|
448
|
648 *p++ = 'l'; /* Always use longs with sprintf() */
|
|
|
649 *p++ = ch;
|
|
|
650 *p++ = '\0';
|
|
446
|
651
|
|
|
652 if (strchr (unsigned_int_converters, ch))
|
|
|
653 sprintf (text_to_print, constructed_spec, arg.ul);
|
|
|
654 else
|
|
428
|
655 sprintf (text_to_print, constructed_spec, arg.l);
|
|
|
656 }
|
|
|
657
|
|
771
|
658 doprnt_2 (stream, (Intbyte *) text_to_print,
|
|
448
|
659 strlen (text_to_print), 0, -1, 0, 0);
|
|
428
|
660 }
|
|
|
661 }
|
|
|
662 }
|
|
|
663
|
|
771
|
664 unbind_to (count);
|
|
428
|
665 return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count;
|
|
|
666 }
|
|
|
667
|
|
771
|
668 /* Basic external entry point into string formatting. See
|
|
|
669 emacs_doprnt_1().
|
|
|
670 */
|
|
|
671
|
|
|
672 Bytecount
|
|
|
673 emacs_doprnt_va (Lisp_Object stream, const Intbyte *format_nonreloc,
|
|
|
674 Bytecount format_length, Lisp_Object format_reloc,
|
|
|
675 va_list vargs)
|
|
|
676 {
|
|
|
677 return emacs_doprnt_1 (stream, format_nonreloc, format_length,
|
|
|
678 format_reloc, 0, 0, vargs);
|
|
|
679 }
|
|
|
680
|
|
|
681 /* Basic external entry point into string formatting. See
|
|
|
682 emacs_doprnt_1().
|
|
|
683 */
|
|
|
684
|
|
|
685 Bytecount
|
|
|
686 emacs_doprnt (Lisp_Object stream, const Intbyte *format_nonreloc,
|
|
|
687 Bytecount format_length, Lisp_Object format_reloc,
|
|
|
688 int nargs, const Lisp_Object *largs, ...)
|
|
428
|
689 {
|
|
|
690 va_list vargs;
|
|
|
691 Bytecount val;
|
|
|
692 va_start (vargs, largs);
|
|
771
|
693 val = emacs_doprnt_1 (stream, format_nonreloc, format_length,
|
|
|
694 format_reloc, nargs, largs, vargs);
|
|
428
|
695 va_end (vargs);
|
|
|
696 return val;
|
|
|
697 }
|
|
|
698
|
|
771
|
699 /* Similar to `format' in that its arguments are Lisp objects rather than C
|
|
|
700 objects. (For the versions that take C objects, see the
|
|
|
701 emacs_[v]sprintf... functions below.) Accepts the format string as
|
|
|
702 either a C string (FORMAT_NONRELOC, which *MUST NOT* come from Lisp
|
|
|
703 string data, unless GC is inhibited) or a Lisp string (FORMAT_RELOC).
|
|
|
704 Return resulting formatted string as a Lisp string.
|
|
428
|
705
|
|
771
|
706 All arguments are GCPRO'd, including FORMAT_RELOC; this makes it OK to
|
|
|
707 pass newly created objects into this function (as often happens).
|
|
428
|
708
|
|
771
|
709 #### It shouldn't be necessary to specify the number of arguments.
|
|
|
710 This would require some rewriting of the doprnt() functions, though.
|
|
|
711 */
|
|
428
|
712
|
|
|
713 Lisp_Object
|
|
771
|
714 emacs_vsprintf_string_lisp (const CIntbyte *format_nonreloc,
|
|
|
715 Lisp_Object format_reloc, int nargs,
|
|
|
716 const Lisp_Object *largs)
|
|
428
|
717 {
|
|
771
|
718 Lisp_Object stream;
|
|
428
|
719 Lisp_Object obj;
|
|
771
|
720 struct gcpro gcpro1, gcpro2;
|
|
|
721 GCPRO2 (largs[0], format_reloc);
|
|
|
722 gcpro1.nvars = nargs;
|
|
428
|
723
|
|
771
|
724 stream = make_resizing_buffer_output_stream ();
|
|
|
725 emacs_doprnt (stream, (Intbyte *) format_nonreloc, format_nonreloc ?
|
|
|
726 strlen (format_nonreloc) : 0,
|
|
|
727 format_reloc, nargs, largs);
|
|
428
|
728 Lstream_flush (XLSTREAM (stream));
|
|
|
729 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
|
|
|
730 Lstream_byte_count (XLSTREAM (stream)));
|
|
771
|
731 Lstream_delete (XLSTREAM (stream));
|
|
428
|
732 UNGCPRO;
|
|
|
733 return obj;
|
|
|
734 }
|
|
|
735
|
|
771
|
736 /* Like emacs_vsprintf_string_lisp() but accepts its extra args directly
|
|
|
737 (using variable arguments), rather than as an array. */
|
|
|
738
|
|
428
|
739 Lisp_Object
|
|
771
|
740 emacs_sprintf_string_lisp (const CIntbyte *format_nonreloc,
|
|
|
741 Lisp_Object format_reloc, int nargs, ...)
|
|
428
|
742 {
|
|
771
|
743 Lisp_Object *args = alloca_array (Lisp_Object, nargs);
|
|
|
744 va_list va;
|
|
|
745 int i;
|
|
428
|
746 Lisp_Object obj;
|
|
|
747
|
|
771
|
748 va_start (va, nargs);
|
|
|
749 for (i = 0; i < nargs; i++)
|
|
|
750 args[i] = va_arg (va, Lisp_Object);
|
|
|
751 va_end (va);
|
|
|
752 obj = emacs_vsprintf_string_lisp (format_nonreloc, format_reloc, nargs,
|
|
|
753 args);
|
|
428
|
754 return obj;
|
|
|
755 }
|
|
|
756
|
|
771
|
757 /* Like emacs_vsprintf_string_lisp() but returns a malloc()ed memory block.
|
|
|
758 Return length out through LEN_OUT, if not null. */
|
|
|
759
|
|
|
760 Intbyte *
|
|
|
761 emacs_vsprintf_malloc_lisp (const CIntbyte *format_nonreloc,
|
|
|
762 Lisp_Object format_reloc, int nargs,
|
|
|
763 const Lisp_Object *largs, Bytecount *len_out)
|
|
|
764 {
|
|
|
765 Lisp_Object stream;
|
|
|
766 Intbyte *retval;
|
|
|
767 Bytecount len;
|
|
|
768 struct gcpro gcpro1, gcpro2;
|
|
|
769
|
|
|
770 GCPRO2 (largs[0], format_reloc);
|
|
|
771 gcpro1.nvars = nargs;
|
|
|
772
|
|
|
773 stream = make_resizing_buffer_output_stream ();
|
|
|
774 emacs_doprnt (stream, (Intbyte *) format_nonreloc, format_nonreloc ?
|
|
|
775 strlen (format_nonreloc) : 0,
|
|
|
776 format_reloc, nargs, largs);
|
|
|
777 Lstream_flush (XLSTREAM (stream));
|
|
|
778 len = Lstream_byte_count (XLSTREAM (stream));
|
|
|
779 retval = (Intbyte *) xmalloc (len + 1);
|
|
|
780 memcpy (retval, resizing_buffer_stream_ptr (XLSTREAM (stream)), len);
|
|
|
781 retval[len] = '\0';
|
|
|
782 Lstream_delete (XLSTREAM (stream));
|
|
|
783
|
|
|
784 if (len_out)
|
|
|
785 *len_out = len;
|
|
|
786 UNGCPRO;
|
|
|
787 return retval;
|
|
|
788 }
|
|
|
789
|
|
|
790 /* Like emacs_sprintf_string_lisp() but returns a malloc()ed memory block.
|
|
|
791 Return length out through LEN_OUT, if not null. */
|
|
|
792
|
|
|
793 Intbyte *
|
|
|
794 emacs_sprintf_malloc_lisp (Bytecount *len_out, const CIntbyte *format_nonreloc,
|
|
|
795 Lisp_Object format_reloc, int nargs, ...)
|
|
|
796 {
|
|
|
797 Lisp_Object *args = alloca_array (Lisp_Object, nargs);
|
|
|
798 va_list va;
|
|
|
799 int i;
|
|
|
800 Intbyte *retval;
|
|
|
801
|
|
|
802 va_start (va, nargs);
|
|
|
803 for (i = 0; i < nargs; i++)
|
|
|
804 args[i] = va_arg (va, Lisp_Object);
|
|
|
805 va_end (va);
|
|
|
806 retval = emacs_vsprintf_malloc_lisp (format_nonreloc, format_reloc, nargs,
|
|
|
807 args, len_out);
|
|
|
808 return retval;
|
|
|
809 }
|
|
|
810
|
|
|
811 /* vsprintf()-like replacement. Returns a Lisp string. Data
|
|
|
812 from Lisp strings is OK because we explicitly inhibit GC. */
|
|
|
813
|
|
428
|
814 Lisp_Object
|
|
771
|
815 emacs_vsprintf_string (const CIntbyte *format, va_list vargs)
|
|
428
|
816 {
|
|
771
|
817 Lisp_Object stream = make_resizing_buffer_output_stream ();
|
|
428
|
818 Lisp_Object obj;
|
|
771
|
819 int count = begin_gc_forbidden ();
|
|
428
|
820
|
|
771
|
821 emacs_doprnt_va (stream, (Intbyte *) format, strlen (format), Qnil,
|
|
|
822 vargs);
|
|
428
|
823 Lstream_flush (XLSTREAM (stream));
|
|
|
824 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
|
|
|
825 Lstream_byte_count (XLSTREAM (stream)));
|
|
|
826 Lstream_delete (XLSTREAM (stream));
|
|
771
|
827 end_gc_forbidden (count);
|
|
428
|
828 return obj;
|
|
|
829 }
|
|
|
830
|
|
771
|
831 /* sprintf()-like replacement. Returns a Lisp string. Data
|
|
|
832 from Lisp strings is OK because we explicitly inhibit GC. */
|
|
|
833
|
|
428
|
834 Lisp_Object
|
|
771
|
835 emacs_sprintf_string (const CIntbyte *format, ...)
|
|
|
836 {
|
|
|
837 va_list vargs;
|
|
|
838 Lisp_Object retval;
|
|
|
839
|
|
|
840 va_start (vargs, format);
|
|
|
841 retval = emacs_vsprintf_string (format, vargs);
|
|
|
842 va_end (vargs);
|
|
|
843 return retval;
|
|
|
844 }
|
|
|
845
|
|
|
846 /* vsprintf()-like replacement. Returns a malloc()ed memory block. Data
|
|
|
847 from Lisp strings is OK because we explicitly inhibit GC. Return
|
|
|
848 length out through LEN_OUT, if not null. */
|
|
|
849
|
|
|
850 Intbyte *
|
|
|
851 emacs_vsprintf_malloc (const CIntbyte *format, va_list vargs,
|
|
|
852 Bytecount *len_out)
|
|
428
|
853 {
|
|
771
|
854 int count = begin_gc_forbidden ();
|
|
428
|
855 Lisp_Object stream = make_resizing_buffer_output_stream ();
|
|
771
|
856 Intbyte *retval;
|
|
|
857 Bytecount len;
|
|
|
858
|
|
|
859 emacs_doprnt_va (stream, (Intbyte *) format, strlen (format), Qnil,
|
|
|
860 vargs);
|
|
|
861 Lstream_flush (XLSTREAM (stream));
|
|
|
862 len = Lstream_byte_count (XLSTREAM (stream));
|
|
|
863 retval = (Intbyte *) xmalloc (len + 1);
|
|
|
864 memcpy (retval, resizing_buffer_stream_ptr (XLSTREAM (stream)), len);
|
|
|
865 retval[len] = '\0';
|
|
|
866 end_gc_forbidden (count);
|
|
|
867 Lstream_delete (XLSTREAM (stream));
|
|
|
868
|
|
|
869 if (len_out)
|
|
|
870 *len_out = len;
|
|
|
871 return retval;
|
|
|
872 }
|
|
|
873
|
|
|
874 /* sprintf()-like replacement. Returns a malloc()ed memory block. Data
|
|
|
875 from Lisp strings is OK because we explicitly inhibit GC. Return length
|
|
|
876 out through LEN_OUT, if not null. */
|
|
428
|
877
|
|
771
|
878 Intbyte *
|
|
|
879 emacs_sprintf_malloc (Bytecount *len_out, const CIntbyte *format, ...)
|
|
|
880 {
|
|
|
881 va_list vargs;
|
|
|
882 Intbyte *retval;
|
|
|
883
|
|
|
884 va_start (vargs, format);
|
|
|
885 retval = emacs_vsprintf_malloc (format, vargs, len_out);
|
|
428
|
886 va_end (vargs);
|
|
771
|
887 return retval;
|
|
|
888 }
|
|
|
889
|
|
|
890 /* vsprintf() replacement. Writes output into OUTPUT, which better
|
|
|
891 have enough space for the output. Data from Lisp strings is OK
|
|
|
892 because we explicitly inhibit GC. */
|
|
|
893
|
|
|
894 Bytecount
|
|
|
895 emacs_vsprintf (Intbyte *output, const CIntbyte *format, va_list vargs)
|
|
|
896 {
|
|
|
897 Bytecount retval;
|
|
|
898 int count = begin_gc_forbidden ();
|
|
|
899 Lisp_Object stream = make_resizing_buffer_output_stream ();
|
|
|
900 Bytecount len;
|
|
428
|
901
|
|
771
|
902 retval = emacs_doprnt_va (stream, (Intbyte *) format, strlen (format), Qnil,
|
|
|
903 vargs);
|
|
428
|
904 Lstream_flush (XLSTREAM (stream));
|
|
771
|
905 len = Lstream_byte_count (XLSTREAM (stream));
|
|
|
906 memcpy (output, resizing_buffer_stream_ptr (XLSTREAM (stream)), len);
|
|
|
907 output[len] = '\0';
|
|
|
908 end_gc_forbidden (count);
|
|
428
|
909 Lstream_delete (XLSTREAM (stream));
|
|
771
|
910
|
|
|
911 return retval;
|
|
428
|
912 }
|
|
771
|
913
|
|
|
914 /* sprintf() replacement. Writes output into OUTPUT, which better
|
|
|
915 have enough space for the output. Data from Lisp strings is OK
|
|
|
916 because we explicitly inhibit GC. */
|
|
|
917
|
|
|
918 Bytecount
|
|
|
919 emacs_sprintf (Intbyte *output, const CIntbyte *format, ...)
|
|
|
920 {
|
|
|
921 va_list vargs;
|
|
|
922 Bytecount retval;
|
|
|
923
|
|
|
924 va_start (vargs, format);
|
|
|
925 retval = emacs_vsprintf (output, format, vargs);
|
|
|
926 va_end (vargs);
|
|
|
927 return retval;
|
|
|
928 }
|
