5cc3becf16
Changes are mostly to the dir structures and build system for ScriptFu. Some changes to the outer plugin source to call the library. Why: so that other executables (future gimp-scheme-interpreter, or a future separated script-fu-server) can exist in separate directories, and share the library in memory (when built shared.) Whether the library is built shared and installed on its own (versus static and not installed) is a compile time option (both automake LibTool and meson abstract it away) The default is shared and installed, say as libgimp-scriptfu-3.0.so. Installed alongside other shared libraries (e.g. wherever libgimp is installed) to simplify packaging. A preliminary refactoring which helps enable MR gimp!647
416 lines
11 KiB
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));
|
|
}
|
|
}
|