]> git.donarmstrong.com Git - lilypond.git/blobdiff - input/regression/scheme-text-spanner.ly
Imported Upstream version 2.16.0
[lilypond.git] / input / regression / scheme-text-spanner.ly
index 6541f05a3463941d0e0b7d8cc350dbb4c4061227..a83bec87aa74c642c8e21e115aefeb1307ee4667 100644 (file)
@@ -1,4 +1,4 @@
-\version "2.14.0"
+\version "2.16.0"
 
 \header {
   texidoc = "Use @code{define-event-class}, scheme engraver methods,
@@ -6,11 +6,27 @@ and grob creation methods to create a fully functional text spanner
 in scheme."
 }
 
-#(define-event-class 'scheme-text-span-event
-   '(scheme-text-span-event
-     span-event
-     music-event
-     StreamEvent))
+#(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 (add-grob-definition grob-name grob-entry)
    (let* ((meta-entry   (assoc-get 'meta grob-entry))
@@ -33,9 +49,9 @@ in scheme."
      (set! meta-entry (assoc-set! meta-entry 'interfaces
                                   ifaces-entry))
      (set! grob-entry (assoc-set! grob-entry 'meta meta-entry))
-     (set! all-grob-descriptions
+     (set! my-grob-descriptions
            (cons (cons grob-name grob-entry)
-                 all-grob-descriptions))))
+                 my-grob-descriptions))))
 
 #(add-grob-definition
   'SchemeTextSpanner
@@ -119,64 +135,58 @@ schemeTextSpannerEngraver =
          (finished '())
          (current-event '())
          (event-drul '(() . ())))
-     (list (cons 'listeners
-                 (list (cons 'scheme-text-span-event
-                             (lambda (engraver event)
-                               (if (= START (ly:event-property event 'span-direction))
-                                   (set-car! event-drul event)
-                                   (set-cdr! event-drul event))))))
-           (cons 'acknowledgers
-                 (list (cons 'note-column-interface
-                             (lambda (engraver grob source-engraver)
-                               (if (ly:spanner? span)
-                                   (begin
-                                     (ly:pointer-group-interface::add-grob span 'note-columns grob)
-                                     (add-bound-item span grob)))
-                               (if (ly:spanner? finished)
-                                   (begin
-                                     (ly:pointer-group-interface::add-grob finished 'note-columns grob)
-                                     (add-bound-item finished grob)))))))
-           (cons 'process-music
-                 (lambda (trans)
-                   (if (ly:stream-event? (cdr event-drul))
-                       (if (null? span)
-                           (ly:warning "You're trying to end a scheme text spanner but you haven't started one.")
-                           (begin (set! finished span)
-                                  (ly:engraver-announce-end-grob trans finished current-event)
-                                  (set! span '())
-                                  (set! current-event '())
-                                  (set-cdr! event-drul '()))))
-                   (if (ly:stream-event? (car event-drul))
-                       (begin (set! current-event (car event-drul))
-                              (set! span (ly:engraver-make-grob trans 'SchemeTextSpanner current-event))
-                              (set-axis! span Y)
-                              (set-car! event-drul '())))))
-           (cons 'stop-translation-timestep
-                 (lambda (trans)
-                   (if (and (ly:spanner? span)
-                            (null? (ly:spanner-bound span LEFT)))
-                       (set! (ly:spanner-bound span LEFT)
-                             (ly:context-property context 'currentMusicalColumn)))
-                   (if (ly:spanner? finished)
-                       (begin
-                         (if (null? (ly:spanner-bound finished RIGHT))
-                             (set! (ly:spanner-bound finished RIGHT)
-                                   (ly:context-property context 'currentMusicalColumn)))
-                         (set! finished '())
-                         (set! event-drul '(() . ()))))))
-           (cons 'finalize
-                 (lambda (trans)
-                   (if (ly:spanner? finished)
-                       (begin
-                         (if (null? (ly:spanner-bound finished RIGHT))
-                             (set! (ly:spanner-bound finished RIGHT)
-                                   (ly:context-property context 'currentMusicalColumn)))
-                         (set! finished '())))
-                   (if (ly:spanner? span)
-                       (begin
-                         (ly:warning "I think there's a dangling scheme text spanner :-(")
-                         (ly:grob-suicide! span)
-                         (set! span '()))))))))
+     (make-engraver
+      (listeners ((scheme-text-span-event engraver event)
+                 (if (= START (ly:event-property event 'span-direction))
+                     (set-car! event-drul event)
+                     (set-cdr! event-drul event))))
+      (acknowledgers ((note-column-interface engraver grob source-engraver)
+                     (if (ly:spanner? span)
+                         (begin
+                           (ly:pointer-group-interface::add-grob span 'note-columns grob)
+                           (add-bound-item span grob)))
+                     (if (ly:spanner? finished)
+                         (begin
+                           (ly:pointer-group-interface::add-grob finished 'note-columns grob)
+                           (add-bound-item finished grob)))))
+      ((process-music trans)
+       (if (ly:stream-event? (cdr event-drul))
+          (if (null? span)
+              (ly:warning "You're trying to end a scheme text spanner but you haven't started one.")
+              (begin (set! finished span)
+                     (ly:engraver-announce-end-grob trans finished current-event)
+                     (set! span '())
+                     (set! current-event '())
+                     (set-cdr! event-drul '()))))
+       (if (ly:stream-event? (car event-drul))
+          (begin (set! current-event (car event-drul))
+                 (set! span (ly:engraver-make-grob trans 'SchemeTextSpanner current-event))
+                 (set-axis! span Y)
+                 (set-car! event-drul '()))))
+      ((stop-translation-timestep trans)
+       (if (and (ly:spanner? span)
+               (null? (ly:spanner-bound span LEFT)))
+          (set! (ly:spanner-bound span LEFT)
+                (ly:context-property context 'currentMusicalColumn)))
+       (if (ly:spanner? finished)
+          (begin
+            (if (null? (ly:spanner-bound finished RIGHT))
+                (set! (ly:spanner-bound finished RIGHT)
+                      (ly:context-property context 'currentMusicalColumn)))
+            (set! finished '())
+            (set! event-drul '(() . ())))))
+      ((finalize trans)
+       (if (ly:spanner? finished)
+          (begin
+            (if (null? (ly:spanner-bound finished RIGHT))
+                (set! (ly:spanner-bound finished RIGHT)
+                      (ly:context-property context 'currentMusicalColumn)))
+            (set! finished '())))
+       (if (ly:spanner? span)
+          (begin
+            (ly:warning "I think there's a dangling scheme text spanner :-(")
+            (ly:grob-suicide! span)
+            (set! span '())))))))
 
 schemeTextSpannerStart =
 #(make-span-event 'SchemeTextSpanEvent START)
@@ -187,7 +197,8 @@ schemeTextSpannerEnd =
 \layout {
   \context {
     \Global
-    \grobdescriptions #all-grob-descriptions
+    \grobdescriptions #my-grob-descriptions
+    #my-event-classes
   }
   \context {
     \Voice