Here's a new protocol message for outputting images. Unlike the previous
approach, it doesn't rely upon EVAL-IN-EMACS. The Bad Thing is that it
puts REPL-specific code inside DISPATCH-EVENT which should be
contrib-agnostic. There seems to be no way to add protocol messages in
contribs, maybe there's some better way not involving protocol messages.
I added the `fake-p' stuff because if it isn't there, the image is
displayed right before the last REPL result (maybe dependent upon
presentations?).
PS in the last commit I got credited as "StanisBaw". The "ł" character
apparently got turned into this "B". It can be transliterated to ASCII
as "l" if the changelog has problems with Unicode.
diff --git a/contrib/slime-repl.el b/contrib/slime-repl.el
index 9e05531..3bcb894 100644
--- a/contrib/slime-repl.el
+++ b/contrib/slime-repl.el
@@ -719,23 +719,27 @@ balanced."
(goto-char (point-max))
(recenter -1))))
-(defun slime-repl-send-input (&optional newline)
+(defun slime-repl-send-input (&optional newline fake-p)
"Goto to the end of the input and send the current input.
-If NEWLINE is true then add a newline at the end of the input."
+If NEWLINE is true then add a newline at the end of the input.
+When FAKE-P is true it doesn't get added to history. Useful for
+adding images to the REPL."
(unless (slime-repl-in-input-area-p)
(error "No input at point."))
(goto-char (point-max))
(let ((end (point))) ; end of input, without the newline
- (slime-repl-add-to-input-history
- (buffer-substring slime-repl-input-start-mark end))
+ (unless fake-p
+ (slime-repl-add-to-input-history
+ (buffer-substring slime-repl-input-start-mark end)))
(when newline
(insert "\n")
(slime-repl-show-maximum-output))
- (let ((inhibit-modification-hooks t))
- (add-text-properties slime-repl-input-start-mark
- (point)
- `(slime-repl-old-input
- ,(incf slime-repl-old-input-counter))))
+ (unless fake-p
+ (let ((inhibit-modification-hooks t))
+ (add-text-properties slime-repl-input-start-mark
+ (point)
+ `(slime-repl-old-input
+ ,(incf slime-repl-old-input-counter)))))
(let ((overlay (make-overlay slime-repl-input-start-mark end)))
;; These properties are on an overlay so that they won't be taken
;; by kill/yank.
@@ -745,7 +749,8 @@ If NEWLINE is true then add a newline at the end of the input."
(goto-char (point-max))
(slime-mark-input-start)
(slime-mark-output-start)
- (slime-repl-send-string input)))
+ (unless fake-p
+ (slime-repl-send-string input))))
(defun slime-repl-grab-old-input (replace)
"Resend the old REPL input at point.
diff --git a/slime.el b/slime.el
index c392996..e60a022 100644
--- a/slime.el
+++ b/slime.el
@@ -2392,6 +2392,12 @@ Debugged requests are ignored."
(let ((slime-dispatching-connection (or process (slime-connection))))
(or (run-hook-with-args-until-success 'slime-event-hooks event)
(destructure-case event
+ ((:write-image pathname)
+ (if (file-exists-p pathname)
+ (with-current-buffer (slime-repl-buffer)
+ (insert-image (create-image pathname))
+ (slime-repl-send-input t t))
+ (error "No such file: '%s'" pathname)))
((:emacs-rex form package thread continuation)
(when (and (slime-use-sigint-for-interrupt) (slime-busy-p))
(slime-display-oneliner "; pipelined request... %S" form))
diff --git a/swank.lisp b/swank.lisp
index 9b1f0f4..a259797 100644
--- a/swank.lisp
+++ b/swank.lisp
@@ -1174,7 +1174,16 @@ The processing is done in the extent of the toplevel restart."
((:reader-error packet condition)
(encode-message `(:reader-error ,packet
,(safe-condition-message condition))
- (current-socket-io)))))
+ (current-socket-io)))
+ ((:write-image pathname)
+ (handler-case (namestring (truename pathname))
+ (error (e)
+ (declare (ignore e))
+ nil)
+ (:no-error (string)
+ (when string
+ (encode-message `(:write-image ,string)
+ (current-socket-io))))))))
(defvar *event-queue* '())
(defvar *events-enqueued* 0)
@@ -3845,4 +3854,4 @@ Collisions are caused because package information is ignored."
(defun init ()
(run-hook *after-init-hook*))
-;;; swank.lisp ends here
\ No newline at end of file
+;;; swank.lisp ends here