Re: [slang-users] SLANG functions within a C program help needed.

[Michael Noble <mnoble@xxxxxxxxxxxxx>]

Hi Ben,
   
  > Inside of my SLAG modules, which are written in C, I need to be able to
  > perform a S-Lang function in a "call back" fashion. i.e.:

This is well within the realm of possibility.  The SLgtk module, for
example, makes extensive use of callbacks from C to S-Lang functions,
with support for passing an essentially arbitrary number of parameters
to and fro.  As a source of examples I've appended below some of the C
code which helps make this happen ... both the support functions as well
as a few wrapper functions for Gtk routines such as gtk_timeout_add,
which might be called from S-Lang scope as

	() = gtk_timeout_add(2500, &callback_func, arg1, arg2, arg3, ...)

SLIRP uses a similar technique for installing preprocessor extensions
into the S-Lang interpreter, the code for which may be found in the
./preproc directory of the distribution.

HTH,
Mike

-------------------------- support funcs --------------------------

typedef struct _slGtkFunction {
  SLang_Name_Type *function;
  void		  *widget;
  SLang_Any_Type  **args;
  unsigned int    nargs;
} slGtkFunction;		/* Used for GtkFunction and GtkCallback */
/* }}} */

/* Callback Support {{{ */ 

static int
function_invoke(slGtkFunction *pf)
{
   unsigned int arg = 0;

   if (SLang_start_arg_list() == -1)
	return -1;

   if (pf->widget && -1 == SLang_push_opaque(GtkWidget_Type,pf->widget,0))
	return -1;

   if (pf->args) {
      for (arg = 0; arg < pf->nargs; arg++)
	  if (SLang_push_anytype(pf->args[arg]) == -1)
	     break;
   }

   if (SLang_get_error() || SLang_end_arg_list() == -1) {
	SLdo_pop_n( (pf->widget != NULL) + arg);
	return -1;
   }

   (void) SLexecute_function(pf->function);

   /* Unrecoverable S-Lang errors should not cause main loop to hang */
   if (SLang_get_error() < 0) {
	error_terminate_main_loop(pf->function->name);
	return -1;
   }

   /* Otherwise try our best to recover */
   if (SLang_get_error()) {
	SLang_restart(0);
	SLang_set_error(0);
   }

   return 0;
}

static void
callback_invoker(GtkWidget *w, gpointer data)
{
   slGtkFunction *pf = (slGtkFunction*)data;
   pf->widget = w;
   (void) function_invoke(pf);
}

static void 
function_marshaller (GtkObject *obj, gpointer data, guint n_args,GtkArg *args)
{
   int retval;
   slGtkFunction *pf = (slGtkFunction*)data;

   (void) obj; (void) n_args;

   if (-1 == function_invoke(pf))
	return;

   if (SLang_pop_integer(&retval) == -1 || SLang_get_error() < 0) {
	char msg[192];
	strcpy(msg,"could not pop expected boolean return value from: ");
	strncat(msg,pf->function->name,
	      	(size_t) MIN(strlen(pf->function->name),192-strlen(msg)-1));
	error_terminate_main_loop(msg);
   }

   *GTK_RETLOC_BOOL(args[0]) = retval ? TRUE : FALSE;
}

static void
function_destroy (gpointer data)
{
   slGtkFunction *f = (slGtkFunction*)data;
   if (f) {
	free_slang_args(f->nargs, f->args);
	SLang_free_function(f->function);
	SLfree((char*)f);
   }
}

static slGtkFunction*
function_create(void *widget, SLang_Ref_Type **slfunc_ref,
				SLang_Any_Type **args, unsigned int nargs)
{
   slGtkFunction *f;
   SLang_Name_Type *slfunc;
   
   if ( (slfunc = SLang_get_fun_from_ref(*slfunc_ref)) == NULL)
      return NULL;

   SLang_free_ref(*slfunc_ref);
   *slfunc_ref = NULL;

   if ( (f = (slGtkFunction*) SLmalloc(sizeof(slGtkFunction))) == NULL) {
	SLang_free_function(slfunc);
	return NULL;
   }

   f->function	= slfunc;
   f->widget	= (GtkWidget*)widget;
   f->args	= args;
   f->nargs	= nargs;

   return f;
}

static slGtkFunction*
function_pop(unsigned int num_args_to_omit)
{
   slGtkFunction *f;
   SLang_Any_Type **args = NULL;
   SLang_Ref_Type *func_ref = NULL;
   unsigned int nargs = SLang_Num_Function_Args - num_args_to_omit - 1;

   if (extract_slang_args(nargs,&args) == 0
      		 && SLang_pop_ref(&func_ref) == 0
		 && (f = function_create(NULL, &func_ref, args, nargs)))
	return f;

   if (args) free_slang_args(nargs,args);
   if (func_ref) SLang_free_ref(func_ref);

   return NULL;
}

int
extract_slang_args(unsigned int nargs, SLang_Any_Type ***pargs)
{
   SLang_Any_Type **args;
   SLang_Any_Type *arg;
   unsigned int narg;

   if (nargs <= 0) {
	*pargs = NULL;
	return 0;
   }

   args = (SLang_Any_Type**) SLmalloc(SIZEOF_POINTER*nargs);
   narg = nargs;
   while (narg) {
	if (pop_anytype_or_null(&arg) == -1) {
	   while (nargs > narg)
		SLang_free_anytype(args[--nargs]);
	   SLfree((char*)args);
	   return -1;
	}
	args[--narg] = arg;

   }
   *pargs = args;
   return 0;
}

void free_slang_args(unsigned int nargs, SLang_Any_Type **args)
{
   while (nargs > 0)
	SLang_free_anytype(args[--nargs]);
   SLfree((char*)args);
}

-------------------------- module/wrapper funcs --------------------------
static unsigned int
slgtk_timeout_add(void)
{
   unsigned int interval;
   slGtkFunction *f = NULL;

   if (	usage_err(2,"id = gtk_timeout_add(millis, func_ref [, arg1, ...])")
				|| (f = function_pop(1)) == NULL
				|| -1 == SLang_pop_uinteger(&interval)) {

	function_destroy(f);
	return 0;
   }

   return gtk_timeout_add_full((guint32)interval, NULL, function_marshaller,
	 					f, function_destroy);
}

static unsigned int
slgtk_idle_add(void)
{
   slGtkFunction *f = NULL;

   if ( usage_err(1,"id = gtk_idle_add(func_ref [, arg1, ...])")
					|| (f = function_pop(0)) == NULL)
	return 0;

   return gtk_idle_add_full(GTK_PRIORITY_DEFAULT, NULL, function_marshaller,
	 						f, function_destroy);
}

static unsigned int
slgtk_quit_add(void)
{
   slGtkFunction *f = NULL;
   guint main_level;

   if (	usage_err(2,"id = gtk_quit_add(main_level, func_ref [,arg1, ...])")
			|| (f = function_pop(1)) == NULL
			|| -1 == SLang_pop_uinteger(&main_level)) {

	function_destroy(f);
	return 0;
   }

   return gtk_quit_add_full(main_level, NULL, function_marshaller, f,
	 						function_destroy);
}

_______________________________________________
To unsubscribe, visit http://jedsoft.org/slang/mailinglists.html