\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))))

#(define (find-clefMiddleCPosition mus)
   (let ((clef-pos -6)) ; treble is default
     (for-some-music
      (lambda (x)
        (let ((n (ly:music-property x 'symbol)))
          (and (eq? n 'middleCClefPosition)
               (set! clef-pos (ly:music-property x 'value)))))
      mus)
     clef-pos))

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? clef-pos)
       (if (null? mus-expr)
           ;; ensure that ottava does not extend past a localized
           ;; use of \ottavate
           (append new-expr loco)
           
           (begin
            ;; find value for 'clefMiddleCPosition
            (if (eq? (ly:music-property (car mus-expr) 'name) 'ContextSpeccedMusic)
                (set! clef-pos (find-clefMiddleCPosition (car mus-expr))))
            
            (cond
             ((music-is-of-type? (car mus-expr) 'event-chord)
              (cond
               ((and
                 start-ottava?
                 (every (lambda (p)
                          (>= (ledger-line-no clef-pos (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 clef-pos))
               ((and 
                 start-loco?
                 (any (lambda (p)
                        (< (ledger-line-no clef-pos (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 clef-pos))
               (else (build-new-elts
                      (cdr mus-expr)
                      (append new-expr (list (car mus-expr)))
                      #t #t clef-pos))))
            
             ((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 clef-pos p) threshold))
                  (build-new-elts
                   (cdr mus-expr)
                   (append
                    new-expr
                    up-an-octave
                    (list (car mus-expr)))
                   #t #f clef-pos))
                 ((and (ly:pitch? p)
                       start-loco?
                       (< (ledger-line-no clef-pos p) threshold))
                  (build-new-elts
                   (cdr mus-expr)
                   (append
                    new-expr
                    loco
                    (list (car mus-expr)))
                   #f #t clef-pos))
                 (else
                  (build-new-elts
                   (cdr mus-expr)
                   (append new-expr (list (car mus-expr)))
                   #t #t clef-pos)))))
            
             (else 
              (build-new-elts
               (cdr mus-expr)
               (append new-expr (list (car mus-expr)))
               #t #t clef-pos))))))
   
     (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 -6))
                 (map recurse elts)))))
   
     (recurse mus)
     
     ;(display-scheme-music mus)
   
     mus))

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

music =
\relative c {
  \new Staff {
    \key g \major
    \new Voice {
      \clef "bass_8"
      <g b>4 <a c>8 <b d> <c e> <d fis> <e g> <fis a>
      \clef bass
      <g b>4 <a c>8 <b d> <c e> <d fis> <e g> <fis a>
      \clef tenor
      <d fis>4 <e g>8 <fis a><g b> <a c> <b d> <c e>
      \clef alto
      <fis, a>4 <g b>8 <a c> <b d> <c e> <d fis> <e g>  
      \clef treble
      <e g>4 <fis a>8 <g b> <a c> <b d> <c e> <d fis> 
    }
  }
}


{
  \ottavate #2 \music
}

{
  \ottavate #1 \music
}