ob-lilypond.el 17 KB

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