/* xlopen - open a text or binary file */
LVAL xlopen(int binaryflag)
{
char *name,*mode=NULL;
FILE *fp;
LVAL dir;
/* get the file name and direction */
name = (char *)getstring(xlgetfname());
if (!xlgetkeyarg(k_direction,&dir))
dir = k_input;
/* get the mode */
if (dir == k_input)
mode = "r";
else if (dir == k_output)
mode = "w";
else
xlerror("bad direction",dir);
/* try to open the file */
if (binaryflag) {
fp = osbopen(name,mode);
} else {
fp = osaopen(name,mode);
}
return (fp ? cvfile(fp) : NIL);
}
/* xsave - save the memory image */
LVAL xsave(void)
{
unsigned char *name;
/* get the file name, verbose flag and print flag */
name = getstring(xlgetfname());
xllastarg();
/* save the memory image */
return (xlisave((char *) name) ? s_true : NIL);
}
/* xget_env - get the value of an environment variable */
LVAL xget_env(void)
{
const char *name = (char *) getstring(xlgetfname());
char *val;
/* check for too many arguments */
xllastarg();
/* get the value of the environment variable */
val = getenv(name);
return (val ? cvstring(val) : NULL);
}
/* xtranscript - open or close a transcript file */
LVAL xtranscript(void)
{
unsigned char *name;
/* get the transcript file name */
name = (moreargs() ? getstring(xlgetfname()) : NULL);
xllastarg();
/* close the current transcript */
if (tfp) osclose(tfp);
/* open the new transcript */
tfp = (name ? osaopen((char *) name,"w") : NULL);
/* return T if a transcript is open, NIL otherwise */
return (tfp ? s_true : NIL);
}
/* xrestore - restore a saved memory image */
LVAL xrestore(void)
{
extern jmp_buf top_level;
unsigned char *name;
/* get the file name, verbose flag and print flag */
name = getstring(xlgetfname());
xllastarg();
/* restore the saved memory image */
if (!xlirestore((char *) name))
return (NIL);
/* return directly to the top level */
stdputstr("[ returning to the top level ]\n");
longjmp(top_level,1);
}
LVAL xlistdir(void)
{
const char *path;
LVAL result = NULL;
LVAL *tail;
/* get the path, converting unsigned char * to char * */
path = (char *)getstring(xlgetfname());
/* try to start listing */
if (osdir_list_start(path)) {
const char *filename;
xlsave1(result);
tail = &result;
while ((filename = osdir_list_next())) {
*tail = cons(NIL, NIL);
rplaca(*tail, cvstring(filename));
tail = &cdr(*tail);
}
osdir_list_finish();
xlpop();
}
return result;
}
/* xload - read and evaluate expressions from a file */
LVAL xload(void)
{
unsigned char *name;
int vflag,pflag;
LVAL arg;
/* get the file name */
name = getstring(xlgetfname());
/* get the :verbose flag */
if (xlgetkeyarg(k_verbose,&arg))
vflag = (arg != NIL);
else
vflag = TRUE;
/* get the :print flag */
if (xlgetkeyarg(k_print,&arg))
pflag = (arg != NIL);
else
pflag = FALSE;
/* load the file */
return (xlload((char *) name, vflag, pflag) ? s_true : NIL);
}
