PIKApp/plug-ins/script-fu/libscriptfu/ftx/ftx.c

416 lines
11 KiB
C

/* TinyScheme Extensions
* (c) 2002 Visual Tools, S.A.
* Manuel Heras-Gilsanz (manuel@heras-gilsanz.com)
*
* This software is subject to the terms stated in the
* LICENSE file.
*/
#include "config.h"
#include <sys/types.h>
#include <sys/stat.h>
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <time.h>
#include <glib.h>
#include "tinyscheme/scheme-private.h"
#undef cons
typedef enum
{
FILE_TYPE_UNKNOWN = 0, FILE_TYPE_FILE, FILE_TYPE_DIR, FILE_TYPE_LINK
} FileType;
struct
named_constant {
const char *name;
FileType value;
};
struct named_constant
file_type_constants[] = {
{ "FILE-TYPE-UNKNOWN", FILE_TYPE_UNKNOWN },
{ "FILE-TYPE-FILE", FILE_TYPE_FILE },
{ "FILE-TYPE-DIR", FILE_TYPE_DIR },
{ "FILE-TYPE-LINK", FILE_TYPE_LINK },
{ NULL, 0 }
};
pointer foreign_fileexists(scheme *sc, pointer args);
pointer foreign_filetype(scheme *sc, pointer args);
pointer foreign_filesize(scheme *sc, pointer args);
pointer foreign_filedelete(scheme *sc, pointer args);
pointer foreign_diropenstream(scheme *sc, pointer args);
pointer foreign_dirreadentry(scheme *sc, pointer args);
pointer foreign_dirrewind(scheme *sc, pointer args);
pointer foreign_dirclosestream(scheme *sc, pointer args);
pointer foreign_mkdir(scheme *sc, pointer args);
pointer foreign_getenv(scheme *sc, pointer args);
pointer foreign_time(scheme *sc, pointer args);
pointer foreign_gettimeofday(scheme *sc, pointer args);
pointer foreign_usleep(scheme *sc, pointer args);
void init_ftx (scheme *sc);
pointer foreign_fileexists(scheme *sc, pointer args)
{
pointer first_arg;
char *filename;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_string(first_arg))
return sc->F;
filename = sc->vptr->string_value(first_arg);
filename = g_filename_from_utf8 (filename, -1, NULL, NULL, NULL);
if (g_file_test(filename, G_FILE_TEST_EXISTS))
return sc->T;
return sc->F;
}
pointer foreign_filetype(scheme *sc, pointer args)
{
pointer first_arg;
char *filename;
int retcode;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_string(first_arg))
return sc->F;
filename = sc->vptr->string_value(first_arg);
filename = g_filename_from_utf8 (filename, -1, NULL, NULL, NULL);
if (g_file_test(filename, G_FILE_TEST_IS_SYMLINK))
retcode = FILE_TYPE_LINK;
else if (g_file_test(filename, G_FILE_TEST_IS_REGULAR))
retcode = FILE_TYPE_FILE;
else if (g_file_test(filename, G_FILE_TEST_IS_DIR))
retcode = FILE_TYPE_DIR;
else
retcode = FILE_TYPE_UNKNOWN;
return sc->vptr->mk_integer(sc, retcode);
}
pointer foreign_filesize(scheme *sc, pointer args)
{
pointer first_arg;
pointer ret;
struct stat buf;
char * filename;
int retcode;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_string(first_arg))
return sc->F;
filename = sc->vptr->string_value(first_arg);
filename = g_filename_from_utf8 (filename, -1, NULL, NULL, NULL);
retcode = stat(filename, &buf);
if (retcode == 0)
ret = sc->vptr->mk_integer(sc,buf.st_size);
else
ret = sc->F;
return ret;
}
pointer foreign_filedelete(scheme *sc, pointer args)
{
pointer first_arg;
pointer ret;
char * filename;
int retcode;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_string(first_arg)) {
return sc->F;
}
filename = sc->vptr->string_value(first_arg);
filename = g_filename_from_utf8 (filename, -1, NULL, NULL, NULL);
retcode = unlink(filename);
if (retcode == 0)
ret = sc->T;
else
ret = sc->F;
return ret;
}
pointer foreign_diropenstream(scheme *sc, pointer args)
{
pointer first_arg;
char *dirpath;
GDir *dir;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_string(first_arg))
return sc->F;
dirpath = sc->vptr->string_value(first_arg);
dirpath = g_filename_from_utf8 (dirpath, -1, NULL, NULL, NULL);
dir = g_dir_open(dirpath, 0, NULL);
if (dir == NULL)
return sc->F;
/* Stuffing a pointer in a long may not always be portable ~~~~~ */
return (sc->vptr->mk_integer(sc, (long) dir));
}
pointer foreign_dirreadentry(scheme *sc, pointer args)
{
pointer first_arg;
GDir *dir;
gchar *entry;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_integer(first_arg))
return sc->F;
dir = (GDir *) sc->vptr->ivalue(first_arg);
if (dir == NULL)
return sc->F;
entry = (gchar *)g_dir_read_name(dir);
if (entry == NULL)
return sc->EOF_OBJ;
entry = g_filename_to_utf8 (entry, -1, NULL, NULL, NULL);
return (sc->vptr->mk_string(sc, entry));
}
pointer foreign_dirrewind(scheme *sc, pointer args)
{
pointer first_arg;
GDir *dir;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_integer(first_arg))
return sc->F;
dir = (GDir *) sc->vptr->ivalue(first_arg);
if (dir == NULL)
return sc->F;
g_dir_rewind(dir);
return sc->T;
}
pointer foreign_dirclosestream(scheme *sc, pointer args)
{
pointer first_arg;
GDir *dir;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_integer(first_arg))
return sc->F;
dir = (GDir *) sc->vptr->ivalue(first_arg);
if (dir == NULL)
return sc->F;
g_dir_close(dir);
return sc->T;
}
pointer foreign_mkdir(scheme *sc, pointer args)
{
pointer first_arg;
pointer rest;
pointer second_arg;
char *dirname;
mode_t mode;
int retcode;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_string(first_arg))
return sc->F;
dirname = sc->vptr->string_value(first_arg);
dirname = g_filename_from_utf8 (dirname, -1, NULL, NULL, NULL);
rest = sc->vptr->pair_cdr(args);
if (sc->vptr->is_pair(rest)) /* optional mode argument */
{
second_arg = sc->vptr->pair_car(rest);
if (!sc->vptr->is_integer(second_arg))
return sc->F;
mode = sc->vptr->ivalue(second_arg);
}
else
mode = 0777;
retcode = g_mkdir(dirname, (mode_t)mode);
if (retcode == 0)
return sc->T;
else
return sc->F;
}
pointer foreign_getenv(scheme *sc, pointer args)
{
pointer first_arg;
pointer ret;
char *varname;
const char *value;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_string(first_arg))
return sc->F;
varname = sc->vptr->string_value(first_arg);
value = g_getenv(varname);
if (value == NULL)
ret = sc->F;
else
ret = sc->vptr->mk_string(sc,value);
return ret;
}
pointer foreign_time(scheme *sc, pointer args)
{
time_t now;
struct tm *now_tm;
pointer ret;
if (args != sc->NIL)
return sc->F;
time(&now);
now_tm = localtime(&now);
ret = sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_year),
sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_mon),
sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_mday),
sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_hour),
sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_min),
sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_sec),sc->NIL))))));
return ret;
}
pointer foreign_gettimeofday(scheme *sc, pointer args)
{
pointer ret;
gint64 time;
time = g_get_real_time ();
ret = sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) time / G_USEC_PER_SEC),
sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) time % G_USEC_PER_SEC),
sc->NIL));
return ret;
}
pointer foreign_usleep(scheme *sc, pointer args)
{
pointer first_arg;
long usec;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_integer(first_arg))
return sc->F;
usec = sc->vptr->ivalue(first_arg);
g_usleep(usec);
return sc->T;
}
/* This function gets called when TinyScheme is loading the extension */
void init_ftx (scheme *sc)
{
int i;
sc->vptr->scheme_define(sc,sc->global_env,
sc->vptr->mk_symbol(sc,"getenv"),
sc->vptr->mk_foreign_func(sc, foreign_getenv));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_symbol(sc,"time"),
sc->vptr->mk_foreign_func(sc, foreign_time));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_symbol(sc,"gettimeofday"),
sc->vptr->mk_foreign_func(sc, foreign_gettimeofday));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_symbol(sc,"usleep"),
sc->vptr->mk_foreign_func(sc, foreign_usleep));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_symbol(sc,"file-exists?"),
sc->vptr->mk_foreign_func(sc, foreign_fileexists));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_symbol(sc,"file-type"),
sc->vptr->mk_foreign_func(sc, foreign_filetype));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_symbol(sc,"file-size"),
sc->vptr->mk_foreign_func(sc, foreign_filesize));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_symbol(sc,"file-delete"),
sc->vptr->mk_foreign_func(sc, foreign_filedelete));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_symbol(sc,"dir-open-stream"),
sc->vptr->mk_foreign_func(sc, foreign_diropenstream));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_symbol(sc,"dir-read-entry"),
sc->vptr->mk_foreign_func(sc, foreign_dirreadentry));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_symbol(sc,"dir-rewind"),
sc->vptr->mk_foreign_func(sc, foreign_dirrewind));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_symbol(sc,"dir-close-stream"),
sc->vptr->mk_foreign_func(sc, foreign_dirclosestream));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_symbol(sc,"dir-make"),
sc->vptr->mk_foreign_func(sc, foreign_mkdir));
for (i = 0; file_type_constants[i].name != NULL; ++i)
{
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_symbol(sc, file_type_constants[i].name),
sc->vptr->mk_integer(sc, file_type_constants[i].value));
}
}