elisp/lilypond-song.el

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