(convert-to-ps): invoke dvips with -t

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

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 62235b68ff5ef14aac836f8812149e099893afbe..4f4152a2750c4b31c6ae7940796d95e47af8deab 100644 (file)
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -48,7 +48,7 @@
       (set! (ly:music-property music 'elements) filtered-es)
       (set! (ly:music-property music 'articulations) filtered-as)
       ;; if filtering emptied the expression, we remove it completely.
-      (if (or (pred? music)
+      (if (or (not (pred? music))
              (and (eq? filtered-es '()) (not (ly:music? e))
                   (or (not (eq? es '()))
                       (ly:music? e))))
@@ -60,14 +60,6 @@
       music
       (make-music 'Music)))      ;must return music.
 
-(define-public (remove-tag tag)
-  (lambda (mus)
-    (music-filter
-     (lambda (m)
-       (let* ((tags (ly:music-property m 'tags))
-             (res (memq tag tags)))
-        res))
-     mus)))
 
 (define-public (display-music music)
   "Display music, not done with music-map for clarity of presentation."
@@ -201,7 +193,7 @@ i.e.  this is not an override"
              'grob-property gprop))
 
 (define direction-polyphonic-grobs
-  '(Stem Tie Rest Slur Script TextScript Dots DotColumn
+  '(Stem Tie Rest Slur Script TextScript Dots DotColumn Fingering
         ))
 
 (define-public (make-voice-props-set n)
@@ -580,6 +572,48 @@ without context specification. Called  from parser."
     (if (vector? props)
        (vector-reverse-map execute-1 props))))
 
+
+
+(defmacro-public def-grace-function (start stop)
+  `(def-music-function (location music) (ly:music?)
+     (make-music 'GraceMusic
+                'origin location
+                'element (make-music 'SequentialMusic
+                                     'elements (list (ly:music-deep-copy ,start)
+                                                     music
+                                                     (ly:music-deep-copy ,stop))))))
+
+(defmacro-public def-music-function (args signature . body)
+  "Helper macro for `ly:make-music-function'.
+Syntax:
+  (def-music-function (location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+    ...function body...)
+"
+  `(ly:make-music-function (list ,@signature)
+                          (lambda (,@args)
+                            ,@body)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-public ((quote-substitute quote-tab) music)
+  (let*
+      ((quoted-name (ly:music-property music 'quoted-music-name))
+       (quoted-vector (if (string? quoted-name)
+                         (hash-ref quote-tab quoted-name #f)
+                         #f
+                         ))
+
+       )
+
+    (if (string? quoted-name)
+       (if  (vector? quoted-vector)
+            (set! (ly:music-property music 'quoted-events) quoted-vector)
+            (ly:warn "Cannot find quoted music `~S'" quoted-name)))
+
+    music))
+    
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; switch it on here, so parsing and init isn't checked (too slow!)
 ;;
@@ -590,11 +624,29 @@ without context specification. Called  from parser."
       (set-debug-cell-accesses! 15000))
   m)
 
+(define (music-check-error music)
+  (define found #f)
+  (define (signal m)
+    (if (and (ly:music? m)
+            (eq? (ly:music-property m 'error-found) #t))
+       (set! found #t)))
+  
+  (for-each signal (ly:music-property music 'elements))
+  (signal (ly:music-property music 'element))
+
+  (if found
+      (set! (ly:music-property music 'error-found) #t))
+  music)
+
 (define-public toplevel-music-functions
   (list
    ;; check-start-chords ; ; no longer needed with chord syntax. 
-   voicify-music
-   (lambda (x) (music-map glue-mm-rest-texts x))
+   (lambda (music parser) (voicify-music music))
+   (lambda (x parser) (music-map glue-mm-rest-texts x))
+   (lambda (x parser) (music-map music-check-error x))
+   (lambda (music parser)
+
+     (music-map (quote-substitute (ly:parser-lookup parser 'musicQuotes))  music))
    ;; switch-on-debugging
    ))
 
@@ -693,8 +745,9 @@ use GrandStaff as a context. "
       ;; Accidentals are cancelled across the staves in the same grand staff as well
       ((equal? style 'piano)
        (set-accidentals-properties #f
-                                  '( Staff (same-octave . 0) (any-octave . 0) (same-octave . 1)
-                                           GrandStaff (any-octave . 0) (same-octave . 1))
+                                  '(Staff (same-octave . 0)
+                                          (any-octave . 0) (same-octave . 1)
+                                          GrandStaff (any-octave . 0) (same-octave . 1))
                                   '()
                                   pcontext))
       ((equal? style 'piano-cautionary)
@@ -721,5 +774,31 @@ use GrandStaff as a context. "
                                   '()
                                   context))
       (else
-       (ly:warn (string-append "Unknown accidental style: " (symbol->string style)))
+       (ly:warn "Unknown accidental style: ~S" (symbol->string style))
        (make-sequential-music '()))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-public (skip-of-length mus)
+  "Create a skip of exactly the same length as MUS."
+  (let*
+   ((skip
+     (make-music
+      'SkipEvent
+      'duration (ly:make-duration 0 0))))
+
+   (make-event-chord (list (ly:music-compress skip (ly:music-length mus))))
+))
+
+
+(define-public (mmrest-of-length mus)
+  "Create a mmrest of exactly the same length as MUS."
+  
+  (let*
+   ((skip
+     (make-multi-measure-rest
+      (ly:make-duration 0 0) '() )))
+   (ly:music-compress skip (ly:music-length mus))
+   skip
+))
+