2006-08-08 Han-Wen Nienhuys <hanwen@lilypond.org>
+ * scm/define-event-classes.scm (lambda): use ly:is-listened-event-class
+
+ * lily/ly-module.cc (ly_module_symbols): use ly_hash_table_keys
+
+ * lily/translator.cc (LY_DEFINE): ly:is-listened-event-class: new
+ function. Use hash tables to check membership.
+
+ * lily/general-scheme.cc (LY_DEFINE): new function.
+
+ * lily/piano-pedal-engraver.cc (struct Pedal_type_info): idem
+
+ * lily/include/translator.hh (struct Acknowledge_information): add Protected_scm
+
* ly/music-functions-init.ly: change name to BreathingEvent
* input/regression/*.ly: apply it.
freopen (ly_scm2newstr (file_name, 0), m, stderr);
return SCM_UNSPECIFIED;
}
+
+static SCM
+accumulate_symbol (void *closure, SCM key, SCM val, SCM result)
+{
+ (void) closure;
+ (void) val;
+ return scm_cons (key, result);
+}
+
+LY_DEFINE(ly_hash_table_keys, "ly:hash-table-keys",
+ 1,0,0, (SCM tab),
+ "return a list of keys in @var{tab}")
+{
+ return scm_internal_hash_fold ((Hash_closure_function) & accumulate_symbol,
+ NULL, SCM_EOL, tab);
+}
SCM ly_alist_vals (SCM alist);
SCM ly_hash2alist (SCM tab);
-
+SCM ly_hash_table_keys (SCM tab);
int procedure_arity (SCM);
/* inserts at front, removing dublicates */
#include "input.hh"
#include "smobs.hh"
#include "std-vector.hh"
+#include "protected-scm.hh"
struct Acknowledge_information
{
- SCM symbol_;
+ Protected_scm symbol_;
Engraver_void_function_engraver_grob_info function_;
};
cxx_id = replace_all (cxx_id, '_', '-');
return cxx_id;
}
+
#define FUNC_NAME __FUNCTION__
-static SCM
-accumulate_symbol (void *closure, SCM key, SCM val, SCM result)
-{
- (void) closure;
- (void) val;
- return scm_cons (key, result);
-}
+
SCM
ly_module_symbols (SCM mod)
SCM_VALIDATE_MODULE (1, mod);
SCM obarr = SCM_MODULE_OBARRAY (mod);
- return scm_internal_hash_fold ((Hash_closure_function) & accumulate_symbol,
- NULL, SCM_EOL, obarr);
+ return ly_hash_table_keys (obarr);
}
static SCM
#include "stream-event.hh"
#include "string-convert.hh"
#include "warn.hh"
-
+#include "protected-scm.hh"
#include "translator.icc"
/*
struct Pedal_type_info
{
string base_name_;
- SCM event_class_sym_;
- SCM style_sym_;
- SCM strings_sym_;
+ Protected_scm event_class_sym_;
+ Protected_scm style_sym_;
+ Protected_scm strings_sym_;
+
const char *pedal_line_spanner_c_str_;
const char *pedal_c_str_;
};
Pedal_type_info *tbl = &pedal_types_[i];
tbl->base_name_ = name;
- /* These symbols are static and need to be protected */
- tbl->event_class_sym_ = scm_gc_protect_object (scm_str2symbol ((base_ident + "-event").c_str ()));
+ tbl->event_class_sym_ = scm_str2symbol ((base_ident + "-event").c_str ());
tbl->pedal_line_spanner_c_str_ = strdup ((base_name + "PedalLineSpanner").c_str ());
- tbl->style_sym_ = scm_gc_protect_object (scm_str2symbol (("pedal" + base_name + "Style").c_str ()));
- tbl->strings_sym_ = scm_gc_protect_object (scm_str2symbol (("pedal" + base_name + "Strings").c_str ()));
+ tbl->style_sym_ = scm_str2symbol (("pedal" + base_name + "Style").c_str ());
+ tbl->strings_sym_ = scm_str2symbol (("pedal" + base_name + "Strings").c_str ());
tbl->pedal_c_str_ = strdup ((base_name + "Pedal").c_str ());
}
}
c->events_below ()->remove_listener (r->get_listener_ (this), r->event_class_);
}
-static SCM listened_event_classes = SCM_EOL;
+static SCM listened_event_class_table;
+void
+ensure_listened_hash ()
+{
+ if (!listened_event_class_table)
+ listened_event_class_table = scm_permanent_object (scm_c_make_hash_table (61));
+}
+
LY_DEFINE (ly_get_listened_event_classes, "ly:get-listened-event-classes",
0, 0, 0, (),
"Returns a list of all event classes that some translator listens to.")
{
- return listened_event_classes;
+ ensure_listened_hash ();
+ return ly_hash_table_keys (listened_event_class_table);
+}
+
+LY_DEFINE (ly_is_listened_event_class, "ly:is-listened-event-class",
+ 1, 0, 0, (SCM sym),
+ "Is @var{sym} a listened event class?")
+{
+ ensure_listened_hash ();
+ return scm_hashq_ref (listened_event_class_table, sym, SCM_BOOL_F);
}
+void
+add_listened_event_class (SCM sym)
+{
+ ensure_listened_hash ();
+
+ scm_hashq_set_x (listened_event_class_table, sym, SCM_BOOL_T);
+}
+
+
/*
- Internally called once, statically, for each translator
+ internally called once, statically, for each translator
listener. Connects the name of an event class with a procedure that
fetches the corresponding listener.
*/
void
Translator::add_translator_listener (translator_listener_record **listener_list,
- translator_listener_record *r,
- Listener (*get_listener) (void *),
- const char *ev_class)
+ translator_listener_record *r,
+ Listener (*get_listener) (void *),
+ const char *ev_class)
{
/* ev_class is the C++ identifier name. Convert to scm symbol */
string name = string (ev_class);
name = replace_all (name, '_', '-');
- name = name + "-event";
+ name += "-event";
+
/* It's OK to use scm_gc_protect_object for protection, because r is
statically allocated. */
- SCM class_sym = scm_gc_protect_object (scm_str2symbol (name.c_str ()));
- listened_event_classes = scm_gc_protect_object (scm_cons (class_sym, listened_event_classes));
+ // NO it's damn not !!!! --hwn
+ SCM class_sym = scm_str2symbol (name.c_str ());
+
+ add_listened_event_class (class_sym);
r->event_class_ = class_sym;
r->get_listener_ = get_listener;
r->next_ = *listener_list;
interface_name = replace_all (interface_name, '_', '-');
interface_name += "-interface";
- inf.symbol_ = scm_gc_protect_object (ly_symbol2scm (interface_name.c_str ()));
+ inf.symbol_ = ly_symbol2scm (interface_name.c_str ());
ack_array->push_back (inf);
}
;; available translators; print warnings otherwise.
(map-tree (lambda (sym)
(if (and (symbol? sym)
- (not (memq sym (ly:get-listened-event-classes)))
+ (not (ly:is-listened-event-class sym))
(not (assq sym event-classes))
(not (memq sym unlistened-music-event-classes)))
(ly:programming-error (_ "event class ~A seems to be unused") sym)))
music-event-tree)
+
(map (lambda (sym)
(if (not (pair? (ly:make-event-class sym)))
;; should be programming-error
projects / lilypond.git / commitdiff