lisp/ob-lilypond.el

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