Fix 1152.

[lilypond.git] / scm / music-functions.scm

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 324e5aa8f0087114cbb76da277fba7d028ace8e8..57f17baaa2a6588777d535457f07c06ab2ae4d47 100644 (file)
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -1,9 +1,20 @@
-;;;; music-functions.scm --
+;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;;  source file of the GNU LilyPond music typesetter
-;;;;
-;;;; (c) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2010 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;                 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;;
+;;;; 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 <http://www.gnu.org/licenses/>.
 
 ;; (use-modules (ice-9 optargs))
 
@@ -25,6 +36,14 @@
   (make-procedure-with-setter ly:grob-property
                              ly:grob-set-property!))
 
+(define-public ly:grob-object
+  (make-procedure-with-setter ly:grob-object
+                             ly:grob-set-object!))
+
+(define-public ly:grob-parent
+  (make-procedure-with-setter ly:grob-parent
+                             ly:grob-set-parent!))
+
 (define-public ly:prob-property
   (make-procedure-with-setter ly:prob-property
                              ly:prob-set-property!))
@@ -292,17 +311,15 @@ through MUSIC."
 ;; repeats.
 
 (define-public (unfold-repeats music)
-  "
-This function replaces all repeats  with unfold repeats. "
+  "This function replaces all repeats with unfolded repeats."
 
   (let ((es (ly:music-property music 'elements))
-       (e  (ly:music-property music 'element))
-       )
+       (e (ly:music-property music 'element)))
+
     (if (memq 'repeated-music (ly:music-property music 'types))
-       (let*
-           ((props (ly:music-mutable-properties music))
-            (old-name (ly:music-property music 'name))
-            (flattened  (flatten-alist props)))
+       (let* ((props (ly:music-mutable-properties music))
+              (old-name (ly:music-property music 'name))
+              (flattened (flatten-alist props)))
 
          (set! music (apply make-music (cons 'UnfoldedRepeatedMusic
                                              flattened)))
@@ -310,20 +327,22 @@ This function replaces all repeats  with unfold repeats. "
          (if (equal? old-name 'TremoloRepeatedMusic)
              (let* ((seq-arg? (memq 'sequential-music
                                     (ly:music-property e 'types)))
-                    (count  (ly:music-property music 'repeat-count))
+                    (count (ly:music-property music 'repeat-count))
                     (dot-shift (if (= 0 (remainder count 3))
-                                   -1 0)))
+                                   -1 0))
+                    (child-count (if seq-arg?
+                                     (length (ly:music-property e 'elements))
+                                     0)))
 
                (if (= 0 -1)
                    (set! count (* 2 (quotient count 3))))
 
-               (shift-duration-log music (+ (if seq-arg? 1 0)
+               (shift-duration-log music (+ (if (= 2 child-count)
+                                                1 0)
                                             (ly:intlog2 count)) dot-shift)
 
                (if seq-arg?
-                   (ly:music-compress e (ly:make-moment (length (ly:music-property
-                                                                 e 'elements)) 1)))))))
-
+                   (ly:music-compress e (ly:make-moment child-count 1)))))))
 
     (if (pair? es)
        (set! (ly:music-property music 'elements)
@@ -657,7 +676,7 @@ inside of and outside of chord construct."
 ;; Make a function that checks score element for being of a specific type.
 (define-public (make-type-checker symbol)
   (lambda (elt)
-    (not (eq? #f (memq symbol (ly:grob-property elt 'interfaces))))))
+    (grob::has-interface elt symbol)))
 
 (define-public ((outputproperty-compatibility func sym val) grob g-context ao-context)
   (if (func grob)
@@ -1293,6 +1312,29 @@ use GrandStaff as a context. "
                                           ,(make-accidental-rule 'same-octave 1)
                                           ,neo-modern-accidental-rule)
                                   context))
+      ((equal? style 'neo-modern-voice)
+       (set-accidentals-properties #f
+                                  `(Voice ,(make-accidental-rule 'same-octave 0)
+                                          ,(make-accidental-rule 'any-octave 0)
+                                          ,(make-accidental-rule 'same-octave 1)
+                                          ,neo-modern-accidental-rule
+                                    Staff ,(make-accidental-rule 'same-octave 0)
+                                          ,(make-accidental-rule 'any-octave 0)
+                                          ,(make-accidental-rule 'same-octave 1)
+                                     ,neo-modern-accidental-rule)
+                                  '()
+                                  context))
+      ((equal? style 'neo-modern-voice-cautionary)
+       (set-accidentals-properties #f
+                                  `(Voice ,(make-accidental-rule 'same-octave 0))
+                                  `(Voice ,(make-accidental-rule 'any-octave 0)
+                                          ,(make-accidental-rule 'same-octave 1)
+                                          ,neo-modern-accidental-rule
+                                    Staff ,(make-accidental-rule 'same-octave 0)
+                                          ,(make-accidental-rule 'any-octave 0)
+                                          ,(make-accidental-rule 'same-octave 1)
+                                          ,neo-modern-accidental-rule)
+                                  context))
       ;; Accidentals as they were common in dodecaphonic music with no tonality.
       ;; Each note gets one accidental.
       ((equal? style 'dodecaphonic)