X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fchord-entry.scm;h=1d41c973e80330876afc9de25d5e090e4bc223ef;hb=530857ca80db51aad52eb1c92ad5f23bfdcfdd4a;hp=ec95dff287f0ba2385d79702bfcb73754d210ec2;hpb=47db9a3883d726ca53e2133a3b2298f78dd6a32e;p=lilypond.git diff --git a/scm/chord-entry.scm b/scm/chord-entry.scm index ec95dff287..1d41c973e8 100644 --- a/scm/chord-entry.scm +++ b/scm/chord-entry.scm @@ -32,6 +32,8 @@ Entry point for the parser." (inversion #f) (lead-mod #f) (explicit-11 #f) + (explicit-2/4 #f) + (omit-3 #f) (start-additions #t)) (define (interpret-inversion chord mods) @@ -49,7 +51,8 @@ Entry point for the parser." (set! bass (cadr mods)) (set! mods (cddr mods)))) (if (pair? mods) - (ly:warning (_ "Spurious garbage following chord: ~A") mods)) + (ly:parser-error + (format #f (_ "Spurious garbage following chord: ~A") mods))) chord) (define (interpret-removals chord mods) @@ -66,8 +69,10 @@ Entry point for the parser." "Interpret additions. TODO: should restrict modifier use?" (cond ((null? mods) chord) ((ly:pitch? (car mods)) - (if (= (pitch-step (car mods)) 11) - (set! explicit-11 #t)) + (case (pitch-step (car mods)) + ((11) (set! explicit-11 #t)) + ((2 4) (set! explicit-2/4 #t)) + ((3) (set! omit-3 #f))) (interpret-additions (cons (car mods) (remove-step (pitch-step (car mods)) chord)) (cdr mods))) ((procedure? (car mods)) @@ -129,8 +134,10 @@ the bass specified. (ly:pitch? (car flat-mods)) (not (eq? lead-mod sus-modifier))) (begin - (if (= (pitch-step (car flat-mods)) 11) - (set! explicit-11 #t)) + (cond ((= (pitch-step (car flat-mods)) 11) + (set! explicit-11 #t)) + ((equal? (ly:make-pitch 0 4 0) (car flat-mods)) + (set! omit-3 #t))) (set! base-chord (stack-thirds (car flat-mods) the-canonical-chord)) (set! flat-mods (cdr flat-mods)))) @@ -141,6 +148,10 @@ the bass specified. (if start-additions (interpret-additions base-chord flat-mods) (interpret-removals base-chord flat-mods))) + ;; if sus has been given neither 2 or 4, we add 4. + (if (and (eq? lead-mod sus-modifier) + (not explicit-2/4)) + (set! complete-chord (cons (ly:make-pitch 0 4 0) complete-chord))) (set! complete-chord (sort complete-chord ly:pitch