(eval-and-compile
  (require 'slime))

(define-slime-contrib slime-media
  "Display things other than text in SLIME buffers"
  (:authors "Christophe Rhodes <csr21@cantab.net>")
  (:license "GPL")
  (:slime-dependencies slime-repl)
  (:swank-dependencies swank-media)
  (:on-load
   (add-hook 'slime-event-hooks 'slime-dispatch-media-event)))

(defun slime-media-decode-image (image)
  (mapcar (lambda (image)
	    (if (plist-get image :data)
		(plist-put image :data (base64-decode-string (plist-get image :data)))
	      image))
	  image))

(defun slime-dispatch-media-event (event)
  (slime-dcase event
    ((:write-image image string)
     (let ((img (or (find-image (slime-media-decode-image image))
                    (create-image image))))
       (slime-media-insert-image img string))
     t)
    ((:popup-buffer bufname string mode)
     (slime-with-popup-buffer (bufname :connection t :package t)
       (when mode (funcall mode))
       (princ string)
       (goto-char (point-min)))
     t)
    (t nil)))

(defun slime-media-insert-image (image string &optional bol)
  (with-current-buffer (slime-output-buffer)
    (let ((marker (slime-repl-output-target-marker :repl-result)))
      (goto-char marker)
      (slime-propertize-region `(face slime-repl-result-face
                                      rear-nonsticky (face))
        (insert-image image string))
      ;; Move the input-start marker after the REPL result.
      (set-marker marker (point)))
    (slime-repl-show-maximum-output)))

(provide 'slime-media)