Singing support

1 files changed, 558 insertions, 0 deletions

diff --git a/elisp/lilypond-song.el b/elisp/lilypond-song.el
new file mode 100644
index 0000000000..9886dac685
--- /dev/null
+++ b/elisp/lilypond-song.el
@@ -0,0 +1,558 @@
+;;; lilypond-song.el --- Emacs support for LilyPond singing
+
+;; Copyright (C) 2006 Brailcom, o.p.s.
+
+;; Author: Milan Zamazal <pdm@brailcom.org>
+
+;; COPYRIGHT NOTICE
+
+;; This program 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 2 of the License, or
+;; (at your option) any later version.
+
+;; This program 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 this program; if not, write to the Free Software
+;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA.
+
+;;; 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