--- slime.el.~1.509~	2005-06-18 16:43:11.000000000 -0400
+++ slime.el	2005-06-18 19:37:06.000000000 -0400
@@ -2276,7 +2276,7 @@
   (let ((slime-dispatching-connection (or process (slime-connection))))
     (destructure-case event
       ((:read-output output)
-       (slime-output-string output))
+       (slime-output-string output #'slime-repl-transcript-maybe-prefix-as-output))
       ;;
       ((:emacs-rex form package thread continuation)
        (slime-set-state "|eval...")
@@ -2552,7 +2552,7 @@
   (when (and (slime-connected-p)
              (plusp (length string)))
     (with-current-buffer (process-buffer process)
-      (slime-output-string string))))
+      (slime-output-string string #'slime-repl-transcript-maybe-prefix-as-output))))
 
 ;; FIXME: This conditional is not right - just used because the code
 ;; here does not work in XEmacs.
@@ -2619,14 +2619,158 @@
       (slime-net-send secret stream))
     stream))
 
-(defun slime-output-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")
+(defvar slime-repl-transcript-make-transcript nil
+  "If non-NIL, prepend prefix strings to lines printed in the
+REPL buffer.  Should only ever be non-NIL in REPL buffers, where
+its value should be buffer-local.  See variable
+`slime-repl-transcript-string-prefix-alist' for details about
+prefixes.")
+
+(defvar slime-repl-transcript-string-prefix-alist
+  '((output . "-| ")
+    (input . "<- ")
+    (error . "!! ")
+    (value . "=> "))
+  "Alist of (kind . prefix) pairs whose prefix strings are to be
+prepended to different kinds of lines printed in the REPL when
+`slime-repl-transcript-make-transcript' is non-NIL.  Supported
+kinds: output, input, error, and value.")
+
+(defun slime-repl-transcript-get-prefix-for-string-kind (string-kind)
+  (cdr (assoc string-kind  slime-repl-transcript-string-prefix-alist)))
+
+(defun slime-repl-do-prefix-string (string prefix)
+  ;; Peel off a terminal newline, and put it back at the end.
+  (let* ((final-char "")
+         (str (if (= ?\n (elt string (1- (length string))))
+                  (progn
+                    (setq final-char (string ?\n))
+                    (substring string 0 (1- (length string))))
+                  string)))
+    (concat
+     (replace-regexp-in-string 
+      "^"
+      (concat prefix "\\&")
+      str)
+     final-char)))
+
+;; The next four defuns handle every case we prepend prefix strings
+;; to.
+(defun slime-repl-transcript-maybe-prefix-as-output (string)
+  (let ((prefix (slime-repl-transcript-get-prefix-for-string-kind 'output)))
+    (if (and slime-repl-transcript-make-transcript prefix)
+        (slime-repl-do-prefix-string string prefix)
+        string)))
+(defun slime-repl-transcript-maybe-prefix-as-error (string)
+  (let ((prefix (slime-repl-transcript-get-prefix-for-string-kind 'error)))
+    (if (and slime-repl-transcript-make-transcript prefix)
+        (slime-repl-do-prefix-string string prefix)
+        string)))
+;; Munging values for printing is different from munging other string
+;; kinds, because printed values are structured.  So only print the
+;; value prefix for the first line of each value, but preserve
+;; indentation.
+(defun slime-repl-transcript-maybe-prefix-as-value (string)
+  (flet ((prefix-value-string (string prefix)
+           (let ((length (length prefix)))
+             (with-temp-buffer
+               (lisp-mode)
+               (insert string)
+               (goto-char (point-max))
+               (beginning-of-line)
+               (string-rectangle (point-min)
+                                 (point) 
+                                 (make-string length
+                                              ?\ ))
+               (goto-char (point-min))
+               (while (not (eobp))
+                 (delete-char length)
+                 (insert prefix)
+                 (forward-sexp)
+                 (if (> (forward-line) 1)
+                     (beginning-of-line)))
+               (buffer-string)))))
+    (let ((prefix (slime-repl-transcript-get-prefix-for-string-kind 'value)))
+      (if (and slime-repl-transcript-make-transcript prefix)
+          (prefix-value-string string prefix)
+          string))))
+;; Unlike the other prefixers, this one just changes the REPL buffer,
+;; rather than returning a string.
+(defun slime-repl-transcript-maybe-prefix-as-input (string)
+  (let ((prefix (slime-repl-transcript-get-prefix-for-string-kind 'input)))
+    (when (and slime-repl-transcript-make-transcript prefix)
+      (when slime-repl-read-mode
+        (save-excursion
+          (goto-char slime-repl-input-start-mark)
+          (insert prefix))))))
+
+;; Printing conditions automatically requires us to add a function to
+;; sldb-hook, but I don't see a dynamic scope that includes both
+;; slime-repl-send-input and slime-repl-insert-prompt, so we need this
+;; variable.
+(defvar slime-repl-transcript-autoprint-conditions nil
+  "If non-NIL, always print conditions to REPL buffer when
+entering SLDB, if slime-repl-transcript-autoprint-conditions is a
+member of sldb-hook.  Should usually be NIL.")
+
+(defun slime-repl-transcript-autoprint-conditions ()
+  "See variable `slime-repl-transcript-autoprint-conditions'."
+  (when slime-repl-transcript-autoprint-conditions
+    (sldb-print-condition)))
+
+(defun slime-repl-transcript-toggle-transcript-printing ()
+  "Turn on or turn off fancy printing of input, output, errors,
+and return values in the slime-repl buffer.  Set prefix strings
+in `slime-repl-transcript-string-prefix-alist'."
+  (interactive)
+  (let ((buf (slime-output-buffer)))
+    (set-buffer buf)
+    (unless (boundp 'slime-repl-transcript-defrobber-functions)
+      ;; First time calling turning this on in this REPL buffer.
+      (set (make-local-variable 'slime-repl-transcript-defrobber-functions) nil)
+      (make-variable-buffer-local 'slime-repl-transcript-make-transcript))
+    (if slime-repl-transcript-make-transcript
+        ;; Turning off transcription
+        (progn 
+          (setq slime-repl-transcript-make-transcript nil)
+          (mapc
+           #'(lambda (fn) (funcall fn))
+           slime-repl-transcript-defrobber-functions)
+          (setq slime-repl-transcript-defrobber-functions nil)
+          (insert-before-markers
+           ",transcript\n; REPL transcript printing deactivated\n")
+          (slime-rex ()
+              ((list 'swank:listener-eval "") nil)
+            ((:ok result) (with-current-buffer (slime-output-buffer)
+                            (slime-repl-insert-prompt "")))))
+        ;; Turning on transcription.
+        (progn
+          (setq slime-repl-transcript-make-transcript t)
+          (unless (member 'sldb-print-condition sldb-hook)
+            (add-hook 'sldb-hook 'slime-repl-transcript-autoprint-conditions)
+            (push #'(lambda ()
+                      (setq sldb-hook 
+                            (delete 'slime-repl-transcript-autoprint-conditions
+                                    sldb-hook)))
+                  slime-repl-transcript-defrobber-functions))
+          (insert-before-markers 
+           ",transcript\n; REPL transcript printing activated\n")
+          (slime-rex ()
+              ((list 'swank:listener-eval "") nil)
+            ((:ok result) (with-current-buffer (slime-output-buffer)
+                            (slime-repl-insert-prompt ""))))))))
+
+(defun slime-output-string (string &optional string-prefixer)
+  (with-current-buffer (slime-output-buffer)                                             
+    (slime-with-output-end-mark                                                          
+     (slime-propertize-region '(face slime-repl-output-face)                             
+       (insert (funcall (if string-prefixer
+                            string-prefixer
+                            #'identity)
+                        string)))
+     (when (and (= (point) slime-repl-prompt-start-mark)                                 
+                (not (bolp)))                                                            
+       (insert "\n")                                                                     
        (set-marker slime-output-end (1- (point)))))))
 
 (defun slime-switch-to-output-buffer (&optional connection)
@@ -2883,6 +3027,7 @@
 slime-output-end to start of the inserted text slime-input-start to
 end end."
   (slime-flush-output)
+  (setq slime-repl-transcript-autoprint-conditions nil) ; enabled in s-r-send-input
   (goto-char (point-max))
   (let ((start (point)))
     (unless (bolp) (insert "\n"))
@@ -2894,7 +3039,7 @@
                         slime-repl-old-output  ,(- slime-current-output-id)
                         mouse-face slime-repl-output-mouseover-face
                         keymap ,slime-presentation-map))
-        (insert result)))
+        (insert (slime-repl-transcript-maybe-prefix-as-value result))))
       (unless (bolp) (insert "\n"))
       (let ((inhibit-read-only t))
         (put-text-property (- (point) 2) (point)
@@ -3151,11 +3296,14 @@
     (overlay-put overlay 'face 'slime-repl-input-face)
     (overlay-put overlay 'rear-nonsticky '(face slime-repl-old-input-counter)))
   (let ((input (slime-repl-current-input)))
+    (slime-repl-transcript-maybe-prefix-as-input input)
+    (setq slime-repl-transcript-autoprint-conditions 
+          slime-repl-transcript-make-transcript) ; disabled in s-r-insert-prompt
     (goto-char slime-repl-input-end-mark)
     (slime-mark-input-start)
     (slime-mark-output-start)
     (slime-repl-send-string input)))
-
+  
 (defun slime-repl-grab-old-input (replace)
   "Resend the old REPL input at point.  
 If replace it non-nil the current input is replaced with the old
@@ -3616,6 +3764,10 @@
               (slime-repl-send-input)))
   (:one-liner "Define a new global, special, variable."))
 
+(defslime-repl-shortcut slime-repl-transcript-toggle ("transcript")
+  (:handler 'slime-repl-transcript-toggle-transcript-printing)
+  (:one-liner "Toggle printing input, output, errors, and return values with prefixes."))
+
 (defslime-repl-shortcut slime-repl-compile-and-load ("compile-and-load" "cl")
   (:handler (lambda (filename)
               (interactive (list (expand-file-name
@@ -7393,7 +7545,8 @@
     (error "No condition known (wrong buffer?)"))
   (slime-output-string (format "%s\n%s\n"
                                (first sldb-condition)
-                               (second sldb-condition))))
+                               (second sldb-condition))
+                       #'slime-repl-transcript-maybe-prefix-as-error))
 
 
 ;;;; Thread control panel
