lisp/org/ob-lilypond.el

   1 ;;; ob-lilypond.el --- org-babel functions for lilypond evaluation
   2
   3 ;; Copyright (C) 2010-2015 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 (org-babel-lilypond-set-header-args)")
  43
  44 (defvar org-babel-lilypond-compile-post-tangle t
  45   "Following the org-babel-tangle (C-c C-v t) command,
  46 org-babel-lilypond-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 org-babel-lilypond-display-pdf-post-tangle t
  52   "Following a successful LilyPond compilation
  53 org-babel-lilypond-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 org-babel-lilypond-play-midi-post-tangle t
  58   "Following a successful LilyPond compilation
  59 org-babel-lilypond-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 org-babel-lilypond-OSX-ly-path
  64   "/Applications/lilypond.app/Contents/Resources/bin/lilypond")
  65 (defvar org-babel-lilypond-OSX-pdf-path "open")
  66 (defvar org-babel-lilypond-OSX-midi-path "open")
  67
  68 (defvar org-babel-lilypond-nix-ly-path "/usr/bin/lilypond")
  69 (defvar org-babel-lilypond-nix-pdf-path "evince")
  70 (defvar org-babel-lilypond-nix-midi-path "timidity")
  71
  72 (defvar org-babel-lilypond-w32-ly-path "lilypond")
  73 (defvar org-babel-lilypond-w32-pdf-path "")
  74 (defvar org-babel-lilypond-w32-midi-path "")
  75
  76 (defvar org-babel-lilypond-gen-png nil
  77   "Image generation (png) can be turned on by default by setting
  78 ORG-BABEL-LILYPOND-GEN-PNG to t")
  79
  80 (defvar org-babel-lilypond-gen-svg nil
  81   "Image generation (SVG) can be turned on by default by setting
  82 ORG-BABEL-LILYPOND-GEN-SVG to t")
  83
  84 (defvar org-babel-lilypond-gen-html nil
  85   "HTML generation can be turned on by default by setting
  86 ORG-BABEL-LILYPOND-GEN-HTML to t")
  87
  88 (defvar org-babel-lilypond-gen-pdf nil
  89   "PDF generation can be turned on by default by setting
  90 ORG-BABEL-LILYPOND-GEN-PDF to t")
  91
  92 (defvar org-babel-lilypond-use-eps nil
  93   "You can force the compiler to use the EPS backend by setting
  94 ORG-BABEL-LILYPOND-USE-EPS to t")
  95
  96 (defvar org-babel-lilypond-arrange-mode nil
  97   "Arrange mode is turned on by setting ORG-BABEL-LILYPOND-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   (org-babel-lilypond-set-header-args org-babel-lilypond-arrange-mode)
 127   (if org-babel-lilypond-arrange-mode
 128       (org-babel-lilypond-tangle)
 129     (org-babel-lilypond-process-basic body params)))
 130
 131 (defun org-babel-lilypond-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       (org-babel-lilypond-execute-tangled-ly) nil))
 138
 139 (defun org-babel-lilypond-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       (org-babel-lilypond-determine-ly-path)
 152       " -dbackend=eps "
 153       "-dno-gs-load-fonts "
 154       "-dinclude-eps-fonts "
 155       (or (cdr (assoc (file-name-extension out-file)
 156                       '(("pdf" . "--pdf ")
 157                         ("ps" . "--ps ")
 158                         ("png" . "--png "))))
 159           "--png ")
 160       "--output="
 161       (file-name-sans-extension out-file)
 162       " "
 163       cmdline
 164       in-file) "")) nil)
 165
 166 (defun org-babel-prep-session:lilypond (session params)
 167   "Return an error because LilyPond exporter does not support sessions."
 168   (error "Sorry, LilyPond does not currently support sessions!"))
 169
 170 (defun org-babel-lilypond-execute-tangled-ly ()
 171   "Compile result of block tangle with lilypond.
 172 If error in compilation, attempt to mark the error in lilypond org file"
 173   (when org-babel-lilypond-compile-post-tangle
 174     (let ((org-babel-lilypond-tangled-file (org-babel-lilypond-switch-extension
 175                             (buffer-file-name) ".lilypond"))
 176           (org-babel-lilypond-temp-file (org-babel-lilypond-switch-extension
 177                          (buffer-file-name) ".ly")))
 178       (if (file-exists-p org-babel-lilypond-tangled-file)
 179           (progn
 180             (when (file-exists-p org-babel-lilypond-temp-file)
 181               (delete-file org-babel-lilypond-temp-file))
 182             (rename-file org-babel-lilypond-tangled-file
 183                          org-babel-lilypond-temp-file))
 184         (error "Error: Tangle Failed!") t)
 185       (switch-to-buffer-other-window "*lilypond*")
 186       (erase-buffer)
 187       (org-babel-lilypond-compile-lilyfile org-babel-lilypond-temp-file)
 188       (goto-char (point-min))
 189       (if (not (org-babel-lilypond-check-for-compile-error org-babel-lilypond-temp-file))
 190           (progn
 191             (other-window -1)
 192             (org-babel-lilypond-attempt-to-open-pdf org-babel-lilypond-temp-file)
 193             (org-babel-lilypond-attempt-to-play-midi org-babel-lilypond-temp-file))
 194         (error "Error in Compilation!")))) nil)
 195
 196 (defun org-babel-lilypond-compile-lilyfile (file-name &optional test)
 197   "Compile lilypond file and check for compile errors
 198 FILE-NAME is full path to lilypond (.ly) file"
 199   (message "Compiling LilyPond...")
 200   (let ((arg-1 (org-babel-lilypond-determine-ly-path)) ;program
 201         (arg-2 nil)                    ;infile
 202         (arg-3 "*lilypond*")           ;buffer
 203         (arg-4 t)                      ;display
 204         (arg-5 (if org-babel-lilypond-gen-png  "--png"  "")) ;&rest...
 205         (arg-6 (if org-babel-lilypond-gen-html "--html" ""))
 206         (arg-7 (if org-babel-lilypond-gen-pdf "--pdf" ""))
 207         (arg-8 (if org-babel-lilypond-use-eps  "-dbackend=eps" ""))
 208         (arg-9 (if org-babel-lilypond-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 org-babel-lilypond-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           (org-babel-lilypond-process-compile-error file-name))
 230       is-error)))
 231
 232 (defun org-babel-lilypond-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 (org-babel-lilypond-parse-line-num)))
 236     (let ((error-lines (org-babel-lilypond-parse-error-line file-name line-num)))
 237       (org-babel-lilypond-mark-error-line file-name error-lines)
 238       (error "Error: Compilation Failed!"))))
 239
 240 (defun org-babel-lilypond-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             (org-babel-lilypond-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 org-babel-lilypond-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 org-babel-lilypond-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 (org-babel-lilypond-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 org-babel-lilypond-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 org-babel-lilypond-display-pdf-post-tangle
 298     (let ((pdf-file (org-babel-lilypond-switch-extension file-name ".pdf")))
 299       (if (file-exists-p pdf-file)
 300           (let ((cmd-string
 301                  (concat (org-babel-lilypond-determine-pdf-path) " " pdf-file)))
 302             (if test
 303                 cmd-string
 304               (start-process
 305                "\"Audition pdf\""
 306                "*lilypond*"
 307                (org-babel-lilypond-determine-pdf-path)
 308                pdf-file)))
 309         (message  "No pdf file generated so can't display!")))))
 310
 311 (defun org-babel-lilypond-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 org-babel-lilypond-play-midi-post-tangle
 316     (let ((midi-file (org-babel-lilypond-switch-extension file-name ".midi")))
 317       (if (file-exists-p midi-file)
 318           (let ((cmd-string
 319                  (concat (org-babel-lilypond-determine-midi-path) " " midi-file)))
 320             (if test
 321                 cmd-string
 322               (start-process
 323                "\"Audition midi\""
 324                "*lilypond*"
 325                (org-babel-lilypond-determine-midi-path)
 326                midi-file)))
 327         (message "No midi file generated so can't play!")))))
 328
 329 (defun org-babel-lilypond-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            org-babel-lilypond-OSX-ly-path)
 336           ((string= sys-type "windows-nt")
 337            org-babel-lilypond-w32-ly-path)
 338           (t org-babel-lilypond-nix-ly-path))))
 339
 340 (defun org-babel-lilypond-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            org-babel-lilypond-OSX-pdf-path)
 347           ((string= sys-type "windows-nt")
 348            org-babel-lilypond-w32-pdf-path)
 349           (t org-babel-lilypond-nix-pdf-path))))
 350
 351 (defun org-babel-lilypond-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            org-babel-lilypond-OSX-midi-path)
 358           ((string= sys-type "windows-nt")
 359            org-babel-lilypond-w32-midi-path)
 360           (t org-babel-lilypond-nix-midi-path))))
 361
 362 (defun org-babel-lilypond-toggle-midi-play ()
 363   "Toggle whether midi will be played following a successful compilation."
 364   (interactive)
 365   (setq org-babel-lilypond-play-midi-post-tangle
 366         (not org-babel-lilypond-play-midi-post-tangle))
 367   (message (concat "Post-Tangle MIDI play has been "
 368                    (if org-babel-lilypond-play-midi-post-tangle
 369                        "ENABLED." "DISABLED."))))
 370
 371 (defun org-babel-lilypond-toggle-pdf-display ()
 372   "Toggle whether pdf will be displayed following a successful compilation."
 373   (interactive)
 374   (setq org-babel-lilypond-display-pdf-post-tangle
 375         (not org-babel-lilypond-display-pdf-post-tangle))
 376   (message (concat "Post-Tangle PDF display has been "
 377                    (if org-babel-lilypond-display-pdf-post-tangle
 378                        "ENABLED." "DISABLED."))))
 379
 380 (defun org-babel-lilypond-toggle-png-generation ()
 381   "Toggle whether png image will be generated by compilation."
 382   (interactive)
 383   (setq org-babel-lilypond-gen-png (not org-babel-lilypond-gen-png))
 384   (message (concat "PNG image generation has been "
 385                    (if org-babel-lilypond-gen-png "ENABLED." "DISABLED."))))
 386
 387 (defun org-babel-lilypond-toggle-html-generation ()
 388   "Toggle whether html will be generated by compilation."
 389   (interactive)
 390   (setq org-babel-lilypond-gen-html (not org-babel-lilypond-gen-html))
 391   (message (concat "HTML generation has been "
 392                    (if org-babel-lilypond-gen-html "ENABLED." "DISABLED."))))
 393
 394 (defun org-babel-lilypond-toggle-pdf-generation ()
 395   "Toggle whether pdf will be generated by compilation."
 396   (interactive)
 397   (setq org-babel-lilypond-gen-pdf (not org-babel-lilypond-gen-pdf))
 398   (message (concat "PDF generation has been "
 399                    (if org-babel-lilypond-gen-pdf "ENABLED." "DISABLED."))))
 400
 401 (defun org-babel-lilypond-toggle-arrange-mode ()
 402   "Toggle whether in Arrange mode or Basic mode."
 403   (interactive)
 404   (setq org-babel-lilypond-arrange-mode
 405         (not org-babel-lilypond-arrange-mode))
 406   (message (concat "Arrange mode has been "
 407                    (if org-babel-lilypond-arrange-mode "ENABLED." "DISABLED."))))
 408
 409 (defun org-babel-lilypond-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 org-babel-lilypond-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 org-babel-lilypond-set-header-args (mode)
 429   "Set org-babel-default-header-args:lilypond
 430 dependent on ORG-BABEL-LILYPOND-ARRANGE-MODE"
 431   (setq org-babel-default-header-args:lilypond
 432         (org-babel-lilypond-get-header-args mode)))
 433
 434 (provide 'ob-lilypond)
 435
 436 ;;; ob-lilypond.el ends here