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