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