46#include "EST_cutils.h"
50static int format_string(
LISP fd,
const char *
formatstr,
const char *str);
53static int format_float(
LISP fd,
const char *
formatstr,
float f);
54static int format_double(
LISP fd,
const char *
formatstr,
double d);
55static int format_char(
LISP fd,
char c);
56static int get_field_width(
const char *
directive);
57static char *get_directive(
const char *
fstr);
58static char directive_type(
const char *
fstr);
59static void output_string(
LISP fd,
const char *str);
76 err(
"format: wrong number of args for format string",NIL);
117 format_char(
lfd,(
char)get_c_int(car(a)));
123 cerr <<
"SIOD format: unsupported format directive %"
130 return strintern(outstring);
135static int format_string(
LISP fd,
const char *
formatstr,
const char *str)
143 if (width > (
signed)
strlen(str))
144 buff = walloc(
char,width+10);
150 output_string(fd,
buff);
167 err(
"format: width in %l not supported",NIL);
169 buff = siod_sprint(a);
171 output_string(fd,
buff);
187 buff = walloc(
char,width+10);
189 buff = walloc(
char,20);
193 output_string(fd,
buff);
201static int format_float(
LISP fd,
const char *
formatstr,
float f)
210 buff = walloc(
char,width+10);
212 buff = walloc(
char,20);
216 output_string(fd,
buff);
224static int format_double(
LISP fd,
const char *
formatstr,
double d)
233 buff = walloc(
char,width+10);
235 buff = walloc(
char,30);
239 output_string(fd,
buff);
247static int format_char(
LISP fd,
char c)
255 output_string(fd,
buff);
260static int get_field_width(
const char *
directive)
270 if (
nums.matches(anumber_rx))
272 else if (
nums.contains(
"."))
280 cerr <<
"SIOD format: can't find width in directive "
288static char *get_directive(
const char *
fstr)
293 for (i=0;
fstr[i] !=
'\0'; i++)
294 if ((
fstr[i] >=
'a') &&
298 err(
"format: premature end of format structure",NIL);
299 char *
direct = walloc(
char,i+2);
305static char directive_type(
const char *
fstr)
311 for (i=0;
fstr[i] !=
'\0'; i++)
312 if ((
fstr[i] >=
'a') &&
318 err(
"SIOD format: premature end of format structure",NIL);
323static void output_string(
LISP fd,
const char *str)
327 else if (fd == truth)
329 else if (TYPEP(fd,tc_c_file))
330 fprintf(get_c_file(fd,NULL),
"%s",str);
332 err(
"format: not a file",fd);
352void init_subrs_format()
354 init_lsubr(
"format",l_format,
355 "(format FD FORMATSTRING ARG0 ARG1 ...)\n\
356 Output ARGs to FD using FROMATSTRING. FORMATSTRING is like a printf\n\
357 formatstrng. FD may be a filedescriptor, or t (standard output) or\n\
358 nil (return as a string). Note not all printf format directive are\n\
359 supported. %l is additionally support for Lisp objects.\n\