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   (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 "win32")
 337            ly-win32-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 "win32")
 348            ly-win32-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 "win32")
 359            ly-win32-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