lisp/ob-lilypond.el

   1 ;;; ob-lilypond.el --- org-babel functions for lilypond evaluation
   2
   3 ;; Copyright (C) 2010-2012  Free Software Foundation, Inc.
   4
   5 ;; Author: Martyn Jago
   6 ;; Keywords: babel language, literate programming
   7 ;; Homepage: https://github.com/mjago/ob-lilypond
   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 / usage info, and examples are available at
  27 ;; https://github.com/mjago/ob-lilypond
  28
  29 ;;; Code:
  30 (require 'ob)
  31 (require 'ob-eval)
  32 (require 'ob-tangle)
  33 (require 'outline)
  34 (defalias 'lilypond-mode 'LilyPond-mode)
  35
  36 (add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly"))
  37
  38 (defvar org-babel-default-header-args:lilypond '()
  39   "Default header arguments for js code blocks.")
  40
  41 (defconst ly-version "0.3"
  42   "The version number of the file ob-lilypond.el.")
  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-win32-ly-path "lilypond")
  73 (defvar ly-win32-pdf-path "")
  74 (defvar ly-win32-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-use-eps nil
  89 "You can force the compiler to use the EPS backend by setting
  90 LY-USE-EPS to t")
  91
  92 (defvar ly-arrange-mode nil
  93   "Arrange mode is turned on by setting LY-ARRANGE-MODE
  94 to t. In Arrange mode the following settings are altered
  95 from default...
  96 :tangle yes,    :noweb yes
  97 :results silent :comments yes.
  98 In addition lilypond block execution causes tangling of all lilypond
  99 blocks")
 100
 101 (defun org-babel-expand-body:lilypond (body params)
 102   "Expand BODY according to PARAMS, return the expanded body."
 103
 104   (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
 105     (mapc
 106      (lambda (pair)
 107        (let ((name (symbol-name (car pair)))
 108              (value (cdr pair)))
 109          (setq body
 110                (replace-regexp-in-string
 111                 (concat "\$" (regexp-quote name))
 112                 (if (stringp value) value (format "%S" value))
 113                 body))))
 114      vars)
 115     body))
 116
 117 (defun org-babel-execute:lilypond (body params)
 118   "This function is called by `org-babel-execute-src-block'.
 119 Depending on whether we are in arrange mode either:
 120 1. Attempt to execute lilypond block according to header settings
 121   (This is the default basic mode)
 122 2. Tangle all lilypond blocks and process the result (arrange mode)"
 123
 124   (ly-set-header-args ly-arrange-mode)
 125   (if ly-arrange-mode
 126       (ly-tangle)
 127     (ly-process-basic body params)))
 128
 129 (defun ly-tangle ()
 130   "ob-lilypond specific tangle, attempts to invoke
 131 =ly-execute-tangled-ly= if tangle is successful. Also passes
 132 specific arguments to =org-babel-tangle="
 133
 134   (interactive)
 135   (if (org-babel-tangle nil "yes" "lilypond")
 136       (ly-execute-tangled-ly) nil))
 137
 138 (defun ly-process-basic (body params)
 139   "Execute a lilypond block in basic mode"
 140
 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
 150     (org-babel-eval
 151      (concat
 152       (ly-determine-ly-path)
 153       " -dbackend=eps "
 154       "-dno-gs-load-fonts "
 155       "-dinclude-eps-fonts "
 156       "--png "
 157       "--output="
 158       (file-name-sans-extension out-file)
 159       " "
 160       cmdline
 161       in-file) "")
 162     ) nil)
 163
 164 (defun org-babel-prep-session:lilypond (session params)
 165   "Return an error because LilyPond exporter does not support sessions."
 166
 167   (error "Sorry, LilyPond does not currently support sessions!"))
 168
 169 (defun ly-execute-tangled-ly ()
 170   "Compile result of block tangle with lilypond.
 171 If error in compilation, attempt to mark the error in lilypond org file"
 172
 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
 200   (message "Compiling LilyPond...")
 201   (let ((arg-1 (ly-determine-ly-path)) ;program
 202         (arg-2 nil)                    ;infile
 203         (arg-3 "*lilypond*")           ;buffer
 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-use-eps  "-dbackend=eps" ""))
 208         (arg-8 (if ly-gen-svg  "-dbackend=svg" ""))
 209         (arg-9 (concat "--output=" (file-name-sans-extension file-name)))
 210         (arg-10 file-name))
 211     (if test
 212         `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5
 213                  ,arg-6 ,arg-7 ,arg-8 ,arg-9 ,arg-10)
 214       (call-process
 215        arg-1 arg-2 arg-3 arg-4 arg-5
 216        arg-6 arg-7 arg-8 arg-9 arg-10))))
 217
 218 (defun ly-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           (ly-process-compile-error file-name))
 230       is-error)))
 231
 232 (defun ly-process-compile-error (file-name)
 233   "Process the compilation error that has occurred.
 234 FILE-NAME is full path to lilypond file"
 235
 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
 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
 262   (when buffer
 263     (set-buffer buffer))
 264   (let ((start
 265          (and (search-backward ":" nil t)
 266               (search-backward ":" nil t)
 267               (search-backward ":" nil t)
 268               (search-backward ":" nil t)))
 269         (num nil))
 270     (if start
 271         (progn
 272           (forward-char)
 273           (let ((num (buffer-substring
 274                       (+ 1 start)
 275                       (- (search-forward ":" nil t) 1))))
 276             (setq num (string-to-number num))
 277             (if (numberp num)
 278                 num
 279               nil)))
 280       nil)))
 281
 282 (defun ly-parse-error-line (file-name lineNo)
 283   "Extract the erroneous line from the tangled .ly file
 284 FILE-NAME is full path to lilypond file.
 285 LINENO is the number of the erroneous line"
 286
 287   (with-temp-buffer
 288     (insert-file-contents (ly-switch-extension file-name ".ly")
 289                           nil nil nil t)
 290     (if (> lineNo 0)
 291         (progn
 292           (goto-char (point-min))
 293           (forward-line (- lineNo 1))
 294           (buffer-substring (point) (point-at-eol)))
 295       nil)))
 296
 297 (defun ly-attempt-to-open-pdf (file-name &optional test)
 298   "Attempt to display the generated pdf file
 299 FILE-NAME is full path to lilypond file
 300 If TEST is non-nil, the shell command is returned and is not run"
 301
 302   (when ly-display-pdf-post-tangle
 303     (let ((pdf-file (ly-switch-extension file-name ".pdf")))
 304       (if (file-exists-p pdf-file)
 305           (let ((cmd-string
 306                  (concat (ly-determine-pdf-path) " " pdf-file)))
 307             (if test
 308                 cmd-string
 309               (shell-command cmd-string)))
 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
 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               (shell-command cmd-string)))
 325         (message "No midi file generated so can't play!")))))
 326
 327 (defun ly-determine-ly-path (&optional test)
 328   "Return correct path to ly binary depending on OS
 329 If TEST is non-nil, it contains a simulation of the OS for test purposes"
 330
 331   (let ((sys-type
 332          (or test system-type)))
 333     (cond ((string= sys-type  "darwin")
 334            ly-OSX-ly-path)
 335           ((string= sys-type "win32")
 336            ly-win32-ly-path)
 337           (t ly-nix-ly-path))))
 338
 339 (defun ly-determine-pdf-path (&optional test)
 340   "Return correct path to pdf viewer depending on OS
 341 If TEST is non-nil, it contains a simulation of the OS for test purposes"
 342
 343   (let ((sys-type
 344          (or test system-type)))
 345     (cond ((string= sys-type  "darwin")
 346            ly-OSX-pdf-path)
 347           ((string= sys-type "win32")
 348            ly-win32-pdf-path)
 349           (t ly-nix-pdf-path))))
 350
 351 (defun ly-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
 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 "win32")
 360            ly-win32-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
 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
 376   (interactive)
 377   (setq ly-display-pdf-post-tangle
 378         (not ly-display-pdf-post-tangle))
 379   (message (concat "Post-Tangle PDF display has been "
 380                    (if ly-display-pdf-post-tangle
 381                        "ENABLED." "DISABLED."))))
 382
 383 (defun ly-toggle-png-generation ()
 384   "Toggle whether png image will be generated by compilation"
 385
 386   (interactive)
 387   (setq ly-gen-png
 388         (not ly-gen-png))
 389   (message (concat "PNG image generation has been "
 390                    (if ly-gen-png "ENABLED." "DISABLED."))))
 391
 392 (defun ly-toggle-html-generation ()
 393   "Toggle whether html will be generated by compilation"
 394
 395   (interactive)
 396   (setq ly-gen-html
 397         (not ly-gen-html))
 398   (message (concat "HTML generation has been "
 399                    (if ly-gen-html "ENABLED." "DISABLED."))))
 400
 401 (defun ly-toggle-arrange-mode ()
 402   "Toggle whether in Arrange mode or Basic mode"
 403
 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-version (&optional insert-at-point)
 411   (interactive)
 412   (let ((version (format "ob-lilypond version %s" ly-version)))
 413     (when insert-at-point (insert version))
 414     (message version)))
 415
 416   (defun ly-switch-extension (file-name ext)
 417   "Utility command to swap current FILE-NAME extension with EXT"
 418
 419   (concat (file-name-sans-extension
 420            file-name) ext))
 421
 422 (defun ly-get-header-args (mode)
 423   "Default arguments to use when evaluating a lilypond
 424 source block. These depend upon whether we are in arrange
 425 mode i.e. ARRANGE-MODE is t"
 426   (cond (mode
 427          '((:tangle . "yes")
 428            (:noweb . "yes")
 429            (:results . "silent")
 430            (:comments . "yes")))
 431         (t
 432          '((:results . "file")
 433            (:exports . "results")))))
 434
 435 (defun ly-set-header-args (mode)
 436   "Set org-babel-default-header-args:lilypond
 437 dependent on LY-ARRANGE-MODE"
 438   (setq org-babel-default-header-args:lilypond
 439         (ly-get-header-args mode)))
 440
 441 (provide 'ob-lilypond)
 442
 443
 444
 445 ;;; ob-lilypond.el ends here