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