]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/music-functions.scm
Run grand-replace for 2012
[lilypond.git] / scm / music-functions.scm
index defe293619717cb5e1fc52cd65e06c74f6b060f7..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))
 
@@ -400,10 +403,12 @@ in @var{grob}."
              'grob-property gprop))
 
 (define direction-polyphonic-grobs
-  '(DotColumn
+  '(AccidentalSuggestion
+    DotColumn
     Dots
     Fingering
     LaissezVibrerTie
+    LigatureBracket
     PhrasingSlur
     RepeatTie
     Rest
@@ -412,7 +417,8 @@ in @var{grob}."
     Stem
     TextScript
     Tie
-    TupletBracket))
+    TupletBracket
+    TrillSpanner))
 
 (define-safe-public (make-voice-props-set n)
   (make-sequential-music
@@ -424,6 +430,7 @@ in @var{grob}."
      (make-property-set 'graceSettings
                        ;; TODO: take this from voicedGraceSettings or similar.
                        '((Voice Stem font-size -3)
+                         (Voice Flag font-size -3)
                          (Voice NoteHead font-size -3)
                          (Voice TabNoteHead font-size -4)
                          (Voice Dots font-size -3)
@@ -510,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))
@@ -630,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)
@@ -723,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}."
@@ -742,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))
 
 
 
@@ -757,25 +746,125 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0.
                                                      music
                                                      (ly:music-deep-copy ,stop))))))
 
-(defmacro-public define-music-function (args signature . body)
+(defmacro-public define-syntax-function (type args signature . body)
   "Helper macro for `ly:make-music-function'.
 Syntax:
-  (define-music-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+  (define-syntax-function (result-type? parser location arg1 arg2 ...) (result-type? arg1-type arg2-type ...)
     ...function body...)
-"
-(if (and (pair? body) (pair? (car body)) (eqv? '_i (caar body)))
+
+argX-type can take one of the forms @code{predicate?} for mandatory
+arguments satisfying the predicate, @code{(predicate?)} for optional
+parameters of that type defaulting to @code{#f}, @code{@w{(predicate?
+value)}} for optional parameters with a specified default
+value (evaluated at definition time).  An optional parameter can be
+omitted in a call only when it can't get confused with a following
+parameter of different type.
+
+Predicates with syntactical significance are @code{ly:pitch?},
+@code{ly:duration?}, @code{ly:music?}, @code{markup?}.  Other
+predicates require the parameter to be entered as Scheme expression.
+
+@code{result-type?} can specify a default in the same manner as
+predicates, to be used in case of a type error in arguments or
+result."
+
+  (set! signature (map (lambda (pred)
+                        (if (pair? pred)
+                            `(cons ,(car pred)
+                                   ,(and (pair? (cdr pred)) (cadr pred)))
+                            pred))
+                      (cons type signature)))
+  (if (and (pair? body) (pair? (car body)) (eqv? '_i (caar body)))
       ;; When the music function definition contains a i10n doc string,
       ;; (_i "doc string"), keep the literal string only
       (let ((docstring (cadar body))
            (body (cdr body)))
        `(ly:make-music-function (list ,@signature)
-                                (lambda (,@args)
+                                (lambda ,args
                                   ,docstring
                                   ,@body)))
       `(ly:make-music-function (list ,@signature)
-                              (lambda (,@args)
+                              (lambda ,args
                                 ,@body))))
 
+(defmacro-public define-music-function rest
+  "Defining macro returning music functions.
+Syntax:
+  (define-music-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+    ...function body...)
+
+argX-type can take one of the forms @code{predicate?} for mandatory
+arguments satisfying the predicate, @code{(predicate?)} for optional
+parameters of that type defaulting to @code{#f}, @code{@w{(predicate?
+value)}} for optional parameters with a specified default
+value (evaluated at definition time).  An optional parameter can be
+omitted in a call only when it can't get confused with a following
+parameter of different type.
+
+Predicates with syntactical significance are @code{ly:pitch?},
+@code{ly:duration?}, @code{ly:music?}, @code{markup?}.  Other
+predicates require the parameter to be entered as Scheme expression.
+
+Must return a music expression.  The @code{origin} is automatically
+set to the @code{location} parameter."
+
+  `(define-syntax-function (ly:music? (make-music 'Music 'void #t)) ,@rest))
+
+
+(defmacro-public define-scheme-function rest
+  "Defining macro returning Scheme functions.
+Syntax:
+  (define-scheme-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+    ...function body...)
+
+argX-type can take one of the forms @code{predicate?} for mandatory
+arguments satisfying the predicate, @code{(predicate?)} for optional
+parameters of that type defaulting to @code{#f}, @code{@w{(predicate?
+value)}} for optional parameters with a specified default
+value (evaluated at definition time).  An optional parameter can be
+omitted in a call only when it can't get confused with a following
+parameter of different type.
+
+Predicates with syntactical significance are @code{ly:pitch?},
+@code{ly:duration?}, @code{ly:music?}, @code{markup?}.  Other
+predicates require the parameter to be entered as Scheme expression.
+
+Can return arbitrary expressions.  If a music expression is returned,
+its @code{origin} is automatically set to the @code{location}
+parameter."
+
+  `(define-syntax-function scheme? ,@rest))
+
+(defmacro-public define-void-function rest
+  "This defines a Scheme function like @code{define-scheme-function} with
+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? *unspecified*) ,@rest *unspecified*))
+
+(defmacro-public define-event-function rest
+  "Defining macro returning event functions.
+Syntax:
+  (define-event-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+    ...function body...)
+
+argX-type can take one of the forms @code{predicate?} for mandatory
+arguments satisfying the predicate, @code{(predicate?)} for optional
+parameters of that type defaulting to @code{#f}, @code{@w{(predicate?
+value)}} for optional parameters with a specified default
+value (evaluated at definition time).  An optional parameter can be
+omitted in a call only when it can't get confused with a following
+parameter of different type.
+
+Predicates with syntactical significance are @code{ly:pitch?},
+@code{ly:duration?}, @code{ly:music?}, @code{markup?}.  Other
+predicates require the parameter to be entered as Scheme expression.
+
+Must return an event expression.  The @code{origin} is automatically
+set to the @code{location} parameter."
+
+  `(define-syntax-function (ly:event? (make-music 'Event 'void #t)) ,@rest))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -1104,7 +1193,7 @@ active pitch in any octave.
 @var{laziness} states over how many bars an accidental should be remembered.
 @code{0}@tie{}is the default -- accidental lasts over 0@tie{}bar lines, that
 is, to the end of current measure.  A positive integer means that the
-accidental lasts over that many bar lines.  @code{-1} is `forget
+accidental lasts over that many bar lines.  @w{@code{-1}} is `forget
 immediately', that is, only look at key signature.  @code{#t} is `forever'."
 
   (check-pitch-against-signature context pitch barnum laziness octaveness))
@@ -1212,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
@@ -1366,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}.
@@ -1397,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)