46 #include "EST_cutils.h"
50 static int format_string(LISP fd,
const char *formatstr,
const char *str);
51 static int format_lisp(LISP fd,
const char *formatstr, LISP a);
52 static int format_int(LISP fd,
const char *formatstr,
int i);
53 static int format_float(LISP fd,
const char *formatstr,
float f);
54 static int format_double(LISP fd,
const char *formatstr,
double d);
55 static int format_char(LISP fd,
char c);
56 static int get_field_width(
const char *directive);
57 static char *get_directive(
const char *fstr);
58 static char directive_type(
const char *fstr);
59 static void output_string(LISP fd,
const char *str);
60 static int count_arg_places(
const char *formatstring);
65 LISP l_format(LISP args)
69 const char *formatstring = get_c_string(car(cdr(args)));
71 LISP fargs = cdr(cdr(args));
75 if (count_arg_places(formatstring) != siod_llength(fargs))
76 err(
"format: wrong number of args for format string",NIL);
80 for (i=0,a=fargs; formatstring[i] !=
'\0'; i++)
82 if (formatstring[i] !=
'%')
83 format_char(lfd,formatstring[i]);
84 else if (formatstring[i+1] ==
'%')
86 format_char(lfd,formatstring[i]);
89 else if (directive_type(formatstring+i) ==
's')
91 i+= format_string(lfd,formatstring+i,get_c_string(car(a)));
94 else if (directive_type(formatstring+i) ==
'l')
96 i+= format_lisp(lfd,formatstring+i,car(a));
99 else if ((directive_type(formatstring+i) ==
'd') ||
100 (directive_type(formatstring+i) ==
'x'))
102 i += format_int(lfd,formatstring+i,(
int)get_c_int(car(a)));
105 else if (directive_type(formatstring+i) ==
'f')
107 i += format_float(lfd,formatstring+i,(
float)get_c_double(car(a)));
110 else if (directive_type(formatstring+i) ==
'g')
112 i += format_double(lfd,formatstring+i,get_c_double(car(a)));
115 else if (directive_type(formatstring+i) ==
'c')
117 format_char(lfd,(
char)get_c_int(car(a)));
123 cerr <<
"SIOD format: unsupported format directive %"
124 << directive_type(formatstring+i) << endl;
130 return strintern(outstring);
135 static int format_string(LISP fd,
const char *formatstr,
const char *str)
139 char *directive = get_directive(formatstr);
140 int width = get_field_width(directive);
143 if (width > (
signed)strlen(str))
144 buff = walloc(
char,width+10);
146 buff = walloc(
char,strlen(str)+1);
148 sprintf(buff,directive,str);
150 output_string(fd,buff);
151 width = strlen(directive)-1;
158 static int format_lisp(LISP fd,
const char *formatstr, LISP a)
162 char *directive = get_directive(formatstr);
163 int width = get_field_width(directive);
167 err(
"format: width in %l not supported",NIL);
169 buff = siod_sprint(a);
171 output_string(fd,buff);
172 width = strlen(directive)-1;
178 static int format_int(LISP fd,
const char *formatstr,
int i)
182 char *directive = get_directive(formatstr);
183 int width = get_field_width(directive);
187 buff = walloc(
char,width+10);
189 buff = walloc(
char,20);
191 sprintf(buff,directive,i);
193 output_string(fd,buff);
194 width = strlen(directive)-1;
201 static int format_float(LISP fd,
const char *formatstr,
float f)
205 char *directive = get_directive(formatstr);
206 int width = get_field_width(directive);
210 buff = walloc(
char,width+10);
212 buff = walloc(
char,20);
214 sprintf(buff,directive,f);
216 output_string(fd,buff);
217 width = strlen(directive)-1;
224 static int format_double(LISP fd,
const char *formatstr,
double d)
228 char *directive = get_directive(formatstr);
229 int width = get_field_width(directive);
233 buff = walloc(
char,width+10);
235 buff = walloc(
char,30);
237 sprintf(buff,directive,d);
239 output_string(fd,buff);
240 width = strlen(directive)-1;
247 static int format_char(LISP fd,
char c)
253 sprintf(buff,
"%c",c);
255 output_string(fd,buff);
260 static int get_field_width(
const char *directive)
264 if (strlen(directive) == 2)
269 nums = nums.
at(1,strlen(directive)-2);
276 return atoi(n1) + atoi(n2);
280 cerr <<
"SIOD format: can't find width in directive "
281 << directive << endl;
288 static 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);
300 memmove(direct,fstr,i+1);
305 static 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);
323 static void output_string(LISP fd,
const char *str)
327 else if (fd == truth)
328 fprintf(stdout,
"%s",str);
329 else if (TYPEP(fd,tc_c_file))
330 fprintf(get_c_file(fd,NULL),
"%s",str);
332 err(
"format: not a file",fd);
335 static int count_arg_places(
const char *formatstring)
340 for (c=i=0; formatstring[i] !=
'\0'; i++)
341 if (formatstring[i] ==
'%')
343 if (formatstring[i+1] ==
'%')
352 void 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\