+ (define (set-fret note string)
+ (let ((this-fret (calc-fret (ly:event-property note 'pitch)
+ string
+ tuning)))
+ (if (< this-fret 0)
+ (ly:warning (_ "Negative fret for pitch ~a on string ~a")
+ (note-pitch note) string))
+ (set! string-fret-fingering-tuples
+ (cons (list string
+ this-fret
+ (note-finger note))
+ string-fret-fingering-tuples))
+ (delete-free-string string)
+ (set! specified-frets (cons this-fret specified-frets))))
+
+ (define (pad-list target template)
+ (while (< (length target) (length template))
+ (set! target (if (null? target)
+ '(())
+ (append target '(()))))))
+
+ ;;; body of determine-frets-and-strings
+ (set! free-strings (map 1+ (iota (length tuning))))
+
+ ;; get defined-strings same length as notes
+ (pad-list defined-strings notes)
+
+ ;; get defined-fingers same length as notes
+ (pad-list defined-fingers notes)
+
+ ;; handle notes with strings assigned and fingering of 0
+ (for-each
+ (lambda (note string finger)
+ (let ((digit (if (null? finger)
+ #f
+ finger)))
+ (if (and (null? string)
+ (not (eq? digit 0)))
+ (set! unassigned-notes (cons note unassigned-notes))
+ (if (eq? digit 0)
+ (let ((fit-string
+ (find (lambda (string)
+ (open-string string (note-pitch note)))
+ free-strings)))
+ (if fit-string
+ (begin
+ (delete-free-string fit-string)
+ (set-fret note fit-string))
+ (begin
+ (ly:warning (_ "No open string for pitch ~a")
+ (note-pitch note))
+ (set! unassigned-notes (cons note unassigned-notes)))))
+ (begin
+ (delete-free-string string)
+ (set-fret note string))))))
+ notes defined-strings defined-fingers)
+
+ ;; handle notes without strings assigned