lilypond-song.el (20735B)
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 temp-file)) 378 379 (defun lilysong-after-compilation (buffer message) 380 (let ((data lilysong-compilation-data)) 381 (when (and data 382 (equal compile-command 383 (lilysong-compilation-data-command data))) 384 (unwind-protect 385 (when (lilysong-up-to-date-p (lilysong-compilation-data-makefile data)) 386 (lilysong-process-generated-files data)) 387 (delete-file (lilysong-compilation-data-makefile data)))))) 388 389 (defun lilysong-process-generated-files (data) 390 (with-current-buffer (lilysong-compilation-data-buffer data) 391 (setq lilysong-last-language lilysong-language)) 392 (lilysong-play-files (lilysong-compilation-data-in-parallel data) 393 (lilysong-compilation-data-songs data) 394 (lilysong-compilation-data-midi data))) 395 396 397 ;;; Playing files 398 399 400 (defun lilysong-play-files (in-parallel songs midi-files) 401 (funcall (if LilyPond-use-ecasound 402 'lilysong-play-with-ecasound 403 'lilysong-play-with-play) 404 in-parallel songs midi-files)) 405 406 (defun lilysong-call-play (files) 407 (apply 'start-process "lilysong-el" nil LilyPond-play-command files)) 408 409 (defun lilysong-play-with-play (in-parallel songs midi-files) 410 (let ((files (mapcar 'lilysong-file->wav (append songs midi-files)))) 411 (if in-parallel 412 (dolist (f files) 413 (lilysong-call-play (list f))) 414 (lilysong-call-play files)))) 415 416 (defun lilysong-make-ewf-files (files) 417 (let ((offset 0.0)) 418 (dolist (f files) 419 (let* ((wav-file (lilysong-file->wav f)) 420 (length (with-temp-buffer 421 (call-process "ecalength" nil t nil "-s" wav-file) 422 (goto-char (point-max)) 423 (forward-line -1) 424 (read (current-buffer))))) 425 (with-temp-file (lilysong-file->ewf f) 426 (insert "source = " wav-file "\n") 427 (insert (format "offset = %s\n" offset)) 428 (insert "start-position = 0.0\n") 429 (insert (format "length = %s\n" length)) 430 (insert "looping = false\n")) 431 (setq offset (+ offset length)))))) 432 433 (when (and (featurep 'ecasound) 434 (not (fboundp 'eci-cs-set-param))) 435 (defeci cs-set-param ((parameter "sChainsetup option: " "%s")))) 436 437 (defun lilysong-play-with-ecasound (in-parallel songs midi-files) 438 (ecasound) 439 (eci-cs-add "lilysong-el") 440 (eci-cs-select "lilysong-el") 441 (eci-cs-remove) 442 (eci-cs-add "lilysong-el") 443 (eci-cs-select "lilysong-el") 444 (eci-cs-set-param "-z:mixmode,sum") 445 (unless in-parallel 446 (lilysong-make-ewf-files songs) 447 ;; MIDI files should actually start with each of the songs 448 (mapc 'lilysong-make-ewf-files (mapcar 'list midi-files))) 449 (let* ((file->wav (if in-parallel 'lilysong-file->wav 'lilysong-file->ewf)) 450 (files (mapcar file->wav (append songs midi-files)))) 451 (dolist (f files) 452 (eci-c-add f) 453 (eci-c-select f) 454 (eci-ai-add f)) 455 (eci-c-select-all) 456 (eci-ao-add-default) 457 (let* ((n (length songs)) 458 (right (if (<= n 1) 50 0)) 459 (step (if (<= n 1) 0 (/ 100.0 (1- n))))) 460 (dolist (f songs) 461 (let ((chain (funcall file->wav f))) 462 (eci-c-select chain) 463 (eci-cop-add "-erc:1,2") 464 (eci-cop-add (format "-epp:%f" (min right 100))) 465 (incf right step)))) 466 (eci-start))) 467 468 469 ;;; User commands 470 471 472 (defun lilysong-arg->multi (arg) 473 (cond 474 ((not arg) 475 nil) 476 ((or 477 (numberp arg) 478 (equal arg '(4))) 479 t) 480 (t 481 'all))) 482 483 (defun lilysong-command (arg play-midi?) 484 (let* ((multi (lilysong-arg->multi arg)) 485 (song-list (lilysong-song-list multi)) 486 (midi-list (if play-midi? (lilysong-midi-list multi)))) 487 (message "Singing %s" (mapconcat 'identity song-list ", ")) 488 (lilysong-sing song-list midi-list (if play-midi? t (listp arg))))) 489 490 (defun LilyPond-command-sing (&optional arg) 491 "Sing lyrics of the current LilyPond buffer. 492 Without any prefix argument, sing current \\festival* command. 493 With the universal prefix argument, ask which parts to sing. 494 With a double universal prefix argument, sing all the parts. 495 With a numeric prefix argument, ask which parts to sing and sing them 496 sequentially rather than in parallel." 497 (interactive "P") 498 (lilysong-command arg nil)) 499 500 (defun LilyPond-command-sing-and-play (&optional arg) 501 "Sing lyrics and play midi of the current LilyPond buffer. 502 Without any prefix argument, sing and play current \\festival* and \\midi 503 commands. 504 With the universal prefix argument, ask which parts to sing and play. 505 With a double universal prefix argument, sing and play all the parts." 506 (interactive "P") 507 (lilysong-command arg t)) 508 509 (defun LilyPond-command-sing-last () 510 "Repeat last LilyPond singing command." 511 (interactive) 512 (if lilysong-last-command-args 513 (apply 'lilysong-sing lilysong-last-command-args) 514 (error "No previous singing command"))) 515 516 (defun LilyPond-command-clean () 517 "Remove generated *.xml and *.wav files used for singing." 518 (interactive) 519 (flet ((delete-file* (file) 520 (when (file-exists-p file) 521 (delete-file file)))) 522 (dolist (xml-file (lilysong-song-list 'all)) 523 (delete-file* xml-file) 524 (delete-file* (lilysong-file->wav xml-file))) 525 (mapc 'delete-file* (mapcar 'lilysong-file->wav (lilysong-midi-list 'all))))) 526 527 (define-key LilyPond-mode-map "\C-c\C-a" 'LilyPond-command-sing) 528 (define-key LilyPond-mode-map "\C-c\C-q" 'LilyPond-command-sing-and-play) 529 (define-key LilyPond-mode-map "\C-c\C-x" 'LilyPond-command-clean) 530 (define-key LilyPond-mode-map "\C-c\C-z" 'LilyPond-command-sing-last) 531 532 (easy-menu-add-item LilyPond-command-menu nil 533 ["Sing Current" LilyPond-command-sing t]) 534 (easy-menu-add-item LilyPond-command-menu nil 535 ["Sing Selected" (LilyPond-command-sing '(4)) t]) 536 (easy-menu-add-item LilyPond-command-menu nil 537 ["Sing All" (LilyPond-command-sing '(16)) t]) 538 (easy-menu-add-item LilyPond-command-menu nil 539 ["Sing Selected Sequentially" (LilyPond-command-sing 1) t]) 540 (easy-menu-add-item LilyPond-command-menu nil 541 ["Sing and Play Current" LilyPond-command-sing-and-play t]) 542 (easy-menu-add-item LilyPond-command-menu nil 543 ["Sing and Play Selected" (LilyPond-command-sing-and-play '(4)) t]) 544 (easy-menu-add-item LilyPond-command-menu nil 545 ["Sing and Play All" (LilyPond-command-sing-and-play '(16)) t]) 546 (easy-menu-add-item LilyPond-command-menu nil 547 ["Sing Last" LilyPond-command-sing-last t]) 548 549 550 ;;; Announce 551 552 (provide 'lilypond-song) 553 554 555 ;;; lilypond-song.el ends here