lang/plantuml: fix org-babel+plantuml executor

This commit is contained in:
Henrik Lissner 2019-10-23 03:24:34 -04:00
parent d6cbe5dc8b
commit a3765aca32
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395

View file

@ -5,25 +5,26 @@
"Execute a block of plantuml code with org-babel. "Execute a block of plantuml code with org-babel.
This function is called by `org-babel-execute-src-block'." This function is called by `org-babel-execute-src-block'."
(require 'plantuml-mode) (require 'plantuml-mode)
;; REVIEW Refactor me
(let* ((body (replace-regexp-in-string (let* ((body (replace-regexp-in-string
"^[[:blank:]\n]*\\(@start\\)" "^[[:blank:]\n]*\\(@start\\)"
"\\\\\\1" "\\\\\\1"
body)) body))
(out-file (or (cdr (assoc :file params)) (fullbody (org-babel-plantuml-make-body body params))
(concat doom-cache-dir (out-file (or (cdr (assq :file params))
"ob-plantuml/" (org-babel-temp-file "plantuml-" ".png")))
(md5 str nil nil nil t)
".png")))
(in-file (org-babel-temp-file "plantuml-"))) (in-file (org-babel-temp-file "plantuml-")))
(if (eq plantuml-default-exec-mode 'server) (if (eq plantuml-default-exec-mode 'server)
(let* ((url-request-location )) (save-current-buffer
(with-current-buffer (save-match-data
(url-retrieve-synchronously (plantuml-server-encode-url body)) (with-current-buffer
(goto-char (point-min)) (url-retrieve-synchronously (plantuml-server-encode-url body)
;; skip the HTTP headers nil t)
(while (not (looking-at "\n")) (forward-line)) (goto-char (point-min))
(kill-region (point-min) (+ 1 (point))) ;; skip the HTTP headers
(write-file (org-babel-process-file-name out-file)))) (while (not (looking-at "\n")) (forward-line))
(delete-region (point-min) (+ 1 (point)))
(write-file out-file))))
(let* ((cmd (concat (cond ((eq plantuml-default-exec-mode 'executable) (let* ((cmd (concat (cond ((eq plantuml-default-exec-mode 'executable)
(unless (executable-find plantuml-executable-path) (unless (executable-find plantuml-executable-path)
(error "Could not find plantuml at %s" (error "Could not find plantuml at %s"
@ -32,18 +33,28 @@ This function is called by `org-babel-execute-src-block'."
" --headless ")) " --headless "))
((not (file-exists-p org-plantuml-jar-path)) ((not (file-exists-p org-plantuml-jar-path))
(error "Could not find plantuml.jar at %s" org-plantuml-jar-path)) (error "Could not find plantuml.jar at %s" org-plantuml-jar-path))
((concat "java " (or (cdr (assoc :java params)) "") " -jar " ((concat "java " (cdr (assoc :java params)) " -jar "
(shell-quote-argument (expand-file-name plantuml-executable-path))))) (shell-quote-argument
(concat (if (string= (file-name-extension out-file) "svg") (expand-file-name plantuml-executable-path)))))
" -tsvg" "") (pcase (file-name-extension out-file)
(if (string= (file-name-extension out-file) "eps") ("png" "-tpng")
" -teps" "") ("svg" "-tsvg")
" -p " (cdr (assoc :cmdline params)) " < " ("eps" "-teps")
(org-babel-process-file-name in-file) ("pdf" "-tpdf")
" > " ("tex" "-tlatex")
(org-babel-process-file-name out-file))))) ("vdx" "-tvdx")
(with-temp-file in-file ("xmi" "-txmi")
(insert (concat "@startuml\n" body "\n@enduml"))) ("scxml" "-tscxml")
("html" "-thtml")
("txt" "-ttxt")
("utxt" "-utxt"))
" "
" -p " (cdr (assoc :cmdline params)) " < "
(org-babel-process-file-name in-file)
" > "
(org-babel-process-file-name out-file))))
(with-temp-file in-file (insert fullbody))
(message "%s" cmd) (message "%s" cmd)
(org-babel-eval cmd "") (org-babel-eval cmd "")))
nil)))) ;; signal that output has already been written to file (unless (cdr (assq :file params))
out-file)))