elisp/lilypond-song.el

   1 ;;; lilypond-song.el --- Emacs support for LilyPond singing
   2
   3 ;; Copyright (C) 2006 Brailcom, o.p.s.
   4
   5 ;; Author: Milan Zamazal <pdm@brailcom.org>
   6
   7 ;; COPYRIGHT NOTICE
   8
   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.
  13
  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.
  18
  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.
  22
  23 ;;; Commentary:
  24
  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.
  35
  36 ;;; Code:
  37
  38
  39 (require 'cl)
  40 (require 'lilypond-mode)
  41
  42 (ignore-errors (require 'ecasound))
  43
  44
  45 ;;; User options
  46
  47
  48 (defcustom LilyPond-synthesize-command "lilysong"
  49   "Command used to sing LilyPond files."
  50   :group 'LilyPond
  51   :type 'string)
  52
  53 (defcustom LilyPond-play-command (or (executable-find "ecaplay") "play")
  54   "Command used to play WAV files."
  55   :group 'LilyPond
  56   :type 'string)
  57
  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)
  70
  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))
  80
  81 (defcustom LilyPond-use-ecasound (and (featurep 'ecasound)
  82                                       (executable-find "ecasound")
  83                                       t)
  84   "If non-nil, use ecasound for mixing and playing songs."
  85   :group 'LilyPond
  86   :type 'boolean)
  87
  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)
  92
  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)
  99
 100
 101 ;;; Lyrics language handling
 102
 103
 104 (defvar lilysong-language nil)
 105 (make-variable-buffer-local 'lilysong-language)
 106
 107 (defvar lilysong-last-language nil)
 108 (make-variable-buffer-local 'lilysong-last-language)
 109
 110 (defvar lilysong-languages '("cs" "en"))
 111
 112 (defvar lilysong-voices nil)
 113
 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)))
 126
 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)))))
 133
 134 (defun lilysong-update-language ()
 135   (unless lilysong-language
 136     (lilysong-change-language)))
 137
 138
 139 ;;; Looking for \festival* and \midi commands
 140
 141
 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)))
 158
 159 (defvar lilysong-festival-command-regexp
 160   "^[^%\n]*\\\\festival\\(syl\\)? +#\"\\([^\"]+\\)\"")
 161
 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))))
 173
 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)))))
 180
 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)))
 196
 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))))
 203
 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))
 208
 209 (defvar lilysong-song-history nil)
 210 (make-variable-buffer-local 'lilysong-song-history)
 211
 212 (defvar lilysong-last-song-list nil)
 213 (make-variable-buffer-local 'lilysong-last-song-list)
 214
 215 (defvar lilysong-last-command-args nil)
 216 (make-variable-buffer-local 'lilysong-last-command-args)
 217
 218 (defun lilysong-song-list (multi)
 219   (cond
 220    ((eq multi 'all)
 221     (lilysong-all-songs*))
 222    (multi
 223     (lilysong-select-songs))
 224    (t
 225     (lilysong-select-single-song))))
 226
 227 (defun lilysong-select-single-song ()
 228   (let ((song (lilysong-current-song)))
 229     (if song
 230         (list song)
 231       (error "No song found"))))
 232
 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))))))
 264
 265 (defun lilysong-count-midi-words ()
 266   (count-rexp (point-min) (point-max) "^[^%]*\\\\midi"))
 267
 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))))
 281
 282
 283 ;;; Compilation
 284
 285
 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")))
 292
 293 (defun lilysong-file->ewf (filename)
 294   (lilysong-file->wav filename "ewf"))
 295
 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))))
 326
 327 (defun lilysong-up-to-date-p (makefile)
 328   (equal (call-process "make" nil nil nil "-f" makefile "-q") 0))
 329
 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))
 381
 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))))))
 391
 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)))
 398
 399
 400 ;;; Playing files
 401
 402
 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))
 408
 409 (defun lilysong-call-play (files)
 410   (apply 'start-process "lilysong-el" nil LilyPond-play-command files))
 411
 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))))
 418
 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))))))
 435
 436 (when (and (featurep 'ecasound)
 437            (not (fboundp 'eci-cs-set-param)))
 438   (defeci cs-set-param ((parameter "sChainsetup option: " "%s"))))
 439
 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)))
 470
 471
 472 ;;; User commands
 473
 474
 475 (defun lilysong-arg->multi (arg)
 476   (cond
 477    ((not arg)
 478     nil)
 479    ((or
 480      (numberp arg)
 481      (equal arg '(4)))
 482     t)
 483    (t
 484     'all)))
 485
 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)))))
 492
 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))
 502
 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))
 511
 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")))
 518
 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)))))
 529
 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)
 534
 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])
 551
 552
 553 ;;; Announce
 554
 555 (provide 'lilypond-song)
 556
 557
 558 ;;; lilypond-song.el ends here