/[slime]/slime/contrib/slime-media.el
ViewVC logotype

Contents of /slime/contrib/slime-media.el

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Mon Sep 12 16:23:59 2011 UTC (2 years, 7 months ago) by crhodes
Branch: MAIN
CVS Tags: SLIME-2-3, FAIRLY-STABLE, byte-stream, HEAD
Changes since 1.1: +5 -0 lines
new :popup-buffer slime-media event

Allows the inferior process to popup a buffer with given name, mode and
contents.  (Makes ?help work nicely in swankr.)
1 (define-slime-contrib slime-media
2 "Display things other than text in SLIME buffers"
3 (:authors "Christophe Rhodes <csr21@cantab.net>")
4 (:license "GPL")
5 (:slime-dependencies slime-repl)
6 (:swank-dependencies swank-media)
7 (:on-load
8 (add-hook 'slime-event-hooks 'slime-dispatch-media-event)))
9
10 (defun slime-dispatch-media-event (event)
11 (destructure-case event
12 ((:write-image image string)
13 (let ((image (find-image image)))
14 (slime-media-insert-image image string))
15 t)
16 ((:popup-buffer bufname string mode)
17 (slime-with-popup-buffer (bufname :mode mode :connection t :package t)
18 (princ string)
19 (goto-char (point-min)))
20 t)
21 (t nil)))
22
23 (defun slime-media-insert-image (image string &optional bol)
24 (with-current-buffer (slime-output-buffer)
25 (let ((marker (slime-output-target-marker :repl-result)))
26 (goto-char marker)
27 (slime-propertize-region `(face slime-repl-result-face
28 rear-nonsticky (face))
29 (insert-image image string))
30 ;; Move the input-start marker after the REPL result.
31 (set-marker marker (point)))
32 (slime-repl-show-maximum-output)))
33
34 (provide 'slime-media)

  ViewVC Help
Powered by ViewVC 1.1.5