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