[slime-cvs] CVS slime
mkoeppe
mkoeppe at common-lisp.net
Fri Dec 29 16:08:58 UTC 2006
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv31017
Modified Files:
slime.el
Log Message:
(slime-repl-insert-prompt): Don't insert a result, only
the prompt.
(slime-repl-insert-result): Removed.
(slime-repl-eval-string, slime-repl-show-abort)
(slime-repl-set-package, slime-output-buffer)
(slime-repl-update-banner): Change all callers.
(slime-dispatch-event): Event :WRITE-STRING gets an
optional argument TARGET, which controls where the string is
inserted.
(slime-write-string): Handle targets NIL (regular process output)
and :REPL-RESULT.
--- /project/slime/cvsroot/slime/slime.el 2006/12/28 14:14:46 1.726
+++ /project/slime/cvsroot/slime/slime.el 2006/12/29 16:08:56 1.727
@@ -2636,12 +2636,8 @@
(defun slime-dispatch-event (event &optional process)
(let ((slime-dispatching-connection (or process (slime-connection))))
(destructure-case event
- ((:write-string output &optional id)
- (if id
- (with-current-buffer (slime-output-buffer)
- (slime-with-output-end-mark
- (slime-insert-presentation output id)))
- (slime-write-string output)))
+ ((:write-string output &optional id target)
+ (slime-write-string output id target))
((:presentation-start id)
(slime-mark-presentation-start id))
((:presentation-end id)
@@ -2819,7 +2815,7 @@
(setq slime-buffer-connection connection)
(slime-reset-repl-markers)
(unless noprompt
- (slime-repl-insert-prompt '(:suppress-output) 0))
+ (slime-repl-insert-prompt 0))
(current-buffer)))))))
(defun slime-repl-update-banner ()
@@ -2841,8 +2837,7 @@
(animate-string (format "; SLIME %s" (or (slime-changelog-date)
"- ChangeLog file not found"))
0 0))
- (slime-repl-insert-prompt (cond (use-header-p `(:suppress-output))
- (t `(:values (,(concat "; " banner))))))))
+ (slime-repl-insert-prompt)))
(defun slime-init-output-buffer (connection)
(with-current-buffer (slime-output-buffer t)
@@ -3096,15 +3091,31 @@
(switch-to-buffer (process-buffer proc))
(goto-char (point-max)))))
-(defun slime-write-string (string)
- (with-current-buffer (slime-output-buffer)
- (slime-with-output-end-mark
- (slime-propertize-region '(face slime-repl-output-face)
- (insert string))
- (when (and (= (point) slime-repl-prompt-start-mark)
- (not (bolp)))
- (insert "\n")
- (set-marker slime-output-end (1- (point)))))))
+(defun slime-write-string (string &optional id target)
+ "Insert STRING in the REPL buffer. If ID is non-nil, insert STRING
+as a presentation. If TARGET is nil, insert STRING as regular process
+output. If TARGET is :repl-result, insert STRING as the result of the
+evaluation."
+ ;; Other values of TARGET are reserved for future extension,
+ ;; for instance asynchronous output in scratch buffers. --mkoeppe
+ (ecase target
+ ((nil) ; Regular process output
+ (with-current-buffer (slime-output-buffer)
+ (slime-with-output-end-mark
+ (if id
+ (slime-insert-presentation string id)
+ (slime-insert-propertized '(face slime-repl-output-face) string))
+ (when (and (= (point) slime-repl-prompt-start-mark)
+ (not (bolp)))
+ (insert "\n")
+ (set-marker slime-output-end (1- (point)))))))
+ (:repl-result
+ (with-current-buffer (slime-output-buffer)
+ (goto-char (point-max))
+ ;;(unless (bolp) (insert "\n"))
+ (if id
+ (slime-insert-presentation string id)
+ (slime-insert-propertized `(face slime-repl-result-face) string))))))
(defun slime-switch-to-output-buffer (&optional connection)
"Select the output buffer, preferably in a different window."
@@ -3540,57 +3551,33 @@
(when choice
(call-interactively (gethash choice choice-to-lambda)))))))))
-(defun slime-repl-insert-prompt (result &optional time)
- "Goto to point max, insert RESULT and the prompt.
+(defun slime-repl-insert-prompt (&optional time)
+ "Goto to point max, and insert the prompt.
Set slime-output-end to start of the inserted text slime-input-start
to end end."
(goto-char (point-max))
- (let ((start (point)))
- (unless (bolp) (insert "\n"))
- (slime-repl-insert-result result)
- (let ((prompt-start (point))
- (prompt (format "%s> " (slime-lisp-package-prompt-string))))
- (slime-propertize-region
- '(face slime-repl-prompt-face read-only t intangible t
- slime-repl-prompt t
- ;; emacs stuff
- rear-nonsticky (slime-repl-prompt read-only face intangible)
- ;; xemacs stuff
- start-open t end-open t)
- (insert prompt))
- ;; FIXME: we could also set beginning-of-defun-function
- (setq defun-prompt-regexp (concat "^" prompt))
- (set-marker slime-output-end start)
- (set-marker slime-repl-prompt-start-mark prompt-start)
- (slime-mark-input-start)
- (let ((time (or time 0.2)))
- (cond ((zerop time)
- (slime-repl-move-output-mark-before-prompt (current-buffer)))
- (t
- (run-at-time time nil 'slime-repl-move-output-mark-before-prompt
- (current-buffer)))))))
+ (unless (bolp) (insert "\n"))
+ (let ((prompt-start (point))
+ (prompt (format "%s> " (slime-lisp-package-prompt-string))))
+ (slime-propertize-region
+ '(face slime-repl-prompt-face read-only t intangible t
+ slime-repl-prompt t
+ ;; emacs stuff
+ rear-nonsticky (slime-repl-prompt read-only face intangible)
+ ;; xemacs stuff
+ start-open t end-open t)
+ (insert prompt))
+ ;;(set-marker slime-output-end start)
+ (set-marker slime-repl-prompt-start-mark prompt-start)
+ (slime-mark-input-start)
+ (let ((time (or time 0.2)))
+ (cond ((zerop time)
+ (slime-repl-move-output-mark-before-prompt (current-buffer)))
+ (t
+ (run-at-time time nil 'slime-repl-move-output-mark-before-prompt
+ (current-buffer))))))
(slime-repl-show-maximum-output))
-(defun slime-repl-insert-result (result)
- "Insert the result of an evaluation.
-RESULT can be one of:
- (:values (STRING...))
- (:present ((STRING . ID)...))
- (:suppress-output)"
- (destructure-case result
- ((:values strings)
- (cond ((null strings) (insert "; No value\n"))
- (t (dolist (s strings)
- (slime-insert-propertized `(face slime-repl-result-face) s)
- (insert "\n")))))
- ((:present stuff)
- (cond ((and stuff slime-repl-enable-presentations)
- (loop for (s . id) in stuff do
- (slime-insert-presentation s id)
- (insert "\n")))
- (t (slime-repl-insert-result `(:values ,(mapcar #'car stuff))))))
- ((:suppress-output))))
-
(defun slime-repl-move-output-mark-before-prompt (buffer)
(when (buffer-live-p buffer)
(with-current-buffer buffer
@@ -3686,10 +3673,13 @@
(defun slime-repl-eval-string (string)
(slime-rex ()
((list 'swank:listener-eval string) (slime-lisp-package))
- ((:ok result)
+ ((:ok result)
(with-current-buffer (slime-output-buffer)
- (slime-repl-insert-prompt result)))
- ((:abort) (slime-repl-show-abort))))
+ (slime-repl-insert-prompt)))
+ ((:abort)
+ (slime-repl-show-abort)
+ (with-current-buffer (slime-output-buffer)
+ (slime-repl-insert-prompt)))))
(defun slime-repl-send-string (string &optional command-string)
(cond (slime-repl-read-mode
@@ -3700,13 +3690,7 @@
(with-current-buffer (slime-output-buffer)
(slime-with-output-end-mark
(unless (bolp) (insert-before-markers "\n"))
- (insert-before-markers "; Evaluation aborted\n"))
- (slime-rex ()
- ((list 'swank:listener-eval "") nil)
- ((:ok result)
- ;; A hack to get the prompt
- (with-current-buffer (slime-output-buffer)
- (slime-repl-insert-prompt '(:suppress-output)))))))
+ (insert-before-markers "; Evaluation aborted\n"))))
(defun slime-mark-input-start ()
(set-marker slime-repl-last-input-start-mark
@@ -4022,7 +4006,7 @@
(slime-eval `(swank:set-package ,package))
(setf (slime-lisp-package) name)
(setf (slime-lisp-package-prompt-string) prompt-string)
- (slime-repl-insert-prompt '(:suppress-output) 0)
+ (slime-repl-insert-prompt 0)
(insert unfinished-input)))))
More information about the slime-cvs
mailing list