SCM
random2scm(Random* rnd)
{
SCM_DEFER_INTS;
SCM smob;
SCM_NEWCELL (smob);
SCM_SETCDR (smob, rnd);
SCM_SETCAR (smob, random_tag_type);
SCM_ALLOW_INTS;
return smob;
}
SCM
gconf2scm (GConfEngine* conf)
{
SCM smob;
gh_defer_ints();
SCM_NEWCELL (smob);
SCM_SETCDR (smob, conf);
SCM_SETCAR (smob, gconf_type_tag);
gh_allow_ints();
return smob;
}
inline void tmscm_set_cdr (tmscm a, tmscm b) { SCM_SETCDR(a,b); }
void
scm_i_rehash (SCM table,
scm_t_hash_fn hash_fn,
void *closure,
const char* func_name)
{
SCM buckets, new_buckets;
int i;
unsigned long old_size;
unsigned long new_size;
if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table))
{
/* rehashing is not triggered when i <= min_size */
i = SCM_HASHTABLE (table)->size_index;
do
--i;
while (i > SCM_HASHTABLE (table)->min_size_index
&& SCM_HASHTABLE_N_ITEMS (table) < hashtable_size[i] / 4);
}
else
{
i = SCM_HASHTABLE (table)->size_index + 1;
if (i >= HASHTABLE_SIZE_N)
/* don't rehash */
return;
}
SCM_HASHTABLE (table)->size_index = i;
new_size = hashtable_size[i];
if (i <= SCM_HASHTABLE (table)->min_size_index)
SCM_HASHTABLE (table)->lower = 0;
else
SCM_HASHTABLE (table)->lower = new_size / 4;
SCM_HASHTABLE (table)->upper = 9 * new_size / 10;
buckets = SCM_HASHTABLE_VECTOR (table);
new_buckets = scm_c_make_vector (new_size, SCM_EOL);
SCM_SET_HASHTABLE_VECTOR (table, new_buckets);
SCM_SET_HASHTABLE_N_ITEMS (table, 0);
old_size = SCM_SIMPLE_VECTOR_LENGTH (buckets);
for (i = 0; i < old_size; ++i)
{
SCM ls, cell, handle;
ls = SCM_SIMPLE_VECTOR_REF (buckets, i);
SCM_SIMPLE_VECTOR_SET (buckets, i, SCM_EOL);
while (scm_is_pair (ls))
{
unsigned long h;
cell = ls;
handle = SCM_CAR (cell);
ls = SCM_CDR (ls);
h = hash_fn (SCM_CAR (handle), new_size, closure);
if (h >= new_size)
scm_out_of_range (func_name, scm_from_ulong (h));
SCM_SETCDR (cell, SCM_SIMPLE_VECTOR_REF (new_buckets, h));
SCM_SIMPLE_VECTOR_SET (new_buckets, h, cell);
SCM_HASHTABLE_INCREMENT (table);
}
}
}
void gwave_main(void *p, int argc, char **argv)
{
int c;
int i;
int nobacktrace = 0;
/* In guile-1.5 and later, need to use scm_primitive_eval_x
* in order to change modules so that our C primitives
* registered below become globals, instead of hidden away
* in the guile-user module
*/
{
SCM exp = scm_c_read_string("(define-module (guile))");
scm_primitive_eval_x(exp);
}
init_scwm_guile();
init_gtkmisc();
init_gwave();
init_cmd();
init_wavewin();
init_wavelist();
init_wavepanel();
init_event();
init_draw();
gtk_init(&argc, &argv);
prog_name = argv[0];
/* simple pre-processing of debugging options that we need to set up
* before we get into guile. These options cannot be bundled.
* Most of the general user options are handled in std-args.scm */
for(i = 1; i < argc; i++) {
if(strcmp(argv[i], "-n") == 0) {
nobacktrace = 1;
} else if (strcmp(argv[i], "-v") == 0) {
v_flag = 1;
} else if (strcmp(argv[i], "-x") == 0) {
x_flag = 1;
SCM_SETCDR(scm_gwave_debug, SCM_BOOL_T);
}
}
gtk_rc_parse_string(gwave_base_gtkrc);
gtk_rc_parse("gwave.gtkrc");
// assert( SCM_CONSP(scm_gwave_tooltips) );
#ifdef GUILE_GTK_EXTRA_LOADPATH
scm_c_eval_string("(set! %load-path (cons \"" GUILE_GTK_EXTRA_LOADPATH "\" %load-path))");
#endif
/* the default for this seems to have changed between guile-1.3
and guile-1.3.2; only the first clause is needed when
we drop support for guile-1.3.2 */
if (!nobacktrace) {
scm_c_eval_string("(debug-enable 'debug)(debug-enable 'backtrace) (read-enable 'positions)");
} /* else {
scm_c_eval_str("(debug-disable 'debug)(read-disable 'positions)");
}*/
/* the compiled-in initial scheme code comes from minimal.scm,
built into init_scheme_string.c by the Makefile
Among other things, it finds and loads system and user .gwaverc
files.
*/
{ /* scope */
extern char *init_scheme_string;
SCM res;
if(v_flag) {fprintf(stderr, "running init_scheme_string\n");}
res = scwm_safe_eval_str(init_scheme_string);
if(v_flag) {
printf("result="); fflush(stdout);
scm_display(res, scm_cur_outp);
printf("\n"); fflush(stdout);
}
if(!SCM_NFALSEP(res)) {
fprintf(stderr, "gwave: aborting due to errors.\n");
exit(1);
}
} /* end scope */
wtable = g_new0(WaveTable, 1);
wtable->cursor[0] = g_new0(VBCursor, 1);
wtable->cursor[1] = g_new0(VBCursor, 1);
wtable->srange = g_new0(SelRange, 1);
wtable->npanels = 0;
wtable->panels = NULL;
setup_colors(wtable);
setup_waveform_window();
xg_init(NULL); /* X-server interprocess communication for Gtk+ */
gtk_main();
exit(0);
}
