1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
(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)
|
