contrib/lisp/ob-clojure-literate.el

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