ob-clojure.el (11745B)
1 ;;; ob-clojure.el --- Babel Functions for Clojure -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2009-2023 Free Software Foundation, Inc. 4 5 ;; Author: Joel Boehland, Eric Schulte, Oleh Krehel, Frederick Giasson 6 ;; Maintainer: Daniel Kraus <daniel@kraus.my> 7 ;; 8 ;; Keywords: literate programming, reproducible research 9 ;; URL: https://orgmode.org 10 11 ;; This file is part of GNU Emacs. 12 13 ;; GNU Emacs is free software: you can redistribute it and/or modify 14 ;; it under the terms of the GNU General Public License as published by 15 ;; the Free Software Foundation, either version 3 of the License, or 16 ;; (at your option) any later version. 17 18 ;; GNU Emacs is distributed in the hope that it will be useful, 19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 ;; GNU General Public License for more details. 22 23 ;; You should have received a copy of the GNU General Public License 24 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 25 26 ;;; Commentary: 27 28 ;; Support for evaluating Clojure code 29 30 ;; Requirements: 31 32 ;; - Clojure (at least 1.2.0) 33 ;; - clojure-mode 34 ;; - inf-clojure, Cider, SLIME, babashka or nbb 35 36 ;; For clojure-mode, see https://github.com/clojure-emacs/clojure-mode 37 ;; For inf-clojure, see https://github.com/clojure-emacs/inf-clojure 38 ;; For Cider, see https://github.com/clojure-emacs/cider 39 ;; For SLIME, see https://slime.common-lisp.dev 40 ;; For babashka, see https://github.com/babashka/babashka 41 ;; For nbb, see https://github.com/babashka/nbb 42 43 ;; For SLIME, the best way to install its components is by following 44 ;; the directions as set out by Phil Hagelberg (Technomancy) on the 45 ;; web page: https://technomancy.us/126 46 47 ;;; Code: 48 49 (require 'org-macs) 50 (org-assert-version) 51 52 (require 'ob) 53 54 (declare-function cider-current-connection "ext:cider-client" (&optional type)) 55 (declare-function cider-current-ns "ext:cider-client" ()) 56 (declare-function inf-clojure "ext:inf-clojure" (cmd)) 57 (declare-function inf-clojure-cmd "ext:inf-clojure" (project-type)) 58 (declare-function inf-clojure-eval-string "ext:inf-clojure" (code)) 59 (declare-function inf-clojure-project-type "ext:inf-clojure" ()) 60 (declare-function nrepl-dict-get "ext:nrepl-client" (dict key)) 61 (declare-function nrepl-sync-request:eval "ext:nrepl-client" (input connection &optional ns tooling)) 62 (declare-function sesman-start-session "ext:sesman" (system)) 63 (declare-function slime-eval "ext:slime" (sexp &optional package)) 64 65 (defvar cider-buffer-ns) 66 67 (defvar org-babel-tangle-lang-exts) 68 (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) 69 (add-to-list 'org-babel-tangle-lang-exts '("clojurescript" . "cljs")) 70 71 (defvar org-babel-default-header-args:clojure '()) 72 (defvar org-babel-header-args:clojure 73 '((ns . :any) 74 (package . :any) 75 (backend . ((inf-clojure cider slime babashka nbb))))) 76 (defvar org-babel-default-header-args:clojurescript '()) 77 (defvar org-babel-header-args:clojurescript '((package . :any))) 78 79 (defcustom org-babel-clojure-backend (cond 80 ((executable-find "bb") 'babashka) 81 ((executable-find "nbb") 'nbb) 82 ((featurep 'cider) 'cider) 83 ((featurep 'inf-clojure) 'inf-clojure) 84 ((featurep 'slime) 'slime) 85 (t nil)) 86 "Backend used to evaluate Clojure code blocks." 87 :group 'org-babel 88 :package-version '(Org . "9.6") 89 :type '(choice 90 (const :tag "inf-clojure" inf-clojure) 91 (const :tag "cider" cider) 92 (const :tag "slime" slime) 93 (const :tag "babashka" babashka) 94 (const :tag "nbb" nbb) 95 (const :tag "Not configured yet" nil))) 96 97 (defcustom org-babel-clojure-default-ns "user" 98 "Default Clojure namespace for source block when finding ns failed." 99 :type 'string 100 :group 'org-babel) 101 102 (defcustom ob-clojure-babashka-command (executable-find "bb") 103 "Path to the babashka executable." 104 :type '(choice file (const nil)) 105 :group 'org-babel 106 :package-version '(Org . "9.6")) 107 108 (defcustom ob-clojure-nbb-command (executable-find "nbb") 109 "Path to the nbb executable." 110 :type '(choice file (const nil)) 111 :group 'org-babel 112 :package-version '(Org . "9.6")) 113 114 (defun org-babel-expand-body:clojure (body params) 115 "Expand BODY according to PARAMS, return the expanded body." 116 (let* ((vars (org-babel--get-vars params)) 117 (backend-override (cdr (assq :backend params))) 118 (org-babel-clojure-backend 119 (cond 120 (backend-override (intern backend-override)) 121 (org-babel-clojure-backend org-babel-clojure-backend) 122 (t (user-error "You need to customize `org-babel-clojure-backend' 123 or set the `:backend' header argument")))) 124 (ns (or (cdr (assq :ns params)) 125 (if (eq org-babel-clojure-backend 'cider) 126 (or cider-buffer-ns 127 (let ((repl-buf (cider-current-connection))) 128 (and repl-buf (buffer-local-value 129 'cider-buffer-ns repl-buf)))) 130 org-babel-clojure-default-ns))) 131 (result-params (cdr (assq :result-params params))) 132 (print-level nil) 133 (print-length nil) 134 ;; Remove comments, they break (let [...] ...) bindings 135 (body (replace-regexp-in-string "^[ ]*;+.*$" "" body)) 136 (body (org-trim 137 (concat 138 ;; Source block specified namespace :ns. 139 (and (cdr (assq :ns params)) (format "(ns %s)\n" ns)) 140 ;; Variables binding. 141 (if (null vars) (org-trim body) 142 (format "(let [%s]\n%s)" 143 (mapconcat 144 (lambda (var) 145 (format "%S '%S" (car var) (cdr var))) 146 vars 147 "\n ") 148 body)))))) 149 (if (or (member "code" result-params) 150 (member "pp" result-params)) 151 (format "(clojure.pprint/pprint (do %s))" body) 152 body))) 153 154 (defvar ob-clojure-inf-clojure-filter-out) 155 (defvar ob-clojure-inf-clojure-tmp-output) 156 (defun ob-clojure-inf-clojure-output (s) 157 "Store a trimmed version of S in a variable and return S." 158 (let ((s0 (org-trim 159 (replace-regexp-in-string 160 ob-clojure-inf-clojure-filter-out "" s)))) 161 (push s0 ob-clojure-inf-clojure-tmp-output)) 162 s) 163 164 (defmacro ob-clojure-with-temp-expanded (expanded params &rest body) 165 "Run BODY on EXPANDED code block with PARAMS." 166 (declare (debug (body)) (indent 2)) 167 `(with-temp-buffer 168 (insert ,expanded) 169 (goto-char (point-min)) 170 (while (not (looking-at "\\s-*\\'")) 171 (let* ((beg (point)) 172 (end (progn (forward-sexp) (point))) 173 (exp (org-babel-expand-body:clojure 174 (buffer-substring beg end) ,params))) 175 (sit-for .1) 176 ,@body)))) 177 178 (defsubst ob-clojure-string-or-list (l) 179 "Convert list L into a string or a list of list." 180 (if (and (listp l) (= (length l) 1)) 181 (car l) 182 (mapcar #'list l))) 183 184 (defvar inf-clojure-buffer) 185 (defvar comint-prompt-regexp) 186 (defvar inf-clojure-comint-prompt-regexp) 187 (defun ob-clojure-eval-with-inf-clojure (expanded params) 188 "Evaluate EXPANDED code block with PARAMS using inf-clojure." 189 (condition-case nil (require 'inf-clojure) 190 (user-error "inf-clojure not available")) 191 ;; Maybe initiate the inf-clojure session 192 (unless (and inf-clojure-buffer 193 (buffer-live-p (get-buffer inf-clojure-buffer))) 194 (save-window-excursion 195 (let* ((alias (cdr (assq :alias params))) 196 (cmd0 (inf-clojure-cmd (inf-clojure-project-type))) 197 (cmd (if alias (replace-regexp-in-string 198 "clojure" (format "clojure -A%s" alias) 199 cmd0) 200 cmd0))) 201 (setq comint-prompt-regexp inf-clojure-comint-prompt-regexp) 202 (funcall-interactively #'inf-clojure cmd) 203 (goto-char (point-max)))) 204 (sit-for 1)) 205 ;; Now evaluate the code 206 (setq ob-clojure-inf-clojure-filter-out 207 (concat "^nil\\|nil$\\|\\s-*" 208 (or (cdr (assq :ns params)) 209 org-babel-clojure-default-ns) 210 "=>\\s-*")) 211 (add-hook 'comint-preoutput-filter-functions 212 #'ob-clojure-inf-clojure-output) 213 (setq ob-clojure-inf-clojure-tmp-output nil) 214 (ob-clojure-with-temp-expanded expanded nil 215 (inf-clojure-eval-string exp)) 216 (sit-for .5) 217 (remove-hook 'comint-preoutput-filter-functions 218 #'ob-clojure-inf-clojure-output) 219 ;; And return the result 220 (ob-clojure-string-or-list 221 (delete nil 222 (mapcar 223 (lambda (s) 224 (unless (or (equal "" s) 225 (string-match-p "^Clojure" s)) 226 s)) 227 (reverse ob-clojure-inf-clojure-tmp-output))))) 228 229 (defun ob-clojure-eval-with-cider (expanded params) 230 "Evaluate EXPANDED code block with PARAMS using cider." 231 (condition-case nil (require 'cider) 232 (user-error "cider not available")) 233 (let ((connection (cider-current-connection (cdr (assq :target params)))) 234 (result-params (cdr (assq :result-params params))) 235 result0) 236 (unless connection (sesman-start-session 'CIDER)) 237 (if (not connection) 238 ;; Display in the result instead of using `user-error' 239 (setq result0 "Please reevaluate when nREPL is connected") 240 (ob-clojure-with-temp-expanded expanded params 241 (let ((response (nrepl-sync-request:eval exp connection))) 242 (push (or (nrepl-dict-get response "root-ex") 243 (nrepl-dict-get response "ex") 244 (nrepl-dict-get 245 response (if (or (member "output" result-params) 246 (member "pp" result-params)) 247 "out" 248 "value"))) 249 result0))) 250 (ob-clojure-string-or-list 251 ;; Filter out s-expressions that return nil (string "nil" 252 ;; from nrepl eval) or comment forms (actual nil from nrepl) 253 (reverse (delete "" (mapcar (lambda (r) 254 (replace-regexp-in-string "nil" "" (or r ""))) 255 result0))))))) 256 257 (defun ob-clojure-eval-with-slime (expanded params) 258 "Evaluate EXPANDED code block with PARAMS using slime." 259 (condition-case nil (require 'slime) 260 (user-error "slime not available")) 261 (with-temp-buffer 262 (insert expanded) 263 (slime-eval 264 `(swank:eval-and-grab-output 265 ,(buffer-substring-no-properties (point-min) (point-max))) 266 (cdr (assq :package params))))) 267 268 (defun ob-clojure-eval-with-babashka (bb expanded) 269 "Evaluate EXPANDED code block using BB (babashka or nbb)." 270 (let ((script-file (org-babel-temp-file "clojure-bb-script-" ".clj"))) 271 (with-temp-file script-file 272 (insert expanded)) 273 (org-babel-eval 274 (format "%s %s" bb (org-babel-process-file-name script-file)) 275 ""))) 276 277 (defun org-babel-execute:clojure (body params) 278 "Execute the BODY block of Clojure code with PARAMS using Babel." 279 (let* ((backend-override (cdr (assq :backend params))) 280 (org-babel-clojure-backend 281 (cond 282 (backend-override (intern backend-override)) 283 (org-babel-clojure-backend org-babel-clojure-backend) 284 (t (user-error "You need to customize `org-babel-clojure-backend' 285 or set the `:backend' header argument"))))) 286 (let* ((expanded (org-babel-expand-body:clojure body params)) 287 (result-params (cdr (assq :result-params params))) 288 result) 289 (setq result 290 (cond 291 ((eq org-babel-clojure-backend 'inf-clojure) 292 (ob-clojure-eval-with-inf-clojure expanded params)) 293 ((eq org-babel-clojure-backend 'babashka) 294 (ob-clojure-eval-with-babashka ob-clojure-babashka-command expanded)) 295 ((eq org-babel-clojure-backend 'nbb) 296 (ob-clojure-eval-with-babashka ob-clojure-nbb-command expanded)) 297 ((eq org-babel-clojure-backend 'cider) 298 (ob-clojure-eval-with-cider expanded params)) 299 ((eq org-babel-clojure-backend 'slime) 300 (ob-clojure-eval-with-slime expanded params)))) 301 (org-babel-result-cond result-params 302 result 303 (condition-case nil (org-babel-script-escape result) 304 (error result)))))) 305 306 (defun org-babel-execute:clojurescript (body params) 307 "Evaluate BODY with PARAMS as ClojureScript code." 308 (org-babel-execute:clojure body (cons '(:target . "cljs") params))) 309 310 (provide 'ob-clojure) 311 312 ;;; ob-clojure.el ends here