;;; ob-lilypond.el --- Babel Functions for Lilypond -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2024 Free Software Foundation, Inc. ;; Author: Martyn Jago ;; Keywords: babel language, literate programming ;; URL: https://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: ;; Installation, ob-lilypond documentation, and examples are available at ;; https://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html ;; ;; Lilypond documentation can be found at ;; https://lilypond.org/manuals.html ;; ;; This depends on epstopdf --- See https://www.ctan.org/pkg/epstopdf. ;;; Code: (require 'org-macs) (org-assert-version) (require 'ob) (declare-function org-fold-show-all "org-fold" (&optional types)) (add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly")) (add-to-list 'org-src-lang-modes '("lilypond" . "LilyPond")) (defvar org-babel-default-header-args:lilypond '() "Default header arguments for lilypond code blocks. NOTE: The arguments are determined at lilypond compile time. See `org-babel-lilypond-set-header-args' To configure, see `ob-lilypond-header-args' .") (defvar ob-lilypond-header-args '((:results . "file") (:exports . "results")) "User-configurable header arguments for lilypond code blocks. NOTE: The final value used by org-babel is computed at compile-time and stored in `org-babel-default-header-args:lilypond' See `org-babel-lilypond-set-header-args'.") (defvar org-babel-lilypond-compile-post-tangle t "When non-nil, compile tangled file after `org-babel-tangle'.") (defvar org-babel-lilypond-display-pdf-post-tangle t "When non-nil, display pdf after successful LilyPond compilation.") (defvar org-babel-lilypond-play-midi-post-tangle t "When non-nil, play midi file after successful LilyPond compilation.") (defvar org-babel-lilypond-ly-command "" "Command to execute lilypond on your system. Do not set it directly. Customize `org-babel-lilypond-commands' instead.") (defvar org-babel-lilypond-pdf-command "" "Command to show a PDF file on your system. Do not set it directly. Customize `org-babel-lilypond-commands' instead.") (defvar org-babel-lilypond-midi-command "" "Command to play a MIDI file on your system. Do not set it directly. Customize `org-babel-lilypond-commands' instead.") (defcustom org-babel-lilypond-commands (cond ((eq system-type 'darwin) '("/Applications/lilypond.app/Contents/Resources/bin/lilypond" "open" "open")) ((eq system-type 'windows-nt) '("lilypond" "" "")) (t '("lilypond" "xdg-open" "xdg-open"))) "Commands to run lilypond and view or play the results. These should be executables that take a filename as an argument. On some system it is possible to specify the filename directly and the viewer or player will be determined from the file type; you can leave the string empty on this case." :group 'org-babel :type '(list (string :tag "Lilypond ") (string :tag "PDF Viewer ") (string :tag "MIDI Player")) :version "24.4" :package-version '(Org . "8.2.7") :set (lambda (symbol value) (set-default-toplevel-value symbol value) (setq org-babel-lilypond-ly-command (nth 0 value) org-babel-lilypond-pdf-command (nth 1 value) org-babel-lilypond-midi-command (nth 2 value)))) (defvar org-babel-lilypond-gen-png nil "Non-nil means image generation (PNG) is turned on by default.") (defvar org-babel-lilypond-gen-svg nil "Non-nil means image generation (SVG) is be turned on by default.") (defvar org-babel-lilypond-gen-html nil "Non-nil means HTML generation is turned on by default.") (defvar org-babel-lilypond-gen-pdf nil "Non-nil means PDF generation is be turned on by default.") (defvar org-babel-lilypond-use-eps nil "Non-nil forces the compiler to use the EPS backend.") (defvar org-babel-lilypond-arrange-mode nil "Non-nil turns Arrange mode on. In Arrange mode the following settings are altered from default: :tangle yes, :noweb yes :results silent :comments yes. In addition lilypond block execution causes tangling of all lilypond blocks.") (defun org-babel-expand-body:lilypond (body params) "Expand BODY according to PARAMS, return the expanded body." (let ((vars (org-babel--get-vars params)) (prologue (cdr (assq :prologue params))) (epilogue (cdr (assq :epilogue params)))) (mapc (lambda (pair) (let ((name (symbol-name (car pair))) (value (cdr pair))) (setq body (replace-regexp-in-string (concat "$" (regexp-quote name)) (if (stringp value) value (format "%S" value)) body t t)))) vars) (concat (and prologue (concat prologue "\n")) body (and epilogue (concat "\n" epilogue "\n"))))) (defun org-babel-execute:lilypond (body params) "Execute LilyPond src block according to arrange mode. See `org-babel-execute-src-block' for BODY and PARAMS. When in arrange mode, tangle all blocks and process the result. Otherwise, execute block according to header settings." (org-babel-lilypond-set-header-args org-babel-lilypond-arrange-mode) (if org-babel-lilypond-arrange-mode (org-babel-lilypond-tangle) (org-babel-lilypond-process-basic body params))) (defun org-babel-lilypond-tangle () "Tangle lilypond blocks, then `org-babel-liypond-execute-tangled-ly'." (interactive) (if (org-babel-tangle nil "yes" "lilypond") (org-babel-lilypond-execute-tangled-ly) nil)) ;; https://lilypond.org/doc/v2.24/Documentation/usage/other-programs (defvar org-babel-lilypond-paper-settings "#(if (ly:get-option 'use-paper-size-for-page) (begin (ly:set-option 'use-paper-size-for-page #f) (ly:set-option 'tall-page-formats '%s))) \\paper { indent=0\\mm tagline=\"\" oddFooterMarkup=##f oddHeaderMarkup=##f bookTitleMarkup=##f scoreTitleMarkup=##f }\n" "The paper settings required to generate music fragments. They are needed for mixing music and text in basic-mode.") (defun org-babel-lilypond-process-basic (body params) "Execute a lilypond block in basic mode. See `org-babel-execute-src-block' for BODY and PARAMS." (let* ((out-file (cdr (assq :file params))) (file-type (file-name-extension out-file)) (cmdline (or (cdr (assq :cmdline params)) "")) (in-file (org-babel-temp-file "lilypond-"))) (with-temp-file in-file (insert (format org-babel-lilypond-paper-settings file-type) (org-babel-expand-body:generic body params))) (org-babel-eval (concat org-babel-lilypond-ly-command " -dbackend=eps " "-dno-gs-load-fonts " "-dinclude-eps-fonts " (or (assoc-default file-type '(("pdf" . "--pdf ") ("eps" . "--eps "))) "--png ") "--output=" (file-name-sans-extension out-file) " " cmdline in-file) "")) nil) (defun org-babel-prep-session:lilypond (_session _params) "Return an error because LilyPond exporter does not support sessions." (error "Sorry, LilyPond does not currently support sessions!")) (defun org-babel-lilypond-execute-tangled-ly () "Compile result of block tangle with lilypond. If error in compilation, attempt to mark the error in lilypond org file." (when org-babel-lilypond-compile-post-tangle (let ((org-babel-lilypond-tangled-file (org-babel-lilypond-switch-extension (buffer-file-name) ".lilypond")) (org-babel-lilypond-temp-file (org-babel-lilypond-switch-extension (buffer-file-name) ".ly"))) (if (not (file-exists-p org-babel-lilypond-tangled-file)) (error "Error: Tangle Failed!") (when (file-exists-p org-babel-lilypond-temp-file) (delete-file org-babel-lilypond-temp-file)) (rename-file org-babel-lilypond-tangled-file org-babel-lilypond-temp-file)) (switch-to-buffer-other-window "*lilypond*") (erase-buffer) (org-babel-lilypond-compile-lilyfile org-babel-lilypond-temp-file) (goto-char (point-min)) (if (org-babel-lilypond-check-for-compile-error org-babel-lilypond-temp-file) (error "Error in Compilation!") (other-window -1) (org-babel-lilypond-attempt-to-open-pdf org-babel-lilypond-temp-file) (org-babel-lilypond-attempt-to-play-midi org-babel-lilypond-temp-file))))) ;;Ignoring second arg for pre Org 9.7 compatibility (defun org-babel-lilypond-compile-lilyfile (filename &optional _) "Compile Lilypond FILENAME and check for compile errors." (message "Compiling %s..." filename) (let ((args (delq nil (list (and org-babel-lilypond-gen-png "--png") (and org-babel-lilypond-gen-html "--html") (and org-babel-lilypond-gen-pdf "--pdf") (and org-babel-lilypond-use-eps "-dbackend=eps") (and org-babel-lilypond-gen-svg "-dbackend=svg") (concat "--output=" (file-name-sans-extension filename)) filename)))) (apply #'call-process org-babel-lilypond-ly-command nil "*lilypond*" 'display args))) (defun org-babel-lilypond-check-for-compile-error (file-name &optional test) "Check for compile error. This is performed by parsing the *lilypond* buffer containing the output message from the compilation. FILE-NAME is full path to lilypond file. If TEST is t just return nil if no error found, and pass nil as file-name since it is unused in this context." (let ((is-error (search-forward "error:" nil t))) (if test is-error (when is-error (org-babel-lilypond-process-compile-error file-name))))) (defun org-babel-lilypond-process-compile-error (file-name) "Process the compilation error that has occurred. FILE-NAME is full path to lilypond file." (let ((line-num (org-babel-lilypond-parse-line-num))) (let ((error-lines (org-babel-lilypond-parse-error-line file-name line-num))) (org-babel-lilypond-mark-error-line file-name error-lines) (error "Error: Compilation Failed!")))) (defun org-babel-lilypond-mark-error-line (file-name line) "Mark the erroneous lines in the lilypond org buffer. FILE-NAME is full path to lilypond file. LINE is the erroneous line." (switch-to-buffer-other-window (concat (file-name-nondirectory (org-babel-lilypond-switch-extension file-name ".org")))) (let ((temp (point))) (goto-char (point-min)) (setq case-fold-search nil) (if (search-forward line nil t) (progn (org-fold-show-all) (set-mark (point)) (goto-char (- (point) (length line)))) (goto-char temp)))) (defun org-babel-lilypond-parse-line-num (&optional buffer) "Extract error line number in BUFFER or `current-buffer'." (when buffer (set-buffer buffer)) (let ((start (and (search-backward ":" nil t) (search-backward ":" nil t) (search-backward ":" nil t) (search-backward ":" nil t)))) (when start (forward-char) (let ((num (string-to-number (buffer-substring (+ 1 start) (- (search-forward ":" nil t) 1))))) (and (numberp num) num))))) (defun org-babel-lilypond-parse-error-line (file-name lineNo) "Extract the erroneous line from the tangled .ly file. FILE-NAME is full path to lilypond file. LINENO is the number of the erroneous line." (with-temp-buffer (insert-file-contents (org-babel-lilypond-switch-extension file-name ".ly") nil nil nil t) (if (> lineNo 0) (progn (goto-char (point-min)) (forward-line (- lineNo 1)) (buffer-substring (point) (line-end-position))) nil))) (defun org-babel-lilypond-attempt-to-open-pdf (file-name &optional test) "Attempt to display the generated pdf file. FILE-NAME is full path to lilypond file. If TEST is non-nil, the shell command is returned and is not run." (when org-babel-lilypond-display-pdf-post-tangle (let ((pdf-file (org-babel-lilypond-switch-extension file-name ".pdf"))) (if (file-exists-p pdf-file) (let ((cmd-string (concat org-babel-lilypond-pdf-command " " pdf-file))) (if test cmd-string (start-process "\"Audition pdf\"" "*lilypond*" org-babel-lilypond-pdf-command pdf-file))) (message "No pdf file generated so can't display!"))))) (defun org-babel-lilypond-attempt-to-play-midi (file-name &optional test) "Attempt to play the generated MIDI file. FILE-NAME is full path to lilypond file. If TEST is non-nil, the shell command is returned and is not run." (when org-babel-lilypond-play-midi-post-tangle (let* ((ext (if (eq system-type 'windows-nt) ".mid" ".midi")) (midi-file (org-babel-lilypond-switch-extension file-name ext))) (if (file-exists-p midi-file) (let ((cmd-string (concat org-babel-lilypond-midi-command " " midi-file))) (if test cmd-string (start-process "\"Audition midi\"" "*lilypond*" org-babel-lilypond-midi-command midi-file))) (message "No midi file generated so can't play!"))))) (defun org-babel-lilypond-toggle-midi-play () "Toggle whether midi will be played following a successful compilation." (interactive) (setq org-babel-lilypond-play-midi-post-tangle (not org-babel-lilypond-play-midi-post-tangle)) (message (concat "Post-Tangle MIDI play has been " (if org-babel-lilypond-play-midi-post-tangle "ENABLED." "DISABLED.")))) (defun org-babel-lilypond-toggle-pdf-display () "Toggle whether pdf will be displayed following a successful compilation." (interactive) (setq org-babel-lilypond-display-pdf-post-tangle (not org-babel-lilypond-display-pdf-post-tangle)) (message (concat "Post-Tangle PDF display has been " (if org-babel-lilypond-display-pdf-post-tangle "ENABLED." "DISABLED.")))) (defun org-babel-lilypond-toggle-png-generation () "Toggle whether png image will be generated by compilation." (interactive) (setq org-babel-lilypond-gen-png (not org-babel-lilypond-gen-png)) (message (concat "PNG image generation has been " (if org-babel-lilypond-gen-png "ENABLED." "DISABLED.")))) (defun org-babel-lilypond-toggle-html-generation () "Toggle whether html will be generated by compilation." (interactive) (setq org-babel-lilypond-gen-html (not org-babel-lilypond-gen-html)) (message (concat "HTML generation has been " (if org-babel-lilypond-gen-html "ENABLED." "DISABLED.")))) (defun org-babel-lilypond-toggle-pdf-generation () "Toggle whether pdf will be generated by compilation." (interactive) (setq org-babel-lilypond-gen-pdf (not org-babel-lilypond-gen-pdf)) (message (concat "PDF generation has been " (if org-babel-lilypond-gen-pdf "ENABLED." "DISABLED.")))) (defun org-babel-lilypond-toggle-arrange-mode () "Toggle whether in Arrange mode or Basic mode." (interactive) (setq org-babel-lilypond-arrange-mode (not org-babel-lilypond-arrange-mode)) (message (concat "Arrange mode has been " (if org-babel-lilypond-arrange-mode "ENABLED." "DISABLED.")))) (defun org-babel-lilypond-switch-extension (file-name ext) "Utility command to swap current FILE-NAME extension with EXT." (concat (file-name-sans-extension file-name) ext)) (defun org-babel-lilypond-get-header-args (mode) "Default arguments to use when evaluating a lilypond source block. These depend upon whether we are in Arrange mode i.e. MODE is t." (cond (mode '((:tangle . "yes") (:noweb . "yes") (:results . "silent") (:cache . "yes") (:comments . "yes"))) (t ob-lilypond-header-args))) (defun org-babel-lilypond-set-header-args (mode) "Set lilypond babel header according to MODE." (setq org-babel-default-header-args:lilypond (org-babel-lilypond-get-header-args mode))) (provide 'ob-lilypond) ;;; ob-lilypond.el ends here