guile integration

6 files changed, 295 insertions, 44 deletions

diff --git a/mixguile/Makefile.am b/mixguile/Makefile.am
index 392b08d..fed3371 100644
--- a/mixguile/Makefile.am
+++ b/mixguile/Makefile.am
@@ -22,14 +22,13 @@ SCM_PATHS = -DSCM_FILE=\""$(pkgdatadir)/mixguile.scm"\"\
             -DLOCAL_SCM_FILE=\"mixguile.scm\"
 
 pkgdata_DATA = $(SCM_FILES)
-
+INCLUDES = -I$(includedir) $(SCM_PATHS)
 libmixguile_a_INCLUDES = -I$(includedir) -DG_LOG_DOMAIN=\"libmixguile\"
 libmixguile_a_SOURCES = mixguile.h mixguile.c \
                         mixguile_cmd_dispatcher.h mixguile_cmd_dispatcher.c \
                         xmixguile_cmd_dispatcher.h xmixguile_cmd_dispatcher.c
 
 bin_PROGRAMS = mixguile
-mixguile_INCLUDES = -I$(includedir) $(SCM_PATHS)
 mixguile_LDADD = $(top_builddir)/mixlib/libmix.a \
                  $(top_builddir)/lib/libreplace.a \
                  $(top_builddir)/mixguile/libmixguile.a $(INTLLIBS)
diff --git a/mixguile/mixguile.c b/mixguile/mixguile.c
index 52321ca..4072869 100644
--- a/mixguile/mixguile.c
+++ b/mixguile/mixguile.c
@@ -21,31 +21,70 @@
  *  
  */
 
+#include <mixlib/mix_config.h>
 #include "mixguile_cmd_dispatcher.h"
 #include "mixguile.h"
 
 static mixguile_cmd_dispatcher_t *dispatcher_ = NULL;
+static mix_vm_cmd_dispatcher_t *vm_dispatcher_ = NULL;
 static main_func_t main_fun_;
 
 /* do local initialisation and enter the user provided main */
+
 static void
 real_main_ (int argc, char *argv[])
 {
+  if (vm_dispatcher_)
+    {
+      mixguile_set_cmd_dispatcher (vm_dispatcher_);
+      mixguile_load_bootstrap ();
+    }
   (*main_fun_)(argc, argv);
 }
 
 /*
   initialise the guile command dispatcher and enter the provided
-  main function. the mixlib is also initialised.
+  main function.
 */
 void
-mixguile_init (int argc, char *argv[], main_func_t main_fun)
+mixguile_init (int argc, char *argv[], main_func_t main_fun,
+	       mix_vm_cmd_dispatcher_t *dis)
 {
-  mix_init_lib ();
   main_fun_ = main_fun;
+  vm_dispatcher_ = dis;
   gh_enter (argc, argv, real_main_);
 }
 
+/* load bootstrap file */
+void
+mixguile_load_bootstrap (void)
+{
+  FILE *scm = NULL;
+  const gchar *scmfile = SCM_FILE;
+  gchar *lscmfile =
+    g_strconcat (g_get_home_dir (), G_DIR_SEPARATOR_S, MIX_CONFIG_DIR,
+		 G_DIR_SEPARATOR_S, LOCAL_SCM_FILE, NULL);
+  
+  if (!(scm = fopen (scmfile, "r"))
+      && !(scm = fopen ((scmfile = LOCAL_SCM_FILE), "r")))
+    {
+      g_warning ("mixguile bootstrap file %s not found\n", SCM_FILE);
+      scmfile = NULL;
+    }
+  else
+    fclose (scm);
+
+  if (scmfile) mixguile_interpret_file (scmfile);
+
+  if ((scm = fopen (lscmfile, "r")) != NULL)
+    {
+      fclose (scm);
+      mixguile_interpret_file (lscmfile);
+    }
+
+  g_free (lscmfile);
+}
+
 /* enter the guile repl */
 void
 mixguile_enter_repl (int argc, char *argv[])
@@ -60,6 +99,7 @@ mixguile_set_cmd_dispatcher (mix_vm_cmd_dispatcher_t *dis)
 {
   g_return_if_fail (dis != NULL);
   if (dispatcher_) mixguile_cmd_dispatcher_delete (dispatcher_);
+  vm_dispatcher_ = dis;
   dispatcher_ = mixguile_cmd_dispatcher_new (dis);
   g_assert (dispatcher_);
 }
diff --git a/mixguile/mixguile.h b/mixguile/mixguile.h
index 8897d29..6cc7918 100644
--- a/mixguile/mixguile.h
+++ b/mixguile/mixguile.h
@@ -32,12 +32,21 @@
 /* the main function type */
 typedef void (*main_func_t) (int argc, char *argv[]);
 
+
+/* enter and do the initialisation manually inside the guile world */
+#define mixguile_enter(argc,argv,main_fun) gh_enter (argc, argv, main_fun)
+
+/* load mixguile startup file */
+extern void
+mixguile_load_bootstrap ();
+
 /*
   initialise the guile command dispatcher and enter the provided
-  main function. the mixlib is also initialised.
+  main function.
 */
 extern void
-mixguile_init (int argc, char *argv[], main_func_t main_fun);
+mixguile_init (int argc, char *argv[], main_func_t main_fun,
+	       mix_vm_cmd_dispatcher_t *dis);
 
 /* set the command dispatcher */
 extern void
diff --git a/mixguile/mixguile_cmd_dispatcher.c b/mixguile/mixguile_cmd_dispatcher.c
index 4676c43..b55d0ed 100644
--- a/mixguile/mixguile_cmd_dispatcher.c
+++ b/mixguile/mixguile_cmd_dispatcher.c
@@ -30,14 +30,56 @@
 #include "mixguile.h"
 #include "xmixguile_cmd_dispatcher.h"
 
+#define SCM_CMD  "scm"
+#define SCMF_CMD "scmf"
+
+/*local commands */
+static gboolean
+cmd_scm_ (mix_vm_cmd_dispatcher_t *dis, const gchar *arg)
+{
+  (void) gh_eval_str_with_catch ((char *)arg, scm_handle_by_message_noexit);
+  return TRUE;
+}
+
+static gboolean
+cmd_scmf_ (mix_vm_cmd_dispatcher_t *dis, const gchar *arg)
+{
+  (void) gh_eval_file_with_catch ((char *)arg, scm_handle_by_message_noexit);
+  return TRUE;
+}
+
+static mix_vm_command_info_t commands_[] = {
+  { SCM_CMD, cmd_scm_, N_("Eval Scheme command using Guile"), "scm COMMAND"},
+  { SCMF_CMD, cmd_scmf_, N_("Eval Scheme file using Guile"), "scm PATH"},
+  {NULL}
+};
+  
 /* create/destroy cmd dispatcher */
+static void
+make_pipe_ (mixguile_cmd_dispatcher_t *dis)
+{
+  int fildes[2], r;
+  FILE *out;
+  r = pipe (fildes);
+  g_return_if_fail (r == 0);
+  out = fdopen (fildes[1], "w");
+  g_return_if_fail (out != NULL);
+  r = fcntl (fildes[0], F_GETFL, 0);
+  g_return_if_fail (r != -1);
+  r = fcntl (fildes[0], F_SETFL, r | O_NONBLOCK);
+  g_return_if_fail (r != -1);
+
+  dis->guile_out = out;
+  dis->fildes[0] = fildes[0];
+  dis->fildes[1] = fildes[1];
+}
+
 mixguile_cmd_dispatcher_t *
 mixguile_cmd_dispatcher_new (mix_vm_cmd_dispatcher_t *dis)
 {
   static gboolean REGISTERED = FALSE;
   mixguile_cmd_dispatcher_t *result = NULL;
-  int fildes[2], r;
-  FILE *out;
+  int k = 0;
   
   g_return_val_if_fail (dis != NULL, NULL);
   
@@ -46,23 +88,19 @@ mixguile_cmd_dispatcher_new (mix_vm_cmd_dispatcher_t *dis)
       register_scm_commands_ (DEFAULT_SCM_COMMANDS_);
       REGISTERED = TRUE;
     }
-  
-  r = pipe (fildes);
-  g_return_val_if_fail (r == 0, NULL);
-  out = fdopen (fildes[1], "w");
-  g_return_val_if_fail (out != NULL, NULL);
-  r = fcntl (fildes[0], F_GETFL, 0);
-  g_return_val_if_fail (r != -1, NULL);
-  r = fcntl (fildes[0], F_SETFL, r | O_NONBLOCK);
-  g_return_val_if_fail (r != -1, NULL);
 
   result = g_new (mixguile_cmd_dispatcher_t, 1);
   result->dispatcher = dis;
   result->err = result->out = NULL;
-  result->guile_out = out;
-  result->fildes[0] = fildes[0];
-  result->fildes[1] = fildes[1];
   result->result = NULL;
+  result->fildes[0] = result->fildes[1] = -1;
+  result->guile_out = NULL;
+  
+  while (commands_[k].name)
+    {
+      mix_vm_cmd_dispatcher_register_new (dis, commands_ + k);
+      ++k;
+    }
   
   register_cmd_dispatcher_ (result);
   
@@ -74,9 +112,12 @@ void
 mixguile_cmd_dispatcher_delete (mixguile_cmd_dispatcher_t *dis)
 {
   g_return_if_fail (dis != NULL);
-  fclose (dis->guile_out);
-  close (dis->fildes[0]);
-  close (dis->fildes[1]);
+  if (dis->guile_out)
+    {
+      fclose (dis->guile_out);
+      close (dis->fildes[0]);
+      close (dis->fildes[1]);
+    }
   mix_vm_cmd_dispatcher_delete (dis->dispatcher);
 }
 
@@ -99,6 +140,7 @@ mixguile_cmd_dispatcher_last_result (mixguile_cmd_dispatcher_t *dis)
   gchar *tmp = NULL;
   
   g_return_val_if_fail (dis != NULL, NULL);
+  if (!dis->guile_out) return NULL;
   if (dis->result) g_free (dis->result);
   dis->result = NULL;
   fflush (dis->guile_out);
@@ -124,6 +166,7 @@ mixguile_cmd_dispatcher_last_result (mixguile_cmd_dispatcher_t *dis)
 static void
 prepare_dispatcher_ (mixguile_cmd_dispatcher_t *dis)
 {
+  if (!dis->guile_out) make_pipe_ (dis);
   dis->out = mix_vm_cmd_dispatcher_set_out_stream (dis->dispatcher,
 						   dis->guile_out);
   dis->err = mix_vm_cmd_dispatcher_set_error_stream (dis->dispatcher,
@@ -137,14 +180,14 @@ mixguile_cmd_dispatcher_prepare (mixguile_cmd_dispatcher_t *dis)
   prepare_dispatcher_ (dis);
 }
 
-/* interpret commands from file or string */
+/* interpret commands from file or string
 static void
 reset_dispatcher_ (mixguile_cmd_dispatcher_t *dis)
 {
   (void) mix_vm_cmd_dispatcher_set_out_stream (dis->dispatcher, dis->out);
   (void) mix_vm_cmd_dispatcher_set_error_stream (dis->dispatcher, dis->err);
 }
-
+*/
 
 void
 mixguile_cmd_dispatcher_interpret_file (mixguile_cmd_dispatcher_t *dis,
@@ -152,9 +195,8 @@ mixguile_cmd_dispatcher_interpret_file (mixguile_cmd_dispatcher_t *dis,
 {
   g_return_if_fail (dis != NULL);
   g_return_if_fail (path != NULL);
-  prepare_dispatcher_ (dis);
-  (void) gh_eval_file ((char *)path);
-  reset_dispatcher_ (dis);
+  mix_vm_cmd_dispatcher_dispatch_split_text (dis->dispatcher,
+					     SCMF_CMD, path);
 }
 
 void
@@ -163,8 +205,7 @@ mixguile_cmd_dispatcher_interpret_command (mixguile_cmd_dispatcher_t *dis,
 {
   g_return_if_fail (dis != NULL);
   g_return_if_fail (command != NULL);
-  prepare_dispatcher_ (dis);
-  (void) gh_eval_str ((char *)command);
-  reset_dispatcher_ (dis);
+  mix_vm_cmd_dispatcher_dispatch_split_text (dis->dispatcher,
+					     SCM_CMD, command);
 }
 
diff --git a/mixguile/mixguile_main.c b/mixguile/mixguile_main.c
index de9bfa4..183dfaf 100644
--- a/mixguile/mixguile_main.c
+++ b/mixguile/mixguile_main.c
@@ -25,20 +25,19 @@
 #include <stdio.h>
 #include "mixguile.h"
 
-static void
-inner_main_ (int argc, char *argv[])
-{
-  mix_vm_cmd_dispatcher_t *dis = mix_vm_cmd_dispatcher_new (stdout, stderr);
-  mixguile_set_cmd_dispatcher (dis);
-  mixguile_enter_repl (argc, argv);
-}
-
 int
 main (int argc, char *argv[])
 {
-  mixguile_init (argc, argv, inner_main_);
-  return EXIT_SUCCESS; /* never reached */
-}
-
+  const gchar *CONFIG_FILE = "mixvm.config";
+  mix_config_t *config;
+  mix_vm_cmd_dispatcher_t *dis;
+  
+  
+  mix_init_lib ();
 
+  config = mix_config_new (NULL, CONFIG_FILE);
+  dis = mix_vm_cmd_dispatcher_new_with_config (stdout, stderr, config);
+  mixguile_init (argc, argv, mixguile_enter_repl, dis);
 
+  return EXIT_SUCCESS; /* never reached */
+}
diff --git a/mixguile/xmixguile_cmd_dispatcher.c b/mixguile/xmixguile_cmd_dispatcher.c
index 711bc52..744b76b 100644
--- a/mixguile/xmixguile_cmd_dispatcher.c
+++ b/mixguile/xmixguile_cmd_dispatcher.c
@@ -219,6 +219,12 @@ mix_set_over_ (SCM over)
 }
 
 static SCM
+mix_loc_ (void)
+{
+  return gh_long2scm (mix_vm_get_prog_count (vm_));
+}
+
+static SCM
 mix_cmp_ (void)
 {
   gchar *result = NULL;
@@ -261,6 +267,158 @@ mix_set_cmp_ (SCM value)
   return gh_symbol2scm ("ok");
 }
 
+/* ----- hook functions ---- */
+/* auxiliar arg list maker */
+static SCM
+make_arg_list_ (const gchar *arg)
+{
+  gchar **arglist = g_strsplit (arg, " ", -1);
+  SCM argument = gh_list (SCM_UNDEFINED);
+  if (arglist && arglist[0])
+    {
+      int k = 0;
+      while (arglist[k])
+	argument = gh_cons (gh_str02scm (arglist[k++]), argument);
+      argument = gh_reverse (argument);
+    }
+  g_strfreev (arglist);
+  return argument;
+}
+
+/* command hook auxiliar functions and types */
+/*
+static SCM
+hook_error_handler_ (void *data, SCM tag, SCM args)
+{
+  int len;
+  mix_vm_cmd_dispatcher_t *dis = (mix_vm_cmd_dispatcher_t *)dis;
+  gchar *argstr = gh_scm2newstr (args, &len);
+  fprintf (mix_vm_cmd_dispatcher_get_err_stream (dis), "Error in hook: %s\n",
+	   argstr);
+  g_free (argstr);
+  return SCM_BOOL_T;
+}
+*/
+
+typedef struct
+{
+  SCM function;
+  SCM args;
+} hook_data_t;
+
+static SCM
+hook_catch_body_ (void *data)
+{
+  hook_data_t *h = (hook_data_t *)data;
+  return gh_call1 (h->function, h->args);
+}
+
+static void
+scm_hook_ (mix_vm_cmd_dispatcher_t *dis, const gchar *arg, gpointer data)
+{
+  hook_data_t h;
+  h.function = (SCM) data;
+  h.args = make_arg_list_ (arg);
+  gh_catch (SCM_BOOL_T, hook_catch_body_, &h,
+	    scm_handle_by_message_noexit, dis);
+}
+
+/* global hook auxiliar functions and types */
+typedef struct
+{
+  SCM function;
+  SCM cmd;
+  SCM args;
+} global_hook_data_t;
+
+static SCM
+global_hook_catch_body_ (void *data)
+{
+  global_hook_data_t *h = (global_hook_data_t *)data;
+  return gh_call2 (h->function, h->cmd, h->args);
+}
+
+static void
+scm_global_hook_ (mix_vm_cmd_dispatcher_t *dis, mix_vm_command_t cmd,
+		  const gchar *arg, gpointer data)
+{
+  global_hook_data_t h;
+  h.function = (SCM) data;
+  h.cmd = gh_str02scm ((char *)mix_vm_command_to_string (cmd));
+  h.args = make_arg_list_ (arg);
+  gh_catch (SCM_BOOL_T, global_hook_catch_body_, &h,
+	    scm_handle_by_message_noexit, NULL);
+}
+
+static SCM
+mix_add_hook_ (SCM cmd, SCM function, gboolean pre)
+{
+  gchar *cmdstr = NULL;
+  mix_vm_command_t command;
+  int len;
+  const gchar *fun = pre? "mix-add-pre-hook" : "mix-add-post-hook";
+  
+  SCM_ASSERT (SCM_STRINGP (cmd) || SCM_SYMBOLP (cmd), cmd, SCM_ARG1, fun);
+  SCM_ASSERT (gh_procedure_p (function), function, SCM_ARG2, fun);
+  SCM_DEFER_INTS;
+  cmdstr = gh_scm2newstr (cmd, &len);
+  command = mix_vm_command_from_string (cmdstr);
+  g_free (cmdstr);
+  SCM_ALLOW_INTS;
+  SCM_ASSERT (command != MIX_CMD_INVALID, cmd, SCM_ARG1, fun);
+  SCM_DEFER_INTS;
+  if (pre)
+    mix_vm_cmd_dispatcher_pre_hook (vm_dispatcher_, command,
+				    scm_hook_, (gpointer) function);
+  else
+    mix_vm_cmd_dispatcher_post_hook (vm_dispatcher_, command,
+				     scm_hook_, (gpointer) function);
+  SCM_ALLOW_INTS;
+  return gh_symbol2scm ("ok");
+}
+
+static SCM
+mix_add_global_hook_ (SCM function, gboolean pre)
+{
+  const gchar *fun =
+    pre? "mix-add-global-pre-hook" : "mix-add-global-post-hook";
+  
+  SCM_ASSERT (gh_procedure_p (function), function, SCM_ARG1, fun);
+  SCM_DEFER_INTS;
+  if (pre)
+    mix_vm_cmd_dispatcher_global_pre_hook (vm_dispatcher_, scm_global_hook_,
+					   (gpointer) function);
+  else
+    mix_vm_cmd_dispatcher_global_post_hook (vm_dispatcher_, scm_global_hook_,
+					    (gpointer) function);
+  SCM_ALLOW_INTS;
+  return gh_symbol2scm ("ok");
+}
+
+static SCM
+mix_add_pre_hook_ (SCM cmd, SCM function)
+{
+  return mix_add_hook_ (cmd, function, TRUE);
+}
+
+static SCM
+mix_add_post_hook_ (SCM cmd, SCM function)
+{
+  return mix_add_hook_ (cmd, function, FALSE);
+}
+
+static SCM
+mix_add_global_pre_hook_ (SCM function)
+{
+  return mix_add_global_hook_ (function, TRUE);
+}
+
+static SCM
+mix_add_global_post_hook_ (SCM function)
+{
+  return mix_add_global_hook_ (function, FALSE);
+}
+
 /* NULL-terminated list of available scm commands */
 const scm_command_t DEFAULT_SCM_COMMANDS_[] = {
   {"mixvm-cmd", mixvm_cmd_, 2, 0, 0},
@@ -269,8 +427,13 @@ const scm_command_t DEFAULT_SCM_COMMANDS_[] = {
   {"mix-cell", mix_cell_, 1, 0, 0},
   {"mix-set-cell!", mix_set_cell_, 2, 0, 0},
   {"mix-over", mix_over_, 0, 0, 0},
+  {"mix-loc", mix_loc_, 0, 0, 0},
   {"mix-set-over!", mix_set_over_, 1, 0, 0},
   {"mix-cmp", mix_cmp_, 0, 0, 0},
   {"mix-set-cmp!", mix_set_cmp_, 1, 0, 0},
+  {"mix-add-pre-hook", mix_add_pre_hook_, 2, 0, 0},
+  {"mix-add-post-hook", mix_add_post_hook_, 2, 0, 0},
+  {"mix-add-global-pre-hook", mix_add_global_pre_hook_, 1, 0, 0},
+  {"mix-add-global-post-hook", mix_add_global_post_hook_, 1, 0, 0},
   {NULL}
 };