diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index d271db27d..29b7d198c 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,9 @@ +Mon Aug 25 22:00:44 1997 Mikael Djurfeldt + + * emacs.scm (object->string, format, error-args->string): New + procedures. + (emacs-frame-eval): Reworked. + Mon Aug 25 16:15:55 1997 Mikael Djurfeldt * session.scm (apropos-internal): Musn't initialize symbol diff --git a/ice-9/emacs.scm b/ice-9/emacs.scm index a3d162799..8bad32624 100644 --- a/ice-9/emacs.scm +++ b/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,12 +192,51 @@ '()))) '()))) +(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)) - '())))) + (if 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) (if (or (not (module-bound? (current-module) symbol))