X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=250defcdd2f98bdaa09761b16a98eb1d62cd2802;hb=863b09e94acb2b3e543cb68b096e8b40db1889f1;hp=d7fedb689d9cf3e69a445ec7c4731ce176fe75b0;hpb=b9a18c38bf25fe66b0ecea5e83d7beaf69ffa6c0;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index d7fedb689d..250defcdd2 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -16,6 +16,9 @@ ;;;; You should have received a copy of the GNU General Public License ;;;; along with LilyPond. If not, see . +; 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 @@ -230,15 +233,16 @@ Returns `obj'. (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 +404,12 @@ in @var{grob}." 'grob-property gprop)) (define direction-polyphonic-grobs - '(DotColumn + '(AccidentalSuggestion + DotColumn Dots Fingering LaissezVibrerTie + LigatureBracket PhrasingSlur RepeatTie Rest @@ -412,7 +418,8 @@ in @var{grob}." Stem TextScript Tie - TupletBracket)) + TupletBracket + TrillSpanner)) (define-safe-public (make-voice-props-set n) (make-sequential-music @@ -511,24 +518,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)) @@ -631,7 +620,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) @@ -724,7 +713,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}." @@ -743,7 +732,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)) @@ -758,25 +747,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)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1213,8 +1302,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 @@ -1367,7 +1455,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}. @@ -1398,7 +1486,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)