lisp/ob-lilypond.el

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