Clean-up before 0.0.2

svn path=/trunk/externals/k_guile/; revision=1276

3 files changed, 63 insertions, 57 deletions

diff --git a/global.scm b/global.scm
index 334e04e..7fe7ecc 100644
--- a/global.scm
+++ b/global.scm
@@ -27,6 +27,7 @@
 (use-modules (ice-9 stack-catch))
 
 
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Misc. functions
 ;;
@@ -134,6 +135,10 @@
 ;; Backtrace (does not work properly)
 ;;
 ;;
+
+(define (pd-backtrace-eval string)
+  (eval-string string))
+
 (define (pd-display-errorfunc key . args)
   (let ((dasstack (make-stack #t)))
     (display-backtrace dasstack (current-output-port) #f #f)
@@ -149,6 +154,12 @@
 	       thunk
 	       pd-display-errorfunc))
 
+(define (pd-backtrace-runx func arg1) 
+  (stack-catch #t
+	       (lambda x
+		 (apply func x))
+	       pd-display-errorfunc))
+
 (define (pd-backtrace-run1 func arg1)
   (stack-catch #t
 	       (lambda ()
@@ -173,6 +184,6 @@
 		 (func arg1 arg2 arg3 arg4))
 	       pd-display-errorfunc))
 
-
 (pd-backtrace-run1 pd-load-if-exists "/etc/.k_guile.scm")
 (pd-backtrace-run1 pd-load-if-exists (string-append (getenv "HOME") "/.k_guile.scm"))
+
diff --git a/k_guile.c b/k_guile.c
index 4e01f3b..82212b9 100644
--- a/k_guile.c
+++ b/k_guile.c
@@ -31,7 +31,6 @@
 
 #define MAKE_STRING(a) scm_mem2string(a,strlen(a))
 #define EVAL(a) scm_eval_string(MAKE_STRING(a))
-#define EVALINT(a) do{char tempstring[500];sprintf(tempstring,"%d",a);EVAL(tempstring);}while(0)
 
 #define MAKE_SYM(a) gensym(SCM_SYMBOL_CHARS(a))
 
@@ -91,11 +90,12 @@ typedef struct k_guile_workaround{
 
 
 static char *version = 
-"k_guile v0.0.1, written by Kjetil S. Matheussen, k.s.matheussen@notam02.no";
+"k_guile v0.0.2, written by Kjetil S. Matheussen, k.s.matheussen@notam02.no";
 
 static t_class *k_guile_class, *k_guile_workaroundclass;
 
 static SCM pd_backtrace_run;
+static SCM pd_backtrace_runx;
 static SCM pd_backtrace_run1;
 static SCM pd_backtrace_run2;
 static SCM pd_backtrace_run3;
@@ -215,18 +215,6 @@ static void k_guile_anything_first(t_k_guile *x,t_symbol *s, t_int argc, t_atom*
  *****************************************************************************************************
  *****************************************************************************************************/
 
-static SCM gpd_set_inlet_func(SCM instance,SCM func){
-  t_k_guile *x=GET_X(instance);
-  x->inlet_func=func;
-  scm_gc_protect_object(x->inlet_func);
-  RU_;
-}
-static SCM gpd_set_cleanup_func(SCM instance,SCM func){
-  t_k_guile *x=GET_X(instance);
-  x->cleanup_func=func;
-  scm_gc_protect_object(x->cleanup_func);
-  RU_;
-}
 static SCM gpd_inlets(SCM instance,SCM num_ins){
   int lokke;
   t_k_guile *x=GET_X(instance);
@@ -280,6 +268,7 @@ static SCM gpd_get_num_outlets(SCM instance){
 }
 
 
+
 /*****************************************************************************************************
  *****************************************************************************************************
  *    Binding and unbinding. Called from the guile side. 
@@ -441,8 +430,6 @@ static void k_guile_init(void){
   scm_c_define_gsubr("pd-c-inited?",1,0,0,gpd_inited_p);
   scm_c_define_gsubr("pd-c-get-num-inlets",1,0,0,gpd_get_num_inlets);
   scm_c_define_gsubr("pd-c-get-num-outlets",1,0,0,gpd_get_num_outlets);
-  scm_c_define_gsubr("pd-c-set-inlet-func",2,0,0,gpd_set_inlet_func);
-  scm_c_define_gsubr("pd-c-set-cleanup-func",2,0,0,gpd_set_cleanup_func);
   scm_c_define_gsubr("pd-c-bind",2,0,0,gpd_bind);
   scm_c_define_gsubr("pd-c-unbind",2,0,0,gpd_unbind);
   scm_c_define_gsubr("pd-c-outlet-number",3,0,0,gpd_outlet_number);
@@ -462,6 +449,9 @@ static void k_guile_init(void){
   pd_backtrace_run=EVAL("pd-backtrace-run");
   scm_permanent_object(pd_backtrace_run);
 
+  pd_backtrace_runx=EVAL("pd-backtrace-runx");
+  scm_permanent_object(pd_backtrace_runx);
+
   pd_backtrace_run1=EVAL("pd-backtrace-run1");
   scm_permanent_object(pd_backtrace_run1);
 
@@ -488,7 +478,8 @@ static void k_guile_init(void){
  *****************************************************************************************************/
 
 static bool k_guile_load(t_k_guile *x,char *filename){
-  bool ret=true;
+  SCM evalret;
+  bool ret=false;
   
   FILE *file=fopen(filename,"r");
   if(file==NULL){
@@ -497,24 +488,33 @@ static bool k_guile_load(t_k_guile *x,char *filename){
   }
 
 
-  // Let the file live in its own name-space, or something like that.
+  // Let the file live in its own name-space (or something like that).
   eval2("(define (pd-instance-func pd-instance)");
   eval2(
 #include "local_scm.txt"
 );
   eval_file(file);
-  eval2("  (pd-set-inlet-func)(pd-set-cleanup-func))");
+  eval2("  (cons pd-inlet-func pd-cleanup-func))");
   eval2("1");
 
-  if(
-     1!=GET_INTEGER(eval_do())
-     || 1!=GET_INTEGER(scm_call_2(pd_backtrace_run1,EVAL("pd-instance-func"),MAKE_POINTER(x)))
-     )
-    {
-      post("Failed.");
-      ret=false;
-    }
+  if(1!=GET_INTEGER(eval_do())){
+    post("Failed.");
+    goto exit;
+  }
 
+  evalret=scm_call_2(pd_backtrace_run1,EVAL("pd-instance-func"),MAKE_POINTER(x));
+  if(INTEGER_P(evalret)){
+    post("Failed.");
+    goto exit;
+  }
+  x->inlet_func=SCM_CAR(evalret);
+  x->cleanup_func=SCM_CDR(evalret);
+  scm_gc_protect_object(x->inlet_func);
+  scm_gc_protect_object(x->cleanup_func);
+
+  ret=true;
+
+ exit:
   fclose(file);
 
   return ret;
@@ -567,6 +567,7 @@ static void k_guile_eval(t_k_guile *x,t_symbol *s){
 //}
 
 
+
 /*****************************************************************************************************
  *****************************************************************************************************
  *    Das setup
@@ -581,8 +582,8 @@ void k_guile_setup(void){
 
   class_addanything(k_guile_class, (t_method)k_guile_anything_first);
   class_addmethod(k_guile_class, (t_method)k_guile_reload, gensym("reload"), 0);
-  class_addmethod(k_guile_class, (t_method)k_guile_eval, gensym("eval"), A_DEFSYM, 0);
-  //class_addmethod(k_guile_class, (t_method)k_guile_evalfile, gensym("evalfile"), A_DEFSYM, 0);
+  class_addmethod(k_guile_class, (t_method)k_guile_eval, gensym("eval"), A_DEFSYM,0);
+  //class_addmethod(k_guile_class, (t_method)k_guile_evalfile, gensym("evalfile"), A_DEFSYM,0);
   class_sethelpsymbol(k_guile_class, gensym("help-k_guile.pd"));
 
 
diff --git a/local.scm b/local.scm
index 31e107b..65546b2 100644
--- a/local.scm
+++ b/local.scm
@@ -58,21 +58,19 @@
 (define pd-inlet-vector (make-vector 1 '()))
 (define pd-inlet-anyvector (make-vector 1 '()))
 
-(define (pd-set-inlet-func)
-  (pd-c-set-inlet-func pd-instance
-		       ;; This function is called from the C side when the object receives something on an inlet.
-		       (lambda (inlet-num symbol args)
-			 (let ((inlet-func (assq symbol 
-						 (vector-ref pd-inlet-vector
-							     inlet-num))))
-			   (if (not inlet-func)
-			       (begin
-				 (set! inlet-func (assq 'any
-							(vector-ref pd-inlet-vector inlet-num)))
-				 (set! args (cons symbol args))))
-			   (if inlet-func
-			       (apply (cadr inlet-func) args)
-			       (pd-display "No function defined for handling \'" symbol " to inlet " inlet-num))))))
+;; This function is called from the C side when the object receives something on an inlet.
+(define (pd-inlet-func inlet-num symbol args)
+  (let ((inlet-func (assq symbol 
+			  (vector-ref pd-inlet-vector
+				      inlet-num))))
+    (if (not inlet-func)
+	(begin
+	  (set! inlet-func (assq 'any
+				 (vector-ref pd-inlet-vector inlet-num)))
+	  (set! args (cons symbol args))))
+    (if inlet-func
+	(apply (cadr inlet-func) args)
+	(pd-display "No function defined for handling \'" symbol " to inlet " inlet-num))))
 
 (define (pd-inlet inlet-num symbol func)
   (if (not (procedure? func))
@@ -145,7 +143,11 @@
 (define (pd-unbind symbol)
   (set! pd-local-bindings (pd-unbind-do symbol pd-local-bindings)))
 
-
+(define (pd-unbind-all)
+  (if (not (null? pd-local-bindings))
+      (begin
+	(pd-unbind (car (car pd-local-bindings)))
+	(pd-unbind-all))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -158,19 +160,11 @@
       (pd-display "Wrong argument to pd-set-destroy-func: " thunk " is not a procedure.")
       (set! pd-destroy-func thunk)))
 
-(define (pd-cleanup)
+;; This func is called from the C-side.
+(define (pd-cleanup-func)
   (if pd-destroy-func
       (begin
 	(pd-destroy-func)
 	(set! pd-destroy-func #f)))
-  (if (not (null? pd-local-bindings))
-      (begin
-	(pd-unbind (car (car pd-local-bindings)))
-	(pd-cleanup))))
-
-;; This one also returns the return-value for the pd-instance-func function, which is 1 for success.
-(define (pd-set-cleanup-func)
-  (pd-c-set-cleanup-func pd-instance
-			 pd-cleanup)
-  1)
+  (pd-unbind-all))