lisp/ob-lilypond.el

   1 ;;; ob-lilypond.el --- org-babel functions for lilypond evaluation
   2
   3 ;; Copyright (C) 2010-2012  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-win32-ly-path "lilypond")
  76 (defvar ly-win32-pdf-path "")
  77 (defvar ly-win32-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
 111   (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
 112     (mapc
 113      (lambda (pair)
 114        (let ((name (symbol-name (car pair)))
 115              (value (cdr pair)))
 116          (setq body
 117                (replace-regexp-in-string
 118                 (concat "\$" (regexp-quote name))
 119                 (if (stringp value) value (format "%S" value))
 120                 body))))
 121      vars)
 122     body))
 123
 124 (defun org-babel-execute:lilypond (body params)
 125   "This function is called by `org-babel-execute-src-block'.
 126 Depending on whether we are in arrange mode either:
 127 1. Attempt to execute lilypond block according to header settings
 128   (This is the default basic mode)
 129 2. Tangle all lilypond blocks and process the result (arrange mode)"
 130
 131   (ly-set-header-args ly-arrange-mode)
 132   (if ly-arrange-mode
 133       (ly-tangle)
 134     (ly-process-basic body params)))
 135
 136 (defun ly-tangle ()
 137   "ob-lilypond specific tangle, attempts to invoke
 138 =ly-execute-tangled-ly= if tangle is successful. Also passes
 139 specific arguments to =org-babel-tangle="
 140
 141   (interactive)
 142   (if (org-babel-tangle nil "yes" "lilypond")
 143       (ly-execute-tangled-ly) nil))
 144
 145 (defun ly-process-basic (body params)
 146   "Execute a lilypond block in basic mode"
 147
 148   (let* ((result-params (cdr (assoc :result-params params)))
 149          (out-file (cdr (assoc :file params)))
 150          (cmdline (or (cdr (assoc :cmdline params))
 151                       ""))
 152          (in-file (org-babel-temp-file "lilypond-")))
 153
 154     (with-temp-file in-file
 155       (insert (org-babel-expand-body:generic body params)))
 156
 157     (org-babel-eval
 158      (concat
 159       (ly-determine-ly-path)
 160       " -dbackend=eps "
 161       "-dno-gs-load-fonts "
 162       "-dinclude-eps-fonts "
 163       "--png "
 164       "--output="
 165       (file-name-sans-extension out-file)
 166       " "
 167       cmdline
 168       in-file) "")
 169     ) nil)
 170
 171 (defun org-babel-prep-session:lilypond (session params)
 172   "Return an error because LilyPond exporter does not support sessions."
 173
 174   (error "Sorry, LilyPond does not currently support sessions!"))
 175
 176 (defun ly-execute-tangled-ly ()
 177   "Compile result of block tangle with lilypond.
 178 If error in compilation, attempt to mark the error in lilypond org file"
 179
 180   (when ly-compile-post-tangle
 181     (let ((ly-tangled-file (ly-switch-extension
 182                             (buffer-file-name) ".lilypond"))
 183           (ly-temp-file (ly-switch-extension
 184                          (buffer-file-name) ".ly")))
 185       (if (file-exists-p ly-tangled-file)
 186           (progn
 187             (when (file-exists-p ly-temp-file)
 188               (delete-file ly-temp-file))
 189             (rename-file ly-tangled-file
 190                          ly-temp-file))
 191         (error "Error: Tangle Failed!") t)
 192       (switch-to-buffer-other-window "*lilypond*")
 193       (erase-buffer)
 194       (ly-compile-lilyfile ly-temp-file)
 195       (goto-char (point-min))
 196       (if (not (ly-check-for-compile-error ly-temp-file))
 197           (progn
 198             (other-window -1)
 199             (ly-attempt-to-open-pdf ly-temp-file)
 200             (ly-attempt-to-play-midi ly-temp-file))
 201         (error "Error in Compilation!")))) nil)
 202
 203 (defun ly-compile-lilyfile (file-name &optional test)
 204   "Compile lilypond file and check for compile errors
 205 FILE-NAME is full path to lilypond (.ly) file"
 206
 207   (message "Compiling LilyPond...")
 208   (let ((arg-1 (ly-determine-ly-path)) ;program
 209         (arg-2 nil)                    ;infile
 210         (arg-3 "*lilypond*")           ;buffer
 211         (arg-4 t)                      ;display
 212         (arg-4 t)                      ;display
 213         (arg-5 (if ly-gen-png  "--png"  "")) ;&rest...
 214         (arg-6 (if ly-gen-html "--html" ""))
 215         (arg-7 (if ly-gen-pdf "--pdf" ""))
 216         (arg-8 (if ly-use-eps  "-dbackend=eps" ""))
 217         (arg-9 (if ly-gen-svg  "-dbackend=svg" ""))
 218         (arg-10 (concat "--output=" (file-name-sans-extension file-name)))
 219         (arg-11 file-name))
 220     (if test
 221         `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 ,arg-6
 222                  ,arg-7 ,arg-8 ,arg-9 ,arg-10 ,arg-11)
 223       (call-process
 224        arg-1 arg-2 arg-3 arg-4 arg-5 arg-6
 225        arg-7 arg-8 arg-9 arg-10 arg-11))))
 226
 227 (defun ly-check-for-compile-error (file-name &optional test)
 228   "Check for compile error.
 229 This is performed by parsing the *lilypond* buffer
 230 containing the output message from the compilation.
 231 FILE-NAME is full path to lilypond file.
 232 If TEST is t just return nil if no error found, and pass
 233 nil as file-name since it is unused in this context"
 234   (let ((is-error (search-forward "error:" nil t)))
 235     (if (not test)
 236         (if (not is-error)
 237             nil
 238           (ly-process-compile-error file-name))
 239       is-error)))
 240
 241 (defun ly-process-compile-error (file-name)
 242   "Process the compilation error that has occurred.
 243 FILE-NAME is full path to lilypond file"
 244
 245   (let ((line-num (ly-parse-line-num)))
 246     (let ((error-lines (ly-parse-error-line file-name line-num)))
 247       (ly-mark-error-line file-name error-lines)
 248       (error "Error: Compilation Failed!"))))
 249
 250 (defun ly-mark-error-line (file-name line)
 251   "Mark the erroneous lines in the lilypond org buffer.
 252 FILE-NAME is full path to lilypond file.
 253 LINE is the erroneous line"
 254
 255   (switch-to-buffer-other-window
 256    (concat (file-name-nondirectory
 257             (ly-switch-extension file-name ".org"))))
 258   (let ((temp (point)))
 259     (goto-char (point-min))
 260     (setq case-fold-search nil)
 261     (if (search-forward line nil t)
 262         (progn
 263           (show-all)
 264           (set-mark (point))
 265           (goto-char (- (point) (length line))))
 266       (goto-char temp))))
 267
 268 (defun ly-parse-line-num (&optional buffer)
 269   "Extract error line number."
 270
 271   (when buffer
 272     (set-buffer buffer))
 273   (let ((start
 274          (and (search-backward ":" nil t)
 275               (search-backward ":" nil t)
 276               (search-backward ":" nil t)
 277               (search-backward ":" nil t)))
 278         (num nil))
 279     (if start
 280         (progn
 281           (forward-char)
 282           (let ((num (buffer-substring
 283                       (+ 1 start)
 284                       (- (search-forward ":" nil t) 1))))
 285             (setq num (string-to-number num))
 286             (if (numberp num)
 287                 num
 288               nil)))
 289       nil)))
 290
 291 (defun ly-parse-error-line (file-name lineNo)
 292   "Extract the erroneous line from the tangled .ly file
 293 FILE-NAME is full path to lilypond file.
 294 LINENO is the number of the erroneous line"
 295
 296   (with-temp-buffer
 297     (insert-file-contents (ly-switch-extension file-name ".ly")
 298                           nil nil nil t)
 299     (if (> lineNo 0)
 300         (progn
 301           (goto-char (point-min))
 302           (forward-line (- lineNo 1))
 303           (buffer-substring (point) (point-at-eol)))
 304       nil)))
 305
 306 (defun ly-attempt-to-open-pdf (file-name &optional test)
 307   "Attempt to display the generated pdf file
 308 FILE-NAME is full path to lilypond file
 309 If TEST is non-nil, the shell command is returned and is not run"
 310
 311   (when ly-display-pdf-post-tangle
 312     (let ((pdf-file (ly-switch-extension file-name ".pdf")))
 313       (if (file-exists-p pdf-file)
 314           (let ((cmd-string
 315                  (concat (ly-determine-pdf-path) " " pdf-file)))
 316             (if test
 317                 cmd-string
 318               (start-process
 319                "\"Audition pdf\""
 320                "*lilypond*"
 321                (ly-determine-pdf-path)
 322                pdf-file)))
 323         (message  "No pdf file generated so can't display!")))))
 324
 325 (defun ly-attempt-to-play-midi (file-name &optional test)
 326   "Attempt to play the generated MIDI file
 327 FILE-NAME is full path to lilypond file
 328 If TEST is non-nil, the shell command is returned and is not run"
 329
 330   (when ly-play-midi-post-tangle
 331     (let ((midi-file (ly-switch-extension file-name ".midi")))
 332       (if (file-exists-p midi-file)
 333           (let ((cmd-string
 334                  (concat (ly-determine-midi-path) " " midi-file)))
 335             (if test
 336                 cmd-string
 337               (start-process
 338                "\"Audition midi\""
 339                "*lilypond*"
 340                (ly-determine-midi-path)
 341                midi-file)))
 342         (message "No midi file generated so can't play!")))))
 343
 344 (defun ly-determine-ly-path (&optional test)
 345   "Return correct path to ly binary depending on OS
 346 If TEST is non-nil, it contains a simulation of the OS for test purposes"
 347
 348   (let ((sys-type
 349          (or test system-type)))
 350     (cond ((string= sys-type  "darwin")
 351            ly-OSX-ly-path)
 352           ((string= sys-type "win32")
 353            ly-win32-ly-path)
 354           (t ly-nix-ly-path))))
 355
 356 (defun ly-determine-pdf-path (&optional test)
 357   "Return correct path to pdf viewer depending on OS
 358 If TEST is non-nil, it contains a simulation of the OS for test purposes"
 359
 360   (let ((sys-type
 361          (or test system-type)))
 362     (cond ((string= sys-type  "darwin")
 363            ly-OSX-pdf-path)
 364           ((string= sys-type "win32")
 365            ly-win32-pdf-path)
 366           (t ly-nix-pdf-path))))
 367
 368 (defun ly-determine-midi-path (&optional test)
 369   "Return correct path to midi player depending on OS
 370 If TEST is non-nil, it contains a simulation of the OS for test purposes"
 371
 372   (let ((sys-type
 373          (or test test system-type)))
 374     (cond ((string= sys-type  "darwin")
 375            ly-OSX-midi-path)
 376           ((string= sys-type "win32")
 377            ly-win32-midi-path)
 378           (t ly-nix-midi-path))))
 379
 380 (defun ly-toggle-midi-play ()
 381   "Toggle whether midi will be played following a successful compilation"
 382
 383   (interactive)
 384   (setq ly-play-midi-post-tangle
 385         (not ly-play-midi-post-tangle))
 386   (message (concat "Post-Tangle MIDI play has been "
 387                    (if ly-play-midi-post-tangle
 388                        "ENABLED." "DISABLED."))))
 389
 390 (defun ly-toggle-pdf-display ()
 391   "Toggle whether pdf will be displayed following a successful compilation"
 392
 393   (interactive)
 394   (setq ly-display-pdf-post-tangle
 395         (not ly-display-pdf-post-tangle))
 396   (message (concat "Post-Tangle PDF display has been "
 397                    (if ly-display-pdf-post-tangle
 398                        "ENABLED." "DISABLED."))))
 399
 400 (defun ly-toggle-png-generation ()
 401   "Toggle whether png image will be generated by compilation"
 402
 403   (interactive)
 404   (setq ly-gen-png
 405         (not ly-gen-png))
 406   (message (concat "PNG image generation has been "
 407                    (if ly-gen-png "ENABLED." "DISABLED."))))
 408
 409 (defun ly-toggle-html-generation ()
 410   "Toggle whether html will be generated by compilation"
 411
 412   (interactive)
 413   (setq ly-gen-html
 414         (not ly-gen-html))
 415   (message (concat "HTML generation has been "
 416                    (if ly-gen-html "ENABLED." "DISABLED."))))
 417
 418 (defun ly-toggle-pdf-generation ()
 419   "Toggle whether pdf will be generated by compilation"
 420
 421   (interactive)
 422   (setq ly-gen-pdf
 423         (not ly-gen-pdf))
 424   (message (concat "PDF generation has been "
 425                    (if ly-gen-pdf "ENABLED." "DISABLED."))))
 426
 427 (defun ly-toggle-arrange-mode ()
 428   "Toggle whether in Arrange mode or Basic mode"
 429
 430   (interactive)
 431   (setq ly-arrange-mode
 432         (not ly-arrange-mode))
 433   (message (concat "Arrange mode has been "
 434                    (if ly-arrange-mode "ENABLED." "DISABLED."))))
 435
 436 (defun ly-switch-extension (file-name ext)
 437   "Utility command to swap current FILE-NAME extension with EXT"
 438
 439   (concat (file-name-sans-extension
 440            file-name) ext))
 441
 442 (defun ly-get-header-args (mode)
 443   "Default arguments to use when evaluating a lilypond
 444 source block. These depend upon whether we are in arrange
 445 mode i.e. ARRANGE-MODE is t"
 446   (cond (mode
 447          '((:tangle . "yes")
 448            (:noweb . "yes")
 449            (:results . "silent")
 450            (:cache . "yes")
 451            (:comments . "yes")))
 452         (t
 453          '((:results . "file")
 454            (:exports . "results")))))
 455
 456 (defun ly-set-header-args (mode)
 457   "Set org-babel-default-header-args:lilypond
 458 dependent on LY-ARRANGE-MODE"
 459   (setq org-babel-default-header-args:lilypond
 460         (ly-get-header-args mode)))
 461
 462 (provide 'ob-lilypond)
 463
 464 ;;; ob-lilypond.el ends here