beast-guile2.patch

   1 --- beast-0.7.4/configure.in.orig       2011-04-09 00:20:56.000000000 +0200
   2 +++ beast-0.7.4/configure.in    2012-04-20 22:01:31.005986007 +0200
   3 @@ -421,12 +421,14 @@
   4         GUILE_VERSION=`$GUILE_CONFIG info guileversion`
   5         GUILE_CFLAGS=`$GUILE_CONFIG compile`
   6         GUILE_LDFLAGS=`$GUILE_CONFIG link`
   7 +       oldCPPFLAGS="$CPPFLAGS"
   8 +       CPPFLAGS="$CPPFLAGS $GUILE_CFLAGS"
   9         MC_CHECK_VERSION($GUILE_VERSION, $REQUIRED_VERSION, [guile_tests=`expr $guile_tests + 1`])
  10         dnl # check headers seperately, since some distributions ship on-devel guile packages with guile-config
  11 -       AC_CHECK_HEADER(guile/gh.h, guile_tests=`expr $guile_tests + 1`)
  12 -       AC_CHECK_HEADER(libguile/properties.h, guile_tests=`expr $guile_tests + 1`) dnl # guile-1.6 headerfile
  13 +       AC_CHECK_HEADER(libguile.h, guile_tests=`expr $guile_tests + 1`)
  14 +       CPPFLAGS="$oldCPPFLAGS"
  15      fi
  16 -    if test $guile_tests = 4 ; then
  17 +    if test $guile_tests = 3 ; then
  18         BSESCM_CFLAGS="$GUILE_CFLAGS $BSESCM_CFLAGS"
  19         BSESCM_LIBS="$GUILE_LDFLAGS $BSESCM_LIBS"
  20      else
  21 --- beast-0.7.4/shell/bsescm.c.orig     2011-04-08 19:39:22.000000000 +0200
  22 +++ beast-0.7.4/shell/bsescm.c  2012-04-26 21:18:52.321900930 +0200
  23 @@ -17,7 +17,7 @@
  24  #include <string.h>
  25  #include <errno.h>
  26  #include <unistd.h>
  27 -#include <guile/gh.h>
  28 +#include <libguile.h>
  29  #include <bse/bse.h>
  30  #include <bse/bsemain.h>  /* for bse_init_textdomain_only() */
  31  #include <sfi/sfistore.h> /* no bin-compat */
  32 @@ -33,7 +33,8 @@
  33
  34
  35  /* --- prototypes --- */
  36 -static void    gh_main                 (gint    argc,
  37 +static void    gh_main                 (void *closure,
  38 +                                        gint    argc,
  39                                          gchar  *argv[]);
  40  static void    shell_parse_args        (gint    *argc_p,
  41                                          gchar ***argv_p);
  42 @@ -108,14 +109,15 @@ main (int   argc,
  43    /* now that the BSE thread runs, drop scheduling priorities if we have any */
  44    setpriority (PRIO_PROCESS, getpid(), 0);
  45
  46 -  gh_enter (argc, argv, gh_main);
  47 +  scm_boot_guile (argc, argv, gh_main, NULL);
  48
  49    return 0;
  50  }
  51
  52
  53  static void
  54 -gh_main (int   argc,
  55 +gh_main (void * closure,
  56 +        int   argc,
  57          char *argv[])
  58  {
  59    /* initial interpreter setup */
  60 @@ -130,11 +132,11 @@ gh_main (int   argc,
  61
  62    /* exec Bse Scheme bootup code */
  63    const gchar *boot_script = g_intern_printf ("%s/%s", boot_script_path, "bse-scm-glue.boot");
  64 -  gh_load (boot_script);
  65 +  scm_c_primitive_load (boot_script);
  66
  67    /* eval, auto-play or interactive */
  68    if (bse_scm_eval_expr)
  69 -    gh_eval_str (bse_scm_eval_expr);
  70 +    scm_c_eval_string (bse_scm_eval_expr);
  71    else
  72      {
  73        gboolean call_auto_play = FALSE;
  74 @@ -157,14 +159,14 @@ gh_main (int   argc,
  75          }
  76        /* auto-play or interactive */
  77        if (call_auto_play)
  78 -        gh_eval_str ("(bse-scm-auto-play)");
  79 +        scm_c_eval_string ("(bse-scm-auto-play)");
  80        else
  81          {
  82            if (bse_scm_auto_load)
  83 -            gh_eval_str ("(bse-server-register-blocking bse-server-register-core-plugins #f)"
  84 +            scm_c_eval_string ("(bse-server-register-blocking bse-server-register-core-plugins #f)"
  85                           "(bse-server-register-blocking bse-server-register-scripts #f)"
  86                           "(bse-server-register-blocking bse-server-register-ladspa-plugins #f)");
  87 -          gh_repl (argc, argv);
  88 +          scm_shell (argc, argv);
  89          }
  90      }
  91
  92 --- beast-0.7.4/shell/bsescminterp.h.orig       2011-04-08 19:39:22.000000000 +0200
  93 +++ beast-0.7.4/shell/bsescminterp.h    2012-04-26 20:11:33.745318439 +0200
  94 @@ -18,7 +18,7 @@
  95  #define __BSE_SCM_INTERP_H__
  96
  97  #include <bse/bse.h>
  98 -#include <guile/gh.h>
  99 +#include <libguile.h>
 100
 101  G_BEGIN_DECLS
 102
 103 --- beast-0.7.4/shell/bsescminterp.c.orig       2011-04-08 19:39:22.000000000 +0200
 104 +++ beast-0.7.4/shell/bsescminterp.c    2012-04-26 20:59:51.038591385 +0200
 105 @@ -55,7 +55,7 @@
 106  #define IS_SCM_INT(s_scm)               SCM_I_INUMP (s_scm)     // scm_is_integer() breaks for non-fractional floats
 107  #define SFI_NUM_FROM_SCM(s_scm)         ((SfiNum) scm_to_int64 (s_scm))
 108  #define STRING_CHARS_FROM_SCM(s_scm)    scm_i_string_chars (s_scm)
 109 -#define STRING_LENGTH_FROM_SCM(s_scm)   scm_i_string_length (s_scm)
 110 +#define STRING_LENGTH_FROM_SCM(s_scm)   scm_c_string_length (s_scm)
 111  #define IS_SCM_STRING(s_scm)            scm_is_string (s_scm)
 112  #define IS_SCM_SYMBOL(s_scm)            scm_is_symbol (s_scm)
 113  #define IS_SCM_BOOL(s_scm)              scm_is_bool (s_scm)
 114 @@ -157,7 +157,7 @@ bse_scm_enter_gc (SCM           *scm_gc_
 115    gc_cell->free_func = free_func;
 116    gc_cell->size_hint = size_hint + sizeof (BseScmGCCell);
 117    SCM_NEWSMOB (s_cell, tc_glue_gc_cell, gc_cell);
 118 -  *scm_gc_list = gh_cons (s_cell, *scm_gc_list);
 119 +  *scm_gc_list = scm_cons (s_cell, *scm_gc_list);
 120  }
 121
 122  static SCM
 123 @@ -494,21 +494,21 @@ bse_scm_from_value (const GValue *value)
 124        sval = sfi_value_get_bool (value) ? SCM_BOOL_T : SCM_BOOL_F;
 125        break;
 126      case SFI_SCAT_INT:
 127 -      sval = gh_long2scm (sfi_value_get_int (value));
 128 +      sval = scm_from_long (sfi_value_get_int (value));
 129        break;
 130      case SFI_SCAT_NUM:
 131        sval = scm_long_long2num (sfi_value_get_num (value));
 132        break;
 133      case SFI_SCAT_REAL:
 134 -      sval = gh_double2scm (sfi_value_get_real (value));
 135 +      sval = scm_make_real (sfi_value_get_real (value));
 136        break;
 137      case SFI_SCAT_STRING:
 138        str = sfi_value_get_string (value);
 139 -      sval = str ? gh_str02scm (str) : BSE_SCM_NIL;
 140 +      sval = str ? scm_from_locale_string (str) : BSE_SCM_NIL;
 141        break;
 142      case SFI_SCAT_CHOICE:
 143        str = sfi_value_get_choice (value);
 144 -      sval = str ? gh_symbol2scm (str) : BSE_SCM_NIL;
 145 +      sval = str ? scm_from_locale_symbol (str) : BSE_SCM_NIL;
 146        break;
 147      case SFI_SCAT_BBLOCK:
 148        sval = BSE_SCM_NIL;
 149 @@ -692,7 +692,7 @@ signal_marshal_sproc (void *data)
 150    sdata->n_args = 0;
 151
 152    while (i--)
 153 -    args = gh_cons (bse_scm_from_value (sdata->args + i), args);
 154 +    args = scm_cons (bse_scm_from_value (sdata->args + i), args);
 155
 156    s_ret = scm_apply (sdata->s_lambda, args, SCM_EOL);
 157
 158 @@ -729,7 +729,7 @@ bse_scm_signal_connect (SCM s_proxy,
 159    proxy = SCM_GET_GLUE_PROXY (s_proxy);
 160
 161    SCM_ASSERT (IS_SCM_STRING (s_signal), s_signal, SCM_ARG2, "bse-signal-connect");
 162 -  SCM_ASSERT (gh_procedure_p (s_lambda), s_lambda,  SCM_ARG3, "bse-signal-connect");
 163 +  SCM_ASSERT (scm_is_true(scm_procedure_p (s_lambda)), s_lambda,  SCM_ARG3, "bse-signal-connect");
 164
 165    scm_gc_protect_object (s_lambda);
 166
 167 @@ -744,7 +744,7 @@ bse_scm_signal_connect (SCM s_proxy,
 168    id = sfi_glue_signal_connect_closure (proxy, sdata->signal, closure, NULL);
 169    BSE_SCM_ALLOW_INTS ();
 170
 171 -  return gh_ulong2scm (id);
 172 +  return scm_from_ulong (id);
 173  }
 174
 175  SCM
 176 @@ -917,14 +917,6 @@ void
 177  bse_scm_enable_script_register (gboolean enabled)
 178  {
 179    script_register_enabled = enabled != FALSE;
 180 -  if (script_register_enabled)
 181 -    {
 182 -      /* enable position recording wchih is required for __FILE__ and __LINE__ emulation */
 183 -      SCM_DEVAL_P = 1;
 184 -      SCM_BACKTRACE_P = 1;
 185 -      SCM_RECORD_POSITIONS_P = 1;
 186 -      SCM_RESET_DEBUG_MODE;
 187 -    }
 188  }
 189
 190  SCM
 191 @@ -1081,7 +1073,7 @@ bse_scm_context_pending (void)
 192    pending = sfi_glue_context_pending ();
 193    BSE_SCM_ALLOW_INTS ();
 194
 195 -  return gh_bool2scm (pending);
 196 +  return scm_from_bool (pending);
 197  }
 198
 199  SCM
 200 @@ -1090,7 +1082,7 @@ bse_scm_context_iteration (SCM s_may_blo
 201    BSE_SCM_DEFER_INTS ();
 202    if (sfi_glue_context_pending ())
 203      sfi_glue_context_dispatch ();
 204 -  else if (gh_scm2bool (s_may_block))
 205 +  else if (scm_from_bool (s_may_block))
 206      {
 207        /* FIXME: we need a real poll() based wait implementation here */
 208        do
 209 @@ -1124,14 +1116,14 @@ register_types (const gchar **types)
 210         {
 211           s = g_strdup_printf ("(define (bse-is-%s proxy) (bse-item-check-is-a proxy \"%s\"))",
 212                                sname + 4, *types);
 213 -         gh_eval_str (s);
 214 +         scm_c_eval_string (s);
 215           g_free (s);
 216         }
 217        for (i = 0; names[i]; i++)
 218         {
 219           gchar *s = g_strdup_printf ("(define %s-%s (lambda list (bse-glue-call \"%s+%s\" list)))",
 220                                       sname, names[i], *types, names[i]);
 221 -         gh_eval_str (s);
 222 +         scm_c_eval_string (s);
 223           g_free (s);
 224         }
 225        g_free (sname);
 226 @@ -1159,29 +1151,29 @@ bse_scm_interp_init (void)
 227
 228    tc_glue_rec = scm_make_smob_type ("BseGlueRec", 0);
 229    scm_set_smob_free (tc_glue_rec, bse_scm_free_glue_rec);
 230 -  gh_new_procedure ("bse-rec-get", bse_scm_glue_rec_get, 2, 0, 0);
 231 -  gh_new_procedure ("bse-rec-set", bse_scm_glue_rec_set, 3, 0, 0);
 232 -  gh_new_procedure ("bse-rec-new", bse_scm_glue_rec_new, 0, 1, 0);
 233 -  gh_new_procedure ("bse-rec-print", bse_scm_glue_rec_print, 1, 0, 0);
 234 +  scm_c_define_gsubr ("bse-rec-get", 2, 0, 0, bse_scm_glue_rec_get);
 235 +  scm_c_define_gsubr ("bse-rec-set", 3, 0, 0, bse_scm_glue_rec_set);
 236 +  scm_c_define_gsubr ("bse-rec-new", 0, 1, 0, bse_scm_glue_rec_new);
 237 +  scm_c_define_gsubr ("bse-rec-print", 1, 0, 0, bse_scm_glue_rec_print);
 238
 239    tc_glue_proxy = scm_make_smob_type ("SfiProxy", 0);
 240    SCM_NEWSMOB (glue_null_proxy, tc_glue_proxy, 0);
 241    scm_permanent_object (glue_null_proxy);
 242    scm_set_smob_equalp (tc_glue_proxy, bse_scm_proxy_equalp);
 243    scm_set_smob_print (tc_glue_proxy, bse_scm_proxy_print);
 244 -  gh_new_procedure ("bse-proxy-is-null?", bse_scm_proxy_is_null, 1, 0, 0);
 245 -  gh_new_procedure ("bse-proxy-get-null", bse_scm_proxy_get_null, 0, 1, 0);
 246 +  scm_c_define_gsubr ("bse-proxy-is-null?", 1, 0, 0, bse_scm_proxy_is_null);
 247 +  scm_c_define_gsubr ("bse-proxy-get-null", 0, 1, 0, bse_scm_proxy_get_null);
 248
 249 -  gh_new_procedure ("bse-glue-call", bse_scm_glue_call, 2, 0, 0);
 250 -  gh_new_procedure ("bse-glue-set-prop", bse_scm_glue_set_prop, 3, 0, 0);
 251 -  gh_new_procedure ("bse-glue-get-prop", bse_scm_glue_get_prop, 2, 0, 0);
 252 +  scm_c_define_gsubr ("bse-glue-call", 2, 0, 0, bse_scm_glue_call);
 253 +  scm_c_define_gsubr ("bse-glue-set-prop", 3, 0, 0, bse_scm_glue_set_prop);
 254 +  scm_c_define_gsubr ("bse-glue-get-prop", 2, 0, 0, bse_scm_glue_get_prop);
 255
 256    procs = sfi_glue_list_proc_names ();
 257    for (i = 0; procs[i]; i++)
 258      if (strncmp (procs[i], "bse-", 4) == 0)
 259        {
 260         gchar *s = g_strdup_printf ("(define bse-%s (lambda list (bse-glue-call \"%s\" list)))", procs[i] + 4, procs[i]);
 261 -       gh_eval_str (s);
 262 +       scm_c_eval_string (s);
 263         g_free (s);
 264        }
 265
 266 @@ -1189,15 +1181,15 @@ bse_scm_interp_init (void)
 267    procs2[1] = NULL;
 268    register_types (procs2);
 269
 270 -  gh_new_procedure0_0 ("bse-server-get", bse_scm_server_get);
 271 -  gh_new_procedure ("bse-script-register", bse_scm_script_register, 6, 0, 1);
 272 -  gh_new_procedure ("bse-script-fetch-args", bse_scm_script_args, 0, 0, 0);
 273 -  gh_new_procedure ("bse-choice-match?", bse_scm_choice_match, 2, 0, 0);
 274 -  gh_new_procedure ("bse-signal-connect", bse_scm_signal_connect, 3, 0, 0);
 275 -  gh_new_procedure ("bse-signal-disconnect", bse_scm_signal_disconnect, 2, 0, 0);
 276 -  gh_new_procedure ("bse-context-pending", bse_scm_context_pending, 0, 0, 0);
 277 -  gh_new_procedure ("bse-context-iteration", bse_scm_context_iteration, 1, 0, 0);
 278 -  gh_new_procedure ("bse-script-message", bse_scm_script_message, 1, 0, 1);
 279 -  gh_new_procedure ("bse-gettext", bse_scm_gettext, 1, 0, 0);
 280 -  gh_new_procedure ("bse-gettext-q", bse_scm_gettext_q, 1, 0, 0);
 281 +  scm_c_define_gsubr ("bse-server-get", 0, 0, 0, bse_scm_server_get);
 282 +  scm_c_define_gsubr ("bse-script-register", 6, 0, 1, bse_scm_script_register);
 283 +  scm_c_define_gsubr ("bse-script-fetch-args", 0, 0, 0, bse_scm_script_args);
 284 +  scm_c_define_gsubr ("bse-choice-match?", 2, 0, 0, bse_scm_choice_match);
 285 +  scm_c_define_gsubr ("bse-signal-connect", 3, 0, 0, bse_scm_signal_connect);
 286 +  scm_c_define_gsubr ("bse-signal-disconnect", 2, 0, 0, bse_scm_signal_disconnect);
 287 +  scm_c_define_gsubr ("bse-context-pending", 0, 0, 0, bse_scm_context_pending);
 288 +  scm_c_define_gsubr ("bse-context-iteration", 1, 0, 0, bse_scm_context_iteration);
 289 +  scm_c_define_gsubr ("bse-script-message", 1, 0, 1, bse_scm_script_message);
 290 +  scm_c_define_gsubr ("bse-gettext", 1, 0, 0, bse_scm_gettext);
 291 +  scm_c_define_gsubr ("bse-gettext-q", 1, 0, 0, bse_scm_gettext_q);
 292  }