LISP laccess_problem(LISP lfname,LISP lacc)
{char *fname = get_c_string(lfname);
char *acc = get_c_string(lacc),*p;
int amode = 0,iflag = no_interrupt(1),retval;
for(p=acc;*p;++p)
switch(*p)
{case 'r':
amode |= R_OK;
break;
case 'w':
amode |= W_OK;
break;
case 'x':
amode |= X_OK;
break;
case 'f':
amode |= F_OK;
break;
default:
err("bad access mode",lacc);}
retval = access(fname,amode);
no_interrupt(iflag);
if (retval < 0)
return(llast_c_errmsg(-1));
else
return(NIL);}
LISP llink(LISP p1,LISP p2)
{long iflag;
iflag = no_interrupt(1);
if (link(get_c_string(p1),get_c_string(p2)))
return(err("link",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(NIL);}
LISP lrename(LISP p1,LISP p2)
{long iflag;
iflag = no_interrupt(1);
if (rename(get_c_string(p1),get_c_string(p2)))
return(err("rename",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(NIL);}
static LISP lregister_converter(LISP fmt, LISP lext, LISP lcmd,
LISP sext, LISP scmd)
{
register_converter(get_c_string(fmt),
NULLP(lext)?NULL:get_c_string(lext),
NULLP(lcmd)?NULL:get_c_string(lcmd),
NULLP(sext)?NULL:get_c_string(sext),
NULLP(scmd)?NULL:get_c_string(scmd));
return NIL;
}
LISP lexec(LISP path,LISP args,LISP env)
{int iflag;
char **argv = NULL, **envp = NULL;
LISP gcsafe=NIL;
iflag = no_interrupt(1);
argv = list2char(&gcsafe,args);
if NNULLP(env)
envp = list2char(&gcsafe,env);
if (envp)
execve(get_c_string(path),argv,envp);
else
execv(get_c_string(path),argv);
no_interrupt(iflag);
return(err("exec",llast_c_errmsg(-1)));}
LISP lmkdir(LISP p,LISP m)
{long iflag;
iflag = no_interrupt(1);
if (mkdir(get_c_string(p),get_c_long(m)))
return(err("mkdir",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(NIL);}
LISP lrmdir(LISP p)
{long iflag;
iflag = no_interrupt(1);
if (rmdir(get_c_string(p)))
return(err("rmdir",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(NIL);}
LISP lunlink(LISP p)
{long iflag;
iflag = no_interrupt(1);
if (unlink(get_c_string(p)))
return(err("unlink",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(NIL);}
static LISP lput_property(LISP bname, LISP key, LISP value)
{
buffer *b;
char *retval;
if (NULLP(bname)) b = buffer_of_window(w_list);
else b = find_buffer_by_name(get_c_string(bname));
if (!b) {
llpr("No such buffer");
return NIL;
}
retval = put_property(b, get_c_string(key), get_c_string(value));
if (retval) return strcons(strlen(retval), retval);
return NIL;
}
static lref_t find_package(lref_t name)
{
_TCHAR *n = get_c_string(name);
for (lref_t l = interp.fasl_package_list; CONSP(l); l = CDR(l))
{
lref_t p = CAR(l);
if (!PACKAGEP(p))
panic("damaged package list");
if (_tcscmp(n, get_c_string(p->as.package.name)) == 0)
return p;
}
return boolcons(false);
}
LISP lgetpwnam(LISP nam)
{int iflag;
struct passwd *p;
LISP result = NIL;
iflag = no_interrupt(1);
if ((p = getpwnam(get_c_string(nam))))
result = ldecode_pwent(p);
no_interrupt(iflag);
return(result);}
LISP lreadlink(LISP p)
{long iflag;
char buff[PATH_MAX+1];
int size;
iflag = no_interrupt(1);
if ((size = readlink(get_c_string(p),buff,sizeof(buff))) < 0)
return(err("readlink",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(strcons(size,buff));}
LISP lsystem(LISP args)
{int retval;
long iflag;
iflag = no_interrupt(1);
retval = system(get_c_string(string_append(args)));
no_interrupt(iflag);
if (retval < 0)
return(cons(flocons(retval),llast_c_errmsg(-1)));
else
return(flocons(retval));}
void
dbjie_set_errpfx(DB_ENV_JAVAINFO *dbjie, JNIEnv *jnienv, jstring errpfx)
{
if (dbjie->errpfx_ != NULL)
free(dbjie->errpfx_);
if (errpfx)
dbjie->errpfx_ = get_c_string(jnienv, errpfx);
else
dbjie->errpfx_ = NULL;
}
LISP lputenv(LISP lstr)
{char *orig,*cpy;
orig = get_c_string(lstr);
/* unix putenv keeps a pointer to the string we pass,
therefore we must make a fresh copy, which is memory leaky. */
cpy = (char *) must_malloc(strlen(orig)+1);
strcpy(cpy,orig);
if (putenv(cpy))
return(err("putenv",llast_c_errmsg(-1)));
else
return(NIL);}
static LISP ani_property(LISP name, LISP value)
{
buffer *b = w_list->buf;
MwAniScript *lasts = w_list->script;
MwAniObject *lasto = w_list->object;
int n = get_c_long(name);
if (!lasts) err("Last script is NULL", NIL);
if (FLONUMP(value)) {
int lv = get_c_long(value);
switch (n) {
case MW_ANI_X:
lasts->x = lv;
break;
case MW_ANI_Y:
lasts->y = lv;
break;
case MW_ANI_WIDTH:
lasts->width = lv;
break;
case MW_ANI_HEIGHT:
lasts->height = lv;
break;
case MW_ANI_VISIBLE:
lasts->visible = lv;
break;
case MW_ANI_FORMAT:
lasto->fmt = lv;
break;
default:
err("No such property", name);
}
} else {
char *tv = get_c_string(value);
switch (n) {
case MW_ANI_TEXT:
lasto->string = MwStrdup(tv);
break;
default:
err("No such property", name);
}
}
b->change = TRUE;
pr_scr_flag = TRUE;
return NIL;
}
static LISP get_type(LISP bname, LISP row, LISP col)
{
buffer *buf;
int s, t, r, c;
if (NULLP (bname)) {
buf = buffer_of_window(w_list);
s = w_list->sht;
} else {
buf = find_sheet_by_name(get_c_string(bname),
w_list->buf, &s);
}
r = get_c_long(row);
c = get_c_long(col);
t = ret_type(buf, s, r, c);
return flocons(t);
}
LISP lcrypt(LISP key,LISP salt)
{char *result;
if ((result = crypt(get_c_string(key),get_c_string(salt))))
return(strcons(strlen(result),result));
else
return(NIL);}
#include <stdio.h>
#include "siod.h"
static LISP
frob(LISP arg)
{
printf("frob called: ");
if FLONUMP(arg)
printf("%d\n", (int)FLONM(arg));
else
printf("`%s'\n", get_c_string(arg));
return NIL;
}
const char *code = \
"(define foo "
" (lambda (n) "
" (cond ((> n 0) (begin (foo (- n 1)) (frob n)))))) "
"(foo 10) "
"(frob 'howdy) ";
int
main(int argc, char **argv)
{
static char *sargv[4];
static char buf[1024];
int rv;
sargv[0] = argv[0];
static char *strfield(char *name,LISP alist)
{LISP value,key = rintern(name);
if NULLP(value = assq(key,alist))
return("");
return(get_c_string(cdr(value)));}
static LISP lexec_expr(LISP intp, LISP expr)
{
exec_expr(name2interpreter(get_c_string(intp)), get_c_string(expr));
return NIL;
}
} else {
siag_type = ERROR;
siag_result.number = 0, errorflag = 1;
}
}
#define BREAKCHARS "() \t\r\n"
#define TEMPLATE "(get-cell %ld %ld)"
#define RANGE "'RANGE %ld %ld %ld %ld"
static LISP get_xref(LISP bname, LISP cell)
{
char new[1000];
char *old = get_c_string(cell);
long row, col;
buffer *buf;
if (NULLP(bname)) buf = buffer_of_window(w_list);
else buf = find_buffer_by_name(get_c_string(bname));
ref_expander(buf, old, new, BREAKCHARS, "%ld %ld", RANGE);
sscanf(new, "%ld %ld", &row, &col);
return x_get_cell(flocons(row), flocons(col), bname);
}
/* ---
expand Visicalc references
*/
static char *expand_references(buffer *buf, char *orig)
{
LISP lsetpwfile(LISP fname)
{int iflag = no_interrupt(1);
setpwfile(get_c_string(fname));
no_interrupt(iflag);
return(NIL);}
LISP lstatfs(LISP path)
{long iflag;
struct statfs s;
iflag = no_interrupt(1);
if (statfs(get_c_string(path),&s,sizeof(s)))
return(err("statfs",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(symalist("type",(((s.f_type >= 0) && (s.f_type < MNT_NUMTYPES) &&
mnt_names[s.f_type])
? rintern(mnt_names[s.f_type])
: flocons(s.f_type)),
"bsize",flocons(s.f_bsize),
"blocks",flocons(s.f_blocks),
"bfree",flocons(s.f_bfree),
"bavail",flocons(s.f_bavail),
"files",flocons(s.f_files),
"ffree",flocons(s.f_ffree),
"mntonname",strcons(-1,s.f_mntonname),
"mntfromname",strcons(-1,s.f_mntfromname),
NULL));}
