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       (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 ly-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 ly-compile-post-tangle
 174     (let ((ly-tangled-file (ly-switch-extension
 175                             (buffer-file-name) ".lilypond"))
 176           (ly-temp-file (ly-switch-extension
 177                          (buffer-file-name) ".ly")))
 178       (if (file-exists-p ly-tangled-file)
 179           (progn
 180             (when (file-exists-p ly-temp-file)
 181               (delete-file ly-temp-file))
 182             (rename-file ly-tangled-file
 183                          ly-temp-file))
 184         (error "Error: Tangle Failed!") t)
 185       (switch-to-buffer-other-window "*lilypond*")
 186       (erase-buffer)
 187       (ly-compile-lilyfile ly-temp-file)
 188       (goto-char (point-min))
 189       (if (not (ly-check-for-compile-error ly-temp-file))
 190           (progn
 191             (other-window -1)
 192             (ly-attempt-to-open-pdf ly-temp-file)
 193             (ly-attempt-to-play-midi ly-temp-file))
 194         (error "Error in Compilation!")))) nil)
 195
 196 (defun ly-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 (ly-determine-ly-path)) ;program
 201         (arg-2 nil)                    ;infile
 202         (arg-3 "*lilypond*")           ;buffer
 203         (arg-4 t)                      ;display
 204         (arg-4 t)                      ;display
 205         (arg-5 (if ly-gen-png  "--png"  "")) ;&rest...
 206         (arg-6 (if ly-gen-html "--html" ""))
 207         (arg-7 (if ly-gen-pdf "--pdf" ""))
 208         (arg-8 (if ly-use-eps  "-dbackend=eps" ""))
 209         (arg-9 (if ly-gen-svg  "-dbackend=svg" ""))
 210         (arg-10 (concat "--output=" (file-name-sans-extension file-name)))
 211         (arg-11 file-name))
 212     (if test
 213         `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 ,arg-6
 214                  ,arg-7 ,arg-8 ,arg-9 ,arg-10 ,arg-11)
 215       (call-process
 216        arg-1 arg-2 arg-3 arg-4 arg-5 arg-6
 217        arg-7 arg-8 arg-9 arg-10 arg-11))))
 218
 219 (defun ly-check-for-compile-error (file-name &optional test)
 220   "Check for compile error.
 221 This is performed by parsing the *lilypond* buffer
 222 containing the output message from the compilation.
 223 FILE-NAME is full path to lilypond file.
 224 If TEST is t just return nil if no error found, and pass
 225 nil as file-name since it is unused in this context"
 226   (let ((is-error (search-forward "error:" nil t)))
 227     (if (not test)
 228         (if (not is-error)
 229             nil
 230           (ly-process-compile-error file-name))
 231       is-error)))
 232
 233 (defun ly-process-compile-error (file-name)
 234   "Process the compilation error that has occurred.
 235 FILE-NAME is full path to lilypond file"
 236   (let ((line-num (ly-parse-line-num)))
 237     (let ((error-lines (ly-parse-error-line file-name line-num)))
 238       (ly-mark-error-line file-name error-lines)
 239       (error "Error: Compilation Failed!"))))
 240
 241 (defun ly-mark-error-line (file-name line)
 242   "Mark the erroneous lines in the lilypond org buffer.
 243 FILE-NAME is full path to lilypond file.
 244 LINE is the erroneous line"
 245   (switch-to-buffer-other-window
 246    (concat (file-name-nondirectory
 247             (ly-switch-extension file-name ".org"))))
 248   (let ((temp (point)))
 249     (goto-char (point-min))
 250     (setq case-fold-search nil)
 251     (if (search-forward line nil t)
 252         (progn
 253           (show-all)
 254           (set-mark (point))
 255           (goto-char (- (point) (length line))))
 256       (goto-char temp))))
 257
 258 (defun ly-parse-line-num (&optional buffer)
 259   "Extract error line number."
 260   (when buffer
 261     (set-buffer buffer))
 262   (let ((start
 263          (and (search-backward ":" nil t)
 264               (search-backward ":" nil t)
 265               (search-backward ":" nil t)
 266               (search-backward ":" nil t)))
 267         (num nil))
 268     (if start
 269         (progn
 270           (forward-char)
 271           (let ((num (buffer-substring
 272                       (+ 1 start)
 273                       (- (search-forward ":" nil t) 1))))
 274             (setq num (string-to-number num))
 275             (if (numberp num)
 276                 num
 277               nil)))
 278       nil)))
 279
 280 (defun ly-parse-error-line (file-name lineNo)
 281   "Extract the erroneous line from the tangled .ly file
 282 FILE-NAME is full path to lilypond file.
 283 LINENO is the number of the erroneous line"
 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   (when ly-display-pdf-post-tangle
 299     (let ((pdf-file (ly-switch-extension file-name ".pdf")))
 300       (if (file-exists-p pdf-file)
 301           (let ((cmd-string
 302                  (concat (ly-determine-pdf-path) " " pdf-file)))
 303             (if test
 304                 cmd-string
 305               (start-process
 306                "\"Audition pdf\""
 307                "*lilypond*"
 308                (ly-determine-pdf-path)
 309                pdf-file)))
 310         (message  "No pdf file generated so can't display!")))))
 311
 312 (defun ly-attempt-to-play-midi (file-name &optional test)
 313   "Attempt to play the generated MIDI file
 314 FILE-NAME is full path to lilypond file
 315 If TEST is non-nil, the shell command is returned and is not run"
 316   (when ly-play-midi-post-tangle
 317     (let ((midi-file (ly-switch-extension file-name ".midi")))
 318       (if (file-exists-p midi-file)
 319           (let ((cmd-string
 320                  (concat (ly-determine-midi-path) " " midi-file)))
 321             (if test
 322                 cmd-string
 323               (start-process
 324                "\"Audition midi\""
 325                "*lilypond*"
 326                (ly-determine-midi-path)
 327                midi-file)))
 328         (message "No midi file generated so can't play!")))))
 329
 330 (defun ly-determine-ly-path (&optional test)
 331   "Return correct path to ly binary depending on OS
 332 If TEST is non-nil, it contains a simulation of the OS for test purposes"
 333   (let ((sys-type
 334          (or test system-type)))
 335     (cond ((string= sys-type  "darwin")
 336            ly-OSX-ly-path)
 337           ((string= sys-type "windows-nt")
 338            ly-w32-ly-path)
 339           (t ly-nix-ly-path))))
 340
 341 (defun ly-determine-pdf-path (&optional test)
 342   "Return correct path to pdf viewer depending on OS
 343 If TEST is non-nil, it contains a simulation of the OS for test purposes"
 344   (let ((sys-type
 345          (or test system-type)))
 346     (cond ((string= sys-type  "darwin")
 347            ly-OSX-pdf-path)
 348           ((string= sys-type "windows-nt")
 349            ly-w32-pdf-path)
 350           (t ly-nix-pdf-path))))
 351
 352 (defun ly-determine-midi-path (&optional test)
 353   "Return correct path to midi player depending on OS
 354 If TEST is non-nil, it contains a simulation of the OS for test purposes"
 355   (let ((sys-type
 356          (or test test system-type)))
 357     (cond ((string= sys-type  "darwin")
 358            ly-OSX-midi-path)
 359           ((string= sys-type "windows-nt")
 360            ly-w32-midi-path)
 361           (t ly-nix-midi-path))))
 362
 363 (defun ly-toggle-midi-play ()
 364   "Toggle whether midi will be played following a successful compilation."
 365   (interactive)
 366   (setq ly-play-midi-post-tangle
 367         (not ly-play-midi-post-tangle))
 368   (message (concat "Post-Tangle MIDI play has been "
 369                    (if ly-play-midi-post-tangle
 370                        "ENABLED." "DISABLED."))))
 371
 372 (defun ly-toggle-pdf-display ()
 373   "Toggle whether pdf will be displayed following a successful compilation."
 374   (interactive)
 375   (setq ly-display-pdf-post-tangle
 376         (not ly-display-pdf-post-tangle))
 377   (message (concat "Post-Tangle PDF display has been "
 378                    (if ly-display-pdf-post-tangle
 379                        "ENABLED." "DISABLED."))))
 380
 381 (defun ly-toggle-png-generation ()
 382   "Toggle whether png image will be generated by compilation."
 383   (interactive)
 384   (setq ly-gen-png (not ly-gen-png))
 385   (message (concat "PNG image generation has been "
 386                    (if ly-gen-png "ENABLED." "DISABLED."))))
 387
 388 (defun ly-toggle-html-generation ()
 389   "Toggle whether html will be generated by compilation."
 390   (interactive)
 391   (setq ly-gen-html (not ly-gen-html))
 392   (message (concat "HTML generation has been "
 393                    (if ly-gen-html "ENABLED." "DISABLED."))))
 394
 395 (defun ly-toggle-pdf-generation ()
 396   "Toggle whether pdf will be generated by compilation."
 397   (interactive)
 398   (setq ly-gen-pdf (not ly-gen-pdf))
 399   (message (concat "PDF generation has been "
 400                    (if ly-gen-pdf "ENABLED." "DISABLED."))))
 401
 402 (defun ly-toggle-arrange-mode ()
 403   "Toggle whether in Arrange mode or Basic mode."
 404   (interactive)
 405   (setq ly-arrange-mode
 406         (not ly-arrange-mode))
 407   (message (concat "Arrange mode has been "
 408                    (if ly-arrange-mode "ENABLED." "DISABLED."))))
 409
 410 (defun ly-switch-extension (file-name ext)
 411   "Utility command to swap current FILE-NAME extension with EXT"
 412   (concat (file-name-sans-extension
 413            file-name) ext))
 414
 415 (defun ly-get-header-args (mode)
 416   "Default arguments to use when evaluating a lilypond
 417 source block.  These depend upon whether we are in arrange
 418 mode i.e.  ARRANGE-MODE is t"
 419   (cond (mode
 420          '((:tangle . "yes")
 421            (:noweb . "yes")
 422            (:results . "silent")
 423            (:cache . "yes")
 424            (:comments . "yes")))
 425         (t
 426          '((:results . "file")
 427            (:exports . "results")))))
 428
 429 (defun ly-set-header-args (mode)
 430   "Set org-babel-default-header-args:lilypond
 431 dependent on LY-ARRANGE-MODE"
 432   (setq org-babel-default-header-args:lilypond
 433         (ly-get-header-args mode)))
 434
 435 (provide 'ob-lilypond)
 436
 437 ;;; ob-lilypond.el ends here