LSR: Update.
[lilypond.git] / elisp / lilypond-song.el
blob9886dac685d9a4b54b19adf05d2297164dfe8246
1 ;;; lilypond-song.el --- Emacs support for LilyPond singing
3 ;; Copyright (C) 2006 Brailcom, o.p.s.
5 ;; Author: Milan Zamazal <pdm@brailcom.org>
7 ;; COPYRIGHT NOTICE
9 ;; This program is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2 of the License, or
12 ;; (at your option) any later version.
14 ;; This program is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
16 ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 ;; for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with this program; if not, write to the Free Software
21 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
23 ;;; Commentary:
25 ;; This file adds Emacs support for singing lyrics of LilyPond files.
26 ;; It extends lilypond-mode with the following commands (see their
27 ;; documentation for more information):
28 ;;
29 ;; - M-x LilyPond-command-sing (C-c C-a)
30 ;; - M-x LilyPond-command-sing-and-play (C-c C-q)
31 ;; - M-x LilyPond-command-sing-last (C-c C-z)
32 ;;
33 ;; Note these commands are not available from the standard LilyPond mode
34 ;; command menus.
36 ;;; Code:
39 (require 'cl)
40 (require 'lilypond-mode)
42 (ignore-errors (require 'ecasound))
45 ;;; User options
48 (defcustom LilyPond-synthesize-command "lilysong"
49 "Command used to sing LilyPond files."
50 :group 'LilyPond
51 :type 'string)
53 (defcustom LilyPond-play-command (or (executable-find "ecaplay") "play")
54 "Command used to play WAV files."
55 :group 'LilyPond
56 :type 'string)
58 ;; In case you would like to use fluidsynth (not recommended as fluidsynth
59 ;; can perform wave file synthesis only in real time), you can use the
60 ;; following setting:
61 ;; (setq LilyPond-midi->wav-command "fluidsynth -nil -a file soundfont.sf2 '%s' && sox -t raw -s -r 44100 -w -c 2 fluidsynth.raw '%t'")
62 (defcustom LilyPond-midi->wav-command "timidity -Ow %m -s %r -o '%t' '%s'"
63 "Command used to make a WAV file from a MIDI file.
64 %s in the string is replaced with the source MIDI file name,
65 %t is replaced with the target WAV file name.
66 %r is replaced with rate.
67 %m is replaced with lilymidi call."
68 :group 'LilyPond
69 :type 'string)
71 (defcustom LilyPond-voice-rates
72 '((".*czech.*" . 44100)
73 (".*\\<fi\\(\\>\\|nnish\\).*" . 22050)
74 (".*" . 16000))
75 "Alist of regexps matching voices and the corresponding voice rates.
76 It may be necessary to define proper voice rates here in order to
77 avoid ecasound resampling problems."
78 :group 'LilyPond
79 :type '(alist :key-type regexp :value-type integer))
81 (defcustom LilyPond-use-ecasound (and (featurep 'ecasound)
82 (executable-find "ecasound")
84 "If non-nil, use ecasound for mixing and playing songs."
85 :group 'LilyPond
86 :type 'boolean)
88 (defcustom LilyPond-voice-track-regexp "voice"
89 "Perl regexp matching names of MIDI tracks to be ignored on sing&play."
90 :group 'LilyPond
91 :type 'string)
93 (defcustom LilyPond-lilymidi-command "\"`lilymidi --prefix-tracks -Q --filter-tracks '%s' '%f'`\""
94 "Command to insert into LilyPond-midi->wav-command calls.
95 %f is replaced with the corresponding MIDI file name.
96 %s is replaced with `LilyPond-voice-track-regexp'."
97 :group 'LilyPond
98 :type 'string)
101 ;;; Lyrics language handling
104 (defvar lilysong-language nil)
105 (make-variable-buffer-local 'lilysong-language)
107 (defvar lilysong-last-language nil)
108 (make-variable-buffer-local 'lilysong-last-language)
110 (defvar lilysong-languages '("cs" "en"))
112 (defvar lilysong-voices nil)
114 (defun lilysong-voices ()
115 (or lilysong-voices
116 (with-temp-buffer
117 (call-process "lilysong" nil t nil "--list-voices")
118 (call-process "lilysong" nil t nil "--list-languages")
119 (goto-char (point-min))
120 (while (not (eobp))
121 (push (buffer-substring-no-properties
122 (line-beginning-position) (line-end-position))
123 lilysong-voices)
124 (forward-line))
125 lilysong-voices)))
127 (defun lilysong-change-language ()
128 "Change synthesis language or voice of the current document."
129 (interactive)
130 (setq lilysong-language
131 (completing-read "Lyrics language or voice: "
132 (mapcar 'list (lilysong-voices)))))
134 (defun lilysong-update-language ()
135 (unless lilysong-language
136 (lilysong-change-language)))
139 ;;; Looking for \festival* and \midi commands
142 (defun lilysong-document-files ()
143 (let ((resulting-files ())
144 (stack (list (LilyPond-get-master-file))))
145 (while (not (null stack))
146 (let ((file (expand-file-name (pop stack))))
147 (when (and (file-exists-p file)
148 (not (member file resulting-files)))
149 (push file resulting-files)
150 (save-excursion
151 (save-restriction
152 (set-buffer (find-file-noselect file nil))
153 (widen)
154 (goto-char (point-min))
155 (while (re-search-forward "^[^%\n]*\\\\include +\"\\([^\"]+\\)\"" nil t)
156 (push (match-string 1) stack)))))))
157 (nreverse resulting-files)))
159 (defvar lilysong-festival-command-regexp
160 "^[^%\n]*\\\\festival\\(syl\\)? +#\"\\([^\"]+\\)\"")
162 (defun lilysong-find-song (direction)
163 "Find XML file name of the nearest Festival command in the given DIRECTION.
164 DIRECTION is one of the symbols `forward' or `backward'.
165 If no Festival command is found in the current buffer, return nil.
166 The point is left at the position where the command occurrence was found."
167 (save-match-data
168 (when (funcall (if (eq direction 'backward)
169 're-search-backward
170 're-search-forward)
171 lilysong-festival-command-regexp nil t)
172 (match-string-no-properties 2))))
174 (defun lilysong-current-song ()
175 "Return the XML file name corresponding to the song around current point.
176 If there is none, return nil."
177 (save-excursion
178 (or (progn (end-of-line) (lilysong-find-song 'backward))
179 (progn (beginning-of-line) (lilysong-find-song 'forward)))))
181 (defun lilysong-all-songs (&optional limit-to-region)
182 "Return list of XML file names of the song commands in the current buffer.
183 If there are none, return an empty list.
184 If LIMIT-TO-REGION is non-nil, look for the commands in the current region
185 only."
186 (let ((result '())
187 (current nil))
188 (save-excursion
189 (save-restriction
190 (when limit-to-region
191 (narrow-to-region (or (mark) (point)) (point)))
192 (goto-char (point-min))
193 (while (setq current (lilysong-find-song 'forward))
194 (push current result))))
195 (nreverse result)))
197 (defun lilysong-walk-files (collector)
198 (save-excursion
199 (mapcar (lambda (f)
200 (set-buffer (find-file-noselect f))
201 (funcall collector))
202 (lilysong-document-files))))
204 (defun lilysong-all-songs* ()
205 "Return list of XML file names of the song commands in the current document."
206 (remove-duplicates (apply #'append (lilysong-walk-files #'lilysong-all-songs))
207 :test #'equal))
209 (defvar lilysong-song-history nil)
210 (make-variable-buffer-local 'lilysong-song-history)
212 (defvar lilysong-last-song-list nil)
213 (make-variable-buffer-local 'lilysong-last-song-list)
215 (defvar lilysong-last-command-args nil)
216 (make-variable-buffer-local 'lilysong-last-command-args)
218 (defun lilysong-song-list (multi)
219 (cond
220 ((eq multi 'all)
221 (lilysong-all-songs*))
222 (multi
223 (lilysong-select-songs))
225 (lilysong-select-single-song))))
227 (defun lilysong-select-single-song ()
228 (let ((song (lilysong-current-song)))
229 (if song
230 (list song)
231 (error "No song found"))))
233 (defun lilysong-select-songs ()
234 (let* ((all-songs (lilysong-all-songs*))
235 (available-songs all-songs)
236 (initial-songs (if (or (not lilysong-last-song-list)
237 (eq LilyPond-command-current
238 'LilyPond-command-region))
239 (lilysong-all-songs t)
240 lilysong-last-song-list))
241 (last-input (completing-read
242 (format "Sing file%s: "
243 (if initial-songs
244 (format " (default `%s')"
245 (mapconcat 'identity initial-songs
246 ", "))
247 ""))
248 (mapcar 'list all-songs)
249 nil t nil
250 'lilysong-song-history)))
251 (if (equal last-input "")
252 initial-songs
253 (let ((song-list '())
254 default-input)
255 (while (not (equal last-input ""))
256 (push last-input song-list)
257 (setq default-input (second (member last-input available-songs)))
258 (setq available-songs (remove last-input available-songs))
259 (setq last-input (completing-read "Sing file: "
260 (mapcar #'list available-songs)
261 nil t default-input
262 'lilysong-song-history)))
263 (setq lilysong-last-song-list (nreverse song-list))))))
265 (defun lilysong-count-midi-words ()
266 (count-rexp (point-min) (point-max) "^[^%]*\\\\midi"))
268 (defun lilysong-midi-list (multi)
269 (if multi
270 (let ((basename (file-name-sans-extension (buffer-file-name)))
271 (count (apply #'+ (save-match-data
272 (lilysong-walk-files #'lilysong-count-midi-words))))
273 (midi-files '()))
274 (while (> count 0)
275 (setq count (1- count))
276 (if (= count 0)
277 (push (concat basename ".midi") midi-files)
278 (push (format "%s-%d.midi" basename count) midi-files)))
279 midi-files)
280 (list (LilyPond-string-current-midi))))
283 ;;; Compilation
286 (defun lilysong-file->wav (filename &optional extension)
287 (format "%s.%s" (save-match-data
288 (if (string-match "\\.midi$" filename)
289 filename
290 (file-name-sans-extension filename)))
291 (or extension "wav")))
293 (defun lilysong-file->ewf (filename)
294 (lilysong-file->wav filename "ewf"))
296 (defstruct lilysong-compilation-data
297 command
298 makefile
299 buffer
300 songs
301 midi
302 in-parallel)
303 (defvar lilysong-compilation-data nil)
304 (defun lilysong-sing (songs &optional midi-files in-parallel)
305 (setq lilysong-last-command-args (list songs midi-files in-parallel))
306 (lilysong-update-language)
307 (add-to-list 'compilation-finish-functions 'lilysong-after-compilation)
308 (setq songs (mapcar #'expand-file-name songs))
309 (let* ((makefile (lilysong-makefile (current-buffer) songs midi-files))
310 (command (format "make -f %s" makefile)))
311 (setq lilysong-compilation-data
312 (make-lilysong-compilation-data
313 :command command
314 :makefile makefile
315 :buffer (current-buffer)
316 :songs songs
317 :midi midi-files
318 :in-parallel in-parallel))
319 (save-some-buffers (not compilation-ask-about-save))
320 (unless (equal lilysong-language lilysong-last-language)
321 (mapc #'(lambda (f) (when (file-exists-p f) (delete-file f)))
322 (append songs (mapcar 'lilysong-file->wav midi-files))))
323 (if (lilysong-up-to-date-p makefile)
324 (lilysong-process-generated-files lilysong-compilation-data)
325 (compile command))))
327 (defun lilysong-up-to-date-p (makefile)
328 (equal (call-process "make" nil nil nil "-f" makefile "-q") 0))
330 (defun lilysong-makefile (buffer songs midi-files)
331 (let ((temp-file (make-temp-file "Makefile.lilysong-el"))
332 (language lilysong-language))
333 (with-temp-file temp-file
334 (let ((source-files (save-excursion
335 (set-buffer buffer)
336 (lilysong-document-files)))
337 (master-file (save-excursion
338 (set-buffer buffer)
339 (LilyPond-get-master-file)))
340 (lilyfiles (append songs midi-files)))
341 (insert "all:")
342 (dolist (f (mapcar 'lilysong-file->wav (append songs midi-files)))
343 (insert " " f))
344 (insert "\n")
345 (when lilyfiles
346 (dolist (f songs)
347 (insert f " "))
348 (when midi-files
349 (dolist (f midi-files)
350 (insert f " ")))
351 (insert ": " master-file "\n")
352 (insert "\t" LilyPond-lilypond-command " " master-file "\n")
353 (dolist (f songs)
354 (insert (lilysong-file->wav f) ": " f "\n")
355 (insert "\t" LilyPond-synthesize-command " $< " (or language "") "\n"))
356 ;; We can't use midi files in ecasound directly, because setpos
357 ;; doesn't work on them.
358 (let ((lilymidi LilyPond-lilymidi-command)
359 (voice-rate (format "%d" (or (cdr (assoc-if (lambda (key) (string-match key language))
360 LilyPond-voice-rates))
361 16000))))
362 (when (string-match "%s" lilymidi)
363 (setq lilymidi (replace-match LilyPond-voice-track-regexp nil nil lilymidi)))
364 (dolist (f midi-files)
365 (insert (lilysong-file->wav f) ": " f "\n")
366 (let ((command LilyPond-midi->wav-command)
367 (lilymidi* lilymidi))
368 (when (string-match "%s" command)
369 (setq command (replace-match f nil nil command)))
370 (when (string-match "%t" command)
371 (setq command (replace-match (lilysong-file->wav f) nil nil command)))
372 (when (string-match "%r" command)
373 (setq command (replace-match voice-rate nil nil command)))
374 (when (string-match "%f" lilymidi*)
375 (setq lilymidi (replace-match f nil nil lilymidi*)))
376 (when (string-match "%m" command)
377 (setq command (replace-match lilymidi nil nil command)))
378 (insert "\t" command "\n")))
379 ))))
380 temp-file))
382 (defun lilysong-after-compilation (buffer message)
383 (let ((data lilysong-compilation-data))
384 (when (and data
385 (equal compile-command
386 (lilysong-compilation-data-command data)))
387 (unwind-protect
388 (when (lilysong-up-to-date-p (lilysong-compilation-data-makefile data))
389 (lilysong-process-generated-files data))
390 (delete-file (lilysong-compilation-data-makefile data))))))
392 (defun lilysong-process-generated-files (data)
393 (with-current-buffer (lilysong-compilation-data-buffer data)
394 (setq lilysong-last-language lilysong-language))
395 (lilysong-play-files (lilysong-compilation-data-in-parallel data)
396 (lilysong-compilation-data-songs data)
397 (lilysong-compilation-data-midi data)))
400 ;;; Playing files
403 (defun lilysong-play-files (in-parallel songs midi-files)
404 (funcall (if LilyPond-use-ecasound
405 'lilysong-play-with-ecasound
406 'lilysong-play-with-play)
407 in-parallel songs midi-files))
409 (defun lilysong-call-play (files)
410 (apply 'start-process "lilysong-el" nil LilyPond-play-command files))
412 (defun lilysong-play-with-play (in-parallel songs midi-files)
413 (let ((files (mapcar 'lilysong-file->wav (append songs midi-files))))
414 (if in-parallel
415 (dolist (f files)
416 (lilysong-call-play (list f)))
417 (lilysong-call-play files))))
419 (defun lilysong-make-ewf-files (files)
420 (let ((offset 0.0))
421 (dolist (f files)
422 (let* ((wav-file (lilysong-file->wav f))
423 (length (with-temp-buffer
424 (call-process "ecalength" nil t nil "-s" wav-file)
425 (goto-char (point-max))
426 (forward-line -1)
427 (read (current-buffer)))))
428 (with-temp-file (lilysong-file->ewf f)
429 (insert "source = " wav-file "\n")
430 (insert (format "offset = %s\n" offset))
431 (insert "start-position = 0.0\n")
432 (insert (format "length = %s\n" length))
433 (insert "looping = false\n"))
434 (setq offset (+ offset length))))))
436 (when (and (featurep 'ecasound)
437 (not (fboundp 'eci-cs-set-param)))
438 (defeci cs-set-param ((parameter "sChainsetup option: " "%s"))))
440 (defun lilysong-play-with-ecasound (in-parallel songs midi-files)
441 (ecasound)
442 (eci-cs-add "lilysong-el")
443 (eci-cs-select "lilysong-el")
444 (eci-cs-remove)
445 (eci-cs-add "lilysong-el")
446 (eci-cs-select "lilysong-el")
447 (eci-cs-set-param "-z:mixmode,sum")
448 (unless in-parallel
449 (lilysong-make-ewf-files songs)
450 ;; MIDI files should actually start with each of the songs
451 (mapc 'lilysong-make-ewf-files (mapcar 'list midi-files)))
452 (let* ((file->wav (if in-parallel 'lilysong-file->wav 'lilysong-file->ewf))
453 (files (mapcar file->wav (append songs midi-files))))
454 (dolist (f files)
455 (eci-c-add f)
456 (eci-c-select f)
457 (eci-ai-add f))
458 (eci-c-select-all)
459 (eci-ao-add-default)
460 (let* ((n (length songs))
461 (right (if (<= n 1) 50 0))
462 (step (if (<= n 1) 0 (/ 100.0 (1- n)))))
463 (dolist (f songs)
464 (let ((chain (funcall file->wav f)))
465 (eci-c-select chain)
466 (eci-cop-add "-erc:1,2")
467 (eci-cop-add (format "-epp:%f" (min right 100)))
468 (incf right step))))
469 (eci-start)))
472 ;;; User commands
475 (defun lilysong-arg->multi (arg)
476 (cond
477 ((not arg)
478 nil)
479 ((or
480 (numberp arg)
481 (equal arg '(4)))
484 'all)))
486 (defun lilysong-command (arg play-midi?)
487 (let* ((multi (lilysong-arg->multi arg))
488 (song-list (lilysong-song-list multi))
489 (midi-list (if play-midi? (lilysong-midi-list multi))))
490 (message "Singing %s" (mapconcat 'identity song-list ", "))
491 (lilysong-sing song-list midi-list (if play-midi? t (listp arg)))))
493 (defun LilyPond-command-sing (&optional arg)
494 "Sing lyrics of the current LilyPond buffer.
495 Without any prefix argument, sing current \\festival* command.
496 With the universal prefix argument, ask which parts to sing.
497 With a double universal prefix argument, sing all the parts.
498 With a numeric prefix argument, ask which parts to sing and sing them
499 sequentially rather than in parallel."
500 (interactive "P")
501 (lilysong-command arg nil))
503 (defun LilyPond-command-sing-and-play (&optional arg)
504 "Sing lyrics and play midi of the current LilyPond buffer.
505 Without any prefix argument, sing and play current \\festival* and \\midi
506 commands.
507 With the universal prefix argument, ask which parts to sing and play.
508 With a double universal prefix argument, sing and play all the parts."
509 (interactive "P")
510 (lilysong-command arg t))
512 (defun LilyPond-command-sing-last ()
513 "Repeat last LilyPond singing command."
514 (interactive)
515 (if lilysong-last-command-args
516 (apply 'lilysong-sing lilysong-last-command-args)
517 (error "No previous singing command")))
519 (defun LilyPond-command-clean ()
520 "Remove generated *.xml and *.wav files used for singing."
521 (interactive)
522 (flet ((delete-file* (file)
523 (when (file-exists-p file)
524 (delete-file file))))
525 (dolist (xml-file (lilysong-song-list 'all))
526 (delete-file* xml-file)
527 (delete-file* (lilysong-file->wav xml-file)))
528 (mapc 'delete-file* (mapcar 'lilysong-file->wav (lilysong-midi-list 'all)))))
530 (define-key LilyPond-mode-map "\C-c\C-a" 'LilyPond-command-sing)
531 (define-key LilyPond-mode-map "\C-c\C-q" 'LilyPond-command-sing-and-play)
532 (define-key LilyPond-mode-map "\C-c\C-x" 'LilyPond-command-clean)
533 (define-key LilyPond-mode-map "\C-c\C-z" 'LilyPond-command-sing-last)
535 (easy-menu-add-item LilyPond-command-menu nil
536 ["Sing Current" LilyPond-command-sing t])
537 (easy-menu-add-item LilyPond-command-menu nil
538 ["Sing Selected" (LilyPond-command-sing '(4)) t])
539 (easy-menu-add-item LilyPond-command-menu nil
540 ["Sing All" (LilyPond-command-sing '(16)) t])
541 (easy-menu-add-item LilyPond-command-menu nil
542 ["Sing Selected Sequentially" (LilyPond-command-sing 1) t])
543 (easy-menu-add-item LilyPond-command-menu nil
544 ["Sing and Play Current" LilyPond-command-sing-and-play t])
545 (easy-menu-add-item LilyPond-command-menu nil
546 ["Sing and Play Selected" (LilyPond-command-sing-and-play '(4)) t])
547 (easy-menu-add-item LilyPond-command-menu nil
548 ["Sing and Play All" (LilyPond-command-sing-and-play '(16)) t])
549 (easy-menu-add-item LilyPond-command-menu nil
550 ["Sing Last" LilyPond-command-sing-last t])
553 ;;; Announce
555 (provide 'lilypond-song)
558 ;;; lilypond-song.el ends here