]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/music-functions.scm
Run grand-replace for 2012
[lilypond.git] / scm / music-functions.scm
index bfec250992e5c9c7910e496a7f40823a48fadd6e..1b1d07c490fefefbcaeaadfff19f7eec604283fd 100644 (file)
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;                 Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
 ;;;; 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))
+; for define-safe-public when byte-compiling using Guile V2
+(use-modules (scm safe-utility-defs))
+
+(use-modules (ice-9 optargs))
 
 ;;; ly:music-property with setter
 ;;; (ly:music-property my-music 'elements)
@@ -79,9 +82,12 @@ First it recurses over the children, then the function is applied to
                           (inner-music-filter pred? e)
                           e))
           (filtered-es (filter ly:music? (map (lambda (y) (inner-music-filter pred? y)) es))))
-      (set! (ly:music-property music 'element) filtered-e)
-      (set! (ly:music-property music 'elements) filtered-es)
-      (set! (ly:music-property music 'articulations) filtered-as)
+      (if (not (null? e))
+         (set! (ly:music-property music 'element) filtered-e))
+      (if (not (null? es))
+         (set! (ly:music-property music 'elements) filtered-es))
+      (if (not (null? as))
+         (set! (ly:music-property music 'articulations) filtered-as))
       ;; if filtering emptied the expression, we remove it completely.
       (if (or (not (pred? music))
              (and (eq? filtered-es '()) (not (ly:music? e))
@@ -95,24 +101,23 @@ First it recurses over the children, then the function is applied to
       music
       (make-music 'Music)))      ;must return music.
 
-(define-public (display-music music)
+(define*-public (display-music music #:optional (port (current-output-port)))
   "Display music, not done with @code{music-map} for clarity of
 presentation."
-
-  (display music)
-  (display ": { ")
+  (display music port)
+  (display ": { " port)
   (let ((es (ly:music-property music 'elements))
        (e (ly:music-property music 'element)))
-    (display (ly:music-mutable-properties music))
+    (display (ly:music-mutable-properties music) port)
     (if (pair? es)
-       (begin (display "\nElements: {\n")
-              (map display-music es)
-              (display "}\n")))
+       (begin (display "\nElements: {\n" port)
+              (for-each (lambda (m) (display-music m port)) es)
+              (display "}\n" port)))
     (if (ly:music? e)
        (begin
-         (display "\nChild:")
-         (display-music e))))
-  (display " }\n")
+         (display "\nChild:" port)
+         (display-music e port))))
+  (display " }\n" port)
   music)
 
 ;;;
@@ -203,13 +208,9 @@ equivalent to @var{obj}, that is, for a music expression, a
 (use-modules (ice-9 pretty-print))
 (define*-public (display-scheme-music obj #:optional (port (current-output-port)))
   "Displays `obj', typically a music expression, in a friendly fashion,
-which often can be read back in order to generate an equivalent expression.
-
-Returns `obj'.
-"
+which often can be read back in order to generate an equivalent expression."
   (pretty-print (music->make-music obj) port)
-  (newline)
-  obj)
+  (newline port))
 
 ;;;
 ;;; Scheme music expression --> Lily-syntax-using string translator
@@ -217,28 +218,30 @@ Returns `obj'.
 (use-modules (srfi srfi-39)
              (scm display-lily))
 
-(define*-public (display-lily-music expr parser #:key force-duration)
+(define*-public (display-lily-music expr parser #:optional (port (current-output-port))
+                                   #:key force-duration)
   "Display the music expression using LilyPond syntax"
   (memoize-clef-names supported-clefs)
   (parameterize ((*indent* 0)
                 (*previous-duration* (ly:make-duration 2))
                 (*force-duration* force-duration))
-    (display (music->lily-string expr parser))
-    (newline)))
+    (display (music->lily-string expr parser) port)
+    (newline port)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define-public (shift-one-duration-log music shift dot)
   "Add @var{shift} to @code{duration-log} of @code{'duration} in
-@var{music} and optionally @var{dot} to any note encountered.  This
-scales the music up by a factor `2^@var{shift} * (2 - (1/2)^@var{dot})'."
+@var{music} and optionally @var{dot} to any note encountered.
+The number of dots in the shifted music may not be less than zero."
   (let ((d (ly:music-property music 'duration)))
     (if (ly:duration? d)
        (let* ((cp (ly:duration-factor d))
-              (nd (ly:make-duration (+ shift (ly:duration-log d))
-                                    (+ dot (ly:duration-dot-count d))
-                                    (car cp)
-                                    (cdr cp))))
+              (nd (ly:make-duration
+                    (+ shift (ly:duration-log d))
+                    (max 0 (+ dot (ly:duration-dot-count d)))
+                   (car cp)
+                   (cdr cp))))
          (set! (ly:music-property music 'duration) nd)))
     music))
 
@@ -514,24 +517,6 @@ in @var{grob}."
   (make-music 'PropertyUnset
              'symbol sym))
 
-;;; Need to keep this definition for \time calls from parser
-(define-public (make-time-signature-set num den)
-  "Set properties for time signature @var{num}/@var{den}."
-  (make-music 'TimeSignatureMusic
-              'numerator num
-              'denominator den
-              'beat-structure '()))
-
-;;; Used for calls that include beat-grouping setting
-(define-public (set-time-signature num den . rest)
-  "Set properties for time signature @var{num}/@var{den}.
-If @var{rest} is present, it is used to set @code{beatStructure}."
-  (ly:export
-   (make-music 'TimeSignatureMusic
-              'numerator num
-              'denominator den
-              'beat-structure (if (null? rest) rest (car rest)))))
-
 (define-safe-public (make-articulation name)
   (make-music 'ArticulationEvent
              'articulation-type name))
@@ -634,7 +619,7 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0.
     m))
 
 (define-public (empty-music)
-  (ly:export (make-music 'Music)))
+  (make-music 'Music))
 
 ;; Make a function that checks score element for being of a specific type.
 (define-public (make-type-checker symbol)
@@ -727,7 +712,7 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0.
           (new-settings (append current
                                 (list (list context-name grob sym val)))))
       (ly:context-set-property! where 'graceSettings new-settings)))
-  (ly:export (context-spec-music (make-apply-context set-prop) 'Voice)))
+  (context-spec-music (make-apply-context set-prop) 'Voice))
 
 (define-public (remove-grace-property context-name grob sym)
   "Remove all @var{sym} for @var{grob} in @var{context-name}."
@@ -746,7 +731,7 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0.
                  (set! new-settings (delete x new-settings)))
                prop-settings)
       (ly:context-set-property! where 'graceSettings new-settings)))
-  (ly:export (context-spec-music (make-apply-context delete-prop) 'Voice)))
+  (context-spec-music (make-apply-context delete-prop) 'Voice))
 
 
 
@@ -856,7 +841,7 @@ void return value (i.e., what most Guile functions with `unspecified'
 value return).  Use this when defining functions for executing actions
 rather than returning values, to keep Lilypond from trying to interpret
 the return value."
-  `(define-syntax-function void? ,@rest #f (begin)))
+  `(define-syntax-function (void? *unspecified*) ,@rest *unspecified*))
 
 (defmacro-public define-event-function rest
   "Defining macro returning event functions.
@@ -1316,8 +1301,7 @@ as a context."
                     (car rest) 'Staff))
        (pcontext (if (pair? rest)
                      (car rest) 'GrandStaff)))
-    (ly:export
-     (cond
+    (cond
       ;; accidentals as they were common in the 18th century.
       ((equal? style 'default)
        (set-accidentals-properties #t
@@ -1470,7 +1454,7 @@ as a context."
                                   context))
       (else
        (ly:warning (_ "unknown accidental style: ~S") style)
-       (make-sequential-music '()))))))
+       (make-sequential-music '())))))
 
 (define-public (invalidate-alterations context)
   "Invalidate alterations in @var{context}.
@@ -1501,7 +1485,7 @@ Entries that conform with the current key signature are not invalidated."
                   entry
                   (cons (car entry) (cons 'clef (cddr entry))))))
           (ly:context-property context 'localKeySignature)))))
-                   
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define-public (skip-of-length mus)