ob-clojure-literate.el 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295
  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. ;;; Do not allow "ob-clojure" project session name.
  58. (defun ob-clojure-literate-set-session ()
  59. "Set session name for buffer local."
  60. ;; if default session is the only one in connections list.
  61. (if (and (= (length (ob-clojure-literate-get-session-list)) 1)
  62. (member ob-clojure-literate-default-session (ob-clojure-literate-get-session-list)))
  63. (setq-local ob-clojure-literate-session ob-clojure-literate-default-session)
  64. ;; if have any connections, choose one from them.
  65. (if (ob-clojure-literate-any-connection-p)
  66. (setq-local ob-clojure-literate-session
  67. (completing-read "Choose ob-clojure-literate :session : "
  68. (ob-clojure-literate-get-session-list)))
  69. ;; if none, set to default session name to fix `ob-clojure-literate-mode'
  70. ;; is enabled before `cider-jack-in' generated connections.
  71. (setq-local ob-clojure-literate-session
  72. ob-clojure-literate-default-session))))
  73. ;;;###autoload
  74. (defun ob-clojure-literate-specify-session ()
  75. "Specify ob-clojure header argument :session with value selected from a list of available sessions."
  76. (interactive)
  77. (let ((lang (nth 0 (org-babel-get-src-block-info))))
  78. (if (and (string= lang "clojure") ; only in clojure src block.
  79. (car (seq-filter ; only when :session is not specified yet.
  80. (lambda (header-argument)
  81. (if (eq (car header-argument) :session)
  82. (not (null (cdr header-argument)))))
  83. (nth 2 (org-babel-get-src-block-info)))))
  84. (org-babel-insert-header-arg
  85. "session"
  86. (format "\"%s\""
  87. (completing-read
  88. "Choose :session for ob-clojure-literate: "
  89. (ob-clojure-literate-get-session-list))))
  90. (message "This function only used in `clojure' src block.")))
  91. )
  92. ;;; Auto start CIDER REPL session in a complete Leiningen project environment for Org-mode Babel to jack-in.
  93. ;;;###autoload
  94. (defun ob-clojure-literate-auto-jackin ()
  95. "Auto setup ob-clojure-literate scaffold and jack-in Clojure project."
  96. (interactive)
  97. (cond
  98. ;; jack-in outside of Clojure project.
  99. ((null ob-clojure-literate-project-location)
  100. (if (member (get-buffer "*cider-repl localhost*") cider-connections)
  101. (message "CIDER default session already launched.")
  102. (cider-jack-in nil)))
  103. ((not (null ob-clojure-literate-project-location))
  104. (unless (file-directory-p (expand-file-name ob-clojure-literate-project-location))
  105. (make-directory ob-clojure-literate-project-location t)
  106. (let ((default-directory ob-clojure-literate-project-location))
  107. (shell-command "lein new ob-clojure")))
  108. (unless (or
  109. (and (cider-connected-p)
  110. (if (not (null ob-clojure-literate-session))
  111. (seq-contains cider-connections (get-buffer ob-clojure-literate-session))))
  112. cider-connections
  113. (ob-clojure-literate-any-connection-p))
  114. ;; return back to original file.
  115. (if (not (and (= (length (ob-clojure-literate-get-session-list)) 1)
  116. (member ob-clojure-literate-default-session (ob-clojure-literate-get-session-list))))
  117. (save-window-excursion
  118. (find-file (expand-file-name (concat ob-clojure-literate-project-location "ob-clojure/src/ob_clojure/core.clj")))
  119. (with-current-buffer "core.clj"
  120. (cider-jack-in))))))))
  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. ;;; Support header arguments :results graphics :file "image.png" by inject Clojure code.
  169. (defun ob-clojure-literate-inject-code (args)
  170. "Inject Clojure code into `BODY' in `ARGS'.
  171. It is used to change Clojure currently working directory in a FAKE way.
  172. And generate inline graphics image file link result.
  173. Use header argument like this:
  174. :results graphics :file \"incanter-plot.png\"
  175. Then you need to assign image variable to this :file value like:
  176. (def incanter-plot (histogram (sample-normal 1000)))
  177. *NOTE*: Currently only support Incanter's `save' function.
  178. "
  179. (let* ((body (nth 0 args))
  180. (params (nth 1 args))
  181. (dir (cdr (assq :dir params)))
  182. (default-directory (and (buffer-file-name) (file-name-directory (buffer-file-name))))
  183. (directory (and dir (file-name-as-directory (expand-file-name dir))))
  184. (result-type (cdr (assq :results params)))
  185. (file (cdr (assq :file params)))
  186. (file-name (and file (file-name-base file)))
  187. ;; TODO: future support `:graphics-file' to avoid collision.
  188. (graphics-result (member "graphics" (cdr (assq :result-params params))))
  189. ;; (graphics-file (cdr (assq :graphics-file params)))
  190. ;; (graphics-name (file-name-base graphics-file))
  191. (prepend-to-body (lambda (code)
  192. (setq body (concat code "\n" body))))
  193. (append-to-body (lambda (code)
  194. (setq body (concat body "\n" code "\n"))))
  195. )
  196. (when directory
  197. (unless (file-directory-p (expand-file-name directory))
  198. (warn (format "Target directory %s does not exist, please create it." dir))))
  199. (when file
  200. (funcall append-to-body
  201. (format "(save %s \"%s\")" file-name (concat directory file)))
  202. )
  203. (list body params) ; return modified argument list
  204. ))
  205. ;;; support :results graphics :dir "data/image" :file "incanter-plot.png"
  206. (defun ob-clojure-literate-support-graphics-result (result)
  207. "Support :results graphics :dir \"data/images\" :file \"incanter-plot.png\"
  208. reset `RESULT' to `nil'."
  209. (let* ((params (nth 2 info))
  210. (graphics-result (member "graphics" (cdr (assq :result-params params)))))
  211. (if graphics-result
  212. (setq result nil))
  213. result))
  214. (defvar ob-clojure-literate-mode-map
  215. (let ((map (make-sparse-keymap)))
  216. map)
  217. "Keymap for `ob-clojure-literate-mode'.")
  218. (define-key org-babel-map (kbd "M-s") 'ob-clojure-literate-specify-session)
  219. (define-key org-babel-map (kbd "M-j") 'ob-clojure-literate-auto-jackin)
  220. ;; (define-key org-babel-map (kbd "M-e") 'cider-eval-last-sexp)
  221. ;; (define-key org-babel-map (kbd "M-d") 'cider-doc)
  222. ;;;###autoload
  223. (defun ob-clojure-literate-enable ()
  224. "Enable Org-mode buffer locally for `ob-clojure-literate'."
  225. (when (and (not (null cider-connections)) ; only enable `ob-clojure-literate-mode' when has CIDER connections.
  226. (equal major-mode 'org-mode)) ; `ob-clojure-literate-mode' only works in `org-mode'.
  227. (ob-clojure-literate-set-local-cider-connections ob-clojure-literate-mode)
  228. (ob-clojure-literate-set-local-session ob-clojure-literate-mode)
  229. (advice-add 'org-babel-execute:clojure :before #'ob-clojure-literate-set-ns)
  230. (advice-add 'org-babel-expand-body:clojure :filter-args #'ob-clojure-literate-inject-code)
  231. (advice-add 'org-babel-execute:clojure :filter-return #'ob-clojure-literate-support-graphics-result)
  232. (message "ob-clojure-literate minor mode enabled.")))
  233. ;;;###autoload
  234. (defun ob-clojure-literate-disable ()
  235. "Disable Org-mode buffer locally for `ob-clojure-literate'."
  236. (advice-remove 'org-babel-execute:clojure #'ob-clojure-literate-set-ns)
  237. (advice-remove 'org-babel-expand-body:clojure #'ob-clojure-literate-inject-code)
  238. (advice-remove 'org-babel-execute:clojure #'ob-clojure-literate-support-graphics-result)
  239. (setq-local cider-buffer-ns ob-clojure-literate-original-ns)
  240. (ob-clojure-literate-set-local-cider-connections ob-clojure-literate-mode)
  241. (ob-clojure-literate-set-local-session ob-clojure-literate-mode)
  242. (message "ob-clojure-literate minor mode disabled."))
  243. ;;;###autoload
  244. (if ob-clojure-literate-auto-jackin-p (ob-clojure-literate-auto-jackin))
  245. ;;;###autoload
  246. (define-minor-mode ob-clojure-literate-mode
  247. "A minor mode to toggle `ob-clojure-literate'."
  248. :require 'ob-clojure-literate
  249. :init-value nil
  250. :lighter " clj-lp"
  251. :group 'ob-clojure-literate
  252. :keymap ob-clojure-literate-mode-map
  253. :global nil
  254. (if ob-clojure-literate-mode
  255. (ob-clojure-literate-enable)
  256. (ob-clojure-literate-disable))
  257. )
  258. (provide 'ob-clojure-literate)
  259. ;;; ob-clojure-literate.el ends here