lisp/ob-lilypond.el

   1 ;;; ob-lilypond.el --- Babel Functions for Lilypond  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Martyn Jago
   6 ;; Keywords: babel language, literate programming
   7 ;; Homepage: http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html
   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 ;; This depends on epstopdf --- See http://www.ctan.org/pkg/epstopdf.
  33
  34 ;;; Code:
  35 (require 'ob)
  36 (require 'outline)
  37 (defalias 'lilypond-mode 'LilyPond-mode)
  38
  39 (add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly"))
  40
  41 (defvar org-babel-default-header-args:lilypond '()
  42   "Default header arguments for lilypond code blocks.
  43 NOTE: The arguments are determined at lilypond compile time.
  44 See (org-babel-lilypond-set-header-args)")
  45
  46 (defvar org-babel-lilypond-compile-post-tangle t
  47   "Following the org-babel-tangle (C-c C-v t) command,
  48 org-babel-lilypond-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 org-babel-lilypond-display-pdf-post-tangle t
  54   "Following a successful LilyPond compilation
  55 org-babel-lilypond-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 org-babel-lilypond-play-midi-post-tangle t
  60   "Following a successful LilyPond compilation
  61 org-babel-lilypond-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 org-babel-lilypond-ly-command ""
  66   "Command to execute lilypond on your system.
  67 Do not set it directly.  Customize `org-babel-lilypond-commands' instead.")
  68 (defvar org-babel-lilypond-pdf-command ""
  69   "Command to show a PDF file on your system.
  70 Do not set it directly.  Customize `org-babel-lilypond-commands' instead.")
  71 (defvar org-babel-lilypond-midi-command ""
  72   "Command to play a MIDI file on your system.
  73 Do not set it directly.  Customize `org-babel-lilypond-commands' instead.")
  74 (defcustom org-babel-lilypond-commands
  75   (cond
  76    ((eq system-type 'darwin)
  77     '("/Applications/lilypond.app/Contents/Resources/bin/lilypond" "open" "open"))
  78    ((eq system-type 'windows-nt)
  79     '("lilypond" "" ""))
  80    (t
  81     '("lilypond" "xdg-open" "xdg-open")))
  82   "Commands to run lilypond and view or play the results.
  83 These should be executables that take a filename as an argument.
  84 On some system it is possible to specify the filename directly
  85 and the viewer or player will be determined from the file type;
  86 you can leave the string empty on this case."
  87   :group 'org-babel
  88   :type '(list
  89           (string :tag "Lilypond   ")
  90           (string :tag "PDF Viewer ")
  91           (string :tag "MIDI Player"))
  92   :version "24.3"
  93   :package-version '(Org . "8.2.7")
  94   :set
  95   (lambda (_symbol value)
  96     (setq
  97      org-babel-lilypond-ly-command   (nth 0 value)
  98      org-babel-lilypond-pdf-command  (nth 1 value)
  99      org-babel-lilypond-midi-command (nth 2 value))))
 100
 101 (defvar org-babel-lilypond-gen-png nil
 102   "Non-nil means image generation (PNG) is turned on by default.")
 103
 104 (defvar org-babel-lilypond-gen-svg nil
 105   "Non-nil means image generation (SVG) is be turned on by default.")
 106
 107 (defvar org-babel-lilypond-gen-html nil
 108   "Non-nil means HTML generation is turned on by default.")
 109
 110 (defvar org-babel-lilypond-gen-pdf nil
 111   "Non-nil means PDF generation is be turned on by default.")
 112
 113 (defvar org-babel-lilypond-use-eps nil
 114   "Non-nil forces the compiler to use the EPS backend.")
 115
 116 (defvar org-babel-lilypond-arrange-mode nil
 117   "Non-nil turns Arrange mode on.
 118 In Arrange mode the following settings are altered from default:
 119 :tangle yes,    :noweb yes
 120 :results silent :comments yes.
 121 In addition lilypond block execution causes tangling of all lilypond
 122 blocks.")
 123
 124 (defun org-babel-expand-body:lilypond (body params)
 125   "Expand BODY according to PARAMS, return the expanded body."
 126   (let ((vars (org-babel--get-vars params)))
 127     (mapc
 128      (lambda (pair)
 129        (let ((name (symbol-name (car pair)))
 130              (value (cdr pair)))
 131          (setq body
 132                (replace-regexp-in-string
 133                 (concat "$" (regexp-quote name))
 134                 (if (stringp value) value (format "%S" value))
 135                 body))))
 136      vars)
 137     body))
 138
 139 (defun org-babel-execute:lilypond (body params)
 140   "This function is called by `org-babel-execute-src-block'.
 141 Depending on whether we are in arrange mode either:
 142 1. Attempt to execute lilypond block according to header settings
 143   (This is the default basic mode)
 144 2. Tangle all lilypond blocks and process the result (arrange mode)"
 145   (org-babel-lilypond-set-header-args org-babel-lilypond-arrange-mode)
 146   (if org-babel-lilypond-arrange-mode
 147       (org-babel-lilypond-tangle)
 148     (org-babel-lilypond-process-basic body params)))
 149
 150 (defun org-babel-lilypond-tangle ()
 151   "ob-lilypond specific tangle, attempts to invoke
 152 =ly-execute-tangled-ly= if tangle is successful.  Also passes
 153 specific arguments to =org-babel-tangle="
 154   (interactive)
 155   (if (org-babel-tangle nil "yes" "lilypond")
 156       (org-babel-lilypond-execute-tangled-ly) nil))
 157
 158 (defun org-babel-lilypond-process-basic (body params)
 159   "Execute a lilypond block in basic mode."
 160   (let* ((out-file (cdr (assq :file params)))
 161          (cmdline (or (cdr (assq :cmdline params))
 162                       ""))
 163          (in-file (org-babel-temp-file "lilypond-")))
 164
 165     (with-temp-file in-file
 166       (insert (org-babel-expand-body:generic body params)))
 167     (org-babel-eval
 168      (concat
 169       org-babel-lilypond-ly-command
 170       " -dbackend=eps "
 171       "-dno-gs-load-fonts "
 172       "-dinclude-eps-fonts "
 173       (or (cdr (assoc (file-name-extension out-file)
 174                       '(("pdf" . "--pdf ")
 175                         ("ps" . "--ps ")
 176                         ("png" . "--png "))))
 177           "--png ")
 178       "--output="
 179       (file-name-sans-extension out-file)
 180       " "
 181       cmdline
 182       in-file) "")) nil)
 183
 184 (defun org-babel-prep-session:lilypond (_session _params)
 185   "Return an error because LilyPond exporter does not support sessions."
 186   (error "Sorry, LilyPond does not currently support sessions!"))
 187
 188 (defun org-babel-lilypond-execute-tangled-ly ()
 189   "Compile result of block tangle with lilypond.
 190 If error in compilation, attempt to mark the error in lilypond org file"
 191   (when org-babel-lilypond-compile-post-tangle
 192     (let ((org-babel-lilypond-tangled-file (org-babel-lilypond-switch-extension
 193                             (buffer-file-name) ".lilypond"))
 194           (org-babel-lilypond-temp-file (org-babel-lilypond-switch-extension
 195                          (buffer-file-name) ".ly")))
 196       (if (not (file-exists-p org-babel-lilypond-tangled-file))
 197           (error "Error: Tangle Failed!")
 198         (when (file-exists-p org-babel-lilypond-temp-file)
 199           (delete-file org-babel-lilypond-temp-file))
 200         (rename-file org-babel-lilypond-tangled-file
 201                      org-babel-lilypond-temp-file))
 202       (switch-to-buffer-other-window "*lilypond*")
 203       (erase-buffer)
 204       (org-babel-lilypond-compile-lilyfile org-babel-lilypond-temp-file)
 205       (goto-char (point-min))
 206       (if (org-babel-lilypond-check-for-compile-error org-babel-lilypond-temp-file)
 207           (error "Error in Compilation!")
 208         (other-window -1)
 209         (org-babel-lilypond-attempt-to-open-pdf org-babel-lilypond-temp-file)
 210         (org-babel-lilypond-attempt-to-play-midi org-babel-lilypond-temp-file)))))
 211
 212 (defun org-babel-lilypond-compile-lilyfile (file-name &optional test)
 213   "Compile lilypond file and check for compile errors
 214 FILE-NAME is full path to lilypond (.ly) file"
 215   (message "Compiling LilyPond...")
 216   (let ((arg-1 org-babel-lilypond-ly-command) ;program
 217         (arg-2 nil)                    ;infile
 218         (arg-3 "*lilypond*")           ;buffer
 219         (arg-4 t)                      ;display
 220         (arg-5 (if org-babel-lilypond-gen-png  "--png"  "")) ;&rest...
 221         (arg-6 (if org-babel-lilypond-gen-html "--html" ""))
 222         (arg-7 (if org-babel-lilypond-gen-pdf "--pdf" ""))
 223         (arg-8 (if org-babel-lilypond-use-eps  "-dbackend=eps" ""))
 224         (arg-9 (if org-babel-lilypond-gen-svg  "-dbackend=svg" ""))
 225         (arg-10 (concat "--output=" (file-name-sans-extension file-name)))
 226         (arg-11 file-name))
 227     (if test
 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       (call-process
 231        arg-1 arg-2 arg-3 arg-4 arg-5 arg-6
 232        arg-7 arg-8 arg-9 arg-10 arg-11))))
 233
 234 (defun org-babel-lilypond-check-for-compile-error (file-name &optional test)
 235   "Check for compile error.
 236 This is performed by parsing the *lilypond* buffer
 237 containing the output message from the compilation.
 238 FILE-NAME is full path to lilypond file.
 239 If TEST is t just return nil if no error found, and pass
 240 nil as file-name since it is unused in this context"
 241   (let ((is-error (search-forward "error:" nil t)))
 242     (if test
 243         is-error
 244       (when is-error
 245         (org-babel-lilypond-process-compile-error file-name)))))
 246
 247 (defun org-babel-lilypond-process-compile-error (file-name)
 248   "Process the compilation error that has occurred.
 249 FILE-NAME is full path to lilypond file"
 250   (let ((line-num (org-babel-lilypond-parse-line-num)))
 251     (let ((error-lines (org-babel-lilypond-parse-error-line file-name line-num)))
 252       (org-babel-lilypond-mark-error-line file-name error-lines)
 253       (error "Error: Compilation Failed!"))))
 254
 255 (defun org-babel-lilypond-mark-error-line (file-name line)
 256   "Mark the erroneous lines in the lilypond org buffer.
 257 FILE-NAME is full path to lilypond file.
 258 LINE is the erroneous line"
 259   (switch-to-buffer-other-window
 260    (concat (file-name-nondirectory
 261             (org-babel-lilypond-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           (outline-show-all)
 268           (set-mark (point))
 269           (goto-char (- (point) (length line))))
 270       (goto-char temp))))
 271
 272 (defun org-babel-lilypond-parse-line-num (&optional buffer)
 273   "Extract error line number."
 274   (when buffer (set-buffer buffer))
 275   (let ((start
 276          (and (search-backward ":" nil t)
 277               (search-backward ":" nil t)
 278               (search-backward ":" nil t)
 279               (search-backward ":" nil t))))
 280     (when start
 281       (forward-char)
 282       (let ((num (string-to-number
 283                   (buffer-substring
 284                    (+ 1 start)
 285                    (- (search-forward ":" nil t) 1)))))
 286         (and (numberp num) num)))))
 287
 288 (defun org-babel-lilypond-parse-error-line (file-name lineNo)
 289   "Extract the erroneous line from the tangled .ly file
 290 FILE-NAME is full path to lilypond file.
 291 LINENO is the number of the erroneous line"
 292   (with-temp-buffer
 293     (insert-file-contents (org-babel-lilypond-switch-extension file-name ".ly")
 294                           nil nil nil t)
 295     (if (> lineNo 0)
 296         (progn
 297           (goto-char (point-min))
 298           (forward-line (- lineNo 1))
 299           (buffer-substring (point) (point-at-eol)))
 300       nil)))
 301
 302 (defun org-babel-lilypond-attempt-to-open-pdf (file-name &optional test)
 303   "Attempt to display the generated pdf file
 304 FILE-NAME is full path to lilypond file
 305 If TEST is non-nil, the shell command is returned and is not run"
 306   (when org-babel-lilypond-display-pdf-post-tangle
 307     (let ((pdf-file (org-babel-lilypond-switch-extension file-name ".pdf")))
 308       (if (file-exists-p pdf-file)
 309           (let ((cmd-string
 310                  (concat org-babel-lilypond-pdf-command " " pdf-file)))
 311             (if test
 312                 cmd-string
 313               (start-process
 314                "\"Audition pdf\""
 315                "*lilypond*"
 316                org-babel-lilypond-pdf-command
 317                pdf-file)))
 318         (message  "No pdf file generated so can't display!")))))
 319
 320 (defun org-babel-lilypond-attempt-to-play-midi (file-name &optional test)
 321   "Attempt to play the generated MIDI file
 322 FILE-NAME is full path to lilypond file
 323 If TEST is non-nil, the shell command is returned and is not run"
 324   (when org-babel-lilypond-play-midi-post-tangle
 325     (let ((midi-file (org-babel-lilypond-switch-extension file-name ".midi")))
 326       (if (file-exists-p midi-file)
 327           (let ((cmd-string
 328                  (concat org-babel-lilypond-midi-command " " midi-file)))
 329             (if test
 330                 cmd-string
 331               (start-process
 332                "\"Audition midi\""
 333                "*lilypond*"
 334                org-babel-lilypond-midi-command
 335                midi-file)))
 336         (message "No midi file generated so can't play!")))))
 337
 338 (defun org-babel-lilypond-toggle-midi-play ()
 339   "Toggle whether midi will be played following a successful compilation."
 340   (interactive)
 341   (setq org-babel-lilypond-play-midi-post-tangle
 342         (not org-babel-lilypond-play-midi-post-tangle))
 343   (message (concat "Post-Tangle MIDI play has been "
 344                    (if org-babel-lilypond-play-midi-post-tangle
 345                        "ENABLED." "DISABLED."))))
 346
 347 (defun org-babel-lilypond-toggle-pdf-display ()
 348   "Toggle whether pdf will be displayed following a successful compilation."
 349   (interactive)
 350   (setq org-babel-lilypond-display-pdf-post-tangle
 351         (not org-babel-lilypond-display-pdf-post-tangle))
 352   (message (concat "Post-Tangle PDF display has been "
 353                    (if org-babel-lilypond-display-pdf-post-tangle
 354                        "ENABLED." "DISABLED."))))
 355
 356 (defun org-babel-lilypond-toggle-png-generation ()
 357   "Toggle whether png image will be generated by compilation."
 358   (interactive)
 359   (setq org-babel-lilypond-gen-png (not org-babel-lilypond-gen-png))
 360   (message (concat "PNG image generation has been "
 361                    (if org-babel-lilypond-gen-png "ENABLED." "DISABLED."))))
 362
 363 (defun org-babel-lilypond-toggle-html-generation ()
 364   "Toggle whether html will be generated by compilation."
 365   (interactive)
 366   (setq org-babel-lilypond-gen-html (not org-babel-lilypond-gen-html))
 367   (message (concat "HTML generation has been "
 368                    (if org-babel-lilypond-gen-html "ENABLED." "DISABLED."))))
 369
 370 (defun org-babel-lilypond-toggle-pdf-generation ()
 371   "Toggle whether pdf will be generated by compilation."
 372   (interactive)
 373   (setq org-babel-lilypond-gen-pdf (not org-babel-lilypond-gen-pdf))
 374   (message (concat "PDF generation has been "
 375                    (if org-babel-lilypond-gen-pdf "ENABLED." "DISABLED."))))
 376
 377 (defun org-babel-lilypond-toggle-arrange-mode ()
 378   "Toggle whether in Arrange mode or Basic mode."
 379   (interactive)
 380   (setq org-babel-lilypond-arrange-mode
 381         (not org-babel-lilypond-arrange-mode))
 382   (message (concat "Arrange mode has been "
 383                    (if org-babel-lilypond-arrange-mode "ENABLED." "DISABLED."))))
 384
 385 (defun org-babel-lilypond-switch-extension (file-name ext)
 386   "Utility command to swap current FILE-NAME extension with EXT"
 387   (concat (file-name-sans-extension
 388            file-name) ext))
 389
 390 (defun org-babel-lilypond-get-header-args (mode)
 391   "Default arguments to use when evaluating a lilypond
 392 source block.  These depend upon whether we are in arrange
 393 mode i.e.  ARRANGE-MODE is t"
 394   (cond (mode
 395          '((:tangle . "yes")
 396            (:noweb . "yes")
 397            (:results . "silent")
 398            (:cache . "yes")
 399            (:comments . "yes")))
 400         (t
 401          '((:results . "file")
 402            (:exports . "results")))))
 403
 404 (defun org-babel-lilypond-set-header-args (mode)
 405   "Set org-babel-default-header-args:lilypond
 406 dependent on ORG-BABEL-LILYPOND-ARRANGE-MODE"
 407   (setq org-babel-default-header-args:lilypond
 408         (org-babel-lilypond-get-header-args mode)))
 409
 410 (provide 'ob-lilypond)
 411
 412 ;;; ob-lilypond.el ends here