diff options
Diffstat (limited to 'lisp/org/ob-clojure.el')
| -rw-r--r-- | lisp/org/ob-clojure.el | 340 |
1 files changed, 155 insertions, 185 deletions
diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el index 0d6d1c0a84a..299a326e429 100644 --- a/lisp/org/ob-clojure.el +++ b/lisp/org/ob-clojure.el @@ -30,80 +30,70 @@ ;; - clojure (at least 1.2.0) ;; - clojure-mode -;; - either cider or SLIME +;; - inf-clojure, cider or SLIME -;; For Cider, see https://github.com/clojure-emacs/cider +;; For clojure-mode, see https://github.com/clojure-emacs/clojure-mode +;; For cider, see https://github.com/clojure-emacs/cider +;; For inf-clojure, see https://github.com/clojure-emacs/cider ;; For SLIME, the best way to install these components is by following ;; the directions as set out by Phil Hagelberg (Technomancy) on the ;; web page: http://technomancy.us/126 ;;; Code: -(require 'cl-lib) (require 'ob) -(require 'org-macs) -(declare-function cider-jack-in "ext:cider" (&optional prompt-project cljs-too)) (declare-function cider-current-connection "ext:cider-client" (&optional type)) (declare-function cider-current-ns "ext:cider-client" ()) -(declare-function cider-repls "ext:cider-connection" (&optional type ensure)) -(declare-function nrepl--merge "ext:nrepl-client" (dict1 dict2)) +(declare-function inf-clojure "ext:inf-clojure" (cmd)) +(declare-function inf-clojure-cmd "ext:inf-clojure" (project-type)) +(declare-function inf-clojure-eval-string "ext:inf-clojure" (code)) +(declare-function inf-clojure-project-type "ext:inf-clojure" ()) (declare-function nrepl-dict-get "ext:nrepl-client" (dict key)) -(declare-function nrepl-dict-put "ext:nrepl-client" (dict key value)) -(declare-function nrepl-request:eval "ext:nrepl-client" (input callback connection &optional ns line column additional-params tooling)) (declare-function nrepl-sync-request:eval "ext:nrepl-client" (input connection &optional ns tooling)) +(declare-function sesman-start-session "ext:sesman" (system)) (declare-function slime-eval "ext:slime" (sexp &optional package)) -(defvar nrepl-sync-request-timeout) (defvar cider-buffer-ns) -(defvar sesman-system) -(defvar cider-version) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) +(add-to-list 'org-babel-tangle-lang-exts '("clojurescript" . "cljs")) (defvar org-babel-default-header-args:clojure '()) -(defvar org-babel-header-args:clojure '((ns . :any) - (package . :any))) +(defvar org-babel-header-args:clojure '((ns . :any) (package . :any))) +(defvar org-babel-default-header-args:clojurescript '()) +(defvar org-babel-header-args:clojurescript '((package . :any))) -(defcustom org-babel-clojure-sync-nrepl-timeout 10 - "Timeout value, in seconds, of a Clojure sync call. -If the value is nil, timeout is disabled." - :group 'org-babel - :type 'integer - :version "26.1" - :package-version '(Org . "9.1") - :safe #'wholenump) - -(defcustom org-babel-clojure-backend - (cond ((featurep 'cider) 'cider) - (t 'slime)) +(defcustom org-babel-clojure-backend nil "Backend used to evaluate Clojure code blocks." :group 'org-babel :type '(choice + (const :tag "inf-clojure" inf-clojure) (const :tag "cider" cider) - (const :tag "SLIME" slime))) + (const :tag "slime" slime) + (const :tag "Not configured yet" nil))) (defcustom org-babel-clojure-default-ns "user" "Default Clojure namespace for source block when finding ns failed." :type 'string :group 'org-babel) -(defun org-babel-clojure-cider-current-ns () - "Like `cider-current-ns' except `cider-find-ns'." - (or cider-buffer-ns - (let ((repl-buf (cider-current-connection))) - (and repl-buf (buffer-local-value 'cider-buffer-ns repl-buf))) - org-babel-clojure-default-ns)) - (defun org-babel-expand-body:clojure (body params) "Expand BODY according to PARAMS, return the expanded body." (let* ((vars (org-babel--get-vars params)) (ns (or (cdr (assq :ns params)) - (org-babel-clojure-cider-current-ns))) + (if (eq org-babel-clojure-backend 'cider) + (or cider-buffer-ns + (let ((repl-buf (cider-current-connection))) + (and repl-buf (buffer-local-value + 'cider-buffer-ns repl-buf)))) + org-babel-clojure-default-ns))) (result-params (cdr (assq :result-params params))) (print-level nil) (print-length nil) + ;; Remove comments, they break (let [...] ...) bindings + (body (replace-regexp-in-string "^[ ]*;+.*$" "" body)) (body (org-trim (concat ;; Source block specified namespace :ns. @@ -113,7 +103,7 @@ If the value is nil, timeout is disabled." (format "(let [%s]\n%s)" (mapconcat (lambda (var) - (format "%S (quote %S)" (car var) (cdr var))) + (format "%S %S" (car var) (cdr var))) vars "\n ") body)))))) @@ -122,161 +112,141 @@ If the value is nil, timeout is disabled." (format "(clojure.pprint/pprint (do %s))" body) body))) +(defvar ob-clojure-inf-clojure-filter-out) +(defvar ob-clojure-inf-clojure-tmp-output) +(defun ob-clojure-inf-clojure-output (s) + "Store a trimmed version of S in a variable and return S." + (let ((s0 (org-trim + (replace-regexp-in-string + ob-clojure-inf-clojure-filter-out "" s)))) + (push s0 ob-clojure-inf-clojure-tmp-output)) + s) + +(defmacro ob-clojure-with-temp-expanded (expanded params &rest body) + "Run BODY on EXPANDED code block with PARAMS." + (declare (debug (body)) (indent 2)) + `(with-temp-buffer + (insert ,expanded) + (goto-char (point-min)) + (while (not (looking-at "\\s-*\\'")) + (let* ((beg (point)) + (end (progn (forward-sexp) (point))) + (exp (org-babel-expand-body:clojure + (buffer-substring beg end) ,params))) + (sit-for .1) + ,@body)))) + +(defsubst ob-clojure-string-or-list (l) + "Convert list L into a string or a list of list." + (if (and (listp l) (= (length l) 1)) + (car l) + (mapcar #'list l))) + +(defvar inf-clojure-buffer) +(defvar comint-prompt-regexp) +(defvar inf-clojure-comint-prompt-regexp) +(defun ob-clojure-eval-with-inf-clojure (expanded params) + "Evaluate EXPANDED code block with PARAMS using inf-clojure." + (condition-case nil (require 'inf-clojure) + (user-error "inf-clojure not available")) + ;; Maybe initiate the inf-clojure session + (unless (and inf-clojure-buffer + (buffer-live-p (get-buffer inf-clojure-buffer))) + (save-window-excursion + (let* ((alias (cdr (assq :alias params))) + (cmd0 (inf-clojure-cmd (inf-clojure-project-type))) + (cmd (if alias (replace-regexp-in-string + "clojure" (format "clojure -A%s" alias) + cmd0) + cmd0))) + (setq comint-prompt-regexp inf-clojure-comint-prompt-regexp) + (funcall-interactively #'inf-clojure cmd) + (goto-char (point-max)))) + (sit-for 1)) + ;; Now evaluate the code + (setq ob-clojure-inf-clojure-filter-out + (concat "^nil\\|nil$\\|\\s-*" + (or (cdr (assq :ns params)) + org-babel-clojure-default-ns) + "=>\\s-*")) + (add-hook 'comint-preoutput-filter-functions + #'ob-clojure-inf-clojure-output) + (setq ob-clojure-inf-clojure-tmp-output nil) + (ob-clojure-with-temp-expanded expanded nil + (inf-clojure-eval-string exp)) + (sit-for .5) + (remove-hook 'comint-preoutput-filter-functions + #'ob-clojure-inf-clojure-output) + ;; And return the result + (ob-clojure-string-or-list + (delete nil + (mapcar + (lambda (s) + (unless (or (equal "" s) + (string-match-p "^Clojure" s)) + s)) + (reverse ob-clojure-inf-clojure-tmp-output))))) + +(defun ob-clojure-eval-with-cider (expanded params) + "Evaluate EXPANDED code block with PARAMS using cider." + (condition-case nil (require 'cider) + (user-error "cider not available")) + (let ((connection (cider-current-connection (cdr (assq :target params)))) + (result-params (cdr (assq :result-params params))) + result0) + (unless connection (sesman-start-session 'CIDER)) + (if (not connection) + ;; Display in the result instead of using `user-error' + (setq result0 "Please reevaluate when nREPL is connected") + (ob-clojure-with-temp-expanded expanded params + (let ((response (nrepl-sync-request:eval exp connection))) + (push (or (nrepl-dict-get response "root-ex") + (nrepl-dict-get response "ex") + (nrepl-dict-get + response (if (or (member "output" result-params) + (member "pp" result-params)) + "out" + "value"))) + result0))) + (ob-clojure-string-or-list + (reverse (delete "" (mapcar (lambda (r) + (replace-regexp-in-string "nil" "" r)) + result0))))))) + +(defun ob-clojure-eval-with-slime (expanded params) + "Evaluate EXPANDED code block with PARAMS using slime." + (condition-case nil (require 'slime) + (user-error "slime not available")) + (with-temp-buffer + (insert expanded) + (slime-eval + `(swank:eval-and-grab-output + ,(buffer-substring-no-properties (point-min) (point-max))) + (cdr (assq :package params))))) + (defun org-babel-execute:clojure (body params) - "Execute a block of Clojure code with Babel. -The underlying process performed by the code block can be output -using the :show-process parameter." + "Execute a block of Clojure code with Babel." + (unless org-babel-clojure-backend + (user-error "You need to customize org-babel-clojure-backend")) (let* ((expanded (org-babel-expand-body:clojure body params)) - (response (list 'dict)) - result) - (cl-case org-babel-clojure-backend - (cider - (require 'cider) - (let ((result-params (cdr (assq :result-params params))) - (show (cdr (assq :show-process params)))) - (if (member show '(nil "no")) - ;; Run code without showing the process. - (progn - (setq response - (let ((nrepl-sync-request-timeout - org-babel-clojure-sync-nrepl-timeout)) - (nrepl-sync-request:eval expanded - (cider-current-connection)))) - (setq result - (concat - (nrepl-dict-get response - (if (or (member "output" result-params) - (member "pp" result-params)) - "out" - "value")) - (nrepl-dict-get response "ex") - (nrepl-dict-get response "root-ex") - (nrepl-dict-get response "err")))) - ;; Show the process in an output buffer/window. - (let ((process-buffer (switch-to-buffer-other-window - "*Clojure Show Process Sub Buffer*")) - status) - ;; Run the Clojure code in nREPL. - (nrepl-request:eval - expanded - (lambda (resp) - (when (member "out" resp) - ;; Print the output of the nREPL in the output buffer. - (princ (nrepl-dict-get resp "out") process-buffer)) - (when (member "ex" resp) - ;; In case there is an exception, then add it to the - ;; output buffer as well. - (princ (nrepl-dict-get resp "ex") process-buffer) - (princ (nrepl-dict-get resp "root-ex") process-buffer)) - (when (member "err" resp) - ;; In case there is an error, then add it to the - ;; output buffer as well. - (princ (nrepl-dict-get resp "err") process-buffer)) - (nrepl--merge response resp) - ;; Update the status of the nREPL output session. - (setq status (nrepl-dict-get response "status"))) - (cider-current-connection)) - - ;; Wait until the nREPL code finished to be processed. - (while (not (member "done" status)) - (nrepl-dict-put response "status" (remove "need-input" status)) - (accept-process-output nil 0.01) - (redisplay)) - - ;; Delete the show buffer & window when the processing is - ;; finalized. - (mapc #'delete-window - (get-buffer-window-list process-buffer nil t)) - (kill-buffer process-buffer) - - ;; Put the output or the value in the result section of - ;; the code block. - (setq result - (concat - (nrepl-dict-get response - (if (or (member "output" result-params) - (member "pp" result-params)) - "out" - "value")) - (nrepl-dict-get response "ex") - (nrepl-dict-get response "root-ex") - (nrepl-dict-get response "err"))))))) - (slime - (require 'slime) - (with-temp-buffer - (insert expanded) - (setq result - (slime-eval - `(swank:eval-and-grab-output - ,(buffer-substring-no-properties (point-min) (point-max))) - (cdr (assq :package params))))))) - (org-babel-result-cond (cdr (assq :result-params params)) + (result-params (cdr (assq :result-params params))) + result) + (setq result + (cond + ((eq org-babel-clojure-backend 'inf-clojure) + (ob-clojure-eval-with-inf-clojure expanded params)) + ((eq org-babel-clojure-backend 'cider) + (ob-clojure-eval-with-cider expanded params)) + ((eq org-babel-clojure-backend 'slime) + (ob-clojure-eval-with-slime expanded params)))) + (org-babel-result-cond result-params result (condition-case nil (org-babel-script-escape result) (error result))))) -(defun org-babel-clojure-initiate-session (&optional session _params) - "Initiate a session named SESSION according to PARAMS." - (when (and session (not (string= session "none"))) - (save-window-excursion - (cond - ((org-babel-comint-buffer-livep session) nil) - ;; CIDER jack-in to the Clojure project directory. - ((eq org-babel-clojure-backend 'cider) - (require 'cider) - (let ((session-buffer - (save-window-excursion - (if (version< cider-version "0.18.0") - ;; Older CIDER (without sesman) still need to use - ;; old way. - (cider-jack-in nil) ;jack-in without project - ;; New CIDER (with sesman to manage sessions). - (unless (cider-repls) - (let ((sesman-system 'CIDER)) - (call-interactively 'sesman-link-with-directory)))) - (current-buffer)))) - (when (org-babel-comint-buffer-livep session-buffer) - (sit-for .25) - session-buffer))) - ((eq org-babel-clojure-backend 'slime) - (error "Session evaluation with SLIME is not supported")) - (t - (error "Session initiate failed"))) - (get-buffer session)))) - -(defun org-babel-prep-session:clojure (session params) - "Prepare SESSION according to the header arguments specified in PARAMS." - (let ((session (org-babel-clojure-initiate-session session)) - (var-lines (org-babel-variable-assignments:clojure params))) - (when session - (org-babel-comint-in-buffer session - (dolist (var var-lines) - (insert var) - (comint-send-input nil t) - (org-babel-comint-wait-for-output session) - (sit-for .1) - (goto-char (point-max))))) - session)) - -(defun org-babel-clojure-var-to-clojure (var) - "Convert src block's VAR to Clojure variable." - (cond - ((listp var) - (replace-regexp-in-string "(" "'(" var)) - ((stringp var) - ;; Wrap Babel passed-in header argument value with quotes in Clojure. - (format "\"%s\"" var)) - (t - (format "%S" var)))) - -(defun org-babel-variable-assignments:clojure (params) - "Return a list of Clojure statements assigning the block's variables in PARAMS." - (mapcar - (lambda (pair) - (format "(def %s %s)" - (car pair) - (org-babel-clojure-var-to-clojure (cdr pair)))) - (org-babel--get-vars params))) +(defun org-babel-execute:clojurescript (body params) + "Evaluate BODY with PARAMS as ClojureScript code." + (org-babel-execute:clojure body (cons '(:target . "cljs") params))) (provide 'ob-clojure) |