X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-event-classes.scm;h=8695bc5b78874801405a36288a8c5757e0679bfd;hb=e00d0d078eece6de5cbcf6b83b43238a010628c0;hp=84f8a147984e8fdbc13a032fd248a5522df615fe;hpb=d5f9fb204d218c68122d27fc06146cfcd297e65a;p=lilypond.git diff --git a/scm/define-event-classes.scm b/scm/define-event-classes.scm index 84f8a14798..8695bc5b78 100644 --- a/scm/define-event-classes.scm +++ b/scm/define-event-classes.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 2005--2012 Erik Sandberg +;;;; Copyright (C) 2005--2015 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 @@ -25,19 +25,20 @@ (RemoveContext ChangeParent Override Revert UnsetProperty SetProperty music-event OldMusicEvent CreateContext Prepare - OneTimeStep Finish)) + OneTimeStep Finish GraceChange)) (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 part-combine-force-event + part-combine-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 pes-or-flexa-event repeat-tie-event spacing-section-event layout-instruction-event + time-signature-event completize-extender-event break-span-event alternative-event)) (layout-instruction-event . (apply-output-event)) @@ -98,21 +99,20 @@ ;; (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*) +(define-public (define-event-class class parent) + "Defines a new event @code{class} derived from @code{parent}, a +previously defined event class." + (let ((parentclass (ly:make-event-class parent))) + (cond + ((ly:make-event-class class) + (ly:error (_ "Cannot redefine event class `~S'") class)) + ((not parentclass) + (ly:error (_ "Undefined parent event class `~S'") parentclass)) + (else + (hashq-set! ancestor-lookup + class + (cons class parentclass)))) + *unspecified*)) ;; TODO: Allow entering more complex classes, by taking unions. (define-public (ly:make-event-class leaf) @@ -159,7 +159,7 @@ ;;(pretty-print (cons (car music-event-tree) (sort-tree (cdr music-event-tree)))) (defmacro-public make-stream-event (expr) - (Stream_event::undump (primitive-eval (list 'quasiquote expr)))) + (ly:stream-event::undump (primitive-eval (list 'quasiquote expr)))) (define* (simplify e) (cond @@ -168,7 +168,7 @@ ((pair? e) (cons (simplify (car e)) (simplify (cdr e)))) ((ly:stream-event? e) - (list 'unquote (list 'make-stream-event (simplify (Stream_event::dump e))))) + (list 'unquote (list 'make-stream-event (simplify (ly:stream-event::dump e))))) ((ly:music? e) (list 'unquote (music->make-music e))) ((ly:moment? e) @@ -183,7 +183,7 @@ (list 'unquote `(ly:make-duration ,(ly:duration-log e) ,(ly:duration-dot-count e) - ,(ly:duration-scale)))) + ,(ly:duration-scale e)))) ((ly:pitch? e) (list 'unquote `(ly:make-pitch ,(ly:pitch-octave e)