* emacs.scm (object->string, format, error-args->string): New

procedures.
(emacs-frame-eval): Reworked.

ice-9/ChangeLog

@@ -1,3 +1,9 @@
+Mon Aug 25 22:00:44 1997  Mikael Djurfeldt  <mdj@mdj.nada.kth.se>
+
+	* emacs.scm (object->string, format, error-args->string): New
+	procedures.
+	(emacs-frame-eval): Reworked.
+
 Mon Aug 25 16:15:55 1997  Mikael Djurfeldt  <mdj@mdj.nada.kth.se>
 
 	* session.scm (apropos-internal): Musn't initialize symbol

ice-9/emacs.scm

@@ -167,6 +167,7 @@
 (define (emacs-eval-request form)
   (result-to-emacs (eval form)))
 
+;;*fixme* Not necessary to use flags no-stack and no-source
 (define (get-frame-source frame)
   (if (or (not the-last-stack)
 	  (>= frame (stack-length the-last-stack)))
@@ -191,11 +192,50 @@
 		     '())))
 	'())))
 
+(define (object->string x . method)
+  (with-output-to-string
+    (lambda ()
+      ((if (null? method)
+	   write
+	   (car method))
+       x))))
+
+(define (format template . rest)
+  (let loop ((chars (string->list template))
+	     (result '()))
+    (cond ((null? chars) (list->string (reverse result)))
+	  ((char=? (car chars) #\%)
+	   (loop (cddr chars)
+		 (append (reverse
+			  (string->list
+			   (case (cadr chars)
+			     ((#\S) (object->string (car rest)))
+			     ((#\s) (object->string (car rest) display)))))
+			 result)))
+	  (else (loop (cdr chars) (cons (car chars) result))))))
+
+(define (error-args->string args)
+  (let ((msg (apply format (caddr args) (cadddr args))))
+    (if (symbol? (cadr args))
+	(string-append (symbol->string (cadr args))
+		       ": "
+		       msg)
+	msg)))
+
 (define (emacs-frame-eval frame form)
   (let ((source (get-frame-source frame)))
-    (result-to-emacs
     (if source
-	 (local-eval form (memoized-environment source))
+	(catch #t
+	       (lambda ()
+		 (list 'result
+		       (object->string
+			(local-eval (with-input-from-string form read)
+				    (memoized-environment source)))))
+	       (lambda args
+		 (list (car args)
+		       (error-args->string args))))
+	(begin
+	  (no-source)
 	  '()))))
 
 (define (emacs-symdoc symbol)