X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fly-syntax-constructors.scm;h=9cbec5fc4f55f61c6b28f17e558109da84e0a4b4;hb=32a34dcef0c0041c6d62677487a380b5c8b85712;hp=171cee12407e8bbb2ebf1f0c87b25d3ed3e0ce3f;hpb=f41973ff763d5972a85995b6d40c864281ec6714;p=lilypond.git diff --git a/scm/ly-syntax-constructors.scm b/scm/ly-syntax-constructors.scm index 171cee1240..9cbec5fc4f 100644 --- a/scm/ly-syntax-constructors.scm +++ b/scm/ly-syntax-constructors.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 2006--2011 Erik Sandberg +;;;; Copyright (C) 2006--2012 Erik Sandberg ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -43,13 +43,38 @@ m))) ;; Music function: Apply function and check return value. -(define-ly-syntax-loc (music-function parser loc fun args) - (let ((m (apply fun (cons* parser loc args)))) - (if (ly:music? m) - m +;; args are in reverse order, rest may specify additional ones +;; +;; If args is not a proper list, an error has been flagged earlier +;; and no fallback value had been available. In this case, +;; we don't call the function but rather return the general +;; fallback. +(define-ly-syntax (music-function parser loc fun args . rest) + (let* ((sig (ly:music-function-signature fun)) + (pred (if (pair? (car sig)) (caar sig) (car sig))) + (good (proper-list? args)) + (m (and good (apply (ly:music-function-extract fun) + parser loc (reverse! args rest))))) + (if (and good (pred m)) (begin - (ly:parser-error parser (_ "Music head function must return Music object") loc) - (make-music 'Music))))) + (if (ly:music? m) + (set! (ly:music-property m 'origin) loc)) + m) + (begin + (if good + (ly:parser-error parser + (format #f (_ "~a function cannot return ~a") + (type-name pred) m) + loc)) + (and (pair? (car sig)) (cdar sig)))))) + +(define-ly-syntax (argument-error parser location n pred arg) + (ly:parser-error + parser + (format #f + (_ "wrong type for argument ~a. Expecting ~a, found ~s") + n (type-name pred) arg) + location)) (define-ly-syntax-simple (void-music) (make-music 'Music)) @@ -79,16 +104,6 @@ (define-ly-syntax-simple (bar-check) (make-music 'BarCheck)) -(define-ly-syntax-simple (time-scaled-music fraction music) - (make-music 'TimeScaledMusic - 'element (ly:music-compress music (ly:make-moment (car fraction) (cdr fraction))) - 'numerator (car fraction) - 'denominator (cdr fraction))) - -(define-ly-syntax-simple (transpose-music pitch music) - (make-music 'TransposedMusic - 'element (ly:music-transpose music pitch))) - (define-ly-syntax (tempo parser location text . rest) (let* ((unit (and (pair? rest) (car rest))) @@ -118,10 +133,6 @@ (make-sequential-music (list tempo-change tempo-set)) tempo-change))) -(define-ly-syntax-simple (skip-music dur) - (make-music 'SkipMusic - 'duration dur)) - (define-ly-syntax-simple (repeat type num body alts) (make-repeat type num body alts)) @@ -148,20 +159,20 @@ into a @code{MultiMeasureTextEvent}." 'duration duration 'origin location)) -(define-ly-syntax (repetition-chord parser location previous-chord repetition-function duration articulations) - (make-music 'RepeatedChord - 'original-chord previous-chord - 'element (repetition-function previous-chord location duration articulations) +(define-ly-syntax (repetition-chord parser location duration articulations) + (make-music 'EventChord + 'duration duration + 'elements articulations 'origin location)) -(define-ly-syntax-simple (context-specification type id mus ops create-new) +(define-ly-syntax-simple (context-specification type id ops create-new mus) (let* ((type-sym (if (symbol? type) type (string->symbol type))) (csm (context-spec-music mus type-sym id))) (set! (ly:music-property csm 'property-operations) ops) (if create-new (set! (ly:music-property csm 'create-new) #t)) csm)) -(define-ly-syntax (property-operation parser location once ctx music-type symbol . args) +(define-ly-syntax (property-operation parser location ctx music-type symbol . args) (let* ((props (case music-type ((PropertySet) (list 'value (car args))) ((PropertyUnset) '()) @@ -175,11 +186,10 @@ into a @code{MultiMeasureTextEvent}." (list 'grob-property-path (car args)) (list 'grob-property-path args))) (else (ly:error (_ "Invalid property operation ~a") music-type)))) - (oprops (if once (cons* 'once once props) props)) (m (apply make-music music-type 'symbol symbol 'origin location - oprops))) + props))) (make-music 'ContextSpeccedMusic 'element m 'context-type ctx @@ -201,6 +211,9 @@ into a @code{MultiMeasureTextEvent}." (set! unique-counter (1+ unique-counter)) (call-with-output-string (lambda (p) (format p "uniqueContext~s" unique-counter)))) +(define-ly-syntax-simple (lyric-event text duration) + (make-lyric-event text duration)) + (define (lyric-combine-music sync music loc) ;; CompletizeExtenderEvent is added following the last lyric in MUSIC ;; to signal to the Extender_engraver that any pending extender should @@ -237,30 +250,3 @@ into a @code{MultiMeasureTextEvent}." 'origin loc))) addlyrics-list))) (make-simultaneous-music (cons voice lyricstos)))) - -(define-ly-syntax (make-mark-set parser location label) - "Make the music for the \\mark command." - (let* ((set (and (integer? label) - (context-spec-music (make-property-set 'rehearsalMark label) - 'Score))) - (ev (make-music 'MarkEvent)) - (ch (make-event-chord (list ev)))) - - (set! (ly:music-property ev 'origin) location) - (if set - (make-sequential-music (list set ch)) - (begin - (set! (ly:music-property ev 'label) label) - ch)))) - -(define-ly-syntax (partial parser location dur) - "Make a partial measure." - - ;; We use `descend-to-context' here instead of `context-spec-music' to - ;; ensure \partial still works if the Timing_translator is moved - (descend-to-context - (context-spec-music (make-music 'PartialSet - 'origin location - 'partial-duration dur) - 'Timing) - 'Score))