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