| commit | author | age | ||
| 76bbd0 | 1 | ;;; ob-lilypond.el --- Babel Functions for Lilypond -*- lexical-binding: t; -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2010-2018 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 | (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.4" | |
| 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 | |
