Honor content types for interactive evaluations

Rich results were REPL-prompt-only since 2018 (#2476): evaluating a
form returning an image from a source buffer just printed the object.
Interactive evals now opt in to content-typed responses, and the new
cider-eval-rich-content-destination controls where rich results render:
inline in the result overlay (the default), in the REPL (reusing its
content-type handlers, buttons included), in the *cider-result* popup,
or nil for the old plain-value behavior.

Author: bbatsov

CHANGELOG.md

@@ -4,6 +4,7 @@
 
 ### New features
 
+- Honor content types for interactive evaluations too ([#2476](https://github.com/clojure-emacs/cider/issues/2476)): a `cider-eval-last-sexp` returning an image can now render it, per the new `cider-eval-rich-content-destination` - `inline` (the default, in the result overlay at point), `repl` (like results of forms typed at the prompt, with the `[show content]` button for external references), `popup` (the `*cider-result*` buffer) or `nil` (plain values, the previous behavior).
 - Add a transient menu to the debugger (`cider-debug-menu`, bound to `?` during a debug session), grouping all the debugger's single-key commands; they are also proper named commands now (e.g. `cider-debug-next`, `cider-debug-quit`), so they can be invoked via `M-x` as well.
 - Add a transient menu to the inspector (`cider-inspector-menu`, bound to `m` in the inspector buffer), grouping all the inspector commands.
 - [#4065](https://github.com/clojure-emacs/cider/pull/4065): Add a `--print-fn=` flag to the pretty-print transient menu (`cider-eval-pprint-menu`) to pick the printer (pr/pprint/fipp/puget/zprint or a custom var) per invocation.

doc/modules/ROOT/pages/repl/configuration.adoc

@@ -306,6 +306,11 @@ IO (see https://github.com/clojure-emacs/cider/issues/2825[the discussion]).
 The on-demand button, together with the hardened `cider-nrepl` middleware
 (scheme allowlist, size caps, graceful fetch errors), resolves that.
 
+TIP: Interactive evaluations (e.g. kbd:[C-x C-e] in a source buffer) get the
+same treatment, controlled separately by
+`cider-eval-rich-content-destination` - see
+xref:usage/code_evaluation.adoc[Code Evaluation].
+
 == REPL type detection
 
 Normally CIDER would detect automatically the type of a REPL (Clojure or ClojureScript), based

doc/modules/ROOT/pages/usage/code_evaluation.adoc

@@ -411,7 +411,32 @@ Additionally, there's the variable `cider-redirect-server-output-to-repl` that c
 
 NOTE: The redirection functionality is implemented in `cider-nrepl` as nREPL middleware. If you're using CIDER without `cider-nrepl` no output redirection is going to take place.
 
+=== Rich Results
+
+When an interactive evaluation produces a value with a recognized content
+type - an image, or a reference to external content such as a file or URL -
+CIDER can render it instead of just printing the value.  Where it renders is
+controlled by `cider-eval-rich-content-destination`:
+
+* `inline` (the default) - directly displayable content (images) shows in
+  the result overlay at point, just like a regular evaluation result;
+  anything that can't render inline falls back to its plain-text
+  representation.
+* `repl` - rich results render in the current REPL buffer, exactly like the
+  results of forms entered at the prompt; references to external content get
+  a `[show content]` button there.
+* `popup` - rich results render in the `+*cider-result*+` popup buffer,
+  where external references also get a fetch button.
+* `nil` - disable the feature; results display as plain printed values.
 
+[source,lisp]
+----
+(setq cider-eval-rich-content-destination 'repl)
+----
+
+This is the interactive-evaluation counterpart of the REPL's rich content
+support (see xref:repl/configuration.adoc[REPL Configuration]) and likewise
+requires `cider-nrepl`.
 
 === Storing eval results
 

lisp/cider-eval.el

@@ -143,6 +143,30 @@ If `output-buffer', it's sent to a dedicated `*cider-out*' buffer."
   :group 'cider
   :package-version '(cider . "2.0.0"))
 
+(defcustom cider-eval-rich-content-destination 'inline
+  "Where rich (content-typed) interactive evaluation results are rendered.
+When an interactive evaluation (e.g. `cider-eval-last-sexp') produces a
+value with a recognized content type - an image, or a reference to external
+content such as a file or URL - this controls where that content shows up:
+
+  `inline' - render directly displayable content (images) in the result
+             overlay at point; other rich results fall back to their
+             plain-text representation.
+  `repl'   - render in the current REPL buffer, exactly like rich results
+             of forms entered at the REPL prompt (references to external
+             content get a [show content] button there).
+  `popup'  - render in the `*cider-result*' popup buffer.
+  nil      - don't request rich content; results display as plain values.
+
+This is the interactive-evaluation counterpart of
+`cider-repl-use-content-types', and likewise requires cider-nrepl."
+  :type '(choice (const :tag "Inline, in the result overlay" inline)
+                 (const :tag "In the REPL buffer" repl)
+                 (const :tag "In a popup buffer" popup)
+                 (const :tag "Plain printed values" nil))
+  :group 'cider
+  :package-version '(cider . "2.0.0"))
+
 (defcustom cider-comment-prefix ";; => "
   "The prefix to insert before the first line of commented output."
   :type 'string
@@ -403,6 +427,109 @@ Cancel their animation timers and delete the overlays."
   (setq cider--eval-pending-overlays nil))
 
 (declare-function cider-inspect-last-result "cider-inspector")
+;;; Rich content rendering for interactive evals
+
+(defvar cider-repl-content-type-handler-alist)
+(declare-function cider-repl-emit-result "cider-repl")
+
+(defconst cider--image-content-types
+  '(("image/jpeg" . jpeg) ("image/png" . png) ("image/svg+xml" . svg))
+  "Mapping from image MIME types to Emacs image types.")
+
+(defun cider--external-body-url (content-type)
+  "Return the URL referenced by an external-body CONTENT-TYPE, or nil."
+  (pcase-let ((`(,type ,attrs) content-type))
+    (when (equal type "message/external-body")
+      (when-let* ((access-type (nrepl-dict-get attrs "access-type")))
+        (nrepl-dict-get attrs access-type)))))
+
+(defun cider--rich-content-fallback-string (body content-type)
+  "Return a plain-text stand-in for BODY of CONTENT-TYPE.
+Used when rich content can't (or shouldn't) be rendered: external
+references display as their URL, images as a short tag, and anything
+else as its raw body."
+  (pcase-let ((`(,type ,_attrs) content-type))
+    (cond
+     ((cider--external-body-url content-type))
+     ((assoc type cider--image-content-types) (format "#content[%s]" type))
+     (t body))))
+
+(defun cider--render-rich-content-inline (body content-type point)
+  "Render BODY of CONTENT-TYPE in a result overlay at POINT, if possible.
+Only directly displayable content (images) is rendered inline; return nil
+otherwise, so the caller falls back to a plain display."
+  (when-let* ((image-type (cdr (assoc (car content-type)
+                                      cider--image-content-types))))
+    (when (and point
+               (display-images-p)
+               (memq (cider--eval-result-display) '(overlay both)))
+      (cider--make-result-overlay (propertize " " 'display
+                                              (create-image body image-type t))
+        :where point
+        :duration cider-eval-result-duration
+        :prepend-face 'cider-result-overlay-face)
+      (message "%s#content[%s]" cider-eval-result-prefix (car content-type))
+      t)))
+
+(defun cider--render-rich-content-repl (body content-type)
+  "Render BODY of CONTENT-TYPE in the current REPL buffer.
+Reuses the REPL's `cider-repl-content-type-handler-alist' handlers, so
+this behaves exactly like a rich result of a form entered at the prompt.
+Return nil when there's no REPL to render into."
+  (when-let* ((repl (cider-current-repl)))
+    (if-let* ((handler (cdr (assoc (car content-type)
+                                   cider-repl-content-type-handler-alist))))
+        (funcall handler content-type repl body t t)
+      (cider-repl-emit-result repl body t t))
+    t))
+
+(defun cider--popup-insert-rich-content (buffer body content-type)
+  "Insert BODY of CONTENT-TYPE at the end of the popup BUFFER."
+  (with-current-buffer buffer
+    (let ((inhibit-read-only t))
+      (goto-char (point-max))
+      (cond
+       ((when-let* ((image-type (cdr (assoc (car content-type)
+                                            cider--image-content-types))))
+          (insert-image (create-image body image-type t) " ")
+          (insert "\n")
+          t))
+       ((when-let* ((url (cider--external-body-url content-type)))
+          (insert url " ")
+          (insert-text-button "[show content]"
+                              'follow-link t
+                              'help-echo (format "Fetch %s and render it here" url)
+                              'action (lambda (_button)
+                                        (cider--popup-fetch-external-body buffer url)))
+          (insert "\n")
+          t))
+       (t (insert body "\n"))))))
+
+(defun cider--popup-fetch-external-body (buffer url)
+  "Fetch URL via the cider/slurp op and render it into popup BUFFER."
+  (cider-nrepl-send-request
+   (list "op" "cider/slurp" "url" url)
+   (cider-make-eval-handler
+    :buffer buffer
+    :on-content-type (lambda (body content-type)
+                       (cider--popup-insert-rich-content buffer body content-type)))))
+
+(defun cider--render-rich-content-popup (body content-type)
+  "Render BODY of CONTENT-TYPE in the `*cider-result*' popup buffer."
+  (let ((buffer (cider-popup-buffer cider-result-buffer nil 'clojure-mode 'ancillary)))
+    (cider--popup-insert-rich-content buffer body content-type)
+    t))
+
+(defun cider--display-rich-content (body content-type point)
+  "Display BODY of CONTENT-TYPE per `cider-eval-rich-content-destination'.
+POINT anchors inline overlays.  Return non-nil when the content was
+rendered; nil means the caller should fall back to a plain display."
+  (pcase cider-eval-rich-content-destination
+    ('inline (cider--render-rich-content-inline body content-type point))
+    ('repl (cider--render-rich-content-repl body content-type))
+    ('popup (cider--render-rich-content-popup body content-type))
+    (_ nil)))
+
 (defun cider-interactive-eval-handler (&optional buffer place)
   "Make an interactive eval handler for BUFFER.
 PLACE is used to display the evaluation result.
@@ -426,6 +553,14 @@ when `cider-auto-inspect-after-eval' is non-nil."
                      (cider--eval-pending-overlay-remove)))
                  (setq res (concat res value))
                  (cider--display-interactive-eval-result res 'value end))
+     :on-content-type (lambda (body content-type)
+                        (when (buffer-live-p eval-buffer)
+                          (with-current-buffer eval-buffer
+                            (cider--eval-pending-overlay-remove)))
+                        (unless (cider--display-rich-content body content-type end)
+                          (setq res (concat res (cider--rich-content-fallback-string
+                                                 body content-type)))
+                          (cider--display-interactive-eval-result res 'value end)))
      :on-stdout #'cider-emit-interactive-eval-output
      :on-stderr (lambda (err)
                   (cider-emit-interactive-eval-err-output err)
@@ -674,7 +809,12 @@ arguments and only proceed with evaluation if it returns nil."
              :ns (if (cider-ns-form-p form) "user" (cider-current-ns))
              :line (when start (line-number-at-pos start))
              :column (when start (cider-column-number-at-pos start))
-             :additional-params additional-params
+             ;; Opt in to content-typed responses; handlers without an
+             ;; `:on-content-type' slot still see the plain value, since
+             ;; the server sends both.
+             :additional-params (append (when cider-eval-rich-content-destination
+                                          (list "content-type" "true"))
+                                        additional-params)
              :connection connection)))))))
 
 (defun cider-eval-region (start end)

test/cider-eval-tests.el

@@ -403,3 +403,75 @@
        nil
        (lambda () (setq captured cider-print-fn)))
       (expect captured :to-equal 'pprint))))
+
+(describe "cider--external-body-url"
+  (it "extracts the URL from an external-body content-type"
+    (expect (cider--external-body-url
+             (list "message/external-body"
+                   (nrepl-dict "access-type" "URL" "URL" "file:/tmp/x.png")))
+            :to-equal "file:/tmp/x.png"))
+  (it "returns nil for other content types"
+    (expect (cider--external-body-url (list "image/png" (nrepl-dict)))
+            :to-be nil)))
+
+(describe "cider--rich-content-fallback-string"
+  (it "falls back to the URL for external bodies"
+    (expect (cider--rich-content-fallback-string
+             ""
+             (list "message/external-body"
+                   (nrepl-dict "access-type" "URL" "URL" "https://foo.bar/x.png")))
+            :to-equal "https://foo.bar/x.png"))
+  (it "falls back to a short tag for images"
+    (expect (cider--rich-content-fallback-string "<binary>" (list "image/png" (nrepl-dict)))
+            :to-equal "#content[image/png]"))
+  (it "falls back to the raw body for anything else"
+    (expect (cider--rich-content-fallback-string "graph foo {}" (list "text/vnd.graphviz" (nrepl-dict)))
+            :to-equal "graph foo {}")))
+
+(describe "cider--display-rich-content"
+  (it "does nothing when the destination is nil"
+    (let ((cider-eval-rich-content-destination nil))
+      (expect (cider--display-rich-content "body" (list "image/png" (nrepl-dict)) nil)
+              :to-be nil)))
+
+  (it "dispatches to the REPL's content-type handlers for the repl destination"
+    (let ((cider-eval-rich-content-destination 'repl)
+          (handled nil))
+      (cl-letf (((symbol-function 'cider-current-repl)
+                 (lambda (&rest _) (current-buffer)))
+                (cider-repl-content-type-handler-alist
+                 (list (cons "image/png"
+                             (lambda (_type _buffer body &rest _)
+                               (setq handled body))))))
+        (expect (cider--display-rich-content "IMG" (list "image/png" (nrepl-dict)) nil)
+                :to-be-truthy)
+        (expect handled :to-equal "IMG"))))
+
+  (it "reports failure for the repl destination when no REPL is around"
+    (let ((cider-eval-rich-content-destination 'repl))
+      (cl-letf (((symbol-function 'cider-current-repl) (lambda (&rest _) nil)))
+        (expect (cider--display-rich-content "IMG" (list "image/png" (nrepl-dict)) nil)
+                :to-be nil))))
+
+  (it "renders images inline via a result overlay"
+    (let ((cider-eval-rich-content-destination 'inline)
+          (overlaid nil))
+      (cl-letf (((symbol-function 'display-images-p) (lambda (&rest _) t))
+                ((symbol-function 'cider--eval-result-display) (lambda () 'both))
+                ((symbol-function 'cider--make-result-overlay)
+                 (lambda (string &rest _) (setq overlaid string)))
+                ((symbol-function 'create-image)
+                 (lambda (&rest _) '(image :type png)))
+                ((symbol-function 'message) #'ignore))
+        (expect (cider--display-rich-content "IMG" (list "image/png" (nrepl-dict)) 42)
+                :to-be-truthy)
+        (expect (get-text-property 0 'display overlaid) :to-equal '(image :type png)))))
+
+  (it "declines inline rendering for external bodies"
+    (let ((cider-eval-rich-content-destination 'inline))
+      (expect (cider--display-rich-content
+               ""
+               (list "message/external-body"
+                     (nrepl-dict "access-type" "URL" "URL" "file:/x"))
+               42)
+              :to-be nil))))