diff options
Diffstat (limited to 'cider-repl.el')
| -rw-r--r-- | cider-repl.el | 162 |
1 files changed, 142 insertions, 20 deletions
diff --git a/cider-repl.el b/cider-repl.el index 68beee47..68b7d10e 100644 --- a/cider-repl.el +++ b/cider-repl.el @@ -9,6 +9,7 @@ ;; Artur Malabarba <bruce.connor.am@gmail.com> ;; Hugo Duncan <hugo@hugoduncan.org> ;; Steve Purcell <steve@sanityinc.com> +;; Reid McKenzie <me@arrdem.com> ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -112,7 +113,7 @@ If this is set to nil, no re-centering takes place." :package-version '(cider . "0.11.0")) (defcustom cider-repl-use-pretty-printing nil - "Control whether the results in REPL are pretty-printed or not. + "Control whether results in the REPL are pretty-printed or not. The `cider-toggle-pretty-printing' command can be used to interactively change the setting's value." :type 'boolean @@ -127,6 +128,13 @@ defaults to the variable `fill-column'." :group 'cider-repl :package-version '(cider . "0.15.0")) +(defcustom cider-repl-use-content-types t + "Control whether REPL results are presented using content-type information or not. +The `cider-toggle-content-types' command can be used to interactively +change the setting's value." + :type 'boolean + :group 'cider-repl) + (defcustom cider-repl-use-clojure-font-lock t "Non-nil means to use Clojure mode font-locking for input and result. Nil means that `cider-repl-input-face' and `cider-repl-result-face' @@ -799,24 +807,133 @@ the symbol." t))) (t t)))) +(defun cider-repl--display-image (buffer image &optional show-prefix bol string) + "Insert IMAGE into BUFFER at the current point. + +For compatibility with the rest of CIDER's REPL machinery, supports +SHOW-PREFIX and BOL." + (with-current-buffer buffer + (save-excursion + (cider-save-marker cider-repl-output-start + (cider-save-marker cider-repl-output-end + (goto-char cider-repl-input-start-mark) + (when (and bol (not (bolp))) + (insert-before-markers "\n")) + (when show-prefix + (insert-before-markers + (propertize cider-repl-result-prefix 'font-lock-face 'font-lock-comment-face))) + (insert-image image string) + (set-marker cider-repl-input-start-mark (point) buffer) + (set-marker cider-repl-prompt-start-mark (point) buffer)))) + (cider-repl--show-maximum-output)) + t) + +(defcustom cider-repl-image-margin 10 + "Specifies the margin to be applied to images displayed in the REPL. + +Either a single number of pixels - interpreted as a symmetric margin, or +pair of numbers `(x . y)' encoding an arbitrary margin." + :type '(choice integer (vector integer integer)) + :group 'cider-repl + :package-version '(cider . "0.17.0")) + +(defun cider-repl--image (data type datap) + "A helper for creating images with CIDER's image options. + +FILE-OR-DATA is either the path to an image or its base64 coded data. TYPE +is a symbol indicating the image type. DATAP indicates whether the image is +the raw image data or a filename. + +Returns an image instance with a margin per `cider-repl-image-margin'." + (create-image data type datap + :margin cider-repl-image-margin)) + +(defun cider-repl-handle-jpeg (_type buffer image &optional show-prefix bol) + "A handler for inserting a jpeg IMAGE into a repl BUFFER. +Part of the default `cider-repl-content-type-handler-alist'." + (cider-repl--display-image buffer + (cider-repl--image image 'jpeg t) + show-prefix bol image)) + +(defun cider-repl-handle-png (_type buffer image &optional show-prefix bol) + "A handler for inserting a png IMAGE into a repl BUFFER. +Part of the default `cider-repl-content-type-handler-alist'." + (cider-repl--display-image buffer + (cider-repl--image image 'png t) + show-prefix bol image)) + +(defun cider-repl-handle-external-body (type buffer _ &optional show-prefix bol) + "Handler for slurping external content into BUFFER. +Handles an external-body TYPE by issuing a slurp request to fetch the content." + (if-let* ((args (second type)) + (access-type (nrepl-dict-get args "access-type"))) + (nrepl-send-request + (list "op" "slurp" "url" (nrepl-dict-get args "URL")) + (cider-repl-handler buffer) + (cider-current-connection))) + nil) + +(defcustom cider-repl-content-type-handler-alist + `(("message/external-body" . ,#'cider-repl-handle-external-body) + ("image/jpeg" . ,#'cider-repl-handle-jpeg) + ("image/png" . ,#'cider-repl-handle-png)) + "Association list from content-types to handlers. + +Handlers must be functions of two required and two optional arguments - the +REPL buffer to insert into, the value of the given content type as a raw +string, the REPL's show prefix as any and an `end-of-line' flag. + +The return value of the handler should be a flag, indicating whether or not +the REPL is ready for a prompt to be displayed. Most handlers should return +`t', as the content-type response is (currently) an alternative to the +value response. However for handlers which themselves issue subsequent +nREPL ops, it may be convenient to prevent inserting a prompt." + :group 'cider-repl + :package-version '(cider . "0.17.0")) + (defun cider-repl-handler (buffer) "Make an nREPL evaluation handler for the REPL BUFFER." - (nrepl-make-response-handler buffer - (let (after-first-result-chunk) - (lambda (buffer value) - (cider-repl-emit-result buffer value (not after-first-result-chunk) t) - (setq after-first-result-chunk t))) - (lambda (buffer out) - (cider-repl-emit-stdout buffer out)) - (lambda (buffer err) - (cider-repl-emit-stderr buffer err)) - (lambda (buffer) - (cider-repl-emit-prompt buffer)) - nrepl-err-handler - (let (after-first-result-chunk) - (lambda (buffer pprint-out) - (cider-repl-emit-result buffer pprint-out (not after-first-result-chunk)) - (setq after-first-result-chunk t))))) + (let (after-first-result-chunk + (show-prompt t)) + (nrepl-make-response-handler + buffer + (lambda (buffer value) + (cider-repl-emit-result buffer value (not after-first-result-chunk) t) + (setq after-first-result-chunk t)) + (lambda (buffer out) + (cider-repl-emit-stdout buffer out)) + (lambda (buffer err) + (cider-repl-emit-stderr buffer err)) + (lambda (buffer) + (when show-prompt + (cider-repl-emit-prompt buffer) + (let ((win (get-buffer-window (current-buffer) t))) + (when win + (with-selected-window win + (set-window-point win cider-repl-input-start-mark)) + (cider-repl--show-maximum-output))))) + nrepl-err-handler + (lambda (buffer pprint-out) + (cider-repl-emit-result buffer pprint-out (not after-first-result-chunk)) + (setq after-first-result-chunk t)) + (lambda (buffer value content-type) + (if-let* ((content-attrs (second content-type)) + (content-type* (first content-type)) + (handler (cdr (assoc content-type* + cider-repl-content-type-handler-alist)))) + (setq after-first-result-chunk t + show-prompt (funcall handler content-type buffer value + (not after-first-result-chunk) t)) + (progn (cider-repl-emit-result buffer value (not after-first-result-chunk) t) + (setq after-first-result-chunk t))))))) + +(defun cider--repl-request-plist (right-margin &optional pprint-fn) + "Plist to be appended to generic eval requests, as for the REPL. +PPRINT-FN and RIGHT-MARGIN are as in `cider--nrepl-pprint-request-plist'." + (nconc (when cider-repl-use-pretty-printing + (cider--nrepl-pprint-request-plist right-margin pprint-fn)) + (when cider-repl-use-content-types + (cider--nrepl-content-type-plist)))) (defun cider-repl--send-input (&optional newline) "Go to the end of the input and send the current input. @@ -858,9 +975,7 @@ If NEWLINE is true then add a newline at the end of the input." (cider-current-ns) (line-number-at-pos input-start) (cider-column-number-at-pos input-start) - (unless (or (not cider-repl-use-pretty-printing) - (string-match-p "\\`[ \t\r\n]*\\'" input)) - (cider--nrepl-pprint-request-plist (cider--pretty-print-width)))))))) + (cider--repl-request-plist (cider--pretty-print-width))))))) (defun cider-repl-return (&optional end-of-input) "Evaluate the current input string, or insert a newline. @@ -936,6 +1051,13 @@ text property `cider-old-input'." fill-column 80)) +(defun cider-repl-toggle-content-types () + "Toggle content-type rendering in the REPL." + (interactive) + (setq cider-repl-use-content-types (not cider-repl-use-content-types)) + (message "Content-type support in REPL %s." + (if cider-repl-use-content-types "enabled" "disabled"))) + (defun cider-repl-switch-to-other () "Switch between the Clojure and ClojureScript REPLs for the current project." (interactive) |