Adding upstream version 2.10.22.upstream/2.10.22upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 375 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..346a90a
--- /dev/null
+++ b/plug-ins/script-fu/ftx/ftx.c
@@ -0,0 +1,375 @@
+/* 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/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_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_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));
+
+  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));
+  }
+}