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