From: David Kastrup Date: Thu, 4 Jul 2013 12:06:35 +0000 (+0200) Subject: Revert "Make EventClass hierarchy a property of Global context" X-Git-Tag: release/2.17.22-1~9 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=21de640f0cb858515c587774f8f78598d9035591;p=lilypond.git Revert "Make EventClass hierarchy a property of Global context" This reverts commit ae2db5b21bf232f5145f3a3e091689c8fc7247e9. Conflicts: lily/context-scheme.cc lily/global-context.cc lily/music.cc lily/part-combine-iterator.cc scm/define-event-classes.scm scm/document-music.scm Independently introduced conflict: lily/footnote-engraver.cc Also fix tabs reintroduced by revert --- diff --git a/input/regression/scheme-text-spanner.ly b/input/regression/scheme-text-spanner.ly index 6a26177850..e4d84a1cbb 100644 --- a/input/regression/scheme-text-spanner.ly +++ b/input/regression/scheme-text-spanner.ly @@ -6,27 +6,11 @@ and grob creation methods to create a fully functional text spanner in scheme." } -#(define my-grob-descriptions '()) - -#(define my-event-classes (ly:make-context-mod)) - -defineEventClass = -#(define-void-function (parser location class parent) - (symbol? symbol?) - (ly:add-context-mod - my-event-classes - `(apply - ,(lambda (context class parent) - (ly:context-set-property! - context - 'EventClasses - (event-class-cons - class - parent - (ly:context-property context 'EventClasses '())))) - ,class ,parent))) - -\defineEventClass #'scheme-text-span-event #'span-event +#(define-event-class 'scheme-text-span-event + '(scheme-text-span-event + span-event + music-event + StreamEvent)) #(define (add-grob-definition grob-name grob-entry) (let* ((meta-entry (assoc-get 'meta grob-entry)) @@ -49,9 +33,9 @@ defineEventClass = (set! meta-entry (assoc-set! meta-entry 'interfaces ifaces-entry)) (set! grob-entry (assoc-set! grob-entry 'meta meta-entry)) - (set! my-grob-descriptions + (set! all-grob-descriptions (cons (cons grob-name grob-entry) - my-grob-descriptions)))) + all-grob-descriptions)))) #(add-grob-definition 'SchemeTextSpanner @@ -197,8 +181,7 @@ schemeTextSpannerEnd = \layout { \context { \Global - \grobdescriptions #my-grob-descriptions - #my-event-classes + \grobdescriptions #all-grob-descriptions } \context { \Voice diff --git a/lily/context-scheme.cc b/lily/context-scheme.cc index 64f8dd8e15..f58a793ed4 100644 --- a/lily/context-scheme.cc +++ b/lily/context-scheme.cc @@ -211,15 +211,3 @@ LY_DEFINE (ly_context_events_below, "ly:context-events-below", Context *ctx = unsmob_context (context); return ctx->events_below ()->self_scm (); } - -LY_DEFINE (ly_make_event_class, "ly:make-event-class", - 2, 0, 0, (SCM context, SCM type), - "Make an event class (a list of types) from the given @var{type}" - " within the global context containing @var{context}.") -{ - LY_ASSERT_SMOB (Context, context, 1); - LY_ASSERT_TYPE (ly_is_symbol, type, 2); - - Context *ctx = unsmob_context (context); - return ctx->make_event_class (type); -} diff --git a/lily/context.cc b/lily/context.cc index 3da638fe55..3453284cd8 100644 --- a/lily/context.cc +++ b/lily/context.cc @@ -92,7 +92,6 @@ Context::Context () definition_mods_ = SCM_EOL; event_source_ = 0; events_below_ = 0; - ancestor_lookup_ = SCM_UNDEFINED; smobify_self (); @@ -479,7 +478,9 @@ be called from any other place than the send_stream_event macro. void Context::internal_send_stream_event (SCM type, Input *origin, SCM props[]) { - Stream_event *e = new Stream_event (make_event_class (type), origin); + Stream_event *e = new Stream_event + (scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), type), + origin); for (int i = 0; props[i]; i += 2) { e->set_property (props[i], props[i + 1]); @@ -619,14 +620,6 @@ Context::get_score_context () const return 0; } -SCM -Context::make_event_class (SCM event_type) -{ - if (SCM_UNBNDP (ancestor_lookup_)) - ancestor_lookup_ = get_global_context ()->ancestor_lookup_; - return scm_hashq_ref (ancestor_lookup_, event_type, SCM_EOL); -} - Output_def * Context::get_output_def () const { @@ -696,8 +689,6 @@ Context::mark_smob (SCM sm) if (me->events_below_) scm_gc_mark (me->events_below_->self_scm ()); - scm_gc_mark (me->ancestor_lookup_); - return me->properties_scm_; } diff --git a/lily/engraver.cc b/lily/engraver.cc index db1303d63c..b8bf1234c0 100644 --- a/lily/engraver.cc +++ b/lily/engraver.cc @@ -53,7 +53,7 @@ Engraver::make_grob_info (Grob *e, SCM cause) /* TODO: Remove Music code when it's no longer needed */ if (Music *m = unsmob_music (cause)) { - cause = m->to_event (context ())->unprotect (); + cause = m->to_event ()->unprotect (); } if (e->get_property ("cause") == SCM_EOL && (unsmob_stream_event (cause) || unsmob_grob (cause))) diff --git a/lily/footnote-engraver.cc b/lily/footnote-engraver.cc index 39e18cd57c..20ee7c149f 100644 --- a/lily/footnote-engraver.cc +++ b/lily/footnote-engraver.cc @@ -88,7 +88,7 @@ Footnote_engraver::acknowledge_grob (Grob_info info) return; } - footnotify (info.grob (), mus->to_event (context ())->unprotect ()); + footnotify (info.grob (), mus->to_event ()->unprotect ()); // This grob has exhausted its footnote info.grob ()->set_property ("footnote-music", SCM_EOL); diff --git a/lily/global-context.cc b/lily/global-context.cc index 8f22b943ef..49bfff6e19 100644 --- a/lily/global-context.cc +++ b/lily/global-context.cc @@ -52,12 +52,6 @@ Global_context::Global_context (Output_def *o) else globaldef->apply_default_property_operations (this); - SCM p = get_property ("EventClasses"); - - ancestor_lookup_ = scm_make_hash_table (scm_length (p)); - for (; scm_is_pair (p); p = scm_cdr (p)) - scm_hashq_set_x (ancestor_lookup_, scm_caar (p), scm_car (p)); - default_child_ = ly_symbol2scm ("Score"); accepts_list_ = scm_list_1 (default_child_); } diff --git a/lily/include/context.hh b/lily/include/context.hh index 794f275287..14c348f6e4 100644 --- a/lily/include/context.hh +++ b/lily/include/context.hh @@ -118,13 +118,6 @@ public: virtual Moment now_mom () const; virtual Context *get_default_interpreter (string context_id = ""); - // It would make some sense to have the following just available in - // a global context. It would be decidedly tricky, however, to have - // it initialized before the constructor of its Context base class - // was able to trigger garbage collection. - SCM ancestor_lookup_; - SCM make_event_class (SCM); - bool is_alias (SCM) const; void add_alias (SCM); void add_context (Context *trans); diff --git a/lily/include/music.hh b/lily/include/music.hh index b0f4837104..83cc5ff4c3 100644 --- a/lily/include/music.hh +++ b/lily/include/music.hh @@ -24,7 +24,6 @@ #include "moment.hh" #include "pitch.hh" #include "prob.hh" -#include "context.hh" #define is_mus_type(x) internal_is_music_type (ly_symbol2scm (x)) @@ -40,7 +39,7 @@ public: bool internal_is_music_type (SCM) const; - Stream_event *to_event (Context *) const; + Stream_event *to_event () const; DECLARE_SCHEME_CALLBACK (relative_callback, (SCM, SCM)); Pitch to_relative_octave (Pitch); diff --git a/lily/music.cc b/lily/music.cc index be1fb2ed13..eea6a9ca81 100644 --- a/lily/music.cc +++ b/lily/music.cc @@ -275,7 +275,7 @@ Music::origin () const ES TODO: This method should probably be reworked or junked. */ Stream_event * -Music::to_event (Context *c) const +Music::to_event () const { SCM class_name = ly_camel_case_2_lisp_identifier (get_property ("name")); @@ -283,8 +283,9 @@ Music::to_event (Context *c) const if (!internal_is_music_type (class_name)) programming_error ("Not a music type"); - Stream_event *e = new Stream_event (c->make_event_class (class_name), - mutable_property_alist_); + Stream_event *e = new Stream_event + (scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), class_name), + mutable_property_alist_); Moment length = get_length (); if (length.to_bool ()) e->set_property ("length", length.smobbed_copy ()); @@ -297,7 +298,7 @@ Music::to_event (Context *c) const for (; scm_is_pair (art_mus); art_mus = scm_cdr (art_mus)) { Music *m = unsmob_music (scm_car (art_mus)); - art_ev = scm_cons (m->to_event (c)->unprotect (), art_ev); + art_ev = scm_cons (m->to_event ()->unprotect (), art_ev); } e->set_property ("articulations", scm_reverse_x (art_ev, SCM_EOL)); } @@ -314,7 +315,7 @@ Music::to_event (Context *c) const void Music::send_to_context (Context *c) { - Stream_event *ev = to_event (c); + Stream_event *ev = to_event (); c->event_source ()->broadcast (ev); ev->unprotect (); } diff --git a/lily/part-combine-iterator.cc b/lily/part-combine-iterator.cc index c0c9acc893..69c7857b7e 100644 --- a/lily/part-combine-iterator.cc +++ b/lily/part-combine-iterator.cc @@ -224,8 +224,8 @@ Part_combine_iterator::kill_mmrest (int in) if (!mmrest_event_) { mmrest_event_ = new Stream_event - (handles_[in].get_context ()->make_event_class - (ly_symbol2scm ("multi-measure-rest-event"))); + (scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), + ly_symbol2scm ("multi-measure-rest-event"))); mmrest_event_->set_property ("duration", SCM_EOL); mmrest_event_->unprotect (); } @@ -256,15 +256,16 @@ Part_combine_iterator::unisono (bool silent) if (playing_state_ != UNISONO && newstate == UNISONO) { - Context *out = (last_playing_ == SOLO2 ? second_iter_ : first_iter_) - ->get_outlet (); if (!unisono_event_) { unisono_event_ = new Stream_event - (out->make_event_class (ly_symbol2scm ("unisono-event"))); + (scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), + ly_symbol2scm ("unisono-event"))); unisono_event_->unprotect (); } + Context *out = (last_playing_ == SOLO2 ? second_iter_ : first_iter_) + ->get_outlet (); out->event_source ()->broadcast (unisono_event_); playing_state_ = UNISONO; } @@ -290,8 +291,8 @@ Part_combine_iterator::solo1 () if (!solo_one_event_) { solo_one_event_ = new Stream_event - (first_iter_->get_outlet ()->make_event_class - (ly_symbol2scm ("solo-one-event"))); + (scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), + ly_symbol2scm ("solo-one-event"))); solo_one_event_->unprotect (); } @@ -317,8 +318,8 @@ Part_combine_iterator::solo2 () if (!solo_two_event_) { solo_two_event_ = new Stream_event - (second_iter_->get_outlet ()->make_event_class - (ly_symbol2scm ("solo-two-event"))); + (scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), + ly_symbol2scm ("solo-two-event"))); solo_two_event_->unprotect (); } diff --git a/lily/rhythmic-music-iterator.cc b/lily/rhythmic-music-iterator.cc index c1edba9702..64daa8ea5b 100644 --- a/lily/rhythmic-music-iterator.cc +++ b/lily/rhythmic-music-iterator.cc @@ -47,7 +47,7 @@ Rhythmic_music_iterator::process (Moment m) descend_to_bottom_context (); Context *c = get_outlet (); - Stream_event *ev = get_music ()->to_event (c); + Stream_event *ev = get_music ()->to_event (); SCM arts = ev->get_property ("articulations"); if (scm_is_pair (arts)) diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly index 2541163a76..99647c75d0 100644 --- a/ly/engraver-init.ly +++ b/ly/engraver-init.ly @@ -26,7 +26,6 @@ \defaultchild "Score" \description "Hard coded entry point for LilyPond. Cannot be tuned." \grobdescriptions #all-grob-descriptions - EventClasses = #all-event-classes } \context { diff --git a/ly/performer-init.ly b/ly/performer-init.ly index a108212eae..8e3ef0e7ef 100644 --- a/ly/performer-init.ly +++ b/ly/performer-init.ly @@ -37,7 +37,6 @@ \accepts Score \defaultchild Score \description "Hard coded entry point for LilyPond. Cannot be tuned." - EventClasses = #all-event-classes } \context { diff --git a/scm/define-context-properties.scm b/scm/define-context-properties.scm index 180675e2f8..1cbd9fb8b2 100644 --- a/scm/define-context-properties.scm +++ b/scm/define-context-properties.scm @@ -641,7 +641,6 @@ are described in @file{scm/bar-line.scm}.") (apply translator-property-description x)) `( - (EventClasses ,cheap-list? "The initial list of event classes.") (associatedVoiceContext ,ly:context? "The context object of the @code{Voice} that has the melody for this @code{Lyrics}.") diff --git a/scm/define-event-classes.scm b/scm/define-event-classes.scm index fb790a591f..05d8542b00 100644 --- a/scm/define-event-classes.scm +++ b/scm/define-event-classes.scm @@ -78,19 +78,47 @@ (acons elt lineage alist)) classlist class)))) +(define all-event-classes + (fold (lambda (elt classlist) + (event-class-cons (cdr elt) (car elt) classlist)) + '() event-classes)) + +;; Maps event-class to a list of ancestors (inclusive) +(define-public ancestor-lookup + (let ((h (make-hash-table (length all-event-classes)))) + (for-each (lambda (ent) (hashq-set! h (car ent) ent)) + all-event-classes) + h)) + + ;; Each class will be defined as ;; (class parent grandparent .. ) ;; so that (eq? (cdr class) parent) holds. +(define-public (define-event-class leaf heritage) + (cond + ((not (eq? leaf (car heritage))) + (ly:warning (_ "All classes must be the last in their matrilineal line."))) + ((not (equal? (cdr heritage) + (list-head (hashq-ref ancestor-lookup (cadr heritage) '()) + (length (cdr heritage))))) + (ly:warning (_ "All classes must have a well-defined pedigree in the existing class hierarchy."))) + (else (hashq-set! ancestor-lookup + leaf + (cons leaf + (hashq-ref ancestor-lookup + (cadr heritage) + '()))))) + *unspecified*) + +;; TODO: Allow entering more complex classes, by taking unions. +(define-public (ly:make-event-class leaf) + (hashq-ref ancestor-lookup leaf)) + (define-public (ly:in-event-class? ev cl) "Does event @var{ev} belong to event class @var{cl}?" (memq cl (ly:event-property ev 'class))) -(define-public all-event-classes - (fold (lambda (elt classlist) - (event-class-cons (cdr elt) (car elt) classlist)) - '() event-classes)) - ;; does this exist in guile already? (define (map-tree f t) (cond diff --git a/scm/document-music.scm b/scm/document-music.scm index 92c2b52487..ef31ec1f6a 100644 --- a/scm/document-music.scm +++ b/scm/document-music.scm @@ -16,8 +16,6 @@ ;;;; You should have received a copy of the GNU General Public License ;;;; along with LilyPond. If not, see . -(define doc-context (ly:make-global-context $defaultlayout)) - (define (music-props-doc) (make #:name "Music properties" @@ -33,7 +31,7 @@ (define music-types->names (make-hash-table 61)) (filter-map (lambda (entry) (let* ((class (ly:camel-case->lisp-identifier (car entry))) - (classes (ly:make-event-class doc-context class))) + (classes (ly:make-event-class class))) (if classes (map (lambda (cl) @@ -90,7 +88,7 @@ (let* ((namesym (car obj)) (props (cdr obj)) (class (ly:camel-case->lisp-identifier namesym)) - (classes (ly:make-event-class doc-context class)) + (classes (ly:make-event-class class)) (accept-list (if classes (human-listify (map ref-ify