lisp/ob-lilypond.el

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