ob-clojure-literate.el 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351
  1. ;;; ob-clojure-literate.el --- Clojure's Org-mode Literate Programming.
  2. ;; Authors: stardiviner <numbchild@gmail.com>
  3. ;; Package-Requires: ((emacs "24.4") (org "9") (cider "0.16.0") (dash "2.12.0"))
  4. ;; Package-Version: 1.1
  5. ;; Keywords: tools
  6. ;; homepage: https://github.com/stardiviner/ob-clojure-literate
  7. ;; You should have received a copy of the GNU General Public License
  8. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  9. ;;; Commentary:
  10. ;;
  11. ;; Auto setup ob-clojure-literate scaffold and jack-in Clojure project.
  12. ;;
  13. ;; Usage:
  14. ;;
  15. ;; [M-x ob-clojure-literate-mode] to toggle this minor mode.
  16. ;;; Code:
  17. (require 'ob-clojure)
  18. (require 'cider)
  19. (defgroup ob-clojure-literate nil
  20. "Clojure's Org-mode Literate Programming."
  21. :prefix "ob-clojure-literate-"
  22. :group 'ob-babel)
  23. ;;;###autoload
  24. (defcustom ob-clojure-literate-auto-jackin-p nil
  25. "Auto jack in ob-clojure project.
  26. Don't auto jack in by default for not rude."
  27. :type 'boolean
  28. :group 'ob-clojure-literate)
  29. (defcustom ob-clojure-literate-project-location nil
  30. "The location for `ob-clojure-literate' scaffold project.
  31. If it is nil, then `cider-jack-in' will jack-in outside of Clojure project.
  32. If it is a directory, `ob-clojure-literate' will try to create Clojure project automatically."
  33. :type 'string
  34. :group 'ob-clojure-literate)
  35. (defvar ob-clojure-literate-session nil)
  36. (defvar ob-clojure-literate-original-ns nil)
  37. (defvar ob-clojure-literate-session-ns nil)
  38. (defvar ob-clojure-literate-cider-connections nil)
  39. (defcustom ob-clojure-literate-default-session "*cider-repl localhost*"
  40. "The default session name for `ob-clojure-literate'."
  41. :type 'string
  42. :group 'ob-clojure-literate)
  43. (defun ob-clojure-literate-any-connection-p ()
  44. "Return t if have any CIDER connection."
  45. (and
  46. ;; handle the case `cider-jack-in' is not finished creating connection, but `ob-clojure-literate-mode' is enabled.
  47. (not (null (cider-connections)))
  48. (not (null ob-clojure-literate-session)) ; before mode enabled, it is nil.
  49. (not (string-empty-p ob-clojure-literate-session)) ; after disable, it is "".
  50. ))
  51. (defun ob-clojure-literate-get-session-list ()
  52. "Return a list of available started CIDER REPL sessions list."
  53. (mapcar #'buffer-name
  54. ;; for multiple connections case.
  55. ;; get global value instead of buffer local.
  56. (default-value 'cider-connections)))
  57. (defun ob-clojure-literate-set-session ()
  58. "Set session name for buffer local."
  59. ;; if default session is the only one in connections list.
  60. (if (and (= (length (ob-clojure-literate-get-session-list)) 1)
  61. (member ob-clojure-literate-default-session (ob-clojure-literate-get-session-list)))
  62. (setq-local ob-clojure-literate-session ob-clojure-literate-default-session)
  63. ;; if have any connections, choose one from them.
  64. (if (ob-clojure-literate-any-connection-p)
  65. (setq-local ob-clojure-literate-session
  66. (completing-read "Choose ob-clojure-literate :session : "
  67. (ob-clojure-literate-get-session-list)))
  68. ;; if none, set to default session name to fix `ob-clojure-literate-mode'
  69. ;; is enabled before `cider-jack-in' generated connections.
  70. (setq-local ob-clojure-literate-session ob-clojure-literate-default-session))
  71. ))
  72. ;;;###autoload
  73. (defun ob-clojure-literate-specify-session ()
  74. "Specify ob-clojure header argument :session with value selected from a list of available sessions."
  75. (interactive)
  76. (let ((lang (nth 0 (org-babel-get-src-block-info))))
  77. (if (and (string= lang "clojure") ; only in clojure src block.
  78. (car (seq-filter ; only when :session is not specified yet.
  79. (lambda (header-argument)
  80. (if (eq (car header-argument) :session)
  81. (not (null (cdr header-argument)))))
  82. (nth 2 (org-babel-get-src-block-info)))))
  83. (org-babel-insert-header-arg
  84. "session"
  85. (format "\"%s\""
  86. (completing-read
  87. "Choose :session for ob-clojure-literate: "
  88. (ob-clojure-literate-get-session-list))))
  89. (message "This function only used in `clojure' src block.")))
  90. )
  91. ;;; Auto start CIDER REPL session in a complete Leiningen project environment for Org-mode Babel to jack-in.
  92. ;;;###autoload
  93. (defun ob-clojure-literate-auto-jackin ()
  94. "Auto setup ob-clojure-literate scaffold and jack-in Clojure project."
  95. (interactive)
  96. (cond
  97. ;; jack-in outside of Clojure project.
  98. ((null ob-clojure-literate-project-location)
  99. (if (member (get-buffer "*cider-repl localhost*") cider-connections)
  100. (message "CIDER default session already launched.")
  101. (cider-jack-in nil)))
  102. ((not (null ob-clojure-literate-project-location))
  103. (unless (file-directory-p (expand-file-name ob-clojure-literate-project-location))
  104. (make-directory ob-clojure-literate-project-location t)
  105. (let ((default-directory ob-clojure-literate-project-location))
  106. (shell-command "lein new ob-clojure")))
  107. (unless (or
  108. (and (cider-connected-p)
  109. (if (not (null ob-clojure-literate-session))
  110. (seq-contains cider-connections (get-buffer ob-clojure-literate-session))))
  111. cider-connections
  112. (not (null ob-clojure-literate-session)))
  113. ;; return back to original file.
  114. (if (not (and (= (length (ob-clojure-literate-get-session-list)) 1)
  115. (member ob-clojure-literate-default-session (ob-clojure-literate-get-session-list))))
  116. (save-window-excursion
  117. (find-file (expand-file-name (concat ob-clojure-literate-project-location "ob-clojure/src/ob_clojure/core.clj")))
  118. (with-current-buffer "core.clj"
  119. (cider-jack-in))))))
  120. ))
  121. (defun ob-clojure-literate-set-local-cider-connections (toggle?)
  122. "Set buffer local `cider-connections' for `ob-clojure-literate-mode' `TOGGLE?'."
  123. (if toggle?
  124. (progn
  125. (setq ob-clojure-literate-cider-connections cider-connections)
  126. (unless (local-variable-if-set-p 'cider-connections)
  127. (make-local-variable 'cider-connections))
  128. (setq-local cider-connections ob-clojure-literate-cider-connections))
  129. ;; store/restore emptied CIDER connections by `ob-clojure-literate-enable'.
  130. (kill-local-variable 'cider-connections) ; kill local variable so that I can get the original global variable value.
  131. ;; Empty all CIDER connections to avoid `cider-current-connection' return any connection.
  132. ;; FIXME: when try to enable, `cider-connections' is local and nil.
  133. ;; (if (and (= (length (ob-clojure-literate-get-session-list)) 1)
  134. ;; (member ob-clojure-literate-default-session (ob-clojure-literate-get-session-list))))
  135. ;; (unless (local-variable-if-set-p 'cider-connections)
  136. ;; (make-local-variable 'cider-connections))
  137. ;; (setq-local cider-connections '())
  138. ))
  139. (defun ob-clojure-literate-set-ns (body params)
  140. "Fix the issue that `cider-current-ns' try to invoke `clojure-find-ns' to extract ns from buffer."
  141. ;; TODO: Is it possible to find ns in `body'?
  142. (when (ob-clojure-literate-any-connection-p)
  143. (setq ob-clojure-literate-original-ns (cider-current-ns))
  144. (with-current-buffer ob-clojure-literate-session
  145. (setq ob-clojure-literate-session-ns cider-buffer-ns))
  146. (setq-local cider-buffer-ns (or (cdr (assq :ns params))
  147. ob-clojure-literate-session-ns)))
  148. (message (format "ob-clojure-literate: current CIDER ns is [%s]." cider-buffer-ns)))
  149. (defun ob-clojure-literate-set-local-session (toggle?)
  150. "Set buffer local `org-babel-default-header-args:clojure' for `ob-clojure-literate-mode' `TOGGLE?'."
  151. (if toggle?
  152. (progn
  153. ;; set local default session for ob-clojure.
  154. (setq ob-clojure-literate-session (ob-clojure-literate-set-session))
  155. (unless (local-variable-if-set-p 'org-babel-default-header-args:clojure)
  156. (make-local-variable 'org-babel-default-header-args:clojure))
  157. (add-to-list 'org-babel-default-header-args:clojure
  158. `(:session . ,ob-clojure-literate-session))
  159. )
  160. ;; remove :session from buffer local default header arguments list.
  161. (unless (local-variable-if-set-p 'org-babel-default-header-args:clojure)
  162. (make-local-variable 'org-babel-default-header-args:clojure))
  163. (setq org-babel-default-header-args:clojure
  164. (delq t
  165. (mapcar
  166. (lambda (cons) (if (eq (car cons) :session) t cons))
  167. org-babel-default-header-args:clojure)))
  168. ))
  169. ;;; Support `org-babel-initiate-session' / [C-c C-v z] to initialize Clojure session.
  170. (defun org-babel-clojure-initiate-session (&optional session _params)
  171. "Initiate a session named SESSION according to PARAMS."
  172. (when (and session (not (string= session "none")))
  173. (save-window-excursion
  174. (unless (org-babel-comint-buffer-livep session)
  175. ;; CIDER jack-in to the Clojure project directory.
  176. (cond
  177. ((eq org-babel-clojure-backend 'cider)
  178. (require 'cider)
  179. (let ((session-buffer (save-window-excursion
  180. (cider-jack-in t)
  181. (current-buffer))))
  182. (if (org-babel-comint-buffer-livep session-buffer)
  183. (progn (sit-for .25) session-buffer))))
  184. ((eq org-babel-clojure-backend 'slime)
  185. (error "Session evaluation with SLIME is not supported"))
  186. (t
  187. (error "Session initiate failed")))
  188. )
  189. (get-buffer session)
  190. )))
  191. (defun org-babel-prep-session:clojure (session params)
  192. "Prepare SESSION according to the header arguments specified in PARAMS."
  193. (let* ((session (org-babel-clojure-initiate-session session))
  194. (var-lines (org-babel-variable-assignments:clojure params)))
  195. (when session
  196. (org-babel-comint-in-buffer session
  197. (mapc (lambda (var)
  198. (insert var) (comint-send-input nil t)
  199. (org-babel-comint-wait-for-output session)
  200. (sit-for .1) (goto-char (point-max))) var-lines)))
  201. session))
  202. (defun org-babel-clojure-var-to-clojure (var)
  203. "Convert src block's `VAR' to Clojure variable."
  204. (if (listp var)
  205. (replace-regexp-in-string "(" "'(" var)
  206. (cond
  207. ((stringp var)
  208. ;; wrap org-babel passed in header argument value with quote in Clojure.
  209. (format "\"%s\"" var))
  210. (t
  211. (format "%s" var))))
  212. )
  213. (defun org-babel-variable-assignments:clojure (params)
  214. "Return a list of Clojure statements assigning the block's variables in `PARAMS'."
  215. (mapcar
  216. (lambda (pair)
  217. (format "(def %s %s)"
  218. (car pair)
  219. (org-babel-clojure-var-to-clojure (cdr pair))))
  220. (org-babel--get-vars params)))
  221. ;;; Support header arguments :results graphics :file "image.png" by inject Clojure code.
  222. (defun ob-clojure-literate-inject-code (args)
  223. "Inject Clojure code into `BODY' in `ARGS'.
  224. It is used to change Clojure currently working directory in a FAKE way.
  225. And generate inline graphics image file link result.
  226. Use header argument like this:
  227. :results graphics :file \"incanter-plot.png\"
  228. Then you need to assign image variable to this :file value like:
  229. (def incanter-plot (histogram (sample-normal 1000)))
  230. *NOTE*: Currently only support Incanter's `save' function.
  231. "
  232. (let* ((body (nth 0 args))
  233. (params (nth 1 args))
  234. (dir (cdr (assq :dir params)))
  235. (default-directory (and (buffer-file-name) (file-name-directory (buffer-file-name))))
  236. (directory (and dir (file-name-as-directory (expand-file-name dir))))
  237. (result-type (cdr (assq :results params)))
  238. (file (cdr (assq :file params)))
  239. (file-name (and file (file-name-base file)))
  240. ;; TODO: future support `:graphics-file' to avoid collision.
  241. (graphics-result (member "graphics" (cdr (assq :result-params params))))
  242. ;; (graphics-file (cdr (assq :graphics-file params)))
  243. ;; (graphics-name (file-name-base graphics-file))
  244. (prepend-to-body (lambda (code)
  245. (setq body (concat code "\n" body))))
  246. (append-to-body (lambda (code)
  247. (setq body (concat body "\n" code "\n"))))
  248. )
  249. (when directory
  250. (unless (file-directory-p (expand-file-name directory))
  251. (warn (format "Target directory %s does not exist, please create it." dir))))
  252. (when file
  253. (funcall append-to-body
  254. (format "(save %s \"%s\")" file-name (concat directory file)))
  255. )
  256. (list body params) ; return modified argument list
  257. ))
  258. ;;; support :results graphics :dir "data/image" :file "incanter-plot.png"
  259. (defun ob-clojure-literate-support-graphics-result (result)
  260. "Support :results graphics :dir \"data/images\" :file \"incanter-plot.png\"
  261. reset `RESULT' to `nil'."
  262. (let* ((params (nth 2 info))
  263. (graphics-result (member "graphics" (cdr (assq :result-params params)))))
  264. (if graphics-result
  265. (setq result nil))
  266. result))
  267. (defvar ob-clojure-literate-mode-map
  268. (let ((map (make-sparse-keymap)))
  269. map)
  270. "Keymap for `ob-clojure-literate-mode'.")
  271. (define-key org-babel-map (kbd "M-s") 'ob-clojure-literate-specify-session)
  272. (define-key org-babel-map (kbd "M-j") 'ob-clojure-literate-auto-jackin)
  273. ;; (define-key org-babel-map (kbd "M-e") 'cider-eval-last-sexp)
  274. ;; (define-key org-babel-map (kbd "M-d") 'cider-doc)
  275. ;;;###autoload
  276. (defun ob-clojure-literate-enable ()
  277. "Enable Org-mode buffer locally for `ob-clojure-literate'."
  278. (when (and (not (null cider-connections)) ; only enable `ob-clojure-literate-mode' when has CIDER connections.
  279. (equal major-mode 'org-mode)) ; `ob-clojure-literate-mode' only works in `org-mode'.
  280. (ob-clojure-literate-set-local-cider-connections ob-clojure-literate-mode)
  281. (ob-clojure-literate-set-local-session ob-clojure-literate-mode)
  282. (advice-add 'org-babel-execute:clojure :before #'ob-clojure-literate-set-ns)
  283. (advice-add 'org-babel-expand-body:clojure :filter-args #'ob-clojure-literate-inject-code)
  284. (advice-add 'org-babel-execute:clojure :filter-return #'ob-clojure-literate-support-graphics-result)
  285. (message "ob-clojure-literate minor mode enabled.")))
  286. ;;;###autoload
  287. (defun ob-clojure-literate-disable ()
  288. "Disable Org-mode buffer locally for `ob-clojure-literate'."
  289. (advice-remove 'org-babel-execute:clojure #'ob-clojure-literate-set-ns)
  290. (advice-remove 'org-babel-expand-body:clojure #'ob-clojure-literate-inject-code)
  291. (advice-remove 'org-babel-execute:clojure #'ob-clojure-literate-support-graphics-result)
  292. (setq-local cider-buffer-ns ob-clojure-literate-original-ns)
  293. (ob-clojure-literate-set-local-cider-connections ob-clojure-literate-mode)
  294. (ob-clojure-literate-set-local-session ob-clojure-literate-mode)
  295. (message "ob-clojure-literate minor mode disabled."))
  296. ;;;###autoload
  297. (if ob-clojure-literate-auto-jackin-p (ob-clojure-literate-auto-jackin))
  298. ;;;###autoload
  299. (define-minor-mode ob-clojure-literate-mode
  300. "A minor mode to toggle `ob-clojure-literate'."
  301. :require 'ob-clojure-literate
  302. :init-value t
  303. :lighter " clj-lp"
  304. :group 'ob-clojure-literate
  305. :keymap ob-clojure-literate-mode-map
  306. :global nil
  307. (if ob-clojure-literate-mode
  308. (ob-clojure-literate-enable)
  309. (ob-clojure-literate-disable))
  310. )
  311. (provide 'ob-clojure-literate)
  312. ;;; ob-clojure-literate.el ends here