X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmidi.scm;h=3564a709b398456fe9e3bb8a388a5a5a2eb73418;hb=77267b700c377fd170abcbf4863728937038eb5e;hp=e673555d932b1c715fe1660b18fd6b1ea8d04e3f;hpb=44dd3acc534e7a534f846810b481c3f603eaa92e;p=lilypond.git

diff --git a/scm/midi.scm b/scm/midi.scm
index e673555d93..3564a709b3 100644
--- a/scm/midi.scm
+++ b/scm/midi.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 2000--2012 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 2000--2015 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -290,6 +290,17 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 
+;;; Adapted from the handle-metadata function in framework-ps.scm
+(define (performance-name-from-header header)
+  (define (metadata-lookup-output overridevar fallbackvar)
+    (let* ((overrideval (ly:modules-lookup (list header) overridevar))
+           (fallbackval (ly:modules-lookup (list header) fallbackvar))
+           (val (if overrideval overrideval fallbackval)))
+      (if val (ly:encode-string-for-pdf (markup->string val)) "")))
+  (if (null? header)
+      ""
+      (metadata-lookup-output 'midititle 'title)))
+
 (define-public (write-performances-midis performances basename . rest)
   (let ((midi-ext (ly:get-option 'midi-extension)))
     (let
@@ -297,10 +308,11 @@
       ((perfs performances)
        (count (if (null? rest) 0 (car rest))))
       (if (pair? perfs)
-          (begin
+          (let ((perf (car perfs)))
             (ly:performance-write
-             (car perfs)
+             perf
              (if (> count 0)
                  (format #f "~a-~a.~a" basename count midi-ext)
-                 (format #f "~a.~a" basename midi-ext)))
+                 (format #f "~a.~a" basename midi-ext))
+             (performance-name-from-header (ly:performance-header perf)))
             (loop (cdr perfs) (1+ count)))))))