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