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, music score
   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, 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 ;;; Code:
  33
  34 (require 'ob)
  35 (require 'ob-eval)
  36 (require 'ob-tangle)
  37 (defalias 'lilypond-mode 'LilyPond-mode)
  38
  39 (declare-function show-all "outline" ())
  40
  41 (add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly"))
  42
  43 (defvar org-babel-default-header-args:lilypond '()
  44   "Default header arguments for lilypond code blocks.
  45 NOTE: The arguments are determined at lilypond compile time.
  46 See (ly-set-header-args)")
  47
  48 (defconst ly-version "7.6"
  49   "The version number of the file ob-lilypond.el.")
  50
  51 (defvar ly-compile-post-tangle t
  52   "Following the org-babel-tangle (C-c C-v t) command,
  53 ly-compile-post-tangle determines whether ob-lilypond should
  54 automatically attempt to compile the resultant tangled file.
  55 If the value is nil, no automated compilation takes place.
  56 Default value is t")
  57
  58 (defvar ly-display-pdf-post-tangle t
  59   "Following a successful LilyPond compilation
  60 ly-display-pdf-post-tangle determines whether to automate the
  61 drawing / redrawing of the resultant pdf. If the value is nil,
  62 the pdf is not automatically redrawn. Default value is t")
  63
  64 (defvar ly-play-midi-post-tangle t
  65   "Following a successful LilyPond compilation
  66 ly-play-midi-post-tangle determines whether to automate the
  67 playing of the resultant midi file. If the value is nil,
  68 the midi file is not automatically played. Default value is t")
  69
  70 (defvar ly-OSX-ly-path
  71   "/Applications/lilypond.app/Contents/Resources/bin/lilypond")
  72 (defvar ly-OSX-pdf-path "open")
  73 (defvar ly-OSX-midi-path "open")
  74
  75 (defvar ly-nix-ly-path "/usr/bin/lilypond")
  76 (defvar ly-nix-pdf-path "evince")
  77 (defvar ly-nix-midi-path "timidity")
  78
  79 (defvar ly-win32-ly-path "lilypond")
  80 (defvar ly-win32-pdf-path "")
  81 (defvar ly-win32-midi-path "")
  82
  83 (defvar ly-gen-png nil
  84 "Image generation (png) can be turned on by default by setting
  85 LY-GEN-PNG to t")
  86
  87 (defvar ly-gen-svg nil
  88 "Image generation (SVG) can be turned on by default by setting
  89 LY-GEN-SVG to t")
  90
  91 (defvar ly-gen-html nil
  92 "HTML generation can be turned on by default by setting
  93 LY-GEN-HTML to t")
  94
  95 (defvar ly-gen-pdf nil
  96 "PDF generation can be turned on by default by setting
  97 LY-GEN-PDF to t")
  98
  99 (defvar ly-use-eps nil
 100 "You can force the compiler to use the EPS backend by setting
 101 LY-USE-EPS to t")
 102
 103 (defvar ly-arrange-mode nil
 104   "Arrange mode is turned on by setting LY-ARRANGE-MODE
 105 to t. In Arrange mode the following settings are altered
 106 from default...
 107 :tangle yes,    :noweb yes
 108 :results silent :comments yes.
 109 In addition lilypond block execution causes tangling of all lilypond
 110 blocks")
 111
 112 (defun org-babel-expand-body:lilypond (body params)
 113   "Expand BODY according to PARAMS, return the expanded body."
 114
 115   (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
 116     (mapc
 117      (lambda (pair)
 118        (let ((name (symbol-name (car pair)))
 119              (value (cdr pair)))
 120          (setq body
 121                (replace-regexp-in-string
 122                 (concat "\$" (regexp-quote name))
 123                 (if (stringp value) value (format "%S" value))
 124                 body))))
 125      vars)
 126     body))
 127
 128 (defun org-babel-execute:lilypond (body params)
 129   "This function is called by `org-babel-execute-src-block'.
 130 Depending on whether we are in arrange mode either:
 131 1. Attempt to execute lilypond block according to header settings
 132   (This is the default basic mode)
 133 2. Tangle all lilypond blocks and process the result (arrange mode)"
 134
 135   (ly-set-header-args ly-arrange-mode)
 136   (if ly-arrange-mode
 137       (ly-tangle)
 138     (ly-process-basic body params)))
 139
 140 (defun ly-tangle ()
 141   "ob-lilypond specific tangle, attempts to invoke
 142 =ly-execute-tangled-ly= if tangle is successful. Also passes
 143 specific arguments to =org-babel-tangle="
 144
 145   (interactive)
 146   (if (org-babel-tangle nil "yes" "lilypond")
 147       (ly-execute-tangled-ly) nil))
 148
 149 (defun ly-process-basic (body params)
 150   "Execute a lilypond block in basic mode"
 151
 152   (let* ((result-params (cdr (assoc :result-params params)))
 153          (out-file (cdr (assoc :file params)))
 154          (cmdline (or (cdr (assoc :cmdline params))
 155                       ""))
 156          (in-file (org-babel-temp-file "lilypond-")))
 157
 158     (with-temp-file in-file
 159       (insert (org-babel-expand-body:generic body params)))
 160
 161     (org-babel-eval
 162      (concat
 163       (ly-determine-ly-path)
 164       " -dbackend=eps "
 165       "-dno-gs-load-fonts "
 166       "-dinclude-eps-fonts "
 167       "--png "
 168       "--output="
 169       (file-name-sans-extension out-file)
 170       " "
 171       cmdline
 172       in-file) "")
 173     ) nil)
 174
 175 (defun org-babel-prep-session:lilypond (session params)
 176   "Return an error because LilyPond exporter does not support sessions."
 177
 178   (error "Sorry, LilyPond does not currently support sessions!"))
 179
 180 (defun ly-execute-tangled-ly ()
 181   "Compile result of block tangle with lilypond.
 182 If error in compilation, attempt to mark the error in lilypond org file"
 183
 184   (when ly-compile-post-tangle
 185     (let ((ly-tangled-file (ly-switch-extension
 186                             (buffer-file-name) ".lilypond"))
 187           (ly-temp-file (ly-switch-extension
 188                          (buffer-file-name) ".ly")))
 189       (if (file-exists-p ly-tangled-file)
 190           (progn
 191             (when (file-exists-p ly-temp-file)
 192               (delete-file ly-temp-file))
 193             (rename-file ly-tangled-file
 194                          ly-temp-file))
 195         (error "Error: Tangle Failed!") t)
 196       (switch-to-buffer-other-window "*lilypond*")
 197       (erase-buffer)
 198       (ly-compile-lilyfile ly-temp-file)
 199       (goto-char (point-min))
 200       (if (not (ly-check-for-compile-error ly-temp-file))
 201           (progn
 202             (other-window -1)
 203             (ly-attempt-to-open-pdf ly-temp-file)
 204             (ly-attempt-to-play-midi ly-temp-file))
 205         (error "Error in Compilation!")))) nil)
 206
 207 (defun ly-compile-lilyfile (file-name &optional test)
 208   "Compile lilypond file and check for compile errors
 209 FILE-NAME is full path to lilypond (.ly) file"
 210
 211   (message "Compiling LilyPond...")
 212   (let ((arg-1 (ly-determine-ly-path)) ;program
 213         (arg-2 nil)                    ;infile
 214         (arg-3 "*lilypond*")           ;buffer
 215         (arg-4 t)                      ;display
 216         (arg-4 t)                      ;display
 217         (arg-5 (if ly-gen-png  "--png"  "")) ;&rest...
 218         (arg-6 (if ly-gen-html "--html" ""))
 219         (arg-7 (if ly-gen-pdf "--pdf" ""))
 220         (arg-8 (if ly-use-eps  "-dbackend=eps" ""))
 221         (arg-9 (if ly-gen-svg  "-dbackend=svg" ""))
 222         (arg-10 (concat "--output=" (file-name-sans-extension file-name)))
 223         (arg-11 file-name))
 224     (if test
 225         `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 ,arg-6
 226                  ,arg-7 ,arg-8 ,arg-9 ,arg-10 ,arg-11)
 227       (call-process
 228        arg-1 arg-2 arg-3 arg-4 arg-5 arg-6
 229        arg-7 arg-8 arg-9 arg-10 arg-11))))
 230
 231 (defun ly-check-for-compile-error (file-name &optional test)
 232   "Check for compile error.
 233 This is performed by parsing the *lilypond* buffer
 234 containing the output message from the compilation.
 235 FILE-NAME is full path to lilypond file.
 236 If TEST is t just return nil if no error found, and pass
 237 nil as file-name since it is unused in this context"
 238   (let ((is-error (search-forward "error:" nil t)))
 239     (if (not test)
 240         (if (not is-error)
 241             nil
 242           (ly-process-compile-error file-name))
 243       is-error)))
 244
 245 (defun ly-process-compile-error (file-name)
 246   "Process the compilation error that has occurred.
 247 FILE-NAME is full path to lilypond file"
 248
 249   (let ((line-num (ly-parse-line-num)))
 250     (let ((error-lines (ly-parse-error-line file-name line-num)))
 251       (ly-mark-error-line file-name error-lines)
 252       (error "Error: Compilation Failed!"))))
 253
 254 (defun ly-mark-error-line (file-name line)
 255   "Mark the erroneous lines in the lilypond org buffer.
 256 FILE-NAME is full path to lilypond file.
 257 LINE is the erroneous line"
 258
 259   (switch-to-buffer-other-window
 260    (concat (file-name-nondirectory
 261             (ly-switch-extension file-name ".org"))))
 262   (let ((temp (point)))
 263     (goto-char (point-min))
 264     (setq case-fold-search nil)
 265     (if (search-forward line nil t)
 266         (progn
 267           (show-all)
 268           (set-mark (point))
 269           (goto-char (- (point) (length line))))
 270       (goto-char temp))))
 271
 272 (defun ly-parse-line-num (&optional buffer)
 273   "Extract error line number."
 274
 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 ly-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
 300   (with-temp-buffer
 301     (insert-file-contents (ly-switch-extension file-name ".ly")
 302                           nil nil nil t)
 303     (if (> lineNo 0)
 304         (progn
 305           (goto-char (point-min))
 306           (forward-line (- lineNo 1))
 307           (buffer-substring (point) (point-at-eol)))
 308       nil)))
 309
 310 (defun ly-attempt-to-open-pdf (file-name &optional test)
 311   "Attempt to display the generated pdf file
 312 FILE-NAME is full path to lilypond file
 313 If TEST is non-nil, the shell command is returned and is not run"
 314
 315   (when ly-display-pdf-post-tangle
 316     (let ((pdf-file (ly-switch-extension file-name ".pdf")))
 317       (if (file-exists-p pdf-file)
 318           (let ((cmd-string
 319                  (concat (ly-determine-pdf-path) " " pdf-file)))
 320             (if test
 321                 cmd-string
 322               (start-process
 323                "\"Audition pdf\""
 324                "*lilypond*"
 325                (ly-determine-pdf-path)
 326                pdf-file)))
 327         (message  "No pdf file generated so can't display!")))))
 328
 329 (defun ly-attempt-to-play-midi (file-name &optional test)
 330   "Attempt to play the generated MIDI file
 331 FILE-NAME is full path to lilypond file
 332 If TEST is non-nil, the shell command is returned and is not run"
 333
 334   (when ly-play-midi-post-tangle
 335     (let ((midi-file (ly-switch-extension file-name ".midi")))
 336       (if (file-exists-p midi-file)
 337           (let ((cmd-string
 338                  (concat (ly-determine-midi-path) " " midi-file)))
 339             (if test
 340                 cmd-string
 341               (start-process
 342                "\"Audition midi\""
 343                "*lilypond*"
 344                (ly-determine-midi-path)
 345                midi-file)))
 346         (message "No midi file generated so can't play!")))))
 347
 348 (defun ly-determine-ly-path (&optional test)
 349   "Return correct path to ly binary depending on OS
 350 If TEST is non-nil, it contains a simulation of the OS for test purposes"
 351
 352   (let ((sys-type
 353          (or test system-type)))
 354     (cond ((string= sys-type  "darwin")
 355            ly-OSX-ly-path)
 356           ((string= sys-type "win32")
 357            ly-win32-ly-path)
 358           (t ly-nix-ly-path))))
 359
 360 (defun ly-determine-pdf-path (&optional test)
 361   "Return correct path to pdf viewer depending on OS
 362 If TEST is non-nil, it contains a simulation of the OS for test purposes"
 363
 364   (let ((sys-type
 365          (or test system-type)))
 366     (cond ((string= sys-type  "darwin")
 367            ly-OSX-pdf-path)
 368           ((string= sys-type "win32")
 369            ly-win32-pdf-path)
 370           (t ly-nix-pdf-path))))
 371
 372 (defun ly-determine-midi-path (&optional test)
 373   "Return correct path to midi player depending on OS
 374 If TEST is non-nil, it contains a simulation of the OS for test purposes"
 375
 376   (let ((sys-type
 377          (or test test system-type)))
 378     (cond ((string= sys-type  "darwin")
 379            ly-OSX-midi-path)
 380           ((string= sys-type "win32")
 381            ly-win32-midi-path)
 382           (t ly-nix-midi-path))))
 383
 384 (defun ly-toggle-midi-play ()
 385   "Toggle whether midi will be played following a successful compilation"
 386
 387   (interactive)
 388   (setq ly-play-midi-post-tangle
 389         (not ly-play-midi-post-tangle))
 390   (message (concat "Post-Tangle MIDI play has been "
 391                    (if ly-play-midi-post-tangle
 392                        "ENABLED." "DISABLED."))))
 393
 394 (defun ly-toggle-pdf-display ()
 395   "Toggle whether pdf will be displayed following a successful compilation"
 396
 397   (interactive)
 398   (setq ly-display-pdf-post-tangle
 399         (not ly-display-pdf-post-tangle))
 400   (message (concat "Post-Tangle PDF display has been "
 401                    (if ly-display-pdf-post-tangle
 402                        "ENABLED." "DISABLED."))))
 403
 404 (defun ly-toggle-png-generation ()
 405   "Toggle whether png image will be generated by compilation"
 406
 407   (interactive)
 408   (setq ly-gen-png
 409         (not ly-gen-png))
 410   (message (concat "PNG image generation has been "
 411                    (if ly-gen-png "ENABLED." "DISABLED."))))
 412
 413 (defun ly-toggle-html-generation ()
 414   "Toggle whether html will be generated by compilation"
 415
 416   (interactive)
 417   (setq ly-gen-html
 418         (not ly-gen-html))
 419   (message (concat "HTML generation has been "
 420                    (if ly-gen-html "ENABLED." "DISABLED."))))
 421
 422 (defun ly-toggle-pdf-generation ()
 423   "Toggle whether pdf will be generated by compilation"
 424
 425   (interactive)
 426   (setq ly-gen-pdf
 427         (not ly-gen-pdf))
 428   (message (concat "PDF generation has been "
 429                    (if ly-gen-pdf "ENABLED." "DISABLED."))))
 430
 431 (defun ly-toggle-arrange-mode ()
 432   "Toggle whether in Arrange mode or Basic mode"
 433
 434   (interactive)
 435   (setq ly-arrange-mode
 436         (not ly-arrange-mode))
 437   (message (concat "Arrange mode has been "
 438                    (if ly-arrange-mode "ENABLED." "DISABLED."))))
 439
 440 (defun ly-version (&optional insert-at-point)
 441   (interactive)
 442   (let ((version (format "ob-lilypond version %s" ly-version)))
 443     (when insert-at-point (insert version))
 444     (message version)))
 445
 446   (defun ly-switch-extension (file-name ext)
 447   "Utility command to swap current FILE-NAME extension with EXT"
 448
 449   (concat (file-name-sans-extension
 450            file-name) ext))
 451
 452 (defun ly-get-header-args (mode)
 453   "Default arguments to use when evaluating a lilypond
 454 source block. These depend upon whether we are in arrange
 455 mode i.e. ARRANGE-MODE is t"
 456   (cond (mode
 457          '((:tangle . "yes")
 458            (:noweb . "yes")
 459            (:results . "silent")
 460            (:cache . "yes")
 461            (:comments . "yes")))
 462         (t
 463          '((:results . "file")
 464            (:exports . "results")))))
 465
 466 (defun ly-set-header-args (mode)
 467   "Set org-babel-default-header-args:lilypond
 468 dependent on LY-ARRANGE-MODE"
 469   (setq org-babel-default-header-args:lilypond
 470         (ly-get-header-args mode)))
 471
 472 (provide 'ob-lilypond)
 473
 474 ;;; ob-lilypond.el ends here