X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmidi.scm;h=3564a709b398456fe9e3bb8a388a5a5a2eb73418;hb=HEAD;hp=4c7d6b303529aec9e974b88738d3b140545fe657;hpb=99b6f3aa3558b01c9d4158b19a1f1794c534f89c;p=lilypond.git diff --git a/scm/midi.scm b/scm/midi.scm index 4c7d6b3035..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--2014 Jan Nieuwenhuizen +;;;; Copyright (C) 2000--2015 Jan Nieuwenhuizen ;;;; ;;;; 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)))))))