ob-lilypond.el 17 KB

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