557 lines
20 KiB
EmacsLisp
557 lines
20 KiB
EmacsLisp
;;;; lilypond-song.el --- Emacs support for LilyPond singing
|
|
;;;;
|
|
;;;; This file is part of LilyPond, the GNU music typesetter.
|
|
;;;;
|
|
;;;; Copyright (C) 2006 Brailcom, o.p.s.
|
|
;;;; Author: Milan Zamazal <pdm@brailcom.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
|
|
;;;; the Free Software Foundation, either version 3 of the License, or
|
|
;;;; (at your option) any later version.
|
|
;;;;
|
|
;;;; LilyPond is distributed in the hope that it will be useful,
|
|
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;;;; GNU General Public License for more details.
|
|
;;;;
|
|
;;;; You should have received a copy of the GNU General Public License
|
|
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This file adds Emacs support for singing lyrics of LilyPond files.
|
|
;; It extends lilypond-mode with the following commands (see their
|
|
;; documentation for more information):
|
|
;;
|
|
;; - M-x LilyPond-command-sing (C-c C-a)
|
|
;; - M-x LilyPond-command-sing-and-play (C-c C-q)
|
|
;; - M-x LilyPond-command-sing-last (C-c C-z)
|
|
;;
|
|
;; Note these commands are not available from the standard LilyPond mode
|
|
;; command menus.
|
|
|
|
;;; Code:
|
|
|
|
|
|
(require 'cl)
|
|
(require 'lilypond-mode)
|
|
|
|
(ignore-errors (require 'ecasound))
|
|
|
|
|
|
;;; User options
|
|
|
|
|
|
(defcustom LilyPond-synthesize-command "lilysong"
|
|
"Command used to sing LilyPond files."
|
|
:group 'LilyPond
|
|
:type 'string)
|
|
|
|
(defcustom LilyPond-play-command (or (executable-find "ecaplay") "play")
|
|
"Command used to play WAV files."
|
|
:group 'LilyPond
|
|
:type 'string)
|
|
|
|
;; In case you would like to use fluidsynth (not recommended as fluidsynth
|
|
;; can perform wave file synthesis only in real time), you can use the
|
|
;; following setting:
|
|
;; (setq LilyPond-midi->wav-command "fluidsynth -nil -a file soundfont.sf2 '%s' && sox -t raw -s -r 44100 -w -c 2 fluidsynth.raw '%t'")
|
|
(defcustom LilyPond-midi->wav-command "timidity -Ow %m -s %r -o '%t' '%s'"
|
|
"Command used to make a WAV file from a MIDI file.
|
|
%s in the string is replaced with the source MIDI file name,
|
|
%t is replaced with the target WAV file name.
|
|
%r is replaced with rate.
|
|
%m is replaced with lilymidi call."
|
|
:group 'LilyPond
|
|
:type 'string)
|
|
|
|
(defcustom LilyPond-voice-rates
|
|
'((".*czech.*" . 44100)
|
|
(".*\\<fi\\(\\>\\|nnish\\).*" . 22050)
|
|
(".*" . 16000))
|
|
"Alist of regexps matching voices and the corresponding voice rates.
|
|
It may be necessary to define proper voice rates here in order to
|
|
avoid ecasound resampling problems."
|
|
:group 'LilyPond
|
|
:type '(alist :key-type regexp :value-type integer))
|
|
|
|
(defcustom LilyPond-use-ecasound (and (featurep 'ecasound)
|
|
(executable-find "ecasound")
|
|
t)
|
|
"If non-nil, use ecasound for mixing and playing songs."
|
|
:group 'LilyPond
|
|
:type 'boolean)
|
|
|
|
(defcustom LilyPond-voice-track-regexp "voice"
|
|
"Perl regexp matching names of MIDI tracks to be ignored on sing&play."
|
|
:group 'LilyPond
|
|
:type 'string)
|
|
|
|
(defcustom LilyPond-lilymidi-command "\"`lilymidi --prefix-tracks -Q --filter-tracks '%s' '%f'`\""
|
|
"Command to insert into LilyPond-midi->wav-command calls.
|
|
%f is replaced with the corresponding MIDI file name.
|
|
%s is replaced with `LilyPond-voice-track-regexp'."
|
|
:group 'LilyPond
|
|
:type 'string)
|
|
|
|
|
|
;;; Lyrics language handling
|
|
|
|
|
|
(defvar lilysong-language nil)
|
|
(make-variable-buffer-local 'lilysong-language)
|
|
|
|
(defvar lilysong-last-language nil)
|
|
(make-variable-buffer-local 'lilysong-last-language)
|
|
|
|
(defvar lilysong-languages '("cs" "en"))
|
|
|
|
(defvar lilysong-voices nil)
|
|
|
|
(defun lilysong-voices ()
|
|
(or lilysong-voices
|
|
(with-temp-buffer
|
|
(call-process "lilysong" nil t nil "--list-voices")
|
|
(call-process "lilysong" nil t nil "--list-languages")
|
|
(goto-char (point-min))
|
|
(while (not (eobp))
|
|
(push (buffer-substring-no-properties
|
|
(line-beginning-position) (line-end-position))
|
|
lilysong-voices)
|
|
(forward-line))
|
|
lilysong-voices)))
|
|
|
|
(defun lilysong-change-language ()
|
|
"Change synthesis language or voice of the current document."
|
|
(interactive)
|
|
(setq lilysong-language
|
|
(completing-read "Lyrics language or voice: "
|
|
(mapcar 'list (lilysong-voices)))))
|
|
|
|
(defun lilysong-update-language ()
|
|
(unless lilysong-language
|
|
(lilysong-change-language)))
|
|
|
|
|
|
;;; Looking for \festival* and \midi commands
|
|
|
|
|
|
(defun lilysong-document-files ()
|
|
(let ((resulting-files ())
|
|
(stack (list (LilyPond-get-master-file))))
|
|
(while (not (null stack))
|
|
(let ((file (expand-file-name (pop stack))))
|
|
(when (and (file-exists-p file)
|
|
(not (member file resulting-files)))
|
|
(push file resulting-files)
|
|
(save-excursion
|
|
(save-restriction
|
|
(set-buffer (find-file-noselect file nil))
|
|
(widen)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "^[^%\n]*\\\\include +\"\\([^\"]+\\)\"" nil t)
|
|
(push (match-string 1) stack)))))))
|
|
(nreverse resulting-files)))
|
|
|
|
(defvar lilysong-festival-command-regexp
|
|
"^[^%\n]*\\\\festival\\(syl\\)? +#\"\\([^\"]+\\)\"")
|
|
|
|
(defun lilysong-find-song (direction)
|
|
"Find XML file name of the nearest Festival command in the given DIRECTION.
|
|
DIRECTION is one of the symbols `forward' or `backward'.
|
|
If no Festival command is found in the current buffer, return nil.
|
|
The point is left at the position where the command occurrence was found."
|
|
(save-match-data
|
|
(when (funcall (if (eq direction 'backward)
|
|
're-search-backward
|
|
're-search-forward)
|
|
lilysong-festival-command-regexp nil t)
|
|
(match-string-no-properties 2))))
|
|
|
|
(defun lilysong-current-song ()
|
|
"Return the XML file name corresponding to the song around current point.
|
|
If there is none, return nil."
|
|
(save-excursion
|
|
(or (progn (end-of-line) (lilysong-find-song 'backward))
|
|
(progn (beginning-of-line) (lilysong-find-song 'forward)))))
|
|
|
|
(defun lilysong-all-songs (&optional limit-to-region)
|
|
"Return list of XML file names of the song commands in the current buffer.
|
|
If there are none, return an empty list.
|
|
If LIMIT-TO-REGION is non-nil, look for the commands in the current region
|
|
only."
|
|
(let ((result '())
|
|
(current nil))
|
|
(save-excursion
|
|
(save-restriction
|
|
(when limit-to-region
|
|
(narrow-to-region (or (mark) (point)) (point)))
|
|
(goto-char (point-min))
|
|
(while (setq current (lilysong-find-song 'forward))
|
|
(push current result))))
|
|
(nreverse result)))
|
|
|
|
(defun lilysong-walk-files (collector)
|
|
(save-excursion
|
|
(mapcar (lambda (f)
|
|
(set-buffer (find-file-noselect f))
|
|
(funcall collector))
|
|
(lilysong-document-files))))
|
|
|
|
(defun lilysong-all-songs* ()
|
|
"Return list of XML file names of the song commands in the current document."
|
|
(remove-duplicates (apply #'append (lilysong-walk-files #'lilysong-all-songs))
|
|
:test #'equal))
|
|
|
|
(defvar lilysong-song-history nil)
|
|
(make-variable-buffer-local 'lilysong-song-history)
|
|
|
|
(defvar lilysong-last-song-list nil)
|
|
(make-variable-buffer-local 'lilysong-last-song-list)
|
|
|
|
(defvar lilysong-last-command-args nil)
|
|
(make-variable-buffer-local 'lilysong-last-command-args)
|
|
|
|
(defun lilysong-song-list (multi)
|
|
(cond
|
|
((eq multi 'all)
|
|
(lilysong-all-songs*))
|
|
(multi
|
|
(lilysong-select-songs))
|
|
(t
|
|
(lilysong-select-single-song))))
|
|
|
|
(defun lilysong-select-single-song ()
|
|
(let ((song (lilysong-current-song)))
|
|
(if song
|
|
(list song)
|
|
(error "No song found"))))
|
|
|
|
(defun lilysong-select-songs ()
|
|
(let* ((all-songs (lilysong-all-songs*))
|
|
(available-songs all-songs)
|
|
(initial-songs (if (or (not lilysong-last-song-list)
|
|
(eq LilyPond-command-current
|
|
'LilyPond-command-region))
|
|
(lilysong-all-songs t)
|
|
lilysong-last-song-list))
|
|
(last-input (completing-read
|
|
(format "Sing file%s: "
|
|
(if initial-songs
|
|
(format " (default `%s')"
|
|
(mapconcat 'identity initial-songs
|
|
", "))
|
|
""))
|
|
(mapcar 'list all-songs)
|
|
nil t nil
|
|
'lilysong-song-history)))
|
|
(if (equal last-input "")
|
|
initial-songs
|
|
(let ((song-list '())
|
|
default-input)
|
|
(while (not (equal last-input ""))
|
|
(push last-input song-list)
|
|
(setq default-input (second (member last-input available-songs)))
|
|
(setq available-songs (remove last-input available-songs))
|
|
(setq last-input (completing-read "Sing file: "
|
|
(mapcar #'list available-songs)
|
|
nil t default-input
|
|
'lilysong-song-history)))
|
|
(setq lilysong-last-song-list (nreverse song-list))))))
|
|
|
|
(defun lilysong-count-midi-words ()
|
|
(count-rexp (point-min) (point-max) "^[^%]*\\\\midi"))
|
|
|
|
(defun lilysong-midi-list (multi)
|
|
(if multi
|
|
(let ((basename (file-name-sans-extension (buffer-file-name)))
|
|
(count (apply #'+ (save-match-data
|
|
(lilysong-walk-files #'lilysong-count-midi-words))))
|
|
(midi-files '()))
|
|
(while (> count 0)
|
|
(setq count (1- count))
|
|
(if (= count 0)
|
|
(push (concat basename ".midi") midi-files)
|
|
(push (format "%s-%d.midi" basename count) midi-files)))
|
|
midi-files)
|
|
(list (LilyPond-string-current-midi))))
|
|
|
|
|
|
;;; Compilation
|
|
|
|
|
|
(defun lilysong-file->wav (filename &optional extension)
|
|
(format "%s.%s" (save-match-data
|
|
(if (string-match "\\.midi$" filename)
|
|
filename
|
|
(file-name-sans-extension filename)))
|
|
(or extension "wav")))
|
|
|
|
(defun lilysong-file->ewf (filename)
|
|
(lilysong-file->wav filename "ewf"))
|
|
|
|
(defstruct lilysong-compilation-data
|
|
command
|
|
makefile
|
|
buffer
|
|
songs
|
|
midi
|
|
in-parallel)
|
|
(defvar lilysong-compilation-data nil)
|
|
(defun lilysong-sing (songs &optional midi-files in-parallel)
|
|
(setq lilysong-last-command-args (list songs midi-files in-parallel))
|
|
(lilysong-update-language)
|
|
(add-to-list 'compilation-finish-functions 'lilysong-after-compilation)
|
|
(setq songs (mapcar #'expand-file-name songs))
|
|
(let* ((makefile (lilysong-makefile (current-buffer) songs midi-files))
|
|
(command (format "make -f %s" makefile)))
|
|
(setq lilysong-compilation-data
|
|
(make-lilysong-compilation-data
|
|
:command command
|
|
:makefile makefile
|
|
:buffer (current-buffer)
|
|
:songs songs
|
|
:midi midi-files
|
|
:in-parallel in-parallel))
|
|
(save-some-buffers (not compilation-ask-about-save))
|
|
(unless (equal lilysong-language lilysong-last-language)
|
|
(mapc #'(lambda (f) (when (file-exists-p f) (delete-file f)))
|
|
(append songs (mapcar 'lilysong-file->wav midi-files))))
|
|
(if (lilysong-up-to-date-p makefile)
|
|
(lilysong-process-generated-files lilysong-compilation-data)
|
|
(compile command))))
|
|
|
|
(defun lilysong-up-to-date-p (makefile)
|
|
(equal (call-process "make" nil nil nil "-f" makefile "-q") 0))
|
|
|
|
(defun lilysong-makefile (buffer songs midi-files)
|
|
(let ((temp-file (make-temp-file "Makefile.lilysong-el"))
|
|
(language lilysong-language))
|
|
(with-temp-file temp-file
|
|
(let ((source-files (save-excursion
|
|
(set-buffer buffer)
|
|
(lilysong-document-files)))
|
|
(master-file (save-excursion
|
|
(set-buffer buffer)
|
|
(LilyPond-get-master-file)))
|
|
(lilyfiles (append songs midi-files)))
|
|
(insert "all:")
|
|
(dolist (f (mapcar 'lilysong-file->wav (append songs midi-files)))
|
|
(insert " " f))
|
|
(insert "\n")
|
|
(when lilyfiles
|
|
(dolist (f songs)
|
|
(insert f " "))
|
|
(when midi-files
|
|
(dolist (f midi-files)
|
|
(insert f " ")))
|
|
(insert ": " master-file "\n")
|
|
(insert "\t" LilyPond-lilypond-command " " master-file "\n")
|
|
(dolist (f songs)
|
|
(insert (lilysong-file->wav f) ": " f "\n")
|
|
(insert "\t" LilyPond-synthesize-command " $< " (or language "") "\n"))
|
|
;; We can't use midi files in ecasound directly, because setpos
|
|
;; doesn't work on them.
|
|
(let ((lilymidi LilyPond-lilymidi-command)
|
|
(voice-rate (format "%d" (or (cdr (assoc-if (lambda (key) (string-match key language))
|
|
LilyPond-voice-rates))
|
|
16000))))
|
|
(when (string-match "%s" lilymidi)
|
|
(setq lilymidi (replace-match LilyPond-voice-track-regexp nil nil lilymidi)))
|
|
(dolist (f midi-files)
|
|
(insert (lilysong-file->wav f) ": " f "\n")
|
|
(let ((command LilyPond-midi->wav-command)
|
|
(lilymidi* lilymidi))
|
|
(when (string-match "%s" command)
|
|
(setq command (replace-match f nil nil command)))
|
|
(when (string-match "%t" command)
|
|
(setq command (replace-match (lilysong-file->wav f) nil nil command)))
|
|
(when (string-match "%r" command)
|
|
(setq command (replace-match voice-rate nil nil command)))
|
|
(when (string-match "%f" lilymidi*)
|
|
(setq lilymidi (replace-match f nil nil lilymidi*)))
|
|
(when (string-match "%m" command)
|
|
(setq command (replace-match lilymidi nil nil command)))
|
|
(insert "\t" command "\n")))
|
|
))))
|
|
temp-file))
|
|
|
|
(defun lilysong-after-compilation (buffer message)
|
|
(let ((data lilysong-compilation-data))
|
|
(when (and data
|
|
(equal compile-command
|
|
(lilysong-compilation-data-command data)))
|
|
(unwind-protect
|
|
(when (lilysong-up-to-date-p (lilysong-compilation-data-makefile data))
|
|
(lilysong-process-generated-files data))
|
|
(delete-file (lilysong-compilation-data-makefile data))))))
|
|
|
|
(defun lilysong-process-generated-files (data)
|
|
(with-current-buffer (lilysong-compilation-data-buffer data)
|
|
(setq lilysong-last-language lilysong-language))
|
|
(lilysong-play-files (lilysong-compilation-data-in-parallel data)
|
|
(lilysong-compilation-data-songs data)
|
|
(lilysong-compilation-data-midi data)))
|
|
|
|
|
|
;;; Playing files
|
|
|
|
|
|
(defun lilysong-play-files (in-parallel songs midi-files)
|
|
(funcall (if LilyPond-use-ecasound
|
|
'lilysong-play-with-ecasound
|
|
'lilysong-play-with-play)
|
|
in-parallel songs midi-files))
|
|
|
|
(defun lilysong-call-play (files)
|
|
(apply 'start-process "lilysong-el" nil LilyPond-play-command files))
|
|
|
|
(defun lilysong-play-with-play (in-parallel songs midi-files)
|
|
(let ((files (mapcar 'lilysong-file->wav (append songs midi-files))))
|
|
(if in-parallel
|
|
(dolist (f files)
|
|
(lilysong-call-play (list f)))
|
|
(lilysong-call-play files))))
|
|
|
|
(defun lilysong-make-ewf-files (files)
|
|
(let ((offset 0.0))
|
|
(dolist (f files)
|
|
(let* ((wav-file (lilysong-file->wav f))
|
|
(length (with-temp-buffer
|
|
(call-process "ecalength" nil t nil "-s" wav-file)
|
|
(goto-char (point-max))
|
|
(forward-line -1)
|
|
(read (current-buffer)))))
|
|
(with-temp-file (lilysong-file->ewf f)
|
|
(insert "source = " wav-file "\n")
|
|
(insert (format "offset = %s\n" offset))
|
|
(insert "start-position = 0.0\n")
|
|
(insert (format "length = %s\n" length))
|
|
(insert "looping = false\n"))
|
|
(setq offset (+ offset length))))))
|
|
|
|
(when (and (featurep 'ecasound)
|
|
(not (fboundp 'eci-cs-set-param)))
|
|
(defeci cs-set-param ((parameter "sChainsetup option: " "%s"))))
|
|
|
|
(defun lilysong-play-with-ecasound (in-parallel songs midi-files)
|
|
(ecasound)
|
|
(eci-cs-add "lilysong-el")
|
|
(eci-cs-select "lilysong-el")
|
|
(eci-cs-remove)
|
|
(eci-cs-add "lilysong-el")
|
|
(eci-cs-select "lilysong-el")
|
|
(eci-cs-set-param "-z:mixmode,sum")
|
|
(unless in-parallel
|
|
(lilysong-make-ewf-files songs)
|
|
;; MIDI files should actually start with each of the songs
|
|
(mapc 'lilysong-make-ewf-files (mapcar 'list midi-files)))
|
|
(let* ((file->wav (if in-parallel 'lilysong-file->wav 'lilysong-file->ewf))
|
|
(files (mapcar file->wav (append songs midi-files))))
|
|
(dolist (f files)
|
|
(eci-c-add f)
|
|
(eci-c-select f)
|
|
(eci-ai-add f))
|
|
(eci-c-select-all)
|
|
(eci-ao-add-default)
|
|
(let* ((n (length songs))
|
|
(right (if (<= n 1) 50 0))
|
|
(step (if (<= n 1) 0 (/ 100.0 (1- n)))))
|
|
(dolist (f songs)
|
|
(let ((chain (funcall file->wav f)))
|
|
(eci-c-select chain)
|
|
(eci-cop-add "-erc:1,2")
|
|
(eci-cop-add (format "-epp:%f" (min right 100)))
|
|
(incf right step))))
|
|
(eci-start)))
|
|
|
|
|
|
;;; User commands
|
|
|
|
|
|
(defun lilysong-arg->multi (arg)
|
|
(cond
|
|
((not arg)
|
|
nil)
|
|
((or
|
|
(numberp arg)
|
|
(equal arg '(4)))
|
|
t)
|
|
(t
|
|
'all)))
|
|
|
|
(defun lilysong-command (arg play-midi?)
|
|
(let* ((multi (lilysong-arg->multi arg))
|
|
(song-list (lilysong-song-list multi))
|
|
(midi-list (if play-midi? (lilysong-midi-list multi))))
|
|
(message "Singing %s" (mapconcat 'identity song-list ", "))
|
|
(lilysong-sing song-list midi-list (if play-midi? t (listp arg)))))
|
|
|
|
(defun LilyPond-command-sing (&optional arg)
|
|
"Sing lyrics of the current LilyPond buffer.
|
|
Without any prefix argument, sing current \\festival* command.
|
|
With the universal prefix argument, ask which parts to sing.
|
|
With a double universal prefix argument, sing all the parts.
|
|
With a numeric prefix argument, ask which parts to sing and sing them
|
|
sequentially rather than in parallel."
|
|
(interactive "P")
|
|
(lilysong-command arg nil))
|
|
|
|
(defun LilyPond-command-sing-and-play (&optional arg)
|
|
"Sing lyrics and play midi of the current LilyPond buffer.
|
|
Without any prefix argument, sing and play current \\festival* and \\midi
|
|
commands.
|
|
With the universal prefix argument, ask which parts to sing and play.
|
|
With a double universal prefix argument, sing and play all the parts."
|
|
(interactive "P")
|
|
(lilysong-command arg t))
|
|
|
|
(defun LilyPond-command-sing-last ()
|
|
"Repeat last LilyPond singing command."
|
|
(interactive)
|
|
(if lilysong-last-command-args
|
|
(apply 'lilysong-sing lilysong-last-command-args)
|
|
(error "No previous singing command")))
|
|
|
|
(defun LilyPond-command-clean ()
|
|
"Remove generated *.xml and *.wav files used for singing."
|
|
(interactive)
|
|
(flet ((delete-file* (file)
|
|
(when (file-exists-p file)
|
|
(delete-file file))))
|
|
(dolist (xml-file (lilysong-song-list 'all))
|
|
(delete-file* xml-file)
|
|
(delete-file* (lilysong-file->wav xml-file)))
|
|
(mapc 'delete-file* (mapcar 'lilysong-file->wav (lilysong-midi-list 'all)))))
|
|
|
|
(define-key LilyPond-mode-map "\C-c\C-a" 'LilyPond-command-sing)
|
|
(define-key LilyPond-mode-map "\C-c\C-q" 'LilyPond-command-sing-and-play)
|
|
(define-key LilyPond-mode-map "\C-c\C-x" 'LilyPond-command-clean)
|
|
(define-key LilyPond-mode-map "\C-c\C-z" 'LilyPond-command-sing-last)
|
|
|
|
(easy-menu-add-item LilyPond-command-menu nil
|
|
["Sing Current" LilyPond-command-sing t])
|
|
(easy-menu-add-item LilyPond-command-menu nil
|
|
["Sing Selected" (LilyPond-command-sing '(4)) t])
|
|
(easy-menu-add-item LilyPond-command-menu nil
|
|
["Sing All" (LilyPond-command-sing '(16)) t])
|
|
(easy-menu-add-item LilyPond-command-menu nil
|
|
["Sing Selected Sequentially" (LilyPond-command-sing 1) t])
|
|
(easy-menu-add-item LilyPond-command-menu nil
|
|
["Sing and Play Current" LilyPond-command-sing-and-play t])
|
|
(easy-menu-add-item LilyPond-command-menu nil
|
|
["Sing and Play Selected" (LilyPond-command-sing-and-play '(4)) t])
|
|
(easy-menu-add-item LilyPond-command-menu nil
|
|
["Sing and Play All" (LilyPond-command-sing-and-play '(16)) t])
|
|
(easy-menu-add-item LilyPond-command-menu nil
|
|
["Sing Last" LilyPond-command-sing-last t])
|
|
|
|
|
|
;;; Announce
|
|
|
|
(provide 'lilypond-song)
|
|
|
|
|
|
;;; lilypond-song.el ends here
|