| 1 | ;;; ob-lilypond.el --- org-babel functions for lilypond evaluation |
| 2 | |
| 3 | ;; Copyright (C) 2010-2013 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Martyn Jago |
| 6 | ;; Keywords: babel language, literate programming |
| 7 | ;; Homepage: http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html |
| 8 | |
| 9 | ;; This file is part of GNU Emacs. |
| 10 | |
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 12 | ;; it under the terms of the GNU General Public License as published by |
| 13 | ;; the Free Software Foundation, either version 3 of the License, or |
| 14 | ;; (at your option) any later version. |
| 15 | |
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 19 | ;; GNU General Public License for more details. |
| 20 | |
| 21 | ;; You should have received a copy of the GNU General Public License |
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;; Installation, ob-lilypond documentation, and examples are available at |
| 27 | ;; http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html |
| 28 | ;; |
| 29 | ;; Lilypond documentation can be found at |
| 30 | ;; http://lilypond.org/manuals.html |
| 31 | |
| 32 | ;;; Code: |
| 33 | |
| 34 | (require 'ob) |
| 35 | (require 'ob-eval) |
| 36 | (require 'ob-tangle) |
| 37 | (require 'outline) |
| 38 | (defalias 'lilypond-mode 'LilyPond-mode) |
| 39 | |
| 40 | (add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly")) |
| 41 | |
| 42 | (defvar org-babel-default-header-args:lilypond '() |
| 43 | "Default header arguments for lilypond code blocks. |
| 44 | NOTE: The arguments are determined at lilypond compile time. |
| 45 | See (ly-set-header-args)") |
| 46 | |
| 47 | (defvar ly-compile-post-tangle t |
| 48 | "Following the org-babel-tangle (C-c C-v t) command, |
| 49 | ly-compile-post-tangle determines whether ob-lilypond should |
| 50 | automatically attempt to compile the resultant tangled file. |
| 51 | If the value is nil, no automated compilation takes place. |
| 52 | Default value is t") |
| 53 | |
| 54 | (defvar ly-display-pdf-post-tangle t |
| 55 | "Following a successful LilyPond compilation |
| 56 | ly-display-pdf-post-tangle determines whether to automate the |
| 57 | drawing / redrawing of the resultant pdf. If the value is nil, |
| 58 | the pdf is not automatically redrawn. Default value is t") |
| 59 | |
| 60 | (defvar ly-play-midi-post-tangle t |
| 61 | "Following a successful LilyPond compilation |
| 62 | ly-play-midi-post-tangle determines whether to automate the |
| 63 | playing of the resultant midi file. If the value is nil, |
| 64 | the midi file is not automatically played. Default value is t") |
| 65 | |
| 66 | (defvar ly-OSX-ly-path |
| 67 | "/Applications/lilypond.app/Contents/Resources/bin/lilypond") |
| 68 | (defvar ly-OSX-pdf-path "open") |
| 69 | (defvar ly-OSX-midi-path "open") |
| 70 | |
| 71 | (defvar ly-nix-ly-path "/usr/bin/lilypond") |
| 72 | (defvar ly-nix-pdf-path "evince") |
| 73 | (defvar ly-nix-midi-path "timidity") |
| 74 | |
| 75 | (defvar ly-w32-ly-path "lilypond") |
| 76 | (defvar ly-w32-pdf-path "") |
| 77 | (defvar ly-w32-midi-path "") |
| 78 | |
| 79 | (defvar ly-gen-png nil |
| 80 | "Image generation (png) can be turned on by default by setting |
| 81 | LY-GEN-PNG to t") |
| 82 | |
| 83 | (defvar ly-gen-svg nil |
| 84 | "Image generation (SVG) can be turned on by default by setting |
| 85 | LY-GEN-SVG to t") |
| 86 | |
| 87 | (defvar ly-gen-html nil |
| 88 | "HTML generation can be turned on by default by setting |
| 89 | LY-GEN-HTML to t") |
| 90 | |
| 91 | (defvar ly-gen-pdf nil |
| 92 | "PDF generation can be turned on by default by setting |
| 93 | LY-GEN-PDF to t") |
| 94 | |
| 95 | (defvar ly-use-eps nil |
| 96 | "You can force the compiler to use the EPS backend by setting |
| 97 | LY-USE-EPS to t") |
| 98 | |
| 99 | (defvar ly-arrange-mode nil |
| 100 | "Arrange mode is turned on by setting LY-ARRANGE-MODE |
| 101 | to t. In Arrange mode the following settings are altered |
| 102 | from default... |
| 103 | :tangle yes, :noweb yes |
| 104 | :results silent :comments yes. |
| 105 | In addition lilypond block execution causes tangling of all lilypond |
| 106 | blocks") |
| 107 | |
| 108 | (defun org-babel-expand-body:lilypond (body params) |
| 109 | "Expand BODY according to PARAMS, return the expanded body." |
| 110 | (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) |
| 111 | (mapc |
| 112 | (lambda (pair) |
| 113 | (let ((name (symbol-name (car pair))) |
| 114 | (value (cdr pair))) |
| 115 | (setq body |
| 116 | (replace-regexp-in-string |
| 117 | (concat "\$" (regexp-quote name)) |
| 118 | (if (stringp value) value (format "%S" value)) |
| 119 | body)))) |
| 120 | vars) |
| 121 | body)) |
| 122 | |
| 123 | (defun org-babel-execute:lilypond (body params) |
| 124 | "This function is called by `org-babel-execute-src-block'. |
| 125 | Depending on whether we are in arrange mode either: |
| 126 | 1. Attempt to execute lilypond block according to header settings |
| 127 | (This is the default basic mode) |
| 128 | 2. Tangle all lilypond blocks and process the result (arrange mode)" |
| 129 | (ly-set-header-args ly-arrange-mode) |
| 130 | (if ly-arrange-mode |
| 131 | (ly-tangle) |
| 132 | (ly-process-basic body params))) |
| 133 | |
| 134 | (defun ly-tangle () |
| 135 | "ob-lilypond specific tangle, attempts to invoke |
| 136 | =ly-execute-tangled-ly= if tangle is successful. Also passes |
| 137 | specific arguments to =org-babel-tangle=" |
| 138 | (interactive) |
| 139 | (if (org-babel-tangle nil "yes" "lilypond") |
| 140 | (ly-execute-tangled-ly) nil)) |
| 141 | |
| 142 | (defun ly-process-basic (body params) |
| 143 | "Execute a lilypond block in basic mode." |
| 144 | (let* ((result-params (cdr (assoc :result-params params))) |
| 145 | (out-file (cdr (assoc :file params))) |
| 146 | (cmdline (or (cdr (assoc :cmdline params)) |
| 147 | "")) |
| 148 | (in-file (org-babel-temp-file "lilypond-"))) |
| 149 | |
| 150 | (with-temp-file in-file |
| 151 | (insert (org-babel-expand-body:generic body params))) |
| 152 | (org-babel-eval |
| 153 | (concat |
| 154 | (ly-determine-ly-path) |
| 155 | " -dbackend=eps " |
| 156 | "-dno-gs-load-fonts " |
| 157 | "-dinclude-eps-fonts " |
| 158 | "--png " |
| 159 | "--output=" |
| 160 | (file-name-sans-extension out-file) |
| 161 | " " |
| 162 | cmdline |
| 163 | in-file) "")) nil) |
| 164 | |
| 165 | (defun org-babel-prep-session:lilypond (session params) |
| 166 | "Return an error because LilyPond exporter does not support sessions." |
| 167 | (error "Sorry, LilyPond does not currently support sessions!")) |
| 168 | |
| 169 | (defun ly-execute-tangled-ly () |
| 170 | "Compile result of block tangle with lilypond. |
| 171 | If error in compilation, attempt to mark the error in lilypond org file" |
| 172 | (when ly-compile-post-tangle |
| 173 | (let ((ly-tangled-file (ly-switch-extension |
| 174 | (buffer-file-name) ".lilypond")) |
| 175 | (ly-temp-file (ly-switch-extension |
| 176 | (buffer-file-name) ".ly"))) |
| 177 | (if (file-exists-p ly-tangled-file) |
| 178 | (progn |
| 179 | (when (file-exists-p ly-temp-file) |
| 180 | (delete-file ly-temp-file)) |
| 181 | (rename-file ly-tangled-file |
| 182 | ly-temp-file)) |
| 183 | (error "Error: Tangle Failed!") t) |
| 184 | (switch-to-buffer-other-window "*lilypond*") |
| 185 | (erase-buffer) |
| 186 | (ly-compile-lilyfile ly-temp-file) |
| 187 | (goto-char (point-min)) |
| 188 | (if (not (ly-check-for-compile-error ly-temp-file)) |
| 189 | (progn |
| 190 | (other-window -1) |
| 191 | (ly-attempt-to-open-pdf ly-temp-file) |
| 192 | (ly-attempt-to-play-midi ly-temp-file)) |
| 193 | (error "Error in Compilation!")))) nil) |
| 194 | |
| 195 | (defun ly-compile-lilyfile (file-name &optional test) |
| 196 | "Compile lilypond file and check for compile errors |
| 197 | FILE-NAME is full path to lilypond (.ly) file" |
| 198 | (message "Compiling LilyPond...") |
| 199 | (let ((arg-1 (ly-determine-ly-path)) ;program |
| 200 | (arg-2 nil) ;infile |
| 201 | (arg-3 "*lilypond*") ;buffer |
| 202 | (arg-4 t) ;display |
| 203 | (arg-4 t) ;display |
| 204 | (arg-5 (if ly-gen-png "--png" "")) ;&rest... |
| 205 | (arg-6 (if ly-gen-html "--html" "")) |
| 206 | (arg-7 (if ly-gen-pdf "--pdf" "")) |
| 207 | (arg-8 (if ly-use-eps "-dbackend=eps" "")) |
| 208 | (arg-9 (if ly-gen-svg "-dbackend=svg" "")) |
| 209 | (arg-10 (concat "--output=" (file-name-sans-extension file-name))) |
| 210 | (arg-11 file-name)) |
| 211 | (if test |
| 212 | `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 ,arg-6 |
| 213 | ,arg-7 ,arg-8 ,arg-9 ,arg-10 ,arg-11) |
| 214 | (call-process |
| 215 | arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 |
| 216 | arg-7 arg-8 arg-9 arg-10 arg-11)))) |
| 217 | |
| 218 | (defun ly-check-for-compile-error (file-name &optional test) |
| 219 | "Check for compile error. |
| 220 | This is performed by parsing the *lilypond* buffer |
| 221 | containing the output message from the compilation. |
| 222 | FILE-NAME is full path to lilypond file. |
| 223 | If TEST is t just return nil if no error found, and pass |
| 224 | nil as file-name since it is unused in this context" |
| 225 | (let ((is-error (search-forward "error:" nil t))) |
| 226 | (if (not test) |
| 227 | (if (not is-error) |
| 228 | nil |
| 229 | (ly-process-compile-error file-name)) |
| 230 | is-error))) |
| 231 | |
| 232 | (defun ly-process-compile-error (file-name) |
| 233 | "Process the compilation error that has occurred. |
| 234 | FILE-NAME is full path to lilypond file" |
| 235 | (let ((line-num (ly-parse-line-num))) |
| 236 | (let ((error-lines (ly-parse-error-line file-name line-num))) |
| 237 | (ly-mark-error-line file-name error-lines) |
| 238 | (error "Error: Compilation Failed!")))) |
| 239 | |
| 240 | (defun ly-mark-error-line (file-name line) |
| 241 | "Mark the erroneous lines in the lilypond org buffer. |
| 242 | FILE-NAME is full path to lilypond file. |
| 243 | LINE is the erroneous line" |
| 244 | (switch-to-buffer-other-window |
| 245 | (concat (file-name-nondirectory |
| 246 | (ly-switch-extension file-name ".org")))) |
| 247 | (let ((temp (point))) |
| 248 | (goto-char (point-min)) |
| 249 | (setq case-fold-search nil) |
| 250 | (if (search-forward line nil t) |
| 251 | (progn |
| 252 | (show-all) |
| 253 | (set-mark (point)) |
| 254 | (goto-char (- (point) (length line)))) |
| 255 | (goto-char temp)))) |
| 256 | |
| 257 | (defun ly-parse-line-num (&optional buffer) |
| 258 | "Extract error line number." |
| 259 | (when buffer |
| 260 | (set-buffer buffer)) |
| 261 | (let ((start |
| 262 | (and (search-backward ":" nil t) |
| 263 | (search-backward ":" nil t) |
| 264 | (search-backward ":" nil t) |
| 265 | (search-backward ":" nil t))) |
| 266 | (num nil)) |
| 267 | (if start |
| 268 | (progn |
| 269 | (forward-char) |
| 270 | (let ((num (buffer-substring |
| 271 | (+ 1 start) |
| 272 | (- (search-forward ":" nil t) 1)))) |
| 273 | (setq num (string-to-number num)) |
| 274 | (if (numberp num) |
| 275 | num |
| 276 | nil))) |
| 277 | nil))) |
| 278 | |
| 279 | (defun ly-parse-error-line (file-name lineNo) |
| 280 | "Extract the erroneous line from the tangled .ly file |
| 281 | FILE-NAME is full path to lilypond file. |
| 282 | LINENO is the number of the erroneous line" |
| 283 | (with-temp-buffer |
| 284 | (insert-file-contents (ly-switch-extension file-name ".ly") |
| 285 | nil nil nil t) |
| 286 | (if (> lineNo 0) |
| 287 | (progn |
| 288 | (goto-char (point-min)) |
| 289 | (forward-line (- lineNo 1)) |
| 290 | (buffer-substring (point) (point-at-eol))) |
| 291 | nil))) |
| 292 | |
| 293 | (defun ly-attempt-to-open-pdf (file-name &optional test) |
| 294 | "Attempt to display the generated pdf file |
| 295 | FILE-NAME is full path to lilypond file |
| 296 | If TEST is non-nil, the shell command is returned and is not run" |
| 297 | (when ly-display-pdf-post-tangle |
| 298 | (let ((pdf-file (ly-switch-extension file-name ".pdf"))) |
| 299 | (if (file-exists-p pdf-file) |
| 300 | (let ((cmd-string |
| 301 | (concat (ly-determine-pdf-path) " " pdf-file))) |
| 302 | (if test |
| 303 | cmd-string |
| 304 | (start-process |
| 305 | "\"Audition pdf\"" |
| 306 | "*lilypond*" |
| 307 | (ly-determine-pdf-path) |
| 308 | pdf-file))) |
| 309 | (message "No pdf file generated so can't display!"))))) |
| 310 | |
| 311 | (defun ly-attempt-to-play-midi (file-name &optional test) |
| 312 | "Attempt to play the generated MIDI file |
| 313 | FILE-NAME is full path to lilypond file |
| 314 | If TEST is non-nil, the shell command is returned and is not run" |
| 315 | (when ly-play-midi-post-tangle |
| 316 | (let ((midi-file (ly-switch-extension file-name ".midi"))) |
| 317 | (if (file-exists-p midi-file) |
| 318 | (let ((cmd-string |
| 319 | (concat (ly-determine-midi-path) " " midi-file))) |
| 320 | (if test |
| 321 | cmd-string |
| 322 | (start-process |
| 323 | "\"Audition midi\"" |
| 324 | "*lilypond*" |
| 325 | (ly-determine-midi-path) |
| 326 | midi-file))) |
| 327 | (message "No midi file generated so can't play!"))))) |
| 328 | |
| 329 | (defun ly-determine-ly-path (&optional test) |
| 330 | "Return correct path to ly binary depending on OS |
| 331 | If TEST is non-nil, it contains a simulation of the OS for test purposes" |
| 332 | (let ((sys-type |
| 333 | (or test system-type))) |
| 334 | (cond ((string= sys-type "darwin") |
| 335 | ly-OSX-ly-path) |
| 336 | ((string= sys-type "windows-nt") |
| 337 | ly-w32-ly-path) |
| 338 | (t ly-nix-ly-path)))) |
| 339 | |
| 340 | (defun ly-determine-pdf-path (&optional test) |
| 341 | "Return correct path to pdf viewer depending on OS |
| 342 | If TEST is non-nil, it contains a simulation of the OS for test purposes" |
| 343 | (let ((sys-type |
| 344 | (or test system-type))) |
| 345 | (cond ((string= sys-type "darwin") |
| 346 | ly-OSX-pdf-path) |
| 347 | ((string= sys-type "windows-nt") |
| 348 | ly-w32-pdf-path) |
| 349 | (t ly-nix-pdf-path)))) |
| 350 | |
| 351 | (defun ly-determine-midi-path (&optional test) |
| 352 | "Return correct path to midi player depending on OS |
| 353 | If TEST is non-nil, it contains a simulation of the OS for test purposes" |
| 354 | (let ((sys-type |
| 355 | (or test test system-type))) |
| 356 | (cond ((string= sys-type "darwin") |
| 357 | ly-OSX-midi-path) |
| 358 | ((string= sys-type "windows-nt") |
| 359 | ly-w32-midi-path) |
| 360 | (t ly-nix-midi-path)))) |
| 361 | |
| 362 | (defun ly-toggle-midi-play () |
| 363 | "Toggle whether midi will be played following a successful compilation." |
| 364 | (interactive) |
| 365 | (setq ly-play-midi-post-tangle |
| 366 | (not ly-play-midi-post-tangle)) |
| 367 | (message (concat "Post-Tangle MIDI play has been " |
| 368 | (if ly-play-midi-post-tangle |
| 369 | "ENABLED." "DISABLED.")))) |
| 370 | |
| 371 | (defun ly-toggle-pdf-display () |
| 372 | "Toggle whether pdf will be displayed following a successful compilation." |
| 373 | (interactive) |
| 374 | (setq ly-display-pdf-post-tangle |
| 375 | (not ly-display-pdf-post-tangle)) |
| 376 | (message (concat "Post-Tangle PDF display has been " |
| 377 | (if ly-display-pdf-post-tangle |
| 378 | "ENABLED." "DISABLED.")))) |
| 379 | |
| 380 | (defun ly-toggle-png-generation () |
| 381 | "Toggle whether png image will be generated by compilation." |
| 382 | (interactive) |
| 383 | (setq ly-gen-png (not ly-gen-png)) |
| 384 | (message (concat "PNG image generation has been " |
| 385 | (if ly-gen-png "ENABLED." "DISABLED.")))) |
| 386 | |
| 387 | (defun ly-toggle-html-generation () |
| 388 | "Toggle whether html will be generated by compilation." |
| 389 | (interactive) |
| 390 | (setq ly-gen-html (not ly-gen-html)) |
| 391 | (message (concat "HTML generation has been " |
| 392 | (if ly-gen-html "ENABLED." "DISABLED.")))) |
| 393 | |
| 394 | (defun ly-toggle-pdf-generation () |
| 395 | "Toggle whether pdf will be generated by compilation." |
| 396 | (interactive) |
| 397 | (setq ly-gen-pdf (not ly-gen-pdf)) |
| 398 | (message (concat "PDF generation has been " |
| 399 | (if ly-gen-pdf "ENABLED." "DISABLED.")))) |
| 400 | |
| 401 | (defun ly-toggle-arrange-mode () |
| 402 | "Toggle whether in Arrange mode or Basic mode." |
| 403 | (interactive) |
| 404 | (setq ly-arrange-mode |
| 405 | (not ly-arrange-mode)) |
| 406 | (message (concat "Arrange mode has been " |
| 407 | (if ly-arrange-mode "ENABLED." "DISABLED.")))) |
| 408 | |
| 409 | (defun ly-switch-extension (file-name ext) |
| 410 | "Utility command to swap current FILE-NAME extension with EXT" |
| 411 | (concat (file-name-sans-extension |
| 412 | file-name) ext)) |
| 413 | |
| 414 | (defun ly-get-header-args (mode) |
| 415 | "Default arguments to use when evaluating a lilypond |
| 416 | source block. These depend upon whether we are in arrange |
| 417 | mode i.e. ARRANGE-MODE is t" |
| 418 | (cond (mode |
| 419 | '((:tangle . "yes") |
| 420 | (:noweb . "yes") |
| 421 | (:results . "silent") |
| 422 | (:cache . "yes") |
| 423 | (:comments . "yes"))) |
| 424 | (t |
| 425 | '((:results . "file") |
| 426 | (:exports . "results"))))) |
| 427 | |
| 428 | (defun ly-set-header-args (mode) |
| 429 | "Set org-babel-default-header-args:lilypond |
| 430 | dependent on LY-ARRANGE-MODE" |
| 431 | (setq org-babel-default-header-args:lilypond |
| 432 | (ly-get-header-args mode))) |
| 433 | |
| 434 | (provide 'ob-lilypond) |
| 435 | |
| 436 | ;;; ob-lilypond.el ends here |