Fix some bugs in the dynamic engraver and PostScript backend

[lilypond.git] / scm / define-music-display-methods.scm

diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm
index 67d0ee21e91d80d697d20df7b45882de85cb20f5..ad1dbf3de7a236fc485044f4fc70bbf70480d7cc 100644 (file)
--- a/scm/define-music-display-methods.scm
+++ b/scm/define-music-display-methods.scm
@@ -585,9 +585,6 @@ Otherwise, return #f."
 (define-display-method BarCheck (check)
   (format #f "|~a" (new-line->lily-string)))
 
-(define-display-method BreakEvent (br)
-  "\\break") ;; TODO: use page-penalty, penalty properties?
-
 (define-display-method PesOrFlexaEvent (expr)
   "\\~")
 
@@ -726,17 +723,16 @@ Otherwise, return #f."
 
 (define-display-method ContextSpeccedMusic (expr)
   (let ((id    (ly:music-property expr 'context-id))
+        (create-new (ly:music-property expr 'create-new))
        (music (ly:music-property expr 'element))
        (operations (ly:music-property expr 'property-operations))
        (ctype (ly:music-property expr 'context-type)))
     (format #f "~a ~a~a~a ~a"
-           (if (and (not (null? id)) 
-                    (equal? id "$uniqueContextId"))
+           (if (and (not (null? create-new)) create-new)
                "\\new"
                "\\context")
            ctype
-           (if (or (null? id)
-                   (equal? id "$uniqueContextId"))
+           (if (null? id)
                ""
                (format #f " = ~s" id))
            (if (null? operations)
@@ -756,7 +752,7 @@ Otherwise, return #f."
 ;; special cases: \figures \lyrics \drums
 (define-extra-display-method ContextSpeccedMusic (expr)
   (with-music-match (expr (music 'ContextSpeccedMusic
-                                context-id "$uniqueContextId"
+                                 create-new #t
                                 property-operations ?op
                                 context-type ?context-type
                                 element ?sequence))
@@ -929,15 +925,11 @@ Otherwise, return #f."
 (define-extra-display-method ContextSpeccedMusic (expr)
   "If `expr' is a bar, return \"\\bar ...\".
 Otherwise, return #f."
-  (with-music-match (expr (music
-                          'ContextSpeccedMusic
-                          element (music
-                                   'ContextSpeccedMusic
-                                   context-type 'Timing
-                                   element (music
-                                            'PropertySet
-                                            value ?bar-type
-                                            symbol 'whichBar))))
+  (with-music-match (expr (music 'ContextSpeccedMusic
+                                 context-type 'Timing
+                                 element (music 'PropertySet
+                                                value ?bar-type
+                                                symbol 'whichBar)))
      (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string))))
 
 ;;; \partial
@@ -986,20 +978,22 @@ Otherwise, return #f."
 ;;;
 
 (define-display-method ApplyOutputEvent (applyoutput)
-  (let ((proc (ly:music-property applyoutput 'procedure))))
-    (format #f "\\applyoutput #~a"
+  (let ((proc (ly:music-property applyoutput 'procedure))
+        (ctx  (ly:music-property applyoutput 'context-type)))
+    (format #f "\\applyOutput #'~a #~a"
+            ctx
            (or (procedure-name proc)
                (with-output-to-string
                  (lambda ()
-                   (pretty-print (procedure-source proc)))))))
+                   (pretty-print (procedure-source proc))))))))
 
 (define-display-method ApplyContext (applycontext)
-  (let ((proc (ly:music-property applycontext 'procedure))))
-    (format #f "\\applycontext #~a"
+  (let ((proc (ly:music-property applycontext 'procedure)))
+    (format #f "\\applyContext #~a"
            (or (procedure-name proc)
                (with-output-to-string
                  (lambda ()
-                   (pretty-print (procedure-source proc)))))))
+                   (pretty-print (procedure-source proc))))))))
 
 ;;; \partcombine
 (define-display-method PartCombineMusic (expr)
@@ -1043,6 +1037,42 @@ Otherwise, return #f."
              (ly:music-property expr 'quoted-music-name)
              (music->lily-string (ly:music-property expr 'element)))))
 
+;;;
+;;; Breaks
+;;;
+(define-display-method LineBreakEvent (expr)
+  (if (null? (ly:music-property expr 'break-permission))
+      "\\noBreak"
+      "\\break"))
+
+(define-display-method PageBreakEvent (expr)
+  (if (null? (ly:music-property expr 'break-permission))
+      "\\noPageBreak"
+      "\\pageBreak"))
+
+(define-display-method PageTurnEvent (expr)
+  (if (null? (ly:music-property expr 'break-permission))
+      "\\noPageTurn"
+      "\\pageTurn"))
+
+(define-extra-display-method EventChord (expr)
+  (with-music-match (expr (music 'EventChord
+                            elements ((music 'LineBreakEvent
+                                             break-permission 'force)
+                                      (music 'PageBreakEvent
+                                             break-permission 'force))))
+    "\\pageBreak"))
+
+(define-extra-display-method EventChord (expr)
+  (with-music-match (expr (music 'EventChord
+                            elements ((music 'LineBreakEvent
+                                             break-permission 'force)
+                                      (music 'PageBreakEvent
+                                             break-permission 'force)
+                                      (music 'PageTurnEvent
+                                             break-permission 'force))))
+    "\\pageTurn"))
+
 ;;;
 ;;; Lyrics
 ;;;
@@ -1054,24 +1084,16 @@ Otherwise, return #f."
          (parameterize ((*explicit-mode* #f))
            (music->lily-string (ly:music-property expr 'element)))))
 
-(define-display-method OldLyricCombineMusic (expr)
-  (format #f "\\oldaddlyrics ~a~a~a"
-         (music->lily-string (first (ly:music-property expr 'elements)))
-         (new-line->lily-string)
-         (music->lily-string (second (ly:music-property expr 'elements)))))
-
 ;; \addlyrics
 (define-extra-display-method SimultaneousMusic (expr)
   (with-music-match (expr (music 'SimultaneousMusic
                                 elements ((music 'ContextSpeccedMusic
                                                  context-id ?id
-                                                 ;;property-operations '()
                                                  context-type 'Voice
                                                  element ?note-sequence)
                                           (music 'ContextSpeccedMusic
-                                                 context-id "$uniqueContextId"
-                                                 ;;property-operations '()
                                                  context-type 'Lyrics
+                                                  create-new #t
                                                  element (music 'LyricCombineMusic
                                                                 associated-context ?associated-id
                                                                 element ?lyric-sequence)))))