lisp/ob-lilypond.el

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