]> git.donarmstrong.com Git - lilypond.git/blobdiff - ly/music-functions-init.ly
* ly/engraver-init.ly (AncientRemoveEmptyStaffContext): remove
[lilypond.git] / ly / music-functions-init.ly
index d211476bbb4e48ffe4ec0b85ba620277a5d8d6d6..0d7aeb26c0e81a222b0c17c15648280380d756c3 100644 (file)
@@ -6,7 +6,44 @@
 
 #(use-modules (srfi srfi-1))  
 
-applymusic =
+
+tweak = #(def-music-function (parser location sym val arg)
+          (symbol? scheme? ly:music?)
+
+          "Add @code{sym . val} to the @code{tweaks} property of @var{arg}."
+
+          
+          (set!
+           (ly:music-property arg 'tweaks)
+           (acons sym val
+                  (ly:music-property arg 'tweaks)))
+          arg)
+
+          
+
+tag = #(def-music-function (parser location tag arg)
+   (symbol? ly:music?)
+
+   "Add @var{tag} to the @code{tags} property of @var{arg}."
+
+   (set!
+    (ly:music-property arg 'tags)
+    (cons tag
+         (ly:music-property arg 'tags)))
+   arg)
+
+tag = #(def-music-function (parser location tag arg)
+   (symbol? ly:music?)
+
+   "Add @var{tag} to the @code{tags} property of @var{arg}."
+
+   (set!
+    (ly:music-property arg 'tags)
+    (cons tag
+         (ly:music-property arg 'tags)))
+   arg)
+
+applyMusic =
 #(def-music-function (parser location func music) (procedure? ly:music?)
                (func music))
 
@@ -33,7 +70,7 @@ autochange =
 #(def-music-function (parser location music) (ly:music?)
                (make-autochange-music music))
 
-applycontext =
+applyContext =
 #(def-music-function (parser location proc) (procedure?)
                  (make-music 'ApplyContext 
                    'origin location
@@ -58,12 +95,45 @@ displayLilyMusic =
    (display-lily-music music)
    music)
 
-applyoutput =
+applyOutput =
 #(def-music-function (parser location proc) (procedure?)
                 (make-music 'ApplyOutputEvent 
                   'origin location
                   'procedure proc))
 
+overrideProperty =
+#(def-music-function (parser location name property value)
+   (string? symbol? scheme?)
+
+
+   "Set @var{property} to @var{value} in all grobs named @var{name}.
+The @var{name} argument is a string of the form @code{\"Context.GrobName\"}
+or @code{\"GrobName\"}"
+
+   (let*
+       ((name-components (string-split name #\.))
+       (context-name 'Bottom)
+       (grob-name #f))
+
+     (if (> 2 (length name-components))
+        (set! grob-name (string->symbol (car name-components)))
+        (begin
+          (set! grob-name (string->symbol (list-ref name-components 1)))
+          (set! context-name (string->symbol (list-ref name-components 0)))))
+
+     (context-spec-music
+      (make-music 'ApplyOutputEvent
+                 'origin location
+                 'procedure
+                 (lambda (grob orig-context context)
+                   (if (equal?
+                        (cdr (assoc 'name (ly:grob-property grob 'meta)))
+                        grob-name)
+                       (set! (ly:grob-property grob property) value)
+                       )))
+
+      context-name)))
+
 breathe =
 #(def-music-function (parser location) ()
             (make-music 'EventChord 
@@ -156,7 +226,7 @@ pitchedTrill =
             )))
      
      (if (ly:pitch? trill-pitch)
-        (for-each (lambda (m) (ly:music-set-property! m 'trill-pitch trill-pitch))
+        (for-each (lambda (m) (ly:music-set-property! m 'pitch trill-pitch))
                   trill-events)
         (begin
           (ly:warning (_ "Second argument of \\pitchedTrill should be single note: "))
@@ -217,6 +287,30 @@ barNumberCheck =
                                         cbn n))))))
 
 
+
+% for regression testing purposes.
+assertBeamQuant =
+#(def-music-function (parser location l r) (pair? pair?)
+  (make-grob-property-override 'Beam 'positions
+   (ly:make-simple-closure
+    (ly:make-simple-closure
+     (append
+      (list chain-grob-member-functions `(,cons 0 0))
+      (check-quant-callbacks l r))))))
+    
+% for regression testing purposes.
+assertBeamSlope =
+#(def-music-function (parser location comp) (procedure?)
+  (make-grob-property-override 'Beam 'positions
+   (ly:make-simple-closure
+    (ly:make-simple-closure
+     (append
+      (list chain-grob-member-functions `(,cons 0 0))
+      (check-slope-callbacks comp))))))
+    
+
+
+
 %{
 
 TODO: