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