lisp/ob-lilypond.el

   1 ;;; ob-lilypond.el --- org-babel functions for lilypond evaluation
   2
   3 ;; Copyright (C) 2010-2011  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: 7.7
   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 (require 'ob-tangle)
  34 (defalias 'lilypond-mode 'LilyPond-mode)
  35
  36 (declare-function show-all "outline" ())
  37
  38 (add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly"))
  39
  40 (defvar org-babel-default-header-args:lilypond '()
  41   "Default header arguments for js code blocks.")
  42
  43 (defconst ly-version "0.3"
  44   "The version number of the file ob-lilypond.el.")
  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-win32-ly-path "lilypond")
  75 (defvar ly-win32-pdf-path "")
  76 (defvar ly-win32-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-use-eps nil
  91 "You can force the compiler to use the EPS backend by setting
  92 LY-USE-EPS to t")
  93
  94 (defvar ly-arrange-mode nil
  95   "Arrange mode is turned on by setting LY-ARRANGE-MODE
  96 to t. In Arrange mode the following settings are altered
  97 from default...
  98 :tangle yes,    :noweb yes
  99 :results silent :comments yes.
 100 In addition lilypond block execution causes tangling of all lilypond
 101 blocks")
 102
 103 (defun org-babel-expand-body:lilypond (body params)
 104   "Expand BODY according to PARAMS, return the expanded body."
 105
 106   (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
 107     (mapc
 108      (lambda (pair)
 109        (let ((name (symbol-name (car pair)))
 110              (value (cdr pair)))
 111          (setq body
 112                (replace-regexp-in-string
 113                 (concat "\$" (regexp-quote name))
 114                 (if (stringp value) value (format "%S" value))
 115                 body))))
 116      vars)
 117     body))
 118
 119 (defun org-babel-execute:lilypond (body params)
 120   "This function is called by `org-babel-execute-src-block'.
 121 Depending on whether we are in arrange mode either:
 122 1. Attempt to execute lilypond block according to header settings
 123   (This is the default basic mode)
 124 2. Tangle all lilypond blocks and process the result (arrange mode)"
 125
 126   (ly-set-header-args ly-arrange-mode)
 127   (if ly-arrange-mode
 128       (ly-tangle)
 129     (ly-process-basic body params)))
 130
 131 (defun ly-tangle ()
 132   "ob-lilypond specific tangle, attempts to invoke
 133 =ly-execute-tangled-ly= if tangle is successful. Also passes
 134 specific arguments to =org-babel-tangle="
 135
 136   (interactive)
 137   (if (org-babel-tangle nil "yes" "lilypond")
 138       (ly-execute-tangled-ly) nil))
 139
 140 (defun ly-process-basic (body params)
 141   "Execute a lilypond block in basic mode"
 142
 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
 152     (org-babel-eval
 153      (concat
 154       (ly-determine-ly-path)
 155       " -dbackend=eps "
 156       "-dno-gs-load-fonts "
 157       "-dinclude-eps-fonts "
 158       "--png "
 159       "--output="
 160       (file-name-sans-extension out-file)
 161       " "
 162       cmdline
 163       in-file) "")
 164     ) nil)
 165
 166 (defun org-babel-prep-session:lilypond (session params)
 167   "Return an error because LilyPond exporter does not support sessions."
 168
 169   (error "Sorry, LilyPond does not currently support sessions!"))
 170
 171 (defun ly-execute-tangled-ly ()
 172   "Compile result of block tangle with lilypond.
 173 If error in compilation, attempt to mark the error in lilypond org file"
 174
 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
 202   (message "Compiling LilyPond...")
 203   (let ((arg-1 (ly-determine-ly-path)) ;program
 204         (arg-2 nil)                    ;infile
 205         (arg-3 "*lilypond*")           ;buffer
 206         (arg-4 t)                      ;display
 207         (arg-5 (if ly-gen-png  "--png"  "")) ;&rest...
 208   (arg-6 (if ly-gen-html "--html" ""))
 209         (arg-7 (if ly-use-eps  "-dbackend=eps" ""))
 210         (arg-8 (if ly-gen-svg  "-dbackend=svg" ""))
 211         (arg-9 (concat "--output=" (file-name-sans-extension file-name)))
 212         (arg-10 file-name))
 213     (if test
 214         `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5
 215                  ,arg-6 ,arg-7 ,arg-8 ,arg-9 ,arg-10)
 216       (call-process
 217        arg-1 arg-2 arg-3 arg-4 arg-5
 218        arg-6 arg-7 arg-8 arg-9 arg-10))))
 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
 238   (let ((line-num (ly-parse-line-num)))
 239     (let ((error-lines (ly-parse-error-line file-name line-num)))
 240       (ly-mark-error-line file-name error-lines)
 241       (error "Error: Compilation Failed!"))))
 242
 243 (defun ly-mark-error-line (file-name line)
 244   "Mark the erroneous lines in the lilypond org buffer.
 245 FILE-NAME is full path to lilypond file.
 246 LINE is the erroneous line"
 247
 248   (switch-to-buffer-other-window
 249    (concat (file-name-nondirectory
 250             (ly-switch-extension file-name ".org"))))
 251   (let ((temp (point)))
 252     (goto-char (point-min))
 253     (setq case-fold-search nil)
 254     (if (search-forward line nil t)
 255         (progn
 256           (show-all)
 257           (set-mark (point))
 258           (goto-char (- (point) (length line))))
 259       (goto-char temp))))
 260
 261 (defun ly-parse-line-num (&optional buffer)
 262   "Extract error line number."
 263
 264   (when buffer
 265     (set-buffer buffer))
 266   (let ((start
 267          (and (search-backward ":" nil t)
 268               (search-backward ":" nil t)
 269               (search-backward ":" nil t)
 270               (search-backward ":" nil t)))
 271         (num nil))
 272     (if start
 273         (progn
 274           (forward-char)
 275           (let ((num (buffer-substring
 276                       (+ 1 start)
 277                       (- (search-forward ":" nil t) 1))))
 278             (setq num (string-to-number num))
 279             (if (numberp num)
 280                 num
 281               nil)))
 282       nil)))
 283
 284 (defun ly-parse-error-line (file-name lineNo)
 285   "Extract the erroneous line from the tangled .ly file
 286 FILE-NAME is full path to lilypond file.
 287 LINENO is the number of the erroneous line"
 288
 289   (with-temp-buffer
 290     (insert-file-contents (ly-switch-extension file-name ".ly")
 291                           nil nil nil t)
 292     (if (> lineNo 0)
 293         (progn
 294           (goto-char (point-min))
 295           (forward-line (- lineNo 1))
 296           (buffer-substring (point) (point-at-eol)))
 297       nil)))
 298
 299 (defun ly-attempt-to-open-pdf (file-name &optional test)
 300   "Attempt to display the generated pdf file
 301 FILE-NAME is full path to lilypond file
 302 If TEST is non-nil, the shell command is returned and is not run"
 303
 304   (when ly-display-pdf-post-tangle
 305     (let ((pdf-file (ly-switch-extension file-name ".pdf")))
 306       (if (file-exists-p pdf-file)
 307           (let ((cmd-string
 308                  (concat (ly-determine-pdf-path) " " pdf-file)))
 309             (if test
 310                 cmd-string
 311               (shell-command cmd-string)))
 312         (message  "No pdf file generated so can't display!")))))
 313
 314 (defun ly-attempt-to-play-midi (file-name &optional test)
 315   "Attempt to play the generated MIDI file
 316 FILE-NAME is full path to lilypond file
 317 If TEST is non-nil, the shell command is returned and is not run"
 318
 319   (when ly-play-midi-post-tangle
 320     (let ((midi-file (ly-switch-extension file-name ".midi")))
 321       (if (file-exists-p midi-file)
 322           (let ((cmd-string
 323                  (concat (ly-determine-midi-path) " " midi-file)))
 324             (if test
 325                 cmd-string
 326               (shell-command cmd-string)))
 327         (message "No midi file generated so can't play!")))))
 328
 329 (defun ly-determine-ly-path (&optional test)
 330   "Return correct path to ly binary depending on OS
 331 If TEST is non-nil, it contains a simulation of the OS for test purposes"
 332
 333   (let ((sys-type
 334          (or test system-type)))
 335     (cond ((string= sys-type  "darwin")
 336            ly-OSX-ly-path)
 337           ((string= sys-type "win32")
 338            ly-win32-ly-path)
 339           (t ly-nix-ly-path))))
 340
 341 (defun ly-determine-pdf-path (&optional test)
 342   "Return correct path to pdf viewer depending on OS
 343 If TEST is non-nil, it contains a simulation of the OS for test purposes"
 344
 345   (let ((sys-type
 346          (or test system-type)))
 347     (cond ((string= sys-type  "darwin")
 348            ly-OSX-pdf-path)
 349           ((string= sys-type "win32")
 350            ly-win32-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
 357   (let ((sys-type
 358          (or test test system-type)))
 359     (cond ((string= sys-type  "darwin")
 360            ly-OSX-midi-path)
 361           ((string= sys-type "win32")
 362            ly-win32-midi-path)
 363           (t ly-nix-midi-path))))
 364
 365 (defun ly-toggle-midi-play ()
 366   "Toggle whether midi will be played following a successful compilation"
 367
 368   (interactive)
 369   (setq ly-play-midi-post-tangle
 370         (not ly-play-midi-post-tangle))
 371   (message (concat "Post-Tangle MIDI play has been "
 372                    (if ly-play-midi-post-tangle
 373                        "ENABLED." "DISABLED."))))
 374
 375 (defun ly-toggle-pdf-display ()
 376   "Toggle whether pdf will be displayed following a successful compilation"
 377
 378   (interactive)
 379   (setq ly-display-pdf-post-tangle
 380         (not ly-display-pdf-post-tangle))
 381   (message (concat "Post-Tangle PDF display has been "
 382                    (if ly-display-pdf-post-tangle
 383                        "ENABLED." "DISABLED."))))
 384
 385 (defun ly-toggle-png-generation ()
 386   "Toggle whether png image will be generated by compilation"
 387
 388   (interactive)
 389   (setq ly-gen-png
 390         (not ly-gen-png))
 391   (message (concat "PNG image generation has been "
 392                    (if ly-gen-png "ENABLED." "DISABLED."))))
 393
 394 (defun ly-toggle-html-generation ()
 395   "Toggle whether html will be generated by compilation"
 396
 397   (interactive)
 398   (setq ly-gen-html
 399         (not ly-gen-html))
 400   (message (concat "HTML generation has been "
 401                    (if ly-gen-html "ENABLED." "DISABLED."))))
 402
 403 (defun ly-toggle-arrange-mode ()
 404   "Toggle whether in Arrange mode or Basic mode"
 405
 406   (interactive)
 407   (setq ly-arrange-mode
 408         (not ly-arrange-mode))
 409   (message (concat "Arrange mode has been "
 410                    (if ly-arrange-mode "ENABLED." "DISABLED."))))
 411
 412 (defun ly-version (&optional insert-at-point)
 413   (interactive)
 414   (let ((version (format "ob-lilypond version %s" ly-version)))
 415     (when insert-at-point (insert version))
 416     (message version)))
 417
 418   (defun ly-switch-extension (file-name ext)
 419   "Utility command to swap current FILE-NAME extension with EXT"
 420
 421   (concat (file-name-sans-extension
 422            file-name) ext))
 423
 424 (defun ly-get-header-args (mode)
 425   "Default arguments to use when evaluating a lilypond
 426 source block. These depend upon whether we are in arrange
 427 mode i.e. ARRANGE-MODE is t"
 428   (cond (mode
 429          '((:tangle . "yes")
 430            (:noweb . "yes")
 431            (:results . "silent")
 432            (:comments . "yes")))
 433         (t
 434          '((:results . "file")
 435            (:exports . "results")))))
 436
 437 (defun ly-set-header-args (mode)
 438   "Set org-babel-default-header-args:lilypond
 439 dependent on LY-ARRANGE-MODE"
 440   (setq org-babel-default-header-args:lilypond
 441         (ly-get-header-args mode)))
 442
 443 (provide 'ob-lilypond)
 444
 445
 446
 447 ;;; ob-lilypond.el ends here