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