ob-clojure.el: Enhancements and refactoring, removed session code

* lisp/ob-clojure.el (ob-clojure-inf-clojure-output): Filter
out spurious strings.
(ob-clojure-with-temp-expanded): New macro.
(ob-clojure-string-or-list, ob-clojure-eval-with-inf-clojure)
(ob-clojure-eval-with-cider, ob-clojure-eval-with-slime): New
functions.
(org-babel-execute:clojure): Use new functions.
(org-babel-execute:clojurescript): Fix docstring.
(org-babel-edit-prep:clojure)
(org-babel-clojure-initiate-session)
(org-babel-prep-session:clojure)
(org-babel-clojure-var-to-clojure)
(org-babel-variable-assignments:clojure): Delete function.

1 files changed, 114 insertions, 152 deletions

diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el
index 2e6e1d3..5f387b7 100644
--- a/lisp/ob-clojure.el
+++ b/lisp/ob-clojure.el
@@ -41,36 +41,27 @@
 ;; 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))
-(declare-function inf-clojure "ext:inf-clojure" (cmd))
-(declare-function inf-clojure-eval-string "ext:inf-clojure" (code))
 
-(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)))
 
@@ -83,15 +74,6 @@
 	  (const :tag "slime" slime)
 	  (const :tag "Not configured yet" nil)))
 
-(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-default-ns "user"
   "Default Clojure namespace for source block when finding ns failed."
   :type 'string
@@ -135,154 +117,134 @@ If the value is nil, timeout is disabled."
 (defvar ob-clojure-inf-clojure-tmp-output nil)
 (defun ob-clojure-inf-clojure-output (s)
   "Store a trimmed version of S in a variable and return S."
-  (sit-for .1) ; necessary to get the output ordered
-  (let ((s0 (org-trim s)))
+  (let ((s0 (org-trim
+	     (replace-regexp-in-string
+	      "^nil\\|nil$" ""
+	      (replace-regexp-in-string
+	       "\\s-*user=>\\s-*" "" 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 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)))
+	(funcall-interactively #'inf-clojure cmd)
+	(goto-char (point-max))))
+    (sit-for 2))
+  ;; Now evaluate the code
+  (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."
   (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-params (cdr (assq :result-params params)))
 	 result)
-    (cond
-     ((eq org-babel-clojure-backend 'inf-clojure)
-      (condition-case nil (require 'inf-clojure)
-	(user-error "inf-clojure not available"))
-      (add-hook 'comint-preoutput-filter-functions
-		#'ob-clojure-inf-clojure-output)
-      (setq ob-clojure-inf-clojure-tmp-output nil)
-      (unless (and inf-clojure-buffer
-		   (buffer-live-p (get-buffer inf-clojure-buffer)))
-	(setq comint-prompt-regexp inf-clojure-comint-prompt-regexp)
-	(save-window-excursion (call-interactively #'inf-clojure))
-	(sit-for 5)
-	(setq ob-clojure-inf-clojure-tmp-output nil))
-      (inf-clojure-eval-string expanded)
-      (sit-for .3)
-      (remove-hook 'comint-preoutput-filter-functions
-		   #'ob-clojure-inf-clojure-output)
-      (setq result
-	    (mapconcat
-	     (lambda (s)
-	       ;; FIXME: don't hardcode "user=>" below
-	       (unless (or (string-match-p "user=>" s)) s))
-	     (delete "" ob-clojure-inf-clojure-tmp-output)
-	     "\n")))
-     ((eq org-babel-clojure-backend 'cider)
-      (condition-case nil (require 'cider)
-	(user-error "cider not available"))
-      (let ((connection (cider-current-connection (cdr (assq :target params)))))
-	(unless connection
-	  (message "Starting cider default session")
-	  (org-babel-clojure-initiate-session "default"))
-	(setq response
-	      (let ((nrepl-sync-request-timeout
-		     org-babel-clojure-sync-nrepl-timeout))
-		(nrepl-sync-request:eval expanded 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")))))
-     ((eq org-babel-clojure-backend '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)))))))
+    (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-execute:clojurescript (body params)
-  "Execute a block of ClojureScript code with Babel."
+  "Evaluate BODY with PARAMS as ClojureScript code."
   (org-babel-execute:clojure body (cons '(:target . "cljs") params)))
 
-(defun org-babel-edit-prep:clojure (babel-info)
-  "Set `org-edit-special' src block by injecting `cider-buffer-ns' as namespace."
-  (let ((namespace (cdr (assq :ns (nth 2 babel-info)))))
-    (when (and (eq org-babel-clojure-backend 'cider) namespace)
-      (setq-local cider-buffer-ns namespace))))
-
-(defun org-babel-clojure-initiate-session (session &optional _params)
-  "Initiate a session named SESSION according to PARAMS."
-  (when (not (string= session "none"))
-    (save-window-excursion
-      (cond
-       ;; Session is already initiated
-       ((org-babel-comint-buffer-livep session) nil)
-       ;; Initiate a session with CIDER jack-in
-       ((eq org-babel-clojure-backend 'cider)
-	(condition-case nil (require 'cider)
-	  (user-error "cider not available"))
-	(let ((session-buffer
-	       (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 .3)
-	    session-buffer)))
-       ((eq org-babel-clojure-backend 'inf-clojure)
-	(user-error "Session evaluation with inf-clojure is not supported"))
-       ((eq org-babel-clojure-backend 'slime)
-        (user-error "Session evaluation with SLIME is not supported"))
-       (t (user-error "Session initiate failed"))))))
-
-(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)))
-
 (provide 'ob-clojure)
 
 ;;; ob-clojure.el ends here