X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-event-classes.scm;fp=scm%2Fdefine-event-classes.scm;h=c632e430a95f37a1dd184e8a8cdef5e4906ce132;hb=e90f0536f9be39ada0bef0aeb0d275dec3b2fb5b;hp=f5d7b790de852048db22b202fefa30c7ff4e1560;hpb=a8c9e8a7ca320ab0df5fd32e717fd62cd7635ce6;p=lilypond.git diff --git a/scm/define-event-classes.scm b/scm/define-event-classes.scm index f5d7b790de..c632e430a9 100644 --- a/scm/define-event-classes.scm +++ b/scm/define-event-classes.scm @@ -1,8 +1,19 @@ -;;;; stream-event-classes.scm -- define the tree of stream-event classes. +;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; source file of the GNU LilyPond music typesetter +;;;; Copyright (C) 2005--2011 Erik Sandberg ;;;; -;;;; (c) 2005-2006 Erik Sandberg +;;;; LilyPond is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . (use-modules (srfi srfi-1)) @@ -13,32 +24,35 @@ (StreamEvent . (RemoveContext ChangeParent Override Revert UnsetProperty SetProperty music-event OldMusicEvent CreateContext Prepare - OneTimeStep Finish)) - (music-event . (annotate-output-event + OneTimeStep Finish)) + (music-event . (annotate-output-event footnote-event arpeggio-event breathing-event extender-event span-event rhythmic-event dynamic-event break-event label-event percent-event - key-change-event string-number-event stroke-finger-event tie-event part-combine-event - beam-forbid-event script-event + key-change-event string-number-event stroke-finger-event tie-event + part-combine-event part-combine-force-event + beam-forbid-event script-event tempo-change-event tremolo-event bend-after-event fingering-event glissando-event harmonic-event hyphen-event laissez-vibrer-event mark-event - multi-measure-text-event note-grouping-event + multi-measure-text-event note-grouping-event pes-or-flexa-event repeat-tie-event spacing-section-event - layout-instruction-event)) - - (layout-instruction-event . (apply-output-event )) + layout-instruction-event completize-extender-event break-span-event)) + + (layout-instruction-event . (apply-output-event)) (script-event . (articulation-event text-script-event)) (part-combine-event . (solo-one-event solo-two-event unisono-event)) (break-event . (line-break-event page-break-event page-turn-event)) (dynamic-event . (absolute-dynamic-event)) - (span-event . (span-dynamic-event beam-event ligature-event + (span-event . (span-dynamic-event beam-event episema-event ligature-event pedal-event phrasing-slur-event slur-event staff-span-event - text-span-event trill-span-event tremolo-span-event + text-span-event trill-span-event tremolo-span-event tuplet-span-event)) (span-dynamic-event . (decrescendo-event crescendo-event)) + (break-span-event . (break-dynamic-span-event)) (pedal-event . (sostenuto-event sustain-event una-corda-event)) (rhythmic-event . (lyric-event melodic-event multi-measure-rest-event - percent-event - rest-event skip-event bass-figure-event)) + double-percent-event percent-event + repeat-slash-event rest-event + skip-event bass-figure-event)) (melodic-event . (cluster-note-event note-event)) (() . (Announcement)) (Announcement . (AnnounceNewContext)) @@ -54,11 +68,26 @@ (lambda (rel) (for-each (lambda (type) - (hashq-set! ancestor-lookup type + (hashq-set! ancestor-lookup type (cons type (hashq-ref ancestor-lookup (car rel) '())))) (cdr rel))) event-classes) +(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) + '())))))) + ;; TODO: Allow entering more complex classes, by taking unions. (define-public (ly:make-event-class leaf) (hashq-ref ancestor-lookup leaf)) @@ -84,10 +113,11 @@ root))) ;; All leaf event classes that no translator listens to -;; directly. Avoids printing a warning. +;; directly. Avoids printing a warning. (define unlistened-music-event-classes '(harmonic-event line-break-event page-break-event page-turn-event label-event - solo-one-event solo-two-event skip-event unisono-event)) + solo-one-event solo-two-event skip-event unisono-event + part-combine-force-event break-dynamic-span-event)) ;; produce neater representation of music event tree. ;; TODO: switch to this representation for the event-classes list? @@ -111,12 +141,12 @@ ;; check that the music event tree corresponds well with the set of ;; available translators; print warnings otherwise. -(map-tree (lambda (sym) +(map-tree (lambda (sym) (if (and (symbol? sym) (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))) + (ly:programming-error (_ "event class ~A seems to be unused") sym))) music-event-tree) (map (lambda (sym) @@ -163,4 +193,3 @@ (define-public (ly:simplify-scheme e) (list 'quasiquote (simplify e))) -