lilypond-mode

Emacs mode for editing LilyPond source
git clone https://git.jamzattack.xyz/lilypond-mode
Log | Files | Refs

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