LispObject *read(char **s) {
//segfaults if input starts with an open paren
while(isspace(**s))
(*s)++;
if(**s == ')')
return NULL;
else if(**s == '(') {
(*s)++;
ConsCell *out = nil;
ConsCell *node = nil;
for(;;) {
LispObject *x = read(s);
if(x == NULL && **s == ')') {
(*s)++;
return (LispObject*)out;
} else if(out == nil) {
out = new_cons_cell(x, (LispObject*)nil);
node = (ConsCell*)out;
} else {
node->cdr = (LispObject*)new_cons_cell(x, (LispObject*)nil);
node = (ConsCell*)node->cdr;
}
}
} else if(**s == '"') {
(*s)++;
Str *out = (Str*)new_str();
while(**s != '"') {
if(**s == '\\') {
(*s)++;
if(**s == 'n') {
str_append(out, '\n');
(*s)++;
} else if(**s == '\\' || **s == '"') {
str_append(out, **s);
(*s)++;
} else if(isdigit(**s)) {
char buf[4];
int i;
int num;
for(i = 0; i < 3 && isdigit(**s); i++) {
buf[i] = **s;
(*s)++;
}
buf[i] = '\0';
sscanf(buf, "%o", &num);
str_append(out, num);
}
} else {
str_append(out, **s);
(*s)++;
}
}
(*s)++;
return (LispObject*)out;
} else {
//can't handle symbols over 32 chars
char x[MAX_SYMBOL_LEN];
int i = 0;
while(!(**s == '\0' || isspace(**s) || **s == '(' || ** s == ')')) {
x[i] = **s;
i++;
(*s)++;
}
x[i] = '\0';
if(isdigit(x[0]))
return (LispObject*)new_lisp_int(atoi(x));
else
return (LispObject*)new_symbol(x);
}
}
void *l_caller(long number, void *arg)
{
p_ref r1(arg);
void *ret=NULL;
switch (number)
{
case 0 :
{ system(lstring_value(eval(CAR(arg)))); } break;
case 1 :
{
void *fn=eval(CAR(arg)); arg=CDR(arg);
p_ref r1(fn);
char *current_dir=lstring_value(eval(CAR(arg)));
char *filename=lstring_value(fn);
char *last=NULL,*s=filename,*dp;
char dir[200],name[200];
while (*s) { if (*s=='\\' || *s=='/') last=s+1; s++; }
if (last)
{
for (dp=dir,s=filename;s!=last;dp++,s++) { *dp=*s; }
*dp=0;
strcpy(name,last);
} else
{
strcpy(dir,current_dir);
strcpy(name,filename);
}
void *cs=(void *)new_cons_cell();
p_ref r24(cs);
((cons_cell *)cs)->car=new_lisp_string(dir);
((cons_cell *)cs)->cdr=new_lisp_string(name);
ret=cs;
} break;
case 2 :
{
void *fn=eval(CAR(arg)); arg=CDR(arg);
p_ref r1(fn);
char *slash=lstring_value(eval(CAR(arg)));
char *filename=lstring_value(fn);
char tmp[200],*s=filename,*tp;
for (tp=tmp;*s;s++,tp++)
{
if (*s=='/' || *s=='\\')
{
*tp=*slash;
// if (*slash=='\\')
// { tp++; *tp='\\'; }
}
else *tp=*s;
}
*tp=0;
ret=new_lisp_string(tmp);
} break;
case 3 :
{
char cd[100];
getcwd(cd,100);
char name_so_far[100];
char *dir=lstring_value(eval(CAR(arg)));
char *d,ch;
d=dir;
int err=0;
while (*d && !err)
{
if ((*d=='\\' || *d=='/') && d!=dir && *(d-1)!=':')
{
ch=*d;
*d=0;
if (!change_dir(dir))
if (make_dir(dir)!=0)
err=1;
*d=ch;
}
d++;
}
change_dir(cd);
if (err)
ret=NULL;
else ret=true_symbol;
} break;
case 4 :
{
char *fn=lstring_value(eval(CAR(arg)));
char *l=NULL,*s=fn;
while (*s) { if (*s=='.') l=s; s++; }
if (l) ret=new_lisp_string(l);
else ret=new_lisp_string("");
} break;
case 5 :
{
void *tit=eval(CAR(arg)); arg=CDR(arg);
p_ref r1(tit);
void *prompt=eval(CAR(arg)); arg=CDR(arg);
p_ref r2(prompt);
void *def=eval(CAR(arg)); arg=CDR(arg);
p_ref r3(def);
return nice_input(lstring_value(tit),lstring_value(prompt),lstring_value(def));
} break;
case 6 :
{
return nice_menu(CAR(arg),CAR(CDR(arg)),CAR(CDR(CDR(arg))));
} break;
case 7 :
{
return show_yes_no(CAR(arg),CAR(CDR(arg)),CAR(CDR(CDR(arg))),CAR(CDR(CDR(CDR(arg)))));
} break;
case 8 :
{
char cd[150];
getcwd(cd,100);
return new_lisp_string(cd);
} break;
case 9 :
{
return new_lisp_string(getenv(lstring_value(eval(CAR(arg)))));
} break;
case 10 :
{
char str[200];
strcpy(str,lstring_value(eval(CAR(arg))));
modify_install_path(str);
return new_lisp_string(str);
} break;
}
return ret;
}
