Update of /cvsroot/pure-data/externals/k_guile In directory sc8-pr-cvs1:/tmp/cvs-serv27488
Modified Files: global.scm k_guile.c local.scm Log Message: Clean-up before 0.0.2
Index: global.scm =================================================================== RCS file: /cvsroot/pure-data/externals/k_guile/global.scm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** global.scm 12 Jan 2004 13:10:17 -0000 1.2 --- global.scm 21 Jan 2004 08:56:12 -0000 1.3 *************** *** 28,31 **** --- 28,32 ----
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Misc. functions *************** *** 135,138 **** --- 136,143 ---- ;; ;; + + (define (pd-backtrace-eval string) + (eval-string string)) + (define (pd-display-errorfunc key . args) (let ((dasstack (make-stack #t))) *************** *** 150,153 **** --- 155,164 ---- 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 *************** *** 174,178 **** 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")) --- 185,189 ---- 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")) +
Index: k_guile.c =================================================================== RCS file: /cvsroot/pure-data/externals/k_guile/k_guile.c,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** k_guile.c 12 Jan 2004 13:25:12 -0000 1.2 --- k_guile.c 21 Jan 2004 08:56:12 -0000 1.3 *************** *** 32,36 **** #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)) --- 32,35 ---- *************** *** 92,100 ****
static char *version = ! "k_guile v0.0.1, 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_run1; static SCM pd_backtrace_run2; --- 91,100 ----
static char *version = ! "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; *************** *** 216,231 **** *****************************************************************************************************/
- 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; --- 216,219 ---- *************** *** 281,284 **** --- 269,273 ----
+ /***************************************************************************************************** ***************************************************************************************************** *************** *** 442,447 **** 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); --- 431,434 ---- *************** *** 463,466 **** --- 450,456 ---- 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); *************** *** 489,493 ****
static bool k_guile_load(t_k_guile *x,char *filename){ ! bool ret=true;
FILE *file=fopen(filename,"r"); --- 479,484 ----
static bool k_guile_load(t_k_guile *x,char *filename){ ! SCM evalret; ! bool ret=false;
FILE *file=fopen(filename,"r"); *************** *** 498,502 ****
! // Let the file live in its own name-space, or something like that. eval2("(define (pd-instance-func pd-instance)"); eval2( --- 489,493 ----
! // Let the file live in its own name-space (or something like that). eval2("(define (pd-instance-func pd-instance)"); eval2( *************** *** 504,519 **** ); eval_file(file); ! eval2(" (pd-set-inlet-func)(pd-set-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; ! }
fclose(file);
--- 495,519 ---- ); eval_file(file); ! eval2(" (cons pd-inlet-func pd-cleanup-func))"); eval2("1");
! 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);
*************** *** 568,571 **** --- 568,572 ----
+ /***************************************************************************************************** ***************************************************************************************************** *************** *** 582,587 **** 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_sethelpsymbol(k_guile_class, gensym("help-k_guile.pd"));
--- 583,588 ---- 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_sethelpsymbol(k_guile_class, gensym("help-k_guile.pd"));
Index: local.scm =================================================================== RCS file: /cvsroot/pure-data/externals/k_guile/local.scm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** local.scm 16 Jan 2004 15:07:14 -0000 1.2 --- local.scm 21 Jan 2004 08:56:12 -0000 1.3 *************** *** 59,77 **** (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))))))
(define (pd-inlet inlet-num symbol func) --- 59,75 ---- (define pd-inlet-anyvector (make-vector 1 '()))
! ;; 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) *************** *** 146,150 **** (set! pd-local-bindings (pd-unbind-do symbol pd-local-bindings)))
!
--- 144,152 ---- (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))))
*************** *** 159,176 **** (set! pd-destroy-func thunk)))
! (define (pd-cleanup) (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)
--- 161,170 ---- (set! pd-destroy-func thunk)))
! ;; 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))) ! (pd-unbind-all))
-
ksvalastīŧ users.sourceforge.net