\version "2.19.10"

\header {
  tagline = ##f
}

#(define (ledger-line-no middle-C-pos p)
   "Returns the number of ledger-lines a pitch @var{p} will have with
middle C position @var{middle-C-pos} expressed as staff-steps from the
middle staff line."
   (let* ((ps (ly:pitch-steps p))
          (mid-staff-steps (- middle-C-pos))
          (top-line (+ mid-staff-steps 4))
          (bottom-line (- mid-staff-steps 4))
          (above? (> ps top-line))
          (below? (< ps bottom-line))
          (steps-outside-staff
           (cond
            (below? (- ps bottom-line))
            (above? (- ps top-line))
            (else 0))))
     (truncate (/ steps-outside-staff 2))))


ottavate =
#(define-music-function (parser location threshold mus)
   (integer? ly:music?)
   "Create an ottava for notes which have at least @var{threshold} ledger lines"
   (let ((up-an-octave (list (make-music 'OttavaMusic 'ottava-number 1)))
         (loco (list (make-music 'OttavaMusic 'ottava-number 0))))
     
     (define (build-new-elts mus-expr new-expr start-loco? start-ottava?)
       (if (null? mus-expr)
           ;; ensure that ottava does not extend past a localized
           ;; use of \octavate
           (append new-expr loco)
          
           (cond
            ((music-is-of-type? (car mus-expr) 'event-chord)
             (cond
              ((and
                start-ottava?
                (every (lambda (p)
                         (>= (ledger-line-no -6 (ly:music-property p 'pitch)) threshold))
                  (ly:music-property (car mus-expr) 'elements)))
               (build-new-elts
                (cdr mus-expr)
                (append
                 new-expr
                 up-an-octave
                 (list (car mus-expr)))
                #t #f))
              ((and 
                start-loco?
                (any (lambda (p)
                       (< (ledger-line-no -6 (ly:music-property p 'pitch)) threshold))
                  (ly:music-property (car mus-expr) 'elements)))
               (build-new-elts
                (cdr mus-expr)
                (append
                 new-expr
                 loco
                 (list (car mus-expr)))
                #f #t))
              (else (build-new-elts
                     (cdr mus-expr)
                     (append new-expr (list (car mus-expr)))
                     #t #t))))
            
            ((music-is-of-type? (car mus-expr) 'note-event)
             (let ((p (ly:music-property (car mus-expr) 'pitch)))
               (cond
                ((and (ly:pitch? p)
                      start-ottava?
                      (>= (ledger-line-no -6 p) threshold))
                 (build-new-elts
                  (cdr mus-expr)
                  (append
                   new-expr
                   up-an-octave
                   (list (car mus-expr)))
                  #t #f))
                ((and (ly:pitch? p)
                      start-loco?
                      (< (ledger-line-no -6 p) threshold))
                 (build-new-elts
                  (cdr mus-expr)
                  (append
                   new-expr
                   loco
                   (list (car mus-expr)))
                  #f #t))
                (else
                 (build-new-elts
                  (cdr mus-expr)
                  (append new-expr (list (car mus-expr)))
                  #t #t)))))
            
            (else 
             (build-new-elts
              (cdr mus-expr)
              (append new-expr (list (car mus-expr)))
              #t #t)))))
   
     (define (recurse music)
       (let ((elts (ly:music-property music 'elements))
             (e (ly:music-property music 'element)))
         (if (ly:music? e)
             (recurse e))
         (if (pair? elts)
             (if (or
                  
                  (any (lambda (elt) (music-is-of-type? elt 'note-event)) elts)
                  (any (lambda (elt) (music-is-of-type? elt 'event-chord)) elts))
                 (set! (ly:music-property music 'elements)
                       (build-new-elts elts '() #t #t))
                 (map recurse elts)))))
   
     (recurse mus)
     
     ;(display-scheme-music mus)
   
     mus))

%%%%%%%%%%% EXAMPLE %%%%%%%%%%%%

music = \relative c''' {
  \repeat volta 2 {
    a8 b c d e f g a
  }
}

{
  \ottavate #5 \music
  \ottavate #4 \music
  \ottavate #3 \music
  \ottavate #2 \music
}

musictwo = \new PianoStaff <<
  \new Staff { \music R1 }
  \new Staff { \unfoldRepeats \transpose c e { \music } }
>>

{
  \ottavate #3 \musictwo
}

musicthree =
\new PianoStaff <<
  \relative c''' {
    \new Staff {
      \key g \major
      \time 3/4
      \new Voice {
        <a c>8 <b d> <c e> <d fis> <e g> <fis a> <g b> <a c> <b d> <c e> <d fis> <e g>
        <e g> <d fis> <c e> <b d> <a c> <g b> <fis a> <e g> <d fis> <c e> <b d> <a c>
      }
    }
  }
  \relative c'' {
    \new Staff {
      \key g \major
      \new Voice {
        <a c>8 <b d> <c e> <d fis> <e g> <fis a> <g b> <a c> <b d> <c e> <d fis> <e g>
        <e g> <d fis> <c e> <b d> <a c> <g b> <fis a> <e g> <d fis> <c e> <b d> <a c>
      }
    }
  }
>>

{
  \ottavate #1 \musicthree
}