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