Better error presentation.

2 files changed, 24 insertions, 5 deletions

diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el
index 74c9b29..8466a36 100644
--- a/elisp/geiser-eval.el
+++ b/elisp/geiser-eval.el
@@ -104,8 +104,13 @@
 
 (defsubst geiser-eval--retort-p (ret)
   (and (listp ret) (or (assoc 'error ret) (assoc 'result ret))))
-(defsubst geiser-eval--retort-error (ret) (cdr (assoc 'error ret)))
 (defsubst geiser-eval--retort-result (ret) (cdr (assoc 'result ret)))
+(defsubst geiser-eval--retort-error (ret) (cdr (assoc 'error ret)))
+
+(defsubst geiser-eval--error-key (err) (cdr (assoc 'key err)))
+(defsubst geiser-eval--error-subr (err) (cdr (assoc 'subr err)))
+(defsubst geiser-eval--error-msg (err) (cdr (assoc 'msg err)))
+(defsubst geiser-eval--error-rest (err) (cdr (assoc 'rest err)))
 
 
 (provide 'geiser-eval)
diff --git a/scheme/geiser/eval.scm b/scheme/geiser/eval.scm
index 3e800c9..81b2647 100644
--- a/scheme/geiser/eval.scm
+++ b/scheme/geiser/eval.scm
@@ -25,18 +25,32 @@
 ;;; Code:
 
 (define-module (geiser eval)
-  #:export (eval-in))
+  #:export (eval-in)
+  #:use-module (srfi srfi-1))
 
 (define (eval-in form module-name)
   "Evals FORM in the module designated by MODULE-NAME.
 If MODULE-NAME is #f or resolution fails, the current module is used instead.
 The result is a list of the form ((RESULT . <form-value>))
-if no evaluation error happens, or ((ERROR <error-key> <error-arg>...))
-in case of errors."
+if no evaluation error happens, or ((ERROR (KEY . <error-key>) <error-arg>...))
+in case of errors. Each error arg is a cons (NAME . VALUE), where NAME includes
+SUBR, MSG and REST."
   (let ((module (or (and module-name (resolve-module module-name))
                     (current-module))))
     (catch #t
       (lambda () (list (cons 'result (eval form module))))
-      (lambda (key . args) (list (cons 'error (cons key args)))))))
+      (lambda (key . args)
+        (list (cons 'error (apply parse-error (cons key args))))))))
+
+(define (parse-error key . args)
+  (let* ((len (length args))
+         (subr (and (> len 0) (first args)))
+         (msg (and (> len 1) (second args)))
+         (margs (and (> len 2) (third args)))
+         (rest (and (> len 3) (fourth args))))
+    (list (cons 'key key)
+          (cons 'subr (or subr '()))
+          (cons 'msg (if msg (apply format (cons #f (cons msg margs))) '()))
+          (cons 'rest (or rest '())))))
 
 ;;; eval.scm ends here