summaryrefslogtreecommitdiffstats
path: root/plug-ins/script-fu/ftx/ftx.c
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--plug-ins/script-fu/ftx/ftx.c415
1 files changed, 415 insertions, 0 deletions
diff --git a/plug-ins/script-fu/ftx/ftx.c b/plug-ins/script-fu/ftx/ftx.c
new file mode 100644
index 0000000..f9de1bf
--- /dev/null
+++ b/plug-ins/script-fu/ftx/ftx.c
@@ -0,0 +1,415 @@
+/* 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));
+ }
+}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 09:36:06 +0000