%%% Extrahiert Informationen aus einem ly:music-Objekt und liefert eine alist
%%% mit String-Werten zurueck (z.B. ((time . "4/4") (key . "d minor"))).
%%% Benoetigt LilyPond >= 2.26.

%% note-name->lily-string liegt im Modul (lily display-lily).
#(use-modules (lily display-lily))

#(begin

   ;; --- Taktangabe --------------------------------------------------------

   ;; Numerator einer Taktangabe kann eine Zahl oder eine Liste sein.
   (define (numerator->string num)
     (if (list? num)
         (string-join (map number->string num) "+")
         (number->string num)))

   ;; Liefert die Taktangabe als String (z.B. "4/4" oder "7/8") oder #f.
   ;; time-signature ist ein Paar (numerator . denominator).
   (define (time-music->string m)
     (let ((ts (ly:music-property m 'time-signature)))
       (and (pair? ts)
            (string-append (numerator->string (car ts)) "/"
                           (number->string (cdr ts))))))

   ;; --- Tonart ------------------------------------------------------------

   ;; Liefert die Tonart als String (z.B. "d minor" oder "c major") oder #f.
   ;; Vorgehen wie in LilyPonds eigenem \displayMusic (define-music-display-
   ;; methods.scm): pitch-alist nach c zuruecktransponieren und mit den
   ;; bekannten Modus-Definitionen vergleichen. note-name->lily-string liefert
   ;; den Grundton in der aktuell eingestellten Notensprache.
   (define (key-music->string m)
     (let ((tonic (ly:music-property m 'tonic))
           (alist (ly:music-property m 'pitch-alist)))
       (and (ly:pitch? tonic) (pair? alist)
            (let* ((c-alist (ly:transpose-key-alist alist (- tonic)))
                   (mode (any (lambda (mode)
                                (and (equal? (ly:parser-lookup mode) c-alist)
                                     (symbol->string mode)))
                              '(major minor))))
              (and mode
                   (string-append (symbol->string (note-name->lily-string tonic))
                                  " " mode))))))

   ;; --- Header-Metadaten ----------------------------------------------------

   ;; Nimmt einen Bookpart entgegen (wie HEADER aus pool_bottom.ily) und
   ;; liefert dessen Header-Felder als alist, z.B.
   ;; ((title . "Ako umram") (authors . (("..." text melody))) ...).
   ;; Die Werte bleiben unveraendert, wie sie im \header definiert wurden
   ;; (Strings, Listen, Markups ...).
   (define (bookpart->header-alist bookpart)
     (let ((header (ly:book-header bookpart)))
       (if (module? header)
           (sort
            (filter-map (lambda (entry)
                          (and (variable-bound? (cdr entry))
                               (cons (car entry) (variable-ref (cdr entry)))))
                        (module-map cons header))
            (lambda (a b)
              (string<? (symbol->string (car a))
                        (symbol->string (car b)))))
           '())))

   ;; --- Hauptfunktion -----------------------------------------------------

   ;; Liefert das erste Music-Objekt mit gegebenem Namen (oder #f).
   (define (first-named-music music music-name)
     (let ((matches (extract-named-music music music-name)))
       (and (pair? matches) (car matches))))

   ;; Nimmt ly:music entgegen und liefert eine alist mit String-Werten.
   (define (music->data-alist music)
     (let* ((time-m (first-named-music
                     music '(TimeSignatureMusic ReferenceTimeSignatureMusic)))
            (key-m  (first-named-music music 'KeyChangeEvent))
            (time-s (and time-m (time-music->string time-m)))
            (key-s  (and key-m  (key-music->string key-m))))
       (append
        (if time-s (list (cons 'time time-s)) '())
        (if key-s  (list (cons 'key key-s)) '())))))