TupletBracket
TrillSpanner))
+(define general-grace-settings
+ `((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)
+ (Voice Stem length-fraction 0.8)
+ (Voice Stem no-stem-extend #t)
+ (Voice Beam beam-thickness 0.384)
+ (Voice Beam length-fraction 0.8)
+ (Voice Accidental font-size -4)
+ (Voice AccidentalCautionary font-size -4)
+ (Voice Script font-size -3)
+ (Voice Fingering font-size -8)
+ (Voice StringNumber font-size -8)))
+
+(define-public score-grace-settings
+ (append
+ `((Voice Stem direction ,UP)
+ (Voice Slur direction ,DOWN))
+ general-grace-settings))
+
(define-safe-public (make-voice-props-set n)
(make-sequential-music
(append
(if (odd? n) -1 1)))
direction-polyphonic-grobs)
(list
- (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)
- (Voice Stem length-fraction 0.8)
- (Voice Stem no-stem-extend #t)
- (Voice Beam beam-thickness 0.384)
- (Voice Beam length-fraction 0.8)
- (Voice Accidental font-size -4)
- (Voice AccidentalCautionary font-size -4)
- (Voice Script font-size -3)
- (Voice Fingering font-size -8)
- (Voice StringNumber font-size -8)))
-
+ (make-property-set 'graceSettings general-grace-settings)
(make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2))))))
-
(define-safe-public (make-voice-props-override n)
(make-sequential-music
(append
(if (odd? n) -1 1)))
direction-polyphonic-grobs)
(list
- (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)
- (Voice Stem length-fraction 0.8)
- (Voice Stem no-stem-extend #t)
- (Voice Beam beam-thickness 0.384)
- (Voice Beam length-fraction 0.8)
- (Voice Accidental font-size -4)
- (Voice AccidentalCautionary font-size -4)
- (Voice Script font-size -3)
- (Voice Fingering font-size -8)
- (Voice StringNumber font-size -8)))
-
- (make-grob-property-override 'NoteColumn 'horizontal-shift (quotient n 2))
- (make-grob-property-override 'MultiMeasureRest 'staff-position (if (odd? n) -4 4))))))
+ (make-property-set 'graceSettings general-grace-settings)
+ (make-grob-property-override 'NoteColumn 'horizontal-shift (quotient n 2))))))
(define-safe-public (make-voice-props-revert)
(make-sequential-music
(map (lambda (x) (make-grob-property-revert x 'direction))
direction-polyphonic-grobs)
(list (make-property-unset 'graceSettings)
- (make-grob-property-revert 'NoteColumn 'horizontal-shift)
- (make-grob-property-revert 'MultiMeasureRest 'staff-position)))))
+ (make-grob-property-revert 'NoteColumn 'horizontal-shift)))))
(define-safe-public (context-spec-music m context #:optional id)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; warn for bare chords at start.
-(define-public (ly:music-message music msg)
+(define-public (ly:music-message music msg . rest)
(let ((ip (ly:music-property music 'origin)))
(if (ly:input-location? ip)
- (ly:input-message ip msg)
- (ly:message msg))))
+ (apply ly:input-message ip msg rest)
+ (apply ly:message msg rest))))
-(define-public (ly:music-warning music msg)
+(define-public (ly:music-warning music msg . rest)
(let ((ip (ly:music-property music 'origin)))
(if (ly:input-location? ip)
- (ly:input-warning ip msg)
- (ly:warning msg))))
+ (apply ly:input-warning ip msg rest)
+ (apply ly:warning msg rest))))
+
+(define-public (ly:event-warning event msg . rest)
+ (let ((ip (ly:event-property event 'origin)))
+ (if (ly:input-location? ip)
+ (apply ly:input-warning ip msg rest)
+ (apply ly:warning msg rest))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
(define-public (add-grace-property context-name grob sym val)
"Set @var{sym}=@var{val} for @var{grob} in @var{context-name}."
(define (set-prop context)
- (let* ((where (ly:context-property-where-defined context 'graceSettings))
+ (let* ((where (or (ly:context-find context context-name) context))
(current (ly:context-property where 'graceSettings))
(new-settings (append current
(list (list context-name grob sym val)))))
(ly:context-set-property! where 'graceSettings new-settings)))
- (context-spec-music (make-apply-context set-prop) 'Voice))
+ (make-apply-context set-prop))
(define-public (remove-grace-property context-name grob sym)
"Remove all @var{sym} for @var{grob} in @var{context-name}."
(eq? (cadr property) grob)
(eq? (caddr property) sym)))
(define (delete-prop context)
- (let* ((where (ly:context-property-where-defined context 'graceSettings))
+ (let* ((where (or (ly:context-find context context-name) context))
(current (ly:context-property where 'graceSettings))
(prop-settings (filter
(lambda(x) (sym-grob-context? x sym grob context-name))
(set! new-settings (delete x new-settings)))
prop-settings)
(ly:context-set-property! where 'graceSettings new-settings)))
- (context-spec-music (make-apply-context delete-prop) 'Voice))
-
+ (make-apply-context delete-prop))
(defmacro-public def-grace-function (start stop . docstring)
predicates, to be used in case of a type error in arguments or
result."
+ (define (currying-lambda args doc-string? body)
+ (if (and (pair? args)
+ (pair? (car args)))
+ (currying-lambda (car args) doc-string?
+ `((lambda ,(cdr args) ,@body)))
+ (if doc-string?
+ `(lambda ,args ,doc-string? ,@body)
+ `(lambda ,args ,@body))))
+
(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
- ,docstring
- ,@body)))
- `(ly:make-music-function (list ,@signature)
- (lambda ,args
- ,@body))))
+
+ (let ((docstring
+ (and (pair? body) (pair? (cdr body))
+ (if (string? (car body))
+ (car body)
+ (and (pair? (car body))
+ (eq? '_i (caar body))
+ (pair? (cdar body))
+ (string? (cadar body))
+ (null? (cddar body))
+ (cadar body))))))
+ ;; When the music function definition contains an i10n doc string,
+ ;; (_i "doc string"), keep the literal string only
+ `(ly:make-music-function
+ (list ,@signature)
+ ,(currying-lambda args docstring (if docstring (cdr body) body)))))
(defmacro-public define-music-function rest
"Defining macro returning music functions.
(clef (ly:music-property quote-music 'quoted-music-clef #f))
(main-voice (case dir ((1) 1) ((-1) 0) (else #f)))
(cue-voice (and main-voice (- 1 main-voice)))
+ (cue-type (ly:music-property quote-music 'quoted-context-type #f))
+ (cue-id (ly:music-property quote-music 'quoted-context-id))
(main-music (ly:music-property quote-music 'element))
(return-value quote-music))
(delq! #f
(list
(and clef (make-cue-clef-set clef))
-
- ;; Need to establish CueVoice context even in #CENTER case
- (context-spec-music
- (if cue-voice
- (make-voice-props-override cue-voice)
- (make-music 'Music))
- 'CueVoice "cue")
+ (and cue-type cue-voice
+ (context-spec-music
+ (make-voice-props-override cue-voice)
+ cue-type cue-id))
quote-music
- (and cue-voice
+ (and cue-type cue-voice
(context-spec-music
- (make-voice-props-revert) 'CueVoice "cue"))
+ (make-voice-props-revert)
+ cue-type cue-id))
(and clef (make-cue-clef-unset))))))
quote-music))
projects / lilypond.git / blobdiff