123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205 |
- (require 'org-babel)
- (require 'cl)
- (require 'slime)
- (require 'swank-clojure)
- (org-babel-add-interpreter "clojure")
- (add-to-list 'org-babel-tangle-langs '("clojure" "clj"))
- (defvar org-babel-clojure-wrapper-method
- "
- (defn spit
- [f content]
- (with-open [#^java.io.PrintWriter w
- (java.io.PrintWriter.
- (java.io.BufferedWriter.
- (java.io.OutputStreamWriter.
- (java.io.FileOutputStream.
- (java.io.File. f)))))]
- (.print w content)))
- (defn main
- []
- %s)
- (spit \"%s\" (str (main)))")
- (defun org-babel-clojure-clojure-slime-eval (string &optional handler)
- (slime-eval-async `(swank:eval-and-grab-output ,string)
- (or handler #'identity)))
- (defun org-babel-clojure-slime-eval-sync (string)
- (slime-eval `(swank:eval-and-grab-output ,string)))
- (defun org-babel-clojure-babel-clojure-cmd ()
- "Create the command to start clojure according to current settings."
- (if (and (not swank-clojure-binary) (not swank-clojure-jar-path))
- (error "You must specifiy either a `swank-clojure-binary' or a `swank-clojure-jar-path'")
- (if swank-clojure-binary
- (if (listp swank-clojure-binary)
- swank-clojure-binary
- (list swank-clojure-binary))
- (delete-if
- 'null
- (append
- (list swank-clojure-java-path)
- swank-clojure-extra-vm-args
- (list
- (when swank-clojure-library-paths
- (concat "-Djava.library.path="
- (swank-clojure-concat-paths swank-clojure-library-paths)))
- "-classpath"
- (swank-clojure-concat-paths
- (append (list swank-clojure-jar-path
- (concat swank-clojure-path "src/main/clojure/"))
- swank-clojure-extra-classpaths))
- "clojure.main"))))))
- (defun org-babel-clojure-table-or-string (results)
- "If the results look like a table, then convert them into an
- Emacs-lisp table, otherwise return the results as a string."
- (org-babel-read
- (if (string-match "^\\[.+\\]$" results)
- (org-babel-read
- (replace-regexp-in-string
- "\\[" "(" (replace-regexp-in-string
- "\\]" ")" (replace-regexp-in-string
- ", " " " (replace-regexp-in-string
- "'" "\"" results)))))
- results)))
- (defun org-babel-clojure-var-to-clojure (var)
- "Convert an elisp var into a string of clojure source code
- specifying a var of the same value."
- (if (listp var)
- (format "'%s" var)
- (format "%s" var)))
- (defun org-babel-clojure-build-full-form (body vars)
- "Construct a clojure let form with vars as the let vars"
- (let ((vars-forms (mapconcat
- (lambda (pair)
- (format "%s %s" (car pair) (org-babel-clojure-var-to-clojure (cdr pair))))
- vars "\n ")))
- (format "(let [%s]\n %s)" vars-forms (org-babel-trim body))))
- (defun org-babel-prep-session:clojure (session params)
- "Prepare SESSION according to the header arguments specified in PARAMS."
- (let* ((session-buf (org-babel-clojure-initiate-session session))
- (vars (org-babel-ref-variables params))
- (var-lines (mapcar
- (lambda (pair)
- (format "(defn %s %s)\n" (car pair) (org-babel-clojure-var-to-clojure (cdr pair))))
- vars)))
- session-buf))
- (defun org-babel-clojure-initiate-session (&optional session)
- "If there is not a current inferior-process-buffer in SESSION
- then create. Return the initialized session."
- (unless (string= session "none")
- (if (comint-check-proc "*inferior-lisp*")
- (get-buffer "*inferior-lisp*")
- (let ((session-buffer (save-window-excursion (slime 'clojure) (current-buffer))))
- (sit-for 5)
- (if (slime-connected-p)
- session-buffer
- (error "Couldn't create slime clojure *inferior lisp* process"))))))
- (defun org-babel-clojure-evaluate-external-process (buffer body &optional result-type)
- "Evaluate the body in an external process."
- (save-window-excursion
- (case result-type
- (output
- (with-temp-buffer
- (insert body)
- (shell-command-on-region
- (point-min) (point-max)
- (format "%s - " (mapconcat #'identity (org-babel-clojure-babel-clojure-cmd) " "))
- 'replace)
- (buffer-string)))
- (value
- (let ((tmp-src-file (make-temp-file "clojure_babel_input_"))
- (tmp-results-file (make-temp-file "clojure_babel_results_")))
- (with-temp-file tmp-src-file
- (insert (format org-babel-clojure-wrapper-method body tmp-results-file tmp-results-file)))
- (shell-command
- (format "%s %s" (mapconcat #'identity (org-babel-clojure-babel-clojure-cmd) " ")
- tmp-src-file))
- (org-babel-clojure-table-or-string
- (with-temp-buffer (insert-file-contents tmp-results-file) (buffer-string))))))))
- (defun org-babel-clojure-evaluate-session (buffer body &optional result-type)
- "Evaluate the body in the context of a clojure session"
- (let ((raw nil)
- (results nil))
- (setq raw (org-babel-clojure-slime-eval-sync body))
- (setq results (reverse (mapcar #'org-babel-trim raw)))
- (case result-type
- (output (mapconcat #'identity (reverse (cdr results)) "\n"))
- (value (org-babel-clojure-table-or-string (car results))))))
- (defun org-babel-clojure-evaluate (buffer body &optional result-type)
- "Pass BODY to the Clojure process in BUFFER. If RESULT-TYPE equals
- 'output then return a list of the outputs of the statements in
- BODY, if RESULT-TYPE equals 'value then return the value of the
- last statement in BODY, as elisp."
- (if session
- (org-babel-clojure-evaluate-session buffer body result-type)
- (org-babel-clojure-evaluate-external-process buffer body result-type)))
- (defun org-babel-execute:clojure (body params)
- "Execute a block of Clojure code with org-babel."
- (let* ((processed-params (org-babel-process-params params))
- (vars (second processed-params))
- (body (org-babel-clojure-build-full-form body vars))
- (session (org-babel-clojure-initiate-session (first processed-params))))
- (org-babel-clojure-evaluate session body (fourth processed-params))))
- (provide 'org-babel-clojure)
|